beginnings of a test component.

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

diff --git a/src/static-presentations.lisp b/src/static-presentations.lisp
index bdc0b5e..68541d9 100644 (file)
--- a/src/static-presentations.lisp
+++ b/src/static-presentations.lisp
@@ -422,7 +422,21 @@ This method is also used by relation-slot-presentations for the same reason."))
   (:type-name boolean))
 
 (defmethod present-slot ((slot boolean-slot-presentation) instance)
   (:type-name boolean))
 
 (defmethod present-slot ((slot boolean-slot-presentation) instance)

-  (<ucw:input :type "checkbox" :accessor (presentation-slot-value slot instance)))
+  (if (editablep slot)
+    (let ((callback (ucw::make-new-callback
+                  (lambda (val)
+                    
+                    (if (listp val)
+                        (setf (presentation-slot-value slot instance) t)
+                        (setf (presentation-slot-value slot instance) nil))))))
+    (<:input :type "hidden" :name callback :value "DEFAULT")
+    (<:input :type "checkbox"
+            :name callback
+            :checked  (slot-value instance (slot-name slot))))
+    (<:as-html
+     (if (presentation-slot-value slot instance)
+        "YES"
+        "NO"))))

 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; strings
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; strings


@@ -561,7 +575,7 @@ This method is also used by relation-slot-presentations for the same reason."))
   (unless (string= "" value)
     (let ((i (parse-integer value :junk-allowed t)))
       (when i
   (unless (string= "" value)
     (let ((i (parse-integer value :junk-allowed t)))
       (when i

-       (setf (presentation-slot-value slot instance) (parse-integer value))))))
+       (setf (presentation-slot-value slot instance) i)))))

 
 (defmethod present-slot ((slot integer-slot-presentation) instance)
   (if (editablep slot)
 
 (defmethod present-slot ((slot integer-slot-presentation) instance)
   (if (editablep slot)


@@ -579,7 +593,7 @@ This method is also used by relation-slot-presentations for the same reason."))
 ;;;; Currency (double precision reals)
 
 (defslot-presentation currency-slot-presentation (real-slot-presentation)
 ;;;; Currency (double precision reals)
 
 (defslot-presentation currency-slot-presentation (real-slot-presentation)

-  ()
+  ((as-money-p :accessor as-money-p :initarg :as-money-p :initform nil))

   (:type-name currency))
 
 (defmethod (setf presentation-slot-value) ((value string) (c currency-slot-presentation) instance)
   (:type-name currency))
 
 (defmethod (setf presentation-slot-value) ((value string) (c currency-slot-presentation) instance)


@@ -593,7 +607,10 @@ This method is also used by relation-slot-presentations for the same reason."))
   (if (editablep currency)
       (<ucw:input :type "text" :size 10
                  :accessor (presentation-slot-value currency instance))
   (if (editablep currency)
       (<ucw:input :type "text" :size 10
                  :accessor (presentation-slot-value currency instance))

-      (<:as-html (presentation-slot-value currency instance))))
+      (<:as-html (format nil (if (as-money-p currency)
+                                "$~$"
+                                "~D")
+                        (presentation-slot-value currency instance)) )))

 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; dates and times
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; dates and times