1 (in-package :lisp-on-lines
)
3 (define-description editable
()
7 (define-layered-class define-description-attribute
8 :in-layer
#.
(defining-description 'editable
)
12 :layered-accessor attribute-editp
19 :layered-accessor attribute-setter
24 :accessor attribute-editor
25 :initform
(make-instance 'attribute-editor
)
26 :documentation
"This ones a bit odd")))
28 (define-layered-method attribute-setter
(object)
31 (defmethod shared-initialize :after
((object standard-attribute
)
32 slots
&rest args
&key input
&allow-other-keys
)
35 (setf (attribute-editor object
)
36 (apply #'make-instance
(find-editor-class input
)
40 (defun find-editor-class (spec)
41 (let ((class (getf spec
:class
))
42 (type (getf spec
:type
)))
44 (and type
(symbolp type
))
45 (let ((name (format nil
"~A-~A" type
'attribute-editor
)))
46 (or (unless (eq (find-package :cl
)
47 (symbol-package type
))
48 (find-class (intern name
(symbol-package type
)) nil
))
49 (find-class (intern name
) nil
)
50 (find-class (intern name
:lol
) nil
)
51 'string-attribute-editor
))))))
53 (defclass attribute-editor
()
54 ((class :initarg
:class
)
57 :accessor attribute-editor-type
)
58 (parser :initarg
:parse-using
60 :accessor attribute-editor-parsing-function
)
61 (attributes :initarg
:attributes
63 :accessor attribute-editor-attributes
)
64 (prompt :initarg
:prompt
67 :initarg
:unbound-value
72 (defclass string-attribute-editor
(attribute-editor) ())
73 (defclass text-attribute-editor
(string-attribute-editor) ())
75 (deftype password
() 'string
)
77 (defclass password-attribute-editor
(string-attribute-editor) ())
79 (defclass number-attribute-editor
(attribute-editor) ()
81 :parse-using
'parse-number
:PARSE-NUMBER
84 (defun parse-attribute-value (attribute value
)
85 (funcall (attribute-editor-parsing-function
86 (attribute-editor attribute
))
89 (define-layered-function display-attribute-editor
(attribute)
91 (setf (attribute-value attribute
)
92 (funcall (attribute-editor-parsing-function
93 (attribute-editor attribute
))
96 (define-description T
()
97 ((editp :label
"Edit by Default?"
100 (identity :editp nil
)
103 (:in-description editable
))
105 (define-layered-method (setf attribute-value-using-object
)
106 :in-layer
#.
(defining-description 'editable
)(value object attribute
)
108 (let ((setter (attribute-setter attribute
)))
110 (funcall setter value object
)
111 (error "No setter in ~A for ~A" attribute object
))))
114 (define-layered-function attribute-editp
(attribute)
115 (:method
(attribute) nil
))
117 (define-layered-method attribute-editp
118 :in-layer
#.
(defining-description 'editable
)
119 ((attribute standard-attribute
))
120 (let ((value (attribute-value attribute
)))
121 (unless (or (unbound-slot-value-p value
)
123 (attribute-editor-type
124 (attribute-editor attribute
))))
125 (return-from attribute-editp nil
)))
126 (let ((edit?
(call-next-method)))
128 (if (eq :inherit edit?
)
129 (attribute-value (find-attribute
130 (attribute-description attribute
)
135 (define-layered-method display-attribute-value
136 :in-layer
#.
(defining-description 'editable
)
137 ((attribute standard-attribute
))
138 (if (attribute-editp attribute
)
139 (display-attribute-editor attribute
)