Error handling fixes

darcs-hash:20080828201741-39164-3681c55dbcfda08944e3a285cbca9e4e4a12f17f.gz

diff --git a/src/attribute.lisp b/src/attribute.lisp
index d332f60..8f3f862 100644 (file)
--- a/src/attribute.lisp
+++ b/src/attribute.lisp
@@ -290,7 +290,9 @@
                (with-function-access 
                  (slot-value-using-class class attribute property))
                (funcall fn layer (attribute-description attribute)))
-           (funcall fn layer (attribute-description attribute))))))
+           (handler-case (funcall fn layer (attribute-description attribute))
+             (error ()
+               (warn "Error calling ~A" fn)))))))
                    
              
 

diff --git a/src/description-class.lisp b/src/description-class.lisp
index fb6e7ff..de1fc0c 100644 (file)
--- a/src/description-class.lisp
+++ b/src/description-class.lisp
@@ -92,7 +92,7 @@
                (mapcar 
                 (lambda (slot)
                   (or (find-attribute description 
-                                      (slot-definition-name slot))
+                                      (slot-definition-name slot) nil)
                       (let* ((*init-time-description* description)
                              (attribute-class (or 
                                                (ignore-errors 
@@ -129,7 +129,7 @@
                                initargs )
                         (setf (slot-value description (attribute-name attribute)) 
                               (attribute-class attribute))
-                        (apply #'change-class attribute  (attribute-class attribute)
+                        (apply #'change-class attribute  (find-class (attribute-class attribute))
                                initargs)))))))))
 
 
@@ -232,8 +232,9 @@
   (print-unreadable-object (object stream :type t :identity t)
     (princ  (ignore-errors (description-print-name (find-layer object))) stream)))
 
-(defun find-description (name)
-  (find-layer (find-class (defining-description name))))
+(defun find-description (name &optional (errorp t))
+  (let ((class (find-class (defining-description name) errorp)))
+    (when class (find-layer class))))
 
 
 

diff --git a/src/description.lisp b/src/description.lisp
index b64f611..bb1f88a 100644 (file)
--- a/src/description.lisp
+++ b/src/description.lisp
@@ -28,9 +28,10 @@
           #'attribute-active-p
           (description-attributes description)))
 
-(defun find-attribute (description attribute-name)
-  (find attribute-name (description-attributes description)
-       :key #'attribute-name))
+(defun find-attribute (description attribute-name &optional (errorp t))
+  (or (find attribute-name (description-attributes description)
+           :key #'attribute-name)
+      (when errorp (error "No attribute named ~A found in ~A" attribute-name description))))
 
 (define-layered-function description-active-descriptions (description)
   (:method ((description standard-description-object))