Form types
[clinton/lisp-on-lines.git] / src / attributes / numbers.lisp
CommitLineData
2b0fd9c8
DC
1(in-package :lisp-on-lines)
2
3(defattribute number-attribute (base-attribute)
4 ()
5 (:type-name number))
6
7;;;; INTEGER
a4e6154d 8(defattribute integer-attribute (number-attribute)
2b0fd9c8
DC
9 ()
10 (:type-name integer))
11
e1645f63 12(defattribute integer-attribute (number-attribute integer-field)
13 ()
14 (:in-layer editor)
91b9f259 15 (:default-initargs
16 :default-value ""
17 :default-value-predicate (complement #'numberp))
e1645f63 18 (:type-name integer))
19
a4e6154d
DC
20
21(define-layered-method (setf attribute-value) ((value string) object (attribute integer-attribute))
22 (let ((*read-eval* nil))
23 (unless (string= "" value)
24 (let ((value (read-from-string value)))
25 (when (numberp value)
26 (setf (attribute-value object attribute) value))))))
27
2b0fd9c8
DC
28;;;; REALS
29
a4e6154d 30(defattribute real-attribute (number-attribute)
2b0fd9c8
DC
31 ()
32 (:type-name real))
33
a4e6154d
DC
34(define-layered-method (setf attribute-value) ((value string) object (attribute real-attribute))
35 (let ((*read-eval* nil))
36 (unless (string= "" value)
37 (let ((value (read-from-string value)))
38 (when (numberp value)
39 (setf (attribute-value object attribute) value))))))
40
2b0fd9c8
DC
41
42;;;; Currency
a4e6154d 43(defattribute currency-attribute (real-attribute)
2b0fd9c8
DC
44 ()
45 (:type-name currency))
46
a4e6154d 47
fb04c0a8 48(defdisplay
49 :in-layer t
a4e6154d 50 ((currency currency-attribute) object)
fb04c0a8 51
52 (<:as-html (format nil "$~$" (or (attribute-value object currency) ""))))
53
54(defdisplay
55 :in-layer editor
56 ((currency currency-attribute) object)
57 (LET ((value (attribute-value (object currency) currency)))
a4e6154d 58 (<:input
fb04c0a8 59 :NAME
60 (callback currency)
61 :VALUE (escape-as-html (strcat (display-value currency value)))
62 :TYPE
63 "text"))
64 )