Misc Cleanups.
[clinton/lisp-on-lines.git] / src / standard-descriptions / edit.lisp
CommitLineData
4358148e 1(in-package :lisp-on-lines)
2
4358148e 3(define-description editable ()
4 ()
5 (:mixinp t))
6
f4efa7ff 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
2548f054 21 :initarg :editor
f4efa7ff 22 :layered t
23 :accessor attribute-editor
2548f054 24 :initform (make-instance 'attribute-editor)
f4efa7ff 25 :documentation "This ones a bit odd")))
26
2548f054 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)))
ec6dde1e 42 (or (unless (eq (find-package :cl)
43 (symbol-package type))
44 (find-class (intern name (symbol-package type)) nil))
2548f054 45 (find-class (intern name) nil)
ec6dde1e 46 (find-class (intern name :lol) nil)
2548f054 47 'string-attribute-editor))))))
f4efa7ff 48
49(defclass attribute-editor ()
a5a635a2 50 ((class :initarg :class)
51 (type :initarg :type
2548f054 52 :initform 'string
53 :accessor attribute-editor-type)
f4efa7ff 54 (parser :initarg :parse-using
55 :initform 'identity
56 :accessor attribute-editor-parsing-function)
e8fd1a9a 57 (attributes :initarg :attributes
58 :initform nil
59 :accessor attribute-editor-attributes)
f4efa7ff 60 (prompt :initarg :prompt
2548f054 61 :initform nil)
62 (unbound-value
63 :initarg :unbound-value
64 :initform "")))
65
66
f4efa7ff 67
68(defclass string-attribute-editor (attribute-editor) ())
69(defclass text-attribute-editor (string-attribute-editor) ())
2548f054 70
71(deftype password () 'string)
72
f4efa7ff 73(defclass password-attribute-editor (string-attribute-editor) ())
74
75(defclass number-attribute-editor (attribute-editor) ()
76 (:default-initargs
77 :parse-using 'parse-number:PARSE-NUMBER
78 :type 'number))
79
80(defun parse-attribute-value (attribute value)
81 (funcall (attribute-editor-parsing-function
82 (attribute-editor attribute))
83 value))
84
85(define-layered-function display-attribute-editor (attribute)
86 (:method (attribute)
87 (setf (attribute-value attribute)
88 (funcall (attribute-editor-parsing-function
89 (attribute-editor attribute))
90 (read-line)))))
91
4358148e 92(define-description T ()
93 ((editp :label "Edit by Default?"
94 :value nil
95 :editp nil)
96 (identity :editp nil)
97 (type :editp nil)
98 (class :editp nil))
99 (:in-description editable))
100
b7657b86 101(define-layered-method (setf attribute-value-using-object)
102 :in-layer #.(defining-description 'editable)(value object attribute)
103
104 (let ((setter (attribute-setter attribute)))
105 (if setter
106 (funcall setter value object)
107 (error "No setter in ~A for ~A" attribute object))))
4358148e 108
4358148e 109
f4efa7ff 110(define-layered-function attribute-editp (attribute)
111 (:method (attribute) nil))
4358148e 112
113(define-layered-method attribute-editp
114 :in-layer #.(defining-description 'editable)
f4efa7ff 115 ((attribute standard-attribute))
2548f054 116 (let ((value (attribute-value attribute)))
117 (unless (or (unbound-slot-value-p value)
118 (typep value
119 (attribute-editor-type
120 (attribute-editor attribute))))
121 (return-from attribute-editp nil)))
f4efa7ff 122 (let ((edit? (call-next-method)))
123 (if (eq :inherit edit?)
124 (attribute-value (find-attribute
125 (attribute-description attribute)
126 'editp))
127 edit?)))
4358148e 128
129
f4efa7ff 130(define-layered-method display-attribute-value
4358148e 131 :in-layer #.(defining-description 'editable)
f4efa7ff 132 ((attribute standard-attribute))
133 (if (attribute-editp attribute)
134 (display-attribute-editor attribute)
e8d4fa45 135 (call-next-method)))
4358148e 136
137
f4efa7ff 138
139
140
4358148e 141