X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/268f7777bf1c2f858ce2c5cb990f3e2ec42f0646..999a0e357c7d10da5ebc0ecff42a3e94e6a5a639:/src/pset-proto.lisp

diff --git a/src/pset-proto.lisp b/src/pset-proto.lisp
index 0263dc7..2326eba 100644
--- a/src/pset-proto.lisp
+++ b/src/pset-proto.lisp
@@ -290,7 +290,7 @@
 	  ((endp list) pset)
 	(add-property pset (funcall name list) (funcall value list))))))
 
-(export 'check--unused-properties)
+(export 'check-unused-properties)
 (defun check-unused-properties (pset)
   "Issue errors about unused properties in PSET."
   (when pset
@@ -306,7 +306,7 @@
 ;;; Utility macros.
 
 (defmacro default-slot-from-property
-    ((instance slot slot-names)
+    ((instance slot &optional (slot-names t))
      (pset property type
       &optional (pvar (gensym "PROP-"))
       &rest convert-forms)
@@ -321,14 +321,18 @@
    slot value."
 
   (once-only (instance slot slot-names pset property type)
-    (with-gensyms (floc)
-      `(multiple-value-bind (,pvar ,floc)
-	   (get-property ,pset ,property ,type)
-	 (if ,floc
-	     (setf (slot-value ,instance ,slot)
-		   (with-default-error-location (,floc)
-		     ,@(or convert-forms `(,pvar))))
-	     (default-slot (,instance ,slot ,slot-names)
-	       ,@default-forms))))))
+    (multiple-value-bind (docs decls body)
+	(parse-body default-forms :docp nil)
+      (declare (ignore docs))
+      (with-gensyms (floc)
+	`(multiple-value-bind (,pvar ,floc)
+	     (get-property ,pset ,property ,type)
+	   ,@decls
+	   (if ,floc
+	       (setf (slot-value ,instance ,slot)
+		     (with-default-error-location (,floc)
+		       ,@(or convert-forms `(,pvar))))
+	       (default-slot (,instance ,slot ,slot-names)
+		 ,@body)))))))
 
 ;;;----- That's all, folks --------------------------------------------------