Commit | Line | Data |
---|---|---|
d0301620 DC |
1 | (in-package :lisp-on-lines) |
2 | ||
3 | ;;;; LoL CLOS Test Class | |
2b0fd9c8 DC |
4 | (defclass lol-test-class () |
5 | ((test-string :initform "test string")) | |
d0301620 DC |
6 | (:documentation "foo")) |
7 | ||
2b0fd9c8 DC |
8 | (set-default-attributes 'lol-test-class) |
9 | ||
10 | (define-attributes (lol-test-class) | |
11 | (test-string t :label "String :")) | |
d0301620 DC |
12 | |
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)))) | |
17 | ||
18 | (defmethod render ((self test-component)) | |
19 | (let ((test (instance self))) | |
20 | (<:h1 (<:as-html "Lisp on Lines Test Component")) | |
21 | (with-component (self) | |
22 | (<ucw:form | |
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") | |
28 | (<:fieldset | |
29 | (<:legend (<:as-html (current-type self))) | |
30 | (display test :type (current-type self))))) | |
31 | ||
32 | (<:div | |
33 | (<:h2 | |
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)))))) | |
40 | ||
41 | ||
42 | (defcomponent standard-display-component () | |
43 | ((display-function :accessor display-function :initarg :display))) | |
44 | ||
45 | (defmethod render ((self standard-display-component)) | |
46 | (funcall (display-function self) self)) |