X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/f4efa7fff2efa6a3144fc664683137df92c42f91..ddf67d6be45e1ea2d58aef8cceeba26f73ed1a0c:/src/standard-descriptions/edit.lisp

diff --git a/src/standard-descriptions/edit.lisp b/src/standard-descriptions/edit.lisp
index aa71065..9993080 100644
--- a/src/standard-descriptions/edit.lisp
+++ b/src/standard-descriptions/edit.lisp
@@ -1,56 +1,79 @@
 (in-package :lisp-on-lines)
 
-
 (define-description editable ()
   ()
   (: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 :input 
+    :initarg :editor
     :layered t
     :accessor attribute-editor
-    :initform nil
+    :initform (make-instance 'attribute-editor)
     :documentation "This ones a bit odd")))
 
-(defmethod attribute-editor :around (attribute)
-  (flet ((find-editor-class (spec)
-	   (let ((class (getf spec :class))
-		 (type (getf spec :type)))
-	     (or class (when (and type (symbolp type)) 
-			 (intern (format nil "~A-~A" type 'attribute-editor)))
-		 'string-attribute-editor))))
-  (let ((editor? (call-next-method)))
-    (if (listp editor?)
-	(setf (attribute-editor attribute)
-	      (apply #'make-instance (find-editor-class editor?) 
-		     editor?))
-	(call-next-method)))))
-
+(define-layered-method attribute-setter (object)
+  nil)
+
+(defmethod shared-initialize :after ((object standard-attribute) 
+				      slots &rest args &key input &allow-other-keys)
+
+  (when input 
+    (setf (attribute-editor object) 
+	  (apply #'make-instance (find-editor-class input)
+		 input))))
+
+      
+(defun find-editor-class (spec)
+  (let ((class (getf spec :class))
+	(type (getf spec :type)))
+    (or class (when 
+		  (and type (symbolp type)) 
+		(let ((name (format nil "~A-~A" type 'attribute-editor)))
+		  (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 ()
-    ((type :initarg :type
-	   :initform 'string)
+    ((class :initarg :class)
+     (type :initarg :type
+	   :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)))
+	     :initform nil)
+     (unbound-value
+	 :initarg :unbound-value
+       :initform "")))
+
+
 
 (defclass string-attribute-editor (attribute-editor) ())
 (defclass text-attribute-editor (string-attribute-editor) ())
+
+(deftype password () 'string)
+
 (defclass password-attribute-editor (string-attribute-editor) ())
 
 (defclass number-attribute-editor (attribute-editor) ()
@@ -94,7 +117,14 @@
 (define-layered-method attribute-editp 
   :in-layer #.(defining-description 'editable)
   ((attribute standard-attribute))
+  (let ((value (attribute-value attribute)))
+    (unless (or (unbound-slot-value-p value)
+		(typep value 
+		     (attribute-editor-type 
+		      (attribute-editor attribute))))
+      (return-from attribute-editp nil)))
   (let ((edit?       (call-next-method)))
+
     (if (eq :inherit edit?)
 	(attribute-value (find-attribute 
 			  (attribute-description attribute)