1 (in-package :lisp-on-lines
)
3 (deflayer omit-nil-attributes
)
5 (defdisplay :in-layer omit-nil-attributes
6 :around
((attribute standard-attribute
) object
)
7 (when (attribute-value object attribute
)
10 (deflayer label-attributes
)
12 (defdisplay :in-layer label-attributes
13 :around
((attribute standard-attribute
) object
)
17 (<:as-html
(or (label attribute
) (attribute.name attribute
))))
19 :class
"lol-attribute"
24 (defattribute base-attribute
()
27 (defdisplay ((base base-attribute
) object
)
28 (<:as-html
(attribute-value object base
)))
31 (defattribute base-attribute
()
38 :in-layer editor
:around
((string base-attribute
) object
)
39 (dletf (((callback string
) (ucw::make-new-callback
41 (setf (attribute-value object string
) val
)))))
46 (defattribute string-attribute
()
55 :in-layer editor
((string base-attribute
) object
)
59 :name
(callback string
)
60 :value
(or (attribute-value object string
) "")))
63 (defdisplay :in-layer omit-nil-attributes
64 :around
((attribute string-attribute
) object
)
65 (when (< 0 (length (attribute-value object attribute
)))
69 (defdisplay :in-layer viewer
70 ((string string-attribute
) object
)
71 (if (escape-html-p string
)
72 (<:as-html
(attribute-value object string
))
73 (<:as-is
(attribute-value object string
))))
77 (defattribute string-attribute
(base-attribute)
84 (defattribute string-search-attribute
(string-attribute)
87 ;; the func that find search results
89 :search-action
#'(lambda ()
92 ;; when chosing from a list of results, this function selects one.
93 :select-function
(constantly t
))
94 (:type-name string-search
))
97 :in-layer editor
:after
((search string-search-attribute
) object
)
104 (IT.BESE.UCW
::SET-ACTION-PARAMETER
105 ,(IT.BESE.UCW
::MAKE-NEW-ACTION
106 (IT.BESE.UCW
::CONTEXT.CURRENT-FRAME
*CONTEXT
*)
107 (search-action search
)))
112 (defattribute text-attribute
(string-attribute)
116 (defdisplay :in-layer editor
((string text-attribute
) object
)
119 :name
(callback string
)
120 (or (attribute-value object string
) "")))
126 (defattribute wall-time-attribute
(string-attribute)
128 (:type-name clsql-sys
:wall-time
))
130 (define-layered-method attribute-value
(object (attribute wall-time-attribute
))
131 (let ((date (call-next-method)))
132 (when date
(multiple-value-bind (y m d
) (clsql:time-ymd date
)
133 (format nil
"~a/~a/~a" m d y
)))))
136 ((time wall-time-attribute
) object
)
137 (<:as-html
(attribute-value object time
)))
141 (defattribute image
()
144 :css-class
"lol-image"
147 (defdisplay ((buttons (eql 'image-editor-buttons
)) object
)
148 (<ucw
:a
:action
(ok component object
)
149 (<:as-html
"select this image")))
151 (defdisplay ((image image
) object
)
153 :class
(or (css-class image
) "lol-image")
155 (or (prefix image
) "images/")
157 (attribute-value object image
)))))
160 :in-layer editor
((image image
) object
)
163 :class
"lol-image-thumbnails"
164 (<:as-html
"imagie")))