1 ;;; container.lisp --- Container management
3 ;; Copyright (C) 2010, 2011 Didier Verna
5 ;; Author: Didier Verna <didier@lrde.epita.fr>
6 ;; Maintainer: Didier Verna <didier@lrde.epita.fr>
8 ;; This file is part of Clon.
10 ;; Permission to use, copy, modify, and distribute this software for any
11 ;; purpose with or without fee is hereby granted, provided that the above
12 ;; copyright notice and this permission notice appear in all copies.
14 ;; THIS SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
15 ;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
16 ;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
17 ;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
18 ;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
19 ;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
20 ;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
25 ;; Contents management by FCM version 0.1.
30 (in-package :com.dvlsoft.clon
)
31 (in-readtable :com.dvlsoft.clon
)
34 ;; ==========================================================================
35 ;; The Container Class
36 ;; ==========================================================================
38 (defabstract container
(item)
39 ((items :documentation
"The items in the container."
44 (:documentation
"The CONTAINER class.
45 This class is a mixin used in synopsis and groups to represent the program's
46 command-line hierarchy."))
53 (defmethod untraverse ((container container
))
54 "Untraverse all CONTAINER items."
55 (dolist (item (items container
))
60 ;; -------------------------
61 ;; Name clash check protocol
62 ;; -------------------------
64 (defmethod check-name-clash ((container container
) item2
)
65 "Check for name clash between CONTAINER's options and ITEM2's ones."
66 (dolist (item1 (items container
))
67 (check-name-clash item1 item2
)))
69 (defmethod check-name-clash (item1 (container container
))
70 "Check for name clash between ITEM1's options and CONTAINER's ones."
71 (dolist (item2 (items container
))
72 (check-name-clash item1 item2
)))
74 (defmethod check-name-clash ((container1 container
) (container2 container
))
75 "Check for name clash between CONTAINER1's options and CONTAINER2's ones."
76 (dolist (item1 (items container1
))
77 (dolist (item2 (items container2
))
78 (check-name-clash item1 item2
))))
81 ;; -------------------------
82 ;; Help specifation protocol
83 ;; -------------------------
85 (defmethod help-spec ((container container
) &key
)
86 "Return CONTAINER's help specification."
87 (loop :for item
:in
(items container
)
88 :when
(help-spec item
)
93 ;; ==========================================================================
94 ;; Container Instance Creation
95 ;; ==========================================================================
97 (defmethod initialize-instance :around
98 ((container container
) &rest keys
&key item
)
99 "Canonicalize initialization arguments.
101 - computing the :items initarg from the :item ones."
102 (declare (ignore item
))
103 (apply #'call-next-method container
104 :items
(remove :item
(select-keys keys
:item
))
105 (remove-keys keys
:item
)))
107 (defmethod initialize-instance :after
((container container
) &key
)
108 "Perform name clash check on CONTAINER's items."
109 (loop :for items
:on
(items container
)
111 :do
(loop :for item2 in
(cdr items
)
112 :do
(check-name-clash (car items
) item2
))))
115 ;;; container.lisp ends here