1 (in-package :lisp-on-lines
)
3 ;;;; The Standard Layers
7 (define-layered-method label
(anything)
11 :in-layer editor
:around
(description object
)
12 "It is useful to remove the viewer layer when in the editing layer.
13 This allows us to dispatch to a subclasses editor."
14 (with-inactive-layers (viewer)
17 ;;;; These layers affect the layout of the object
23 :in-layer as-string
(d o
)
24 (with-inactive-layers (editor viewer one-line as-table show-attribute-labels
)
26 (display-attribute a o
)
29 (defmethod list-slots (thing)
32 ;;;; * Object displays.
36 ;;;; TODO: all lisp types should have occurences and attributes defined for them.
38 (defdisplay ((description t
) lisp-value
)
39 (<:as-html lisp-value
))
41 (defdisplay (description (object string
))
44 (defdisplay (description object
(component t
))
45 "The default display for CLOS objects"
46 (print (class-name (class-of object
)))
47 (dolist* (slot-name (list-slots object
))
49 (let ((boundp (slot-boundp object slot-name
)))
50 (format t
"~A~A : ~A" (strcat slot-name
)
55 (slot-value object slot-name
) "")))))
57 (defdisplay ((description t
) object
)
58 "The default display for CLOS objects in UCW components"
59 (dolist* (slot-name (list-slots object
))
61 (let ((boundp (slot-boundp object slot-name
)))
62 (<:label
:class
"lol-label"
63 (display-attribute 'label
(strcat slot-name
))
69 (slot-value object slot-name
) "")))))
71 ;;;; ** The default displays for objects with a MEWA occurence
73 (defdisplay (description object
)
76 (when (label description
)
79 (<:as-html
(label description
))))
80 (do-attributes (attribute description
)
83 (display-attribute attribute object
)))))
87 :in-layer one-line
(description object
)
88 "The one line presentation just displays the attributes with a #\Space between them"
89 (do-attributes (attribute description
)
90 (display-attribute attribute object
)
95 (defdisplay :in-layer as-table
(description object
)
97 (do-attributes (a description
)
99 (<:td
:class
"lol-label" (<:as-html
(label a
)))
100 (<:td
(display-attribute a object
))))))
104 (deflayer list-display-layer
)
106 (define-layered-class description
107 :in-layer list-display-layer
()
108 ((list-item :initarg
:list-item
:initform nil
:special t
:accessor list-item
)))
110 (defdisplay (desc (list list
))
111 (with-active-layers (list-display-layer)
114 (<:li
(apply #'display
* item
(list-item desc
)))))))
119 ((attribute standard-attribute
) object
)
122 (define-layered-method display-using-description
123 ((attribute standard-attribute
) object component
)
124 (with-component (component)
125 (<ucw
:a
:action
(call 'info-message
:message
(strcat (symbol-package (description.type attribute
))":/::" (description.type attribute
)))
127 (<:as-html
(attribute-value object attribute
)))