X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/13ada38fa5b2a6f9e1158b3f5365238de5dce84c..598f1fa8d4a53d8b531ee283b69bba52f3a4bd13:/src/mewa.lisp diff --git a/src/mewa.lisp b/src/mewa.lisp index 4ef3ef8..be27094 100644 --- a/src/mewa.lisp +++ b/src/mewa.lisp @@ -121,6 +121,7 @@ attributes is an alist keyed on the attribute name." (:viewer mewa-viewer) (:editor mewa-editor) (:creator mewa-creator) + (:as-string mewa-one-line-presentation) (:one-line mewa-one-line-presentation) (:listing mewa-list-presentation :global-properties (:editablep nil) :editablep t) (:search-model mewa-object-presentation)) @@ -277,13 +278,12 @@ attributes is an alist keyed on the attribute name." (cons (car def) new))) ;;finally if we are just overiding the props ((and (listp x) (symbolp (car x))) + (let ((new (cdr (apply #'make-attribute (cdr x)))) (def (gen-att (car x)))) + (setf (cdr new) (plist-union (cdr new) (cddr def))) - (cons (car def) (cons (second def) (cdr new))))) - - ) - ) + (cons (car def) (cons (second def) (cdr new))))))) (attributes self))) all-attributes)))) @@ -295,7 +295,7 @@ attributes is an alist keyed on the attribute name." (second attribute)) *presentation-slot-type-mapping*) (error "Can't find slot type for ~A in ~A" attribute self )))) - + (cons (first attribute) (apply #'make-instance class-name (append (cddr attribute) (list :parent self :size 30)))))) @@ -318,7 +318,7 @@ attributes is an alist keyed on the attribute name." (defmethod make-presentation ((object t) &key (type :viewer) (initargs nil)) - + ;(warn "Initargs : ~A" initargs) (let* ((p (make-instance 'mewa-object-presentation)) (a (progn (setf (slot-value p 'instance) object) @@ -333,7 +333,6 @@ attributes is an alist keyed on the attribute name." type)) (plist-union initargs (cddr a))))) - (setf (slot-value i 'instance) object) (initialize-slots i) (setf (slot-value i 'initializedp) t)