subclass UCW's form classes in the editor layer.
[clinton/lisp-on-lines.git] / src / attributes / numbers.lisp
1 (in-package :lisp-on-lines)
2
3 (defattribute number-attribute (base-attribute)
4 ()
5 (:type-name number))
6
7 ;;;; INTEGER
8 (defattribute integer-attribute (number-attribute)
9 ()
10 (:type-name integer))
11
12 (defattribute integer-attribute (number-attribute integer-field)
13 ()
14 (:in-layer editor)
15 (:type-name integer))
16
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
25 ;;;; REALS
26
27 (defattribute real-attribute (number-attribute)
28 ()
29 (:type-name real))
30
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
38
39 ;;;; Currency
40 (defattribute currency-attribute (real-attribute)
41 ()
42 (:type-name currency))
43
44 (defdisplay
45 ((currency currency-attribute) object)
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) ""))))