152 |
(unless (or parent-list (eq name 'condition)) |
(unless (or parent-list (eq name 'condition)) |
153 |
(setq parent-list (list 'condition))) |
(setq parent-list (list 'condition))) |
154 |
(let* ((REPORT-FUNCTION nil) |
(let* ((REPORT-FUNCTION nil) |
155 |
|
(DEFAULT-INITARGS nil) |
156 |
(DOCUMENTATION nil)) |
(DOCUMENTATION nil)) |
157 |
(DO ((O OPTIONS (CDR O))) |
(DO ((O OPTIONS (CDR O))) |
158 |
((NULL O)) |
((NULL O)) |
163 |
(DECLARE (IGNORE CONDITION)) |
(DECLARE (IGNORE CONDITION)) |
164 |
(WRITE-STRING ,(CADR OPTION) STREAM)) |
(WRITE-STRING ,(CADR OPTION) STREAM)) |
165 |
(CADR OPTION)))) |
(CADR OPTION)))) |
166 |
|
(:DEFAULT-INITARGS (SETQ DEFAULT-INITARGS OPTION)) |
167 |
(:DOCUMENTATION (SETQ DOCUMENTATION (CADR OPTION))) |
(:DOCUMENTATION (SETQ DOCUMENTATION (CADR OPTION))) |
168 |
(OTHERWISE (CERROR "Ignore this DEFINE-CONDITION option." |
(OTHERWISE (CERROR "Ignore this DEFINE-CONDITION option." |
169 |
"Invalid DEFINE-CONDITION option: ~S" OPTION))))) |
"Invalid DEFINE-CONDITION option: ~S" OPTION))))) |
170 |
`(progn |
`(progn |
171 |
(eval-when (compile) |
(eval-when (compile) |
172 |
#+pcl (setq pcl::*defclass-times* '(compile load eval))) |
#+pcl (setq pcl::*defclass-times* '(compile load eval))) |
173 |
(defclass ,name ,parent-list |
,(if default-initargs |
174 |
,slot-specs) |
`(defclass ,name ,parent-list ,slot-specs ,default-initargs) |
175 |
|
`(defclass ,name ,parent-list ,slot-specs)) |
176 |
(eval-when (compile load eval) |
(eval-when (compile load eval) |
177 |
(pushnew '(,name ,parent-list |
(pushnew '(,name ,parent-list |
178 |
,@(mapcan #'(lambda (slot-spec) |
,@(mapcan #'(lambda (slot-spec) |