X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcondition.lisp;h=ae934684ebe9fd914bc30ab96e78dcbce114a9ff;hb=5369caf4d418065012b96af0d29c74d7851c04ff;hp=165fa06c7c5a8288138d01d8a4db47764ff5630f;hpb=ef793f0d484ac3a527e945a62c93f904d73049a6;p=sbcl.git

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 165fa06..ae93468 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -391,6 +391,8 @@
         (lambda (new-value condition)
           (condition-writer-function condition new-value slot-name))))
 
+(defvar *define-condition-hooks* nil)
+
 (defun %define-condition (name parent-types layout slots documentation
                           report default-initargs all-readers all-writers
                           source-location)
@@ -440,7 +442,10 @@
                        (dolist (initarg (condition-slot-initargs slot) nil)
                          (when (functionp (getf e-def-initargs initarg))
                            (return t))))
-               (push slot (condition-classoid-hairy-slots class))))))))
+               (push slot (condition-classoid-hairy-slots class)))))))
+      (when (boundp '*define-condition-hooks*)
+        (dolist (fun *define-condition-hooks*)
+          (funcall fun class))))
     name))
 
 (defmacro define-condition (name (&rest parent-types) (&rest slot-specs)
@@ -831,7 +836,8 @@
      (destructuring-bind (type data) (cdr reference)
        (ecase type
          (:initialization
-          (format stream "Initialization of ~A Metaobjects" data))
+          (format stream "Initialization of ~:(~A~) Metaobjects"
+                  (substitute #\  #\- (symbol-name data))))
          (:generic-function (format stream "Generic Function ~S" data))
          (:section (format stream "Section ~{~D~^.~}" data)))))
     (:ansi-cl