X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/2b0fd9c886908c6492c66cc30fcacf5fd600bf8e..a4e6154d961ff4b606aa534bd4e1570565cab351:/src/attributes/numbers.lisp diff --git a/src/attributes/numbers.lisp b/src/attributes/numbers.lisp index 8eeff63..6fb0460 100644 --- a/src/attributes/numbers.lisp +++ b/src/attributes/numbers.lisp @@ -5,22 +5,47 @@ (:type-name number)) ;;;; INTEGER -(defattribute integer-attribute (base-attribute) +(defattribute integer-attribute (number-attribute) () (: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 ((currency currency-attribute) object) - (<:as-html (format nil "$~$" (attribute-value object currency)))) + (<:as-html "$") + (call-next-method)) + +(defdisplay :in-layer editor + ((currency currency-attribute) object) + (<:as-html "$") + (<:input + :type "text" + :id (id currency) + :name (callback currency) + :value (format nil "~$" (or (attribute-value object currency) ""))))