fixed the breakage i checked in earlier

[clinton/lisp-on-lines.git] / src / mewa / slot-presentations.lisp

diff --git a/src/mewa/slot-presentations.lisp b/src/mewa/slot-presentations.lisp
index 4d89895..131d01c 100644 (file)
--- a/src/mewa/slot-presentations.lisp
+++ b/src/mewa/slot-presentations.lisp
@@ -1,7 +1,7 @@
 (in-package :it.bese.ucw)
 
 
-(defslot-presentation clsql-wall-time-slot-presentation ()
+(defslot-presentation clsql-wall-time-slot-presentation (mewa-relation-slot-presentation)
        ()
        (:type-name clsql-sys:wall-time))
 
@@ -11,7 +11,13 @@
       (format nil "~a/~a/~a" m d y)))))
 
 (defmethod (setf presentation-slot-value) ((value string) (slot clsql-wall-time-slot-presentation) instance)
-  (setf (presentation-slot-value slot instance) (clsql:parse-date-time (remove #\Space value))))
+  (let ((new-time (clsql:parse-date-time (remove #\Space value)))
+       (old-time (when (slot-boundp instance (slot-name slot))
+                   (slot-value instance (slot-name slot)))))
+    (unless (or (eql old-time new-time)
+               (and (null old-time) new-time)
+                (equal :equal (clsql:time-compare new-time old-time)))
+      (setf (presentation-slot-value slot instance) new-time ))))
 
 (defmethod label :around ((slot clsql-wall-time-slot-presentation))
   (concatenate 'string (call-next-method) "  (mm/dd/yyyy)"))
@@ -36,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))
@@ -50,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) 
@@ -58,6 +88,8 @@
        (t       
         (render))))))
 
+
+
 (defmethod present-slot ((slot mewa-relation-slot-presentation) instance)
   (present-relation slot instance))