subclass UCW's form classes in the editor layer.
[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)
15 (:type-name integer))
16
a4e6154d
DC
17
18(define-layered-method (setf attribute-value) ((value string) object (attribute integer-attribute))
19 (let ((*read-eval* nil))
20 (unless (string= "" value)
21 (let ((value (read-from-string value)))
22 (when (numberp value)
23 (setf (attribute-value object attribute) value))))))
24
2b0fd9c8
DC
25;;;; REALS
26
a4e6154d 27(defattribute real-attribute (number-attribute)
2b0fd9c8
DC
28 ()
29 (:type-name real))
30
a4e6154d
DC
31(define-layered-method (setf attribute-value) ((value string) object (attribute real-attribute))
32 (let ((*read-eval* nil))
33 (unless (string= "" value)
34 (let ((value (read-from-string value)))
35 (when (numberp value)
36 (setf (attribute-value object attribute) value))))))
37
2b0fd9c8
DC
38
39;;;; Currency
a4e6154d 40(defattribute currency-attribute (real-attribute)
2b0fd9c8
DC
41 ()
42 (:type-name currency))
43
44(defdisplay
45 ((currency currency-attribute) object)
a4e6154d
DC
46 (<:as-html "$")
47 (call-next-method))
48
49(defdisplay :in-layer editor
50 ((currency currency-attribute) object)
51 (<:as-html "$")
52 (<:input
53 :type "text"
54 :id (id currency)
55 :name (callback currency)
56 :value (format nil "~$" (or (attribute-value object currency) ""))))