From 3d5707d5f8129d949a4d6fe48c1b3e5eda41edc9 Mon Sep 17 00:00:00 2001
From: drewc <drewc@tech.coop>
Date: Thu, 28 Aug 2008 13:17:41 -0700
Subject: [PATCH] Error handling fixes

darcs-hash:20080828201741-39164-3681c55dbcfda08944e3a285cbca9e4e4a12f17f.gz
---
 src/attribute.lisp         | 4 +++-
 src/description-class.lisp | 9 +++++----
 src/description.lisp       | 7 ++++---
 3 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/src/attribute.lisp b/src/attribute.lisp
index d332f60..8f3f862 100644
--- 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
--- 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
--- 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))
-- 
2.20.1