From: drewc <drewc@tech.coop>
Date: Fri, 17 Jun 2005 04:03:59 +0000 (-0700)
Subject: added better equality checks for clsql-wall-time slot changes
X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/commitdiff_plain/f4170204d3e46318a4132389e5ca6139dd55c8f2?ds=sidebyside

added better equality checks for clsql-wall-time slot changes

darcs-hash:20050617040359-39164-064ac2a65594f0df9dc41b617c272b27ce429b56.gz
---

diff --git a/src/mewa/slot-presentations.lisp b/src/mewa/slot-presentations.lisp
index 4d89895..3df3e1b 100644
--- 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)"))