1 (in-package :lisp-on-lines
)
4 (define-description editable
()
8 (define-layered-class standard-attribute
9 :in-layer
#.
(defining-description 'editable
)
13 :layered-accessor attribute-editp
19 :accessor attribute-setter
24 :accessor attribute-editor
26 :documentation
"This ones a bit odd")))
28 (defmethod attribute-editor :around
(attribute)
29 (flet ((find-editor-class (spec)
30 (let ((class (getf spec
:class
))
31 (type (getf spec
:type
)))
32 (or class
(when (and type
(symbolp type
))
33 (intern (format nil
"~A-~A" type
'attribute-editor
)))
34 'string-attribute-editor
))))
35 (let ((editor?
(call-next-method)))
37 (setf (attribute-editor attribute
)
38 (apply #'make-instance
(find-editor-class editor?
)
40 (call-next-method)))))
43 (defclass attribute-editor
()
46 (parser :initarg
:parse-using
48 :accessor attribute-editor-parsing-function
)
49 (prompt :initarg
:prompt
52 (defclass string-attribute-editor
(attribute-editor) ())
53 (defclass text-attribute-editor
(string-attribute-editor) ())
54 (defclass password-attribute-editor
(string-attribute-editor) ())
56 (defclass number-attribute-editor
(attribute-editor) ()
58 :parse-using
'parse-number
:PARSE-NUMBER
61 (defun parse-attribute-value (attribute value
)
62 (funcall (attribute-editor-parsing-function
63 (attribute-editor attribute
))
66 (define-layered-function display-attribute-editor
(attribute)
68 (setf (attribute-value attribute
)
69 (funcall (attribute-editor-parsing-function
70 (attribute-editor attribute
))
73 (define-description T
()
74 ((editp :label
"Edit by Default?"
80 (:in-description editable
))
82 (define-layered-method (setf attribute-value-using-object
)
83 :in-layer
#.
(defining-description 'editable
)(value object attribute
)
85 (let ((setter (attribute-setter attribute
)))
87 (funcall setter value object
)
88 (error "No setter in ~A for ~A" attribute object
))))
91 (define-layered-function attribute-editp
(attribute)
92 (:method
(attribute) nil
))
94 (define-layered-method attribute-editp
95 :in-layer
#.
(defining-description 'editable
)
96 ((attribute standard-attribute
))
97 (let ((edit?
(call-next-method)))
98 (if (eq :inherit edit?
)
99 (attribute-value (find-attribute
100 (attribute-description attribute
)
105 (define-layered-method display-attribute-value
106 :in-layer
#.
(defining-description 'editable
)
107 ((attribute standard-attribute
))
108 (if (attribute-editp attribute
)
109 (display-attribute-editor attribute
)