X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/a5a635a2ec9a1187c8ebd30c0baab32dd70bd593..ddf67d6be45e1ea2d58aef8cceeba26f73ed1a0c:/src/standard-descriptions/edit.lisp diff --git a/src/standard-descriptions/edit.lisp b/src/standard-descriptions/edit.lisp index 3c04a92..9993080 100644 --- a/src/standard-descriptions/edit.lisp +++ b/src/standard-descriptions/edit.lisp @@ -4,18 +4,19 @@ () (: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 - :layered t) + :layered t + :special t) (setter :initarg :setter :layered t - :accessor attribute-setter + :layered-accessor attribute-setter :initform nil) (attribute-editor :initarg :editor @@ -24,6 +25,9 @@ :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) @@ -39,8 +43,11 @@ (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 :lol) nil) 'string-attribute-editor)))))) (defclass attribute-editor () @@ -51,6 +58,9 @@ (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 @@ -108,12 +118,13 @@ :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)))) - (return-from attribute-editp nil))) + (return-from attribute-editp nil))) (let ((edit? (call-next-method))) + (if (eq :inherit edit?) (attribute-value (find-attribute (attribute-description attribute)