Removed legacy files from .asd
[clinton/lisp-on-lines.git] / src / standard-attributes.lisp
1 (in-package :lisp-on-lines)
2
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
30
31 (defattribute base-attribute ()
32 ()
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)))
43
44 ;;;; Strings
45
46 (defattribute string-attribute ()
47 ()
48 (:type-name string)
49 (:default-properties
50 :escape-html-p t
51 :size nil
52 :max-length nil))
53
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
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
68 ;;;; default
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))))
74
75
76 ;;;; editor
77 (defattribute string-attribute (base-attribute)
78 ()
79 (:in-layer editor)
80 (:default-properties
81 :callback nil))
82
83
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)
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)))))
109
110 ;;;; textarea
111
112 (defattribute text-attribute (string-attribute)
113 ()
114 (:type-name text))
115
116 (defdisplay :in-layer editor ((string text-attribute) object)
117 (<:textarea
118 :id (id string)
119 :name (callback string)
120 (or (attribute-value object string) "")))
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
141 (defattribute image ()
142 ()
143 (:default-properties
144 :css-class "lol-image"
145 :prefix "images/"))
146
147 (defdisplay ((buttons (eql 'image-editor-buttons)) object)
148 (<ucw:a :action (ok component object)
149 (<:as-html "select this image")))
150
151 (defdisplay ((image image) object)
152 (<:img
153 :class (or (css-class image) "lol-image")
154 :src (arnesi:strcat
155 (or (prefix image) "images/")
156 (escape-as-uri
157 (attribute-value object image)))))
158
159 (defdisplay
160 :in-layer editor ((image image) object)
161
162 (<:div
163 :class "lol-image-thumbnails"
164 (<:as-html "imagie")))
165
166
167
168
169
170