From 7d87c1d23f23c4aa5632712191ee989240afe80a Mon Sep 17 00:00:00 2001
From: drewc <drewc@tech.coop>
Date: Thu, 16 Jun 2005 21:05:23 -0700
Subject: [PATCH 1/1] added search for fkeys

darcs-hash:20050617040523-39164-66009298fe43e6ecfc8a1edec7537af4b5be2af0.gz
---
 src/mewa/slot-presentations.lisp | 28 +++++++++++++++++++++++++++-
 1 file changed, 27 insertions(+), 1 deletion(-)

diff --git a/src/mewa/slot-presentations.lisp b/src/mewa/slot-presentations.lisp
index 3df3e1b..131d01c 100644
--- a/src/mewa/slot-presentations.lisp
+++ b/src/mewa/slot-presentations.lisp
@@ -42,6 +42,30 @@
    (linkedp :accessor linkedp :initarg :linkedp :initform t))
   (:type-name relation))
 
+(defun get-fkey-data (instance slot-name)
+  "ugly workaround b/c UCW does not like M-V-B"
+  (multiple-value-bind (finstance foreign-slot-name)
+      (meta-model:explode-foreign-key instance slot-name)
+    (cons finstance foreign-slot-name)))
+
+(defaction search-records ((slot mewa-relation-slot-presentation) instance)
+  (let* ((d (get-fkey-data instance (slot-name slot)))
+	 (finstance (car d))
+	 (foreign-slot-name (cdr d))
+	 (new-instance
+    (call-component 
+     (parent slot) 
+     (make-instance 'mewa::mewa-presentation-search
+		    :search-presentation
+		    (mewa:make-presentation finstance 
+					    :type :search-presentation)
+		    :list-presentation 
+		    (mewa:make-presentation finstance 
+					    :type :listing)))))
+    (setf (slot-value instance (slot-name slot)) (slot-value new-instance foreign-slot-name))
+    (meta-model:sync-instance instance)
+    (clsql:update-objects-joins (list instance))))
+    
 (defmethod present-relation ((slot mewa-relation-slot-presentation) instance)
  ;;;;(<:as-html (slot-name slot) "=> " (foreign-instance slot) " from " instance )
   (let* ((i (foreign-instance slot))
@@ -56,7 +80,7 @@
       (cond 
 	((editablep slot)
 	 (render)
-	 (<ucw:a :action (search-records slot i) (<:as-html " (search)"))
+	 (<ucw:a :action (search-records slot instance) (<:as-html " (search)"))
 	 (<ucw:a :action (create-record slot i) (<:as-html " (new)")))
 	((linkedp slot)
 	 (<ucw:a :action (view-instance slot i) 
@@ -64,6 +88,8 @@
 	(t       
 	 (render))))))
 
+
+
 (defmethod present-slot ((slot mewa-relation-slot-presentation) instance)
   (present-relation slot instance))
 
-- 
2.20.1