remobe ROFL and add validation
[clinton/lisp-on-lines.git] / src / standard-descriptions / edit.lisp
1 (in-package :lisp-on-lines)
2
3 (define-description editable ()
4 ()
5 (:mixinp t))
6
7 (define-layered-class standard-attribute
8 :in-layer #.(defining-description 'editable)
9 ()
10 ((edit-attribute-p
11 :initform :inherit
12 :layered-accessor attribute-editp
13 :initarg :editp
14 :layered t)
15 (setter
16 :initarg :setter
17 :layered t
18 :accessor attribute-setter
19 :initform nil)
20 (attribute-editor
21 :initarg :editor
22 :layered t
23 :accessor attribute-editor
24 :initform (make-instance 'attribute-editor)
25 :documentation "This ones a bit odd")))
26
27 (defmethod shared-initialize :after ((object standard-attribute)
28 slots &rest args &key input &allow-other-keys)
29
30 (when input
31 (setf (attribute-editor object)
32 (apply #'make-instance (find-editor-class input)
33 input))))
34
35
36 (defun find-editor-class (spec)
37 (let ((class (getf spec :class))
38 (type (getf spec :type)))
39 (or class (when
40 (and type (symbolp type))
41 (let ((name (format nil "~A-~A" type 'attribute-editor)))
42 (or (find-class (intern name (symbol-package type)) nil)
43 (find-class (intern name) nil)
44 'string-attribute-editor))))))
45
46 (defclass attribute-editor ()
47 ((class :initarg :class)
48 (type :initarg :type
49 :initform 'string
50 :accessor attribute-editor-type)
51 (parser :initarg :parse-using
52 :initform 'identity
53 :accessor attribute-editor-parsing-function)
54 (attributes :initarg :attributes
55 :initform nil
56 :accessor attribute-editor-attributes)
57 (prompt :initarg :prompt
58 :initform nil)
59 (unbound-value
60 :initarg :unbound-value
61 :initform "")))
62
63
64
65 (defclass string-attribute-editor (attribute-editor) ())
66 (defclass text-attribute-editor (string-attribute-editor) ())
67
68 (deftype password () 'string)
69
70 (defclass password-attribute-editor (string-attribute-editor) ())
71
72 (defclass number-attribute-editor (attribute-editor) ()
73 (:default-initargs
74 :parse-using 'parse-number:PARSE-NUMBER
75 :type 'number))
76
77 (defun parse-attribute-value (attribute value)
78 (funcall (attribute-editor-parsing-function
79 (attribute-editor attribute))
80 value))
81
82 (define-layered-function display-attribute-editor (attribute)
83 (:method (attribute)
84 (setf (attribute-value attribute)
85 (funcall (attribute-editor-parsing-function
86 (attribute-editor attribute))
87 (read-line)))))
88
89 (define-description T ()
90 ((editp :label "Edit by Default?"
91 :value nil
92 :editp nil)
93 (identity :editp nil)
94 (type :editp nil)
95 (class :editp nil))
96 (:in-description editable))
97
98 (define-layered-method (setf attribute-value-using-object)
99 :in-layer #.(defining-description 'editable)(value object attribute)
100
101 (let ((setter (attribute-setter attribute)))
102 (if setter
103 (funcall setter value object)
104 (error "No setter in ~A for ~A" attribute object))))
105
106
107 (define-layered-function attribute-editp (attribute)
108 (:method (attribute) nil))
109
110 (define-layered-method attribute-editp
111 :in-layer #.(defining-description 'editable)
112 ((attribute standard-attribute))
113 (let ((value (attribute-value attribute)))
114 (unless (or (unbound-slot-value-p value)
115 (typep value
116 (attribute-editor-type
117 (attribute-editor attribute))))
118 (return-from attribute-editp nil)))
119 (let ((edit? (call-next-method)))
120 (if (eq :inherit edit?)
121 (attribute-value (find-attribute
122 (attribute-description attribute)
123 'editp))
124 edit?)))
125
126
127 (define-layered-method display-attribute-value
128 :in-layer #.(defining-description 'editable)
129 ((attribute standard-attribute))
130 (if (attribute-editp attribute)
131 (display-attribute-editor attribute)
132 (call-next-method)))
133
134
135
136
137
138