-(in-package :mewa)
+(in-package :lisp-on-lines)
(defparameter *default-type* :ucw)
(defun find-presentation-attributes (model)
(remove nil (mapcar #'(lambda (att)
(when (keywordp (car att))
- att))
+ (copy-list att) ))
(cdr (find-class-attributes model)))))
(: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))
(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))))
(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))))))
(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)
(initialize-slots p)
(assoc type (find-all-attributes p))))
(symbol-name type)
type))
(plist-union initargs (cddr a)))))
+
(setf (slot-value i 'instance) object)
(initialize-slots i)
(setf (slot-value i 'initializedp) t)
i))
-(defmethod make-presentation ((list list) &key (type :listing) (initargs nil))
-
+(defmethod make-presentation ((list list) &key (type :listing) (initargs nil))
(let ((args (append
`(:type ,type)
`(:initargs
(call-next-method)
(render-on res (slot-value self 'body)))
-(defmethod instance-is-stored-p ((instance clsql:standard-db-object))
- (slot-value instance 'clsql-sys::view-database))
-(defmethod instance-is-stored-p ((mewa mewa))
- (instance-is-stored-p (instance mewa)))
+
(defaction cancel-save-instance ((self mewa))
(cond
- ((instance-is-stored-p (instance self))
+ ((meta-model::persistentp (instance self))
(meta-model::update-instance-from-records (instance self))
(answer self))
(t (answer nil))))