HCoop
/
clinton
/
lisp-on-lines.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix missing `without-special-symbol-access' in `funcall-with-attribute-context'
[clinton/lisp-on-lines.git]
/
src
/
standard-descriptions
/
edit.lisp
diff --git
a/src/standard-descriptions/edit.lisp
b/src/standard-descriptions/edit.lisp
index
ab1dd39
..
9993080
100644
(file)
--- a/
src/standard-descriptions/edit.lisp
+++ b/
src/standard-descriptions/edit.lisp
@@
-4,18
+4,19
@@
()
(:mixinp t))
()
(:mixinp t))
-(define-layered-class
standard
-attribute
+(define-layered-class
define-description
-attribute
:in-layer #.(defining-description 'editable)
()
((edit-attribute-p
:initform :inherit
:layered-accessor attribute-editp
:initarg :editp
:in-layer #.(defining-description 'editable)
()
((edit-attribute-p
:initform :inherit
:layered-accessor attribute-editp
:initarg :editp
- :layered t)
+ :layered t
+ :special t)
(setter
:initarg :setter
:layered t
(setter
:initarg :setter
:layered t
- :accessor attribute-setter
+ :
layered-
accessor attribute-setter
:initform nil)
(attribute-editor
:initarg :editor
:initform nil)
(attribute-editor
:initarg :editor
@@
-24,6
+25,9
@@
:initform (make-instance 'attribute-editor)
:documentation "This ones a bit odd")))
:initform (make-instance 'attribute-editor)
:documentation "This ones a bit odd")))
+(define-layered-method attribute-setter (object)
+ nil)
+
(defmethod shared-initialize :after ((object standard-attribute)
slots &rest args &key input &allow-other-keys)
(defmethod shared-initialize :after ((object standard-attribute)
slots &rest args &key input &allow-other-keys)
@@
-39,17
+43,24
@@
(or class (when
(and type (symbolp type))
(let ((name (format nil "~A-~A" type 'attribute-editor)))
(or class (when
(and type (symbolp type))
(let ((name (format nil "~A-~A" type 'attribute-editor)))
- (or (find-class (intern name (symbol-package type)) nil)
+ (or (unless (eq (find-package :cl)
+ (symbol-package type))
+ (find-class (intern name (symbol-package type)) nil))
(find-class (intern name) nil)
(find-class (intern name) nil)
+ (find-class (intern name :lol) nil)
'string-attribute-editor))))))
(defclass attribute-editor ()
'string-attribute-editor))))))
(defclass attribute-editor ()
- ((type :initarg :type
+ ((class :initarg :class)
+ (type :initarg :type
:initform 'string
:accessor attribute-editor-type)
(parser :initarg :parse-using
:initform 'identity
:accessor attribute-editor-parsing-function)
:initform 'string
:accessor attribute-editor-type)
(parser :initarg :parse-using
:initform 'identity
:accessor attribute-editor-parsing-function)
+ (attributes :initarg :attributes
+ :initform nil
+ :accessor attribute-editor-attributes)
(prompt :initarg :prompt
:initform nil)
(unbound-value
(prompt :initarg :prompt
:initform nil)
(unbound-value
@@
-107,12
+118,13
@@
:in-layer #.(defining-description 'editable)
((attribute standard-attribute))
(let ((value (attribute-value attribute)))
:in-layer #.(defining-description 'editable)
((attribute standard-attribute))
(let ((value (attribute-value attribute)))
- (unless (or (unbound-slot-value-p value)
- (typep value
+
(unless (or (unbound-slot-value-p value)
+
(typep value
(attribute-editor-type
(attribute-editor attribute))))
(attribute-editor-type
(attribute-editor attribute))))
- (return-from attribute-editp nil)))
+
(return-from attribute-editp nil)))
(let ((edit? (call-next-method)))
(let ((edit? (call-next-method)))
+
(if (eq :inherit edit?)
(attribute-value (find-attribute
(attribute-description attribute)
(if (eq :inherit edit?)
(attribute-value (find-attribute
(attribute-description attribute)