:serial t))
:serial t
- :depends-on (:contextl :arnesi :alexandria
+ :depends-on (:contextl :arnesi :alexandria :parse-number
;;for rofl:
- :postmodern :simple-date))
+ :simple-date :postmodern))
(:file "attribute-test")
(:file "display-test")
(:file "rofl-test")
+ (:module :standard-descriptions
+ :components ((:file "edit-test"))
+ :serial t)
(:module :ucw
:components ((:file "ucw-test"))
:serial t))
#:define-description
#:described-object
#:described-class
+ #:described-standard-class
#:with-active-descriptions
#:with-inactive-descriptions
#:attribute-label
#:attribute-function
#:attribute-value
- #:active-attributes))
+ #:active-attributes
+
+ ;; Standard Library
+ #:editable
+ #:string-attribute-editor
+ #:number-attribute-editor
+ #:password-attribute-editor))
(%select-objects type #'select query))
(defun select-only-n-objects (n type &rest query)
- (let ((results (%query `(:limit ,(cons :select
- (intern (format nil "*"))
- (if (string-equal (first query) :from)
- query
- (append `(:from ,type) query))) ,n))))
+ (let ((fields (if (eq :fields (car query))
+ (loop
+ :for cons :on (cdr query)
+ :if (not (keywordp (car cons)))
+ :collect (car cons) into fields
+ :else :do
+ (setf query cons)
+ (return (nreverse (print fields)))
+ :finally
+ (setf query cons)
+ (return (nreverse (print fields))))
+
+ (list (intern "*")))))
+ (let ((results
+ (%query
+ (print `(:limit (:select
+ ,@fields
+ ,@(if (string-equal (first query) :from)
+ (print query)
+ (append `(:from ,type) query)))
+ ,n)))))
(if (eql 1 n)
(make-object-from-plist type (first results))
- (mapcar (curry 'make-object-from-plist type) results))))
+ (mapcar (curry 'make-object-from-plist type) results)))))
(defun make-object-from-plist (type plist)
(let* ((class (find-class type))
(finalize-inheritance class)
(ensure-description-for-class class))
+(defclass described-standard-class (standard-class described-class) ())
+
+(defmethod validate-superclass
+ ((class described-standard-class)
+ (superclass standard-class))
+ t)
(define-layered-method description-of ((object standard-object))
(or (ignore-errors (find-description (class-name (class-of object))))
(find-description 'standard-object)))
+
+
--- /dev/null
+(in-package :lol-test)
+
+(deftest test-edit-simple ()
+ (eval `(defclass edit-test ()
+ (string number)
+ (:metaclass described-standard-class)))
+ (eval `(define-description edit-test (description-for-edit-test)
+ ((string :input (:type string))
+ (number :input (:type number)))))
+
+ (is (string= (display nil (make-instance 'lol-test::edit-test))
+ "String #<UNBOUND>
+Number #<UNBOUND>"))
+
+ (progn (let ((i (make-instance 'lol-test::edit-test)))
+ (with-input-from-string (*standard-input*
+"drew
+1
+")
+ (with-active-descriptions (editable)
+ (display t i))
+ (is (equal (display nil i)
+"String drew
+Number 1"))))))
\ No newline at end of file
()
(:mixinp t))
+(define-layered-class standard-attribute
+ :in-layer #.(defining-description 'editable)
+ ()
+ ((edit-attribute-p
+ :initform :inherit
+ :layered-accessor attribute-editp
+ :initarg :editp
+ :layered t)
+ (setter
+ :initarg :setter
+ :layered t
+ :accessor attribute-setter
+ :initform nil)
+ (attribute-editor
+ :initarg :input
+ :layered t
+ :accessor attribute-editor
+ :initform nil
+ :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)))))
+
+
+(defclass attribute-editor ()
+ ((type :initarg :type
+ :initform 'string)
+ (parser :initarg :parse-using
+ :initform 'identity
+ :accessor attribute-editor-parsing-function)
+ (prompt :initarg :prompt
+ :initform nil)))
+
+(defclass string-attribute-editor (attribute-editor) ())
+(defclass text-attribute-editor (string-attribute-editor) ())
+(defclass password-attribute-editor (string-attribute-editor) ())
+
+(defclass number-attribute-editor (attribute-editor) ()
+ (:default-initargs
+ :parse-using 'parse-number:PARSE-NUMBER
+ :type 'number))
+
+(defun parse-attribute-value (attribute value)
+ (funcall (attribute-editor-parsing-function
+ (attribute-editor attribute))
+ value))
+
+(define-layered-function display-attribute-editor (attribute)
+ (:method (attribute)
+ (setf (attribute-value attribute)
+ (funcall (attribute-editor-parsing-function
+ (attribute-editor attribute))
+ (read-line)))))
+
(define-description T ()
((editp :label "Edit by Default?"
:value nil
(funcall setter value object)
(error "No setter in ~A for ~A" attribute object))))
-(define-layered-class standard-attribute
- :in-layer #.(defining-description 'editable)
- ()
- ((edit-attribute-p
- :initform :inherit
- :accessor %attribute-editp
- :initarg :editp
- :layered t)
- (setter
- :initarg :setter
- :layered t
- :accessor attribute-setter
- :initform nil)))
-(define-layered-function attribute-editp (object attribute)
- (:method (object attribute) nil))
+(define-layered-function attribute-editp (attribute)
+ (:method (attribute) nil))
(define-layered-method attribute-editp
:in-layer #.(defining-description 'editable)
- (object (attribute standard-attribute))
-
- (if (eq :inherit (%attribute-editp attribute))
- (attribute-value (find-attribute
- (attribute-description attribute)
- 'editp))
- (%attribute-editp attribute)))
+ ((attribute standard-attribute))
+ (let ((edit? (call-next-method)))
+ (if (eq :inherit edit?)
+ (attribute-value (find-attribute
+ (attribute-description attribute)
+ 'editp))
+ edit?)))
-(define-layered-method display-using-description
+(define-layered-method display-attribute-value
:in-layer #.(defining-description 'editable)
- ((attribute standard-attribute) display object &rest args)
-
- (declare (ignore args))
- (if (attribute-editp object attribute)
- (format *display* "This is where we'd edit")
+ ((attribute standard-attribute))
+ (if (attribute-editp attribute)
+ (display-attribute-editor attribute)
(call-next-method)))
+
+
+
\ No newline at end of file
:value nil
:activep nil
:keyword :deactivate)
- (label-formatter :value (curry #'format nil "~A "))
- (value-formatter :value (curry #'format nil "~A"))))
+ (label-formatter :value (lambda (label)
+ (generic-format *display* "~A " label))
+ :activep nil)
+ (value-formatter :value (curry #'format nil "~A")
+ :activep nil)))
(define-layered-method description-of (any-lisp-object)
(find-description 't))
(define-layered-function display-attribute-label (attribute)
(:method (attribute)
- (princ (funcall (attribute-label-formatter attribute) (attribute-label attribute))
- *display*)))
+ (funcall (attribute-label-formatter attribute) (attribute-label attribute))))
+
(define-layered-function display-attribute-value (attribute)
(define-display ((description t))
(let ((attributes (attributes description)))
(display-attribute (first attributes))
- (dolist (attribute (rest attributes))
+ (dolist (attribute (rest attributes) (values))
(generic-format *display*
(attribute-value
(find-attribute description 'attribute-delimiter)))
(display-attribute attribute))))
-(define-display :around ((description t) (display null))
- (with-output-to-string (*display*)
- (print (call-next-method) *display*)))
+(define-display :around ((description t) (display null) object)
+ (with-output-to-string (*standard-output*)
+ (call-next-layered-method description t object)))
(display-html-attribute object attribute))
+(defun make-attribute-value-writer (attribute)
+ (let ((obj (described-object (attribute-description attribute))))
+ (lambda (val)
+ (dletf (((described-object attribute) obj))
+ (setf (attribute-value attribute)
+ (parse-attribute-value attribute val))))))
+
+
+(defmethod display-html-attribute-editor (attribute editor)
+ (<lol:input :type "text"
+ :reader (attribute-value attribute)
+ :writer (make-attribute-value-writer attribute)))
+
+(defmethod display-html-attribute-editor (attribute (editor password-attribute-editor))
+ (<lol:input :type "password"
+ :reader (attribute-value attribute)
+ :writer (make-attribute-value-writer attribute)))
+
+
+(define-layered-method display-attribute-editor
+ :in-layer #.(defining-description 'html-description) (attribute)
+ (display-html-attribute-editor attribute (attribute-editor attribute)))
+
(define-layered-method display-html-attribute-value
:in-layer #.(defining-description 'editable) (object attribute)
(<:span
:class "lol-attribute-value"
- (if (attribute-editp object attribute)
- (<lol:input :reader (attribute-value attribute)
- :writer (let ((obj (described-object (attribute-description attribute))))
- (lambda (val)
- (dletf (((described-object attribute) obj))
- (setf (attribute-value attribute) val)))))
- (call-next-method))
-))
+ (if (attribute-editp attribute)
+ (display-attribute-editor attribute)
+
+ (call-next-method))))
(define-layered-function display-html-description (description display object &optional next-method)
(:method (description display object &optional (next-method #'display-using-description))