(deflayer viewer)
(deflayer editor)
+;;;; Attributes
+(defdisplay
+ :in-layer editor
+ ((attribute standard-attribute) object)
+ (call-next-method))
+
+(defdisplay
+ ((attribute standard-attribute) object component)
+ (<:as-html (attribute-value object attribute)))
+
+(define-layered-method display-using-description
+ ((attribute standard-attribute) object component)
+ (with-component (component)
+ )
+ (<:as-html (attribute-value object attribute)))
+
(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."
+This allows us to dispatch to a subclasses editor.
+"
(with-inactive-layers (viewer)
(call-next-method)))
(deflayer as-table)
(deflayer as-string)
+(defdisplay
+ :in-layer as-string (d o (self t))
+ (with-output-to-string (yaclml::*yaclml-stream*)
+ (do-attributes (a d)
+ (display-attribute a o)
+ (<:as-html " "))
+ #+nil (with-inactive-layers (editor viewer one-line as-table show-attribute-labels)
+)))
+
+
(defdisplay
:in-layer as-string (d o)
- (with-inactive-layers (editor viewer one-line as-table show-attribute-labels)
+ (with-output-to-string (yaclml::*yaclml-stream*)
(do-attributes (a d)
(display-attribute a o)
- (<:as-is " "))))
+ (<:as-html " "))
+ #+nil (with-inactive-layers (editor viewer one-line as-table show-attribute-labels)
+)))
(defmethod list-slots (thing)
(list 'identity))
(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)))
(dolist* (slot-name (list-slots object))
-
(let ((boundp (slot-boundp object slot-name)))
(format t "~A~A : ~A" (strcat slot-name)
(if boundp
;;;; List Displays
-(deflayer list-display-layer)
+#| (deflayer list-display-layer)
(define-layered-class description
:in-layer list-display-layer ()
- ((list-item :initarg :list-item :initform nil :special t :accessor list-item)))
+ ((list-item :initarg :list-item
+ :initarg :table-item
+ :initform nil
+ :special t
+ :accessor list-item)))
(defdisplay (desc (list list))
(with-active-layers (list-display-layer)
(dolist* (item list)
(<:li (apply #'display* item (list-item desc)))))))
-;;;; Attributes
-(defdisplay
- :in-layer editor
- ((attribute standard-attribute) object)
- (call-next-method))
+(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))))))))))) |#
+
-(define-layered-method display-using-description
- ((attribute standard-attribute) object component)
- (with-component (component)
- (<ucw:a :action (call 'info-message :message (strcat (symbol-package (description.type attribute))":/::" (description.type attribute)))
- (<:as-html "*" )))
- (<:as-html (attribute-value object attribute)))