X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/6f63d3a4f93eb311344748b5698a63ce42dd1813..91f2ab7b92b3a1c3c7e419ce15843e1126755e99:/src/mewa.lisp

diff --git a/src/mewa.lisp b/src/mewa.lisp
index 850ece6..292f351 100644
--- a/src/mewa.lisp
+++ b/src/mewa.lisp
@@ -22,7 +22,8 @@ in both PLIST and NEW-PROPS get the value in NEW-PROPS.
 The other properties in PLIST are left untouched."
   (loop for cons on new-props by #'cddr
 	do (setf (getf plist (first cons)) (second cons))
-	finally (return plist)))
+	finally (return plist))
+  plist)
 
 (defun plist-union (new-props plist)
   "Non-destructive version of plist-nunion"
@@ -75,14 +76,16 @@ Attributes are the metadata used to display, validate, and otherwise manipulate
     (:documentation "Attributes are used to display a part of a thing, such as a slot of an object, a text label, the car of a list, etc."))
 
 (defmacro defattribute (name supers slots &rest args)
-  (let ((type (or (second (assoc :type-name args)) name) ))
+  (let ((type (or (second (assoc :type-name args)) name))
+	(properties (cdr (assoc :default-properties args))))
     `(progn
       
       (define-layered-class
-	  ;;;; TODO: naive way of making sure s-a is a superclass
+	  ;;;; TODO: fix the naive way of making sure s-a is a superclass
 	  ,name ,(or supers '(standard-attribute))
 	  ,slots
-	  #+ (or) ,@ (cdr args) )
+	  #+ (or) ,@ (cdr args)
+	  (:default-initargs :plist (list ,@properties)))
       (defmethod find-attribute-class-for-type ((type (eql ',type)))
 	',name))))
 
@@ -111,9 +114,12 @@ using the attributes defined in an occurence. Presentation Attributes are always
       'standard-attribute))
 
 (defun make-attribute (&key name type plist)
-  (make-instance (or (find-attribute-class-for-type type)
+  (let ((i (make-instance (or (find-attribute-class-for-type type)
 		     (find-attribute-class-for-name name)) 
-		 :name name :type type :plist plist))
+		 :name name :type type)))
+    (setf (attribute.plist i)
+	  (plist-union plist (attribute.plist i)))
+    i)) 
 
 (defmethod ensure-attribute ((occurence standard-occurence) name type plist)
   "Creates an attribute in the given occurence"
@@ -206,8 +212,6 @@ using the attributes defined in an occurence. Presentation Attributes are always
 (define-layered-function attribute-value (instance attribute)
   (:documentation " Like SLOT-VALUE for instances, the base method calls GETTER."))
 
-
-
 (define-layered-method attribute-value (instance (attribute standard-attribute))
   (funcall (getter attribute) instance))