1 (in-package :lisp-on-lines
)
3 ;;;; LoL CLOS Test Class
4 (defclass lol-test-class
()
5 ((test-string :initform
"test string"))
6 (:documentation
"foo"))
8 (set-default-attributes 'lol-test-class
)
10 (define-attributes (lol-test-class)
11 (test-string t
:label
"String :"))
13 (defcomponent test-component
()
14 ((display-types :accessor display-types
:initform
(list 'viewer
'editor
'creator
'one-line
'as-string
))
15 (current-type :accessor current-type
:initform
'viewer
)
16 (instance :accessor instance
:initform
(make-instance 'test-class
))))
18 (defmethod render ((self test-component
))
19 (let ((test (instance self
)))
20 (<:h1
(<:as-html
"Lisp on Lines Test Component"))
21 (with-component (self)
23 :action
(refresh-component self
)
24 (<ucw
:select
:accessor
(current-type self
)
25 (dolist* (type (display-types self
))
26 (<ucw
:option
:value type
(<:as-html type
))))
27 (<:input
:type
"Submit" :value
"update")
29 (<:legend
(<:as-html
(current-type self
)))
30 (display test
:type
(current-type self
)))))
34 (<:as-html
"UCW Presentation based displays (the old school"))
35 (dolist (type '(:viewer
:editor
:creator
:one-line
:as-string
))
36 (<:h3
(<:as-html type
))
37 (present-view (test type self
))
38 (<ucw
:a
:action
(call-view (test type self
))
39 (<:as-html
"Call to " type
))))))
42 (defcomponent standard-display-component
()
43 ((display-function :accessor display-function
:initarg
:display
)))
45 (defmethod render ((self standard-display-component
))
46 (funcall (display-function self
) self
))