From: Drew Crampsie <drewc@tech.coop>
Date: Sat, 29 Oct 2005 11:28:05 +0000 (-0700)
Subject: fixed has-a slot presentations
X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/commitdiff_plain/63c06c541289a6669a5d03c6076b71ff37e4b49d?hp=e5b53af49b8be7c10931bd37eaaec91fab34ea1c

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
--- 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))))))
diff --git a/src/slot-presentations.lisp b/src/slot-presentations.lisp
index 6acc8a9..95e8c8e 100644
--- 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))))))
 
-(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)
@@ -321,26 +316,46 @@ Calendar.setup({
 		   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))
 
-(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)
-      (<:as-html (presentation-slot-value slot instance))
+;      (<:as-html (presentation-slot-value slot instance))
   (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)
-	  (<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
-	    (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)
@@ -376,8 +391,6 @@ Calendar.setup({
 		     :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))