;;;; The Standard Layers
(deflayer viewer)
(deflayer editor)
-(deflayer creator)
+
+(define-layered-method label (anything)
+ nil)
+
+(defdisplay
+ :in-layer editor :around (description object)
+ "It is useful to remove the viewer layer when in the editing layer.
+This allows us to dispatch to a subclasses editor.
+"
+ (with-inactive-layers (viewer)
+ (call-next-method)))
+
+;;;; These layers affect the layout of the object
(deflayer one-line)
(deflayer as-table)
(deflayer as-string)
(defdisplay
:in-layer as-string (d o)
- (do-attributes (a d)
- (display-attribute a o)
- (<:as-is " ")))
+ (with-inactive-layers (editor viewer one-line as-table show-attribute-labels)
+ (do-attributes (a d)
+ (display-attribute a o)
+ (<:as-is " "))))
(defmethod list-slots (thing)
(list 'identity))
-
-;;;; TODO : this doesn't work
-
-(defaction call-display-with-context ((from component) object context &rest properties)
- (call-component self (make-instance 'standard-display-component
- :context context
- :object object
- :args (if (cdr properties)
- properties
- (car properties)))))
-
-(defmacro call-display (component object &rest properties)
- `(let ()
- (call-display-with-context ,component ,object nil ,@properties)))
-
-(defcomponent standard-display-component ()
- ((context :accessor context :initarg :context)
- (object :accessor object :initarg :object)
- (args :accessor args :initarg :args)))
-
-(defmethod render ((self standard-display-component))
-
- (apply #'display self (object self) (args self)))
-
-
;;;; * Object displays.
-;;;; We like to have a label for attributes, and meta-model provides a default.
-(defdisplay ((desc (eql 'label)) label)
- (<:span
- :class "label"
- (<:as-html label)))
+
;;;; TODO: all lisp types should have occurences and attributes defined for them.
(defdisplay (description (object string))
(<:as-html object))
+(defdisplay (description (object symbol))
+ (<:as-html object))
+
(defdisplay (description object (component t))
"The default display for CLOS objects"
(print (class-name (class-of object)))
(defdisplay (description object)
(<:div
- :class "lol-display"
+ :class "lol-display"
+ (when (label description)
+ (<:span
+ :class "title"
+ (<:as-html (label description))))
(do-attributes (attribute description)
(<:div
- :class "lol-attribute-row"
+ :class "attribute"
(display-attribute attribute object)))))
;;;; ** One line
(defdisplay
- :in-layer one-line (description object)
- "The one line presentation just displays the attributes with a #\Space between them"
- (do-attributes (attribute description)
- (display-attribute attribute object)
- (<:as-html " ")))
+ :in-layer one-line (description object)
+ "The one line presentation just displays the attributes with a #\Space between them"
+ (do-attributes (attribute description)
+ (display-attribute attribute object)
+ (<:as-html " ")))
;;;; ** as-table
(<:td (display-attribute a object))))))
;;;; List Displays
+
+(deflayer list-display-layer)
+
+(define-layered-class description
+ :in-layer list-display-layer ()
+ ((list-item :initarg :list-item
+ :initarg :table-item
+ :initform nil
+ :special t
+ :accessor list-item)))
+
(defdisplay (desc (list list))
- (<:ul
- (dolist* (item list)
- (<:li (display* item)
- (<:as-html item)))))
+ (with-active-layers (list-display-layer)
+ (<:ul
+ (dolist* (item list)
+ (<:li (apply #'display* item (list-item desc)))))))
+
+(defdisplay :in-layer as-table (description (list list))
+ (with-active-layers (list-display-layer)
+ (let ((item-description (find-occurence (first list))))
+ (<:table
+ (funcall
+ (apply #'lol::make-display-function self (first list)
+ (list-item description))
+ (lambda (desc item component)
+ (<:tr
+ (do-attributes (a desc)
+ (<:th (<:as-html (label a)))))
+
+ (dolist* (obj list)
+ (<:tr
+ (do-attributes (a desc)
+ (<:td (display-attribute a obj)))))))))))
;;;; Attributes
(defdisplay
:in-layer editor
((attribute standard-attribute) object)
- "Legacy editor using UCW presentations"
-
- (warn "USING LEGACY EDITOR FOR ~A" (slot-name attribute)))
+ (call-next-method))
(define-layered-method display-using-description
((attribute standard-attribute) object component)