Commit | Line | Data |
---|---|---|
d0301620 DC |
1 | (in-package :lisp-on-lines) |
2 | ||
3 | ;;;; LoL CLOS Test Class | |
4 | (defclass/meta test-class () | |
5 | ((test-string :initform "test string" :type string)) | |
6 | (:documentation "foo")) | |
7 | ||
8 | (define-attributes (test-class) | |
9 | (test-string t :label "String :" :editablep t)) | |
10 | ||
11 | (defcomponent test-component () | |
12 | ((display-types :accessor display-types :initform (list 'viewer 'editor 'creator 'one-line 'as-string)) | |
13 | (current-type :accessor current-type :initform 'viewer) | |
14 | (instance :accessor instance :initform (make-instance 'test-class)))) | |
15 | ||
16 | (defmethod render ((self test-component)) | |
17 | (let ((test (instance self))) | |
18 | (<:h1 (<:as-html "Lisp on Lines Test Component")) | |
19 | (with-component (self) | |
20 | (<ucw:form | |
21 | :action (refresh-component self) | |
22 | (<ucw:select :accessor (current-type self) | |
23 | (dolist* (type (display-types self)) | |
24 | (<ucw:option :value type (<:as-html type)))) | |
25 | (<:input :type "Submit" :value "update") | |
26 | (<:fieldset | |
27 | (<:legend (<:as-html (current-type self))) | |
28 | (display test :type (current-type self))))) | |
29 | ||
30 | (<:div | |
31 | (<:h2 | |
32 | (<:as-html "UCW Presentation based displays (the old school")) | |
33 | (dolist (type '(:viewer :editor :creator :one-line :as-string)) | |
34 | (<:h3 (<:as-html type)) | |
35 | (present-view (test type self)) | |
36 | (<ucw:a :action (call-view (test type self)) | |
37 | (<:as-html "Call to " type)))))) | |
38 | ||
39 | ||
40 | (defcomponent standard-display-component () | |
41 | ((display-function :accessor display-function :initarg :display))) | |
42 | ||
43 | (defmethod render ((self standard-display-component)) | |
44 | (funcall (display-function self) self)) |