/[gcl]/gcl/clcs/clcs_conditions.lisp
ViewVC logotype

Diff of /gcl/clcs/clcs_conditions.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by pfdietz, Sat Mar 15 22:18:33 2003 UTC revision 1.3 by camm, Thu Sep 25 16:11:28 2003 UTC
# Line 152  Line 152 
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))
# Line 162  Line 163 
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)

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26