X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/2b0fd9c886908c6492c66cc30fcacf5fd600bf8e..88670beca060fc94190b30d4dc6ccb38dbe2fbcd:/src/attributes/numbers.lisp

diff --git a/src/attributes/numbers.lisp b/src/attributes/numbers.lisp
index 8eeff63..45d8aaa 100644
--- a/src/attributes/numbers.lisp
+++ b/src/attributes/numbers.lisp
@@ -5,22 +5,60 @@
   (:type-name number))
 
 ;;;; INTEGER
-(defattribute integer-attribute (base-attribute)
+(defattribute integer-attribute (number-attribute)
   ()
   (:type-name integer))
 
+(defattribute integer-attribute (number-attribute integer-field)
+  ()
+  (:in-layer editor)
+  (:default-initargs
+      :default-value ""
+    :default-value-predicate (complement #'numberp))
+  (:type-name integer))
+
+
+(define-layered-method (setf attribute-value) ((value string) object (attribute integer-attribute)) 	       
+  (let ((*read-eval* nil))
+    (unless (string= "" value)
+      (let ((value (read-from-string value)))
+	(when (numberp value)
+	  (setf (attribute-value object attribute) value))))))
+
 ;;;; REALS
 
-(defattribute real-attribute (base-attribute)
+(defattribute real-attribute (number-attribute)
   ()
   (:type-name real))
 
+(define-layered-method (setf attribute-value) ((value string) object (attribute real-attribute))
+  (let ((*read-eval* nil))
+    (unless (string= "" value)
+      (let ((value (read-from-string value)))
+	(when (numberp value)
+	  (setf (attribute-value object attribute) value))))))
+
 
 ;;;; Currency
-(defattribute currency-attribute (base-attribute)
+(defattribute currency-attribute (real-attribute)
   ()
   (:type-name currency))
 
+
 (defdisplay
+  :in-layer t
    ((currency currency-attribute) object)
- (<:as-html (format nil "$~$" (attribute-value object currency))))
+
+   (<:as-html (format nil "$~$" (or (attribute-value object currency) ""))))
+
+(defdisplay
+  :in-layer editor
+  ((currency currency-attribute) object)
+    (LET ((value (attribute-value (object currency) currency)))
+    (<:input
+     :NAME
+     (callback currency)
+     :VALUE (escape-as-html (strcat (display-value currency value)))
+     :TYPE
+     "text"))
+  )