Removed legacy files from .asd
[clinton/lisp-on-lines.git] / src / standard-attributes.lisp
CommitLineData
7733a777
DC
1(in-package :lisp-on-lines)
2
2b0fd9c8
DC
3(deflayer omit-nil-attributes)
4
5(defdisplay :in-layer omit-nil-attributes
6 :around ((attribute standard-attribute) object)
7 (when (attribute-value object attribute)
8 (call-next-method)))
9
10(deflayer label-attributes)
11
12(defdisplay :in-layer label-attributes
13 :around ((attribute standard-attribute) object)
14
15 (<:span
16 :class "lol-label"
17 (<:as-html (or (label attribute) (attribute.name attribute))))
18 (<:span
19 :class "lol-attribute"
20 (call-next-method)))
21
22;;;; * Base Types
23
24(defattribute base-attribute ()
25 ())
26
27(defdisplay ((base base-attribute) object)
28 (<:as-html (attribute-value object base)))
29
9af22ce3 30
a4e6154d 31(defattribute base-attribute ()
9af22ce3 32 ()
a4e6154d
DC
33 (:in-layer editor)
34 (:default-properties
35 :callback nil))
36
37(defdisplay
38 :in-layer editor :around ((string base-attribute) object)
39 (dletf (((callback string) (ucw::make-new-callback
40 #'(lambda (val)
41 (setf (attribute-value object string) val)))))
42 (call-next-method)))
2b0fd9c8 43
a4e6154d
DC
44;;;; Strings
45
46(defattribute string-attribute ()
47 ()
9af22ce3
DC
48 (:type-name string)
49 (:default-properties
2b0fd9c8
DC
50 :escape-html-p t
51 :size nil
52 :max-length nil))
9af22ce3 53
a4e6154d
DC
54(defdisplay
55 :in-layer editor ((string base-attribute) object)
56 (<:input
57 :type "text"
58 :id (id string)
59 :name (callback string)
60 :value (or (attribute-value object string) "")))
61
62
2b0fd9c8
DC
63(defdisplay :in-layer omit-nil-attributes
64 :around ((attribute string-attribute) object)
65 (when (< 0 (length (attribute-value object attribute)))
66 (call-next-method)))
67
2b0fd9c8 68;;;; default
a4e6154d
DC
69(defdisplay :in-layer viewer
70 ((string string-attribute) object)
2b0fd9c8 71 (if (escape-html-p string)
9af22ce3
DC
72 (<:as-html (attribute-value object string))
73 (<:as-is (attribute-value object string))))
74
75
2b0fd9c8
DC
76;;;; editor
77(defattribute string-attribute (base-attribute)
78 ()
79 (:in-layer editor)
80 (:default-properties
81 :callback nil))
82
a4e6154d 83
2b0fd9c8
DC
84(defattribute string-search-attribute (string-attribute)
85 ()
86 (:default-properties
87 ;; the func that find search results
88
89 :search-action #'(lambda ()
90 (with-call/cc
91 nil))
92 ;; when chosing from a list of results, this function selects one.
93 :select-function (constantly t))
94 (:type-name string-search))
95
96(defdisplay
97 :in-layer editor :after ((search string-search-attribute) object)
a4e6154d
DC
98 (<:input
99 :TYPE "submit"
100 :VALUE "search"
101 :ONCLICK
102 (JS:JS-INLINE*
103 `(PROGN
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)))
108 (RETURN T)))))
2b0fd9c8
DC
109
110;;;; textarea
111
112(defattribute text-attribute (string-attribute)
a4e6154d
DC
113 ()
114 (:type-name text))
2b0fd9c8
DC
115
116(defdisplay :in-layer editor ((string text-attribute) object)
117 (<:textarea
118 :id (id string)
119 :name (callback string)
a4e6154d 120 (or (attribute-value object string) "")))
2b0fd9c8
DC
121
122
123
124;;;; WALL-TIME
125
126(defattribute wall-time-attribute (string-attribute)
127 ()
128 (:type-name clsql-sys:wall-time))
129
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)))))
134
135(defdisplay
136 ((time wall-time-attribute) object)
137 (<:as-html (attribute-value object time)))
138
139
140
7733a777 141(defattribute image ()
a4e6154d
DC
142 ()
143 (:default-properties
144 :css-class "lol-image"
145 :prefix "images/"))
7733a777 146
2b0fd9c8 147(defdisplay ((buttons (eql 'image-editor-buttons)) object)
60a24293
DC
148 (<ucw:a :action (ok component object)
149 (<:as-html "select this image")))
150
2b0fd9c8 151(defdisplay ((image image) object)
7733a777 152 (<:img
a4e6154d 153 :class (or (css-class image) "lol-image")
7733a777 154 :src (arnesi:strcat
a4e6154d 155 (or (prefix image) "images/")
7733a777
DC
156 (escape-as-uri
157 (attribute-value object image)))))
158
2b0fd9c8
DC
159(defdisplay
160 :in-layer editor ((image image) object)
161
60a24293 162 (<:div
2b0fd9c8 163 :class "lol-image-thumbnails"
a4e6154d 164 (<:as-html "imagie")))
60a24293 165
7733a777
DC
166
167
168
169
170