fixed has-a slot presentations

darcs-hash:20051029112805-5417e-269cf649d6a70577c279ad6112776c3345d9df77.gz

diff --git a/src/mewa.lisp b/src/mewa.lisp
index 4ef3ef8..37f84d9 100644 (file)
--- 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)
   (: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))
   (: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)))
                                (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))))
                              (let ((new (cdr (apply #'make-attribute (cdr x))))
                                    (def (gen-att (car x))))

+                                

                                (setf (cdr new) (plist-union (cdr new) (cddr def)))
                                (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))))
                                   
                        (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 ))))
                          (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))))))
     (cons (first attribute) (apply #'make-instance 
                                   class-name
                                   (append (cddr attribute) (list :parent self :size 30))))))

diff --git a/src/slot-presentations.lisp b/src/slot-presentations.lisp
index 6acc8a9..95e8c8e 100644 (file)
--- a/src/slot-presentations.lisp
+++ b/src/slot-presentations.lisp
@@ -212,12 +212,7 @@ Calendar.setup({
 (defmethod find-foreign-instances ((slot foreign-key-slot-presentation))
   (clsql:select (class-name (class-of (meta-model:explode-foreign-key (instance slot) (slot-name slot))))))
 
 (defmethod find-foreign-instances ((slot foreign-key-slot-presentation))
   (clsql:select (class-name (class-of (meta-model:explode-foreign-key (instance slot) (slot-name slot))))))
 

-(defslot-presentation has-a-slot-presentation (foreign-key-slot-presentation)
-  ()
-  (:type-name has-a))

 
 

-(defmethod present-slot ((slot has-a-slot-presentation) instance)
-  t)

 
 ;;;; HAS MANY 
 (defslot-presentation has-many-slot-presentation (mewa-relation-slot-presentation)
 
 ;;;; HAS MANY 
 (defslot-presentation has-many-slot-presentation (mewa-relation-slot-presentation)


@@ -321,26 +316,46 @@ Calendar.setup({
                   for i from 0 upto (number-to-display slot)
                   collect (car cons))))
 
                   for i from 0 upto (number-to-display slot)
                   collect (car cons))))
 

-(defslot-presentation has-a-slot-presentation (one-of-presentation)
-  ((key :initarg :key :accessor key))
+
+;;;; * Has-a
+(defslot-presentation has-a-slot-presentation (mewa-relation-slot-presentation)
+  ((allow-nil-p :accessor allow-nil-p :initarg :allow-nil-p :initform t)
+   (attributes :accessor attributes :initarg :attributes :initform nil))

   (:type-name has-a))
 
   (:type-name has-a))
 

-(defmethod get-foreign-slot-value ((slot has-a-slot-presentation) (object t) (slot-name t))
-  (slot-value object slot-name))
+(defmethod find-foreign-slot-value ((slot has-a-slot-presentation) (object t))
+  (multiple-value-bind (c s)      
+      (meta-model:explode-foreign-key (instance (ucw::parent slot)) (slot-name slot))
+    (slot-value object s)))
+
+(defmethod get-foreign-instances ((slot mewa-relation-slot-presentation) instance)
+  (clsql:select (class-name (class-of
+                            (meta-model:explode-foreign-key instance (slot-name slot))))
+               :flatp t))

 
 (defmethod present-slot ((slot has-a-slot-presentation) instance)
 
 (defmethod present-slot ((slot has-a-slot-presentation) instance)

-      (<:as-html (presentation-slot-value slot instance))
+;      (<:as-html (presentation-slot-value slot instance))

   (if (editablep slot)
   (if (editablep slot)

-      (<ucw:select :accessor (presentation-slot-value slot instance) :test #'equalp
+      (progn (<ucw:select :accessor (presentation-slot-value slot instance) :test #'equalp

         (when (allow-nil-p slot)
         (when (allow-nil-p slot)

-         (<ucw:option :value nil (<:as-html (none-label slot))))
-       (dolist (option (get-foreign-instances (presentation slot) instance))
-         (setf (instance (presentation slot)) option)
-         (<ucw:option :value (get-foreign-slot-value slot option (key slot)) (present (presentation slot)))))
+         (<ucw:option :value nil (<:as-html "none")))
+       (dolist (option (get-foreign-instances slot instance))
+         (<ucw:option :value (find-foreign-slot-value slot option)
+                      (lol:present
+                       (lol:make-presentation option
+                          :type :as-string
+                          :initargs
+                          `(:attributes ,(attributes slot)))
+                       ))))
+            (<ucw:submit :action  (create-record-on-foreign-key slot instance) :value "Add New" :style "display:inline")) 

       (if (presentation-slot-value slot instance)
          (progn
       (if (presentation-slot-value slot instance)
          (progn

-           (setf (instance (presentation slot)) (presentation-slot-value slot instance))
-           (present (presentation slot)))
+          (lol:present
+           (lol:make-presentation (meta-model:explode-foreign-key instance (slot-name slot))
+                          :type :one-line
+                          :initargs
+                          `(:attributes ,(attributes slot)))
+                          ))

          (<:as-html "--"))))
 
 (defslot-presentation many-to-many-slot-presentation (mewa-relation-slot-presentation)
          (<:as-html "--"))))
 
 (defslot-presentation many-to-many-slot-presentation (mewa-relation-slot-presentation)


@@ -376,8 +391,6 @@ Calendar.setup({
                     :db-info)))
     (getf jcmd :join-class)))
 
                     :db-info)))
     (getf jcmd :join-class)))
 

-
-

 (defmethod find-all-instances ((slot many-to-many-slot-presentation) instance)
   (clsql:select (find-many-to-many-join-class slot instance) :flatp t))
 
 (defmethod find-all-instances ((slot many-to-many-slot-presentation) instance)
   (clsql:select (find-many-to-many-join-class slot instance) :flatp t))