1 (in-package :lisp-on-lines
)
3 ;;;; The Standard Layers
12 :in-layer as-string
(d o
)
14 (display-attribute a o
)
17 (defmethod list-slots (thing)
21 ;;;; TODO : this doesn't work
23 (defaction call-display-with-context
((from component
) object context
&rest properties
)
24 (call-component self
(make-instance 'standard-display-component
27 :args
(if (cdr properties
)
31 (defmacro call-display
(component object
&rest properties
)
33 (call-display-with-context ,component
,object nil
,@properties
)))
35 (defcomponent standard-display-component
()
36 ((context :accessor context
:initarg
:context
)
37 (object :accessor object
:initarg
:object
)
38 (args :accessor args
:initarg
:args
)))
40 (defmethod render ((self standard-display-component
))
42 (apply #'display self
(object self
) (args self
)))
45 ;;;; * Object displays.
47 ;;;; We like to have a label for attributes, and meta-model provides a default.
48 (defdisplay ((desc (eql 'label
)) label
)
53 ;;;; TODO: all lisp types should have occurences and attributes defined for them.
55 (defdisplay ((description t
) lisp-value
)
56 (<:as-html lisp-value
))
58 (defdisplay (description (object string
))
61 (defdisplay (description object
(component t
))
62 "The default display for CLOS objects"
63 (print (class-name (class-of object
)))
64 (dolist* (slot-name (list-slots object
))
66 (let ((boundp (slot-boundp object slot-name
)))
67 (format t
"~A~A : ~A" (strcat slot-name
)
72 (slot-value object slot-name
) "")))))
74 (defdisplay ((description t
) object
)
75 "The default display for CLOS objects in UCW components"
76 (dolist* (slot-name (list-slots object
))
78 (let ((boundp (slot-boundp object slot-name
)))
79 (<:label
:class
"lol-label"
80 (display-attribute 'label
(strcat slot-name
))
86 (slot-value object slot-name
) "")))))
88 ;;;; ** The default displays for objects with a MEWA occurence
90 (defdisplay (description object
)
93 (do-attributes (attribute description
)
95 :class
"lol-attribute-row"
96 (display-attribute attribute object
)))))
100 :in-layer one-line
(description object
)
101 "The one line presentation just displays the attributes with a #\Space between them"
102 (do-attributes (attribute description
)
103 (display-attribute attribute object
)
108 (defdisplay :in-layer as-table
(description object
)
110 (do-attributes (a description
)
112 (<:td
:class
"lol-label" (<:as-html
(label a
)))
113 (<:td
(display-attribute a object
))))))
116 (defdisplay (desc (list list
))
119 (<:li
(display* item
)
125 ((attribute standard-attribute
) object
)
126 "Legacy editor using UCW presentations"
128 (warn "USING LEGACY EDITOR FOR ~A" (slot-name attribute
)))
130 (define-layered-method display-using-description
131 ((attribute standard-attribute
) object component
)
132 (with-component (component)
133 (<ucw
:a
:action
(call 'info-message
:message
(strcat (symbol-package (description.type attribute
))":/::" (description.type attribute
)))
135 (<:as-html
(attribute-value object attribute
)))