whitespace fixes
[clinton/lisp-on-lines.git] / src / ucw-test-component.lisp
CommitLineData
d0301620
DC
1(in-package :lisp-on-lines)
2
a4e6154d
DC
3;;;; LoL CLOS Tests
4;;;;
2b0fd9c8 5(defclass lol-test-class ()
a4e6154d
DC
6 ((test-slot-value :initform "slot-value")
7 (test-string :initform "Test String"))
d0301620
DC
8 (:documentation "foo"))
9
a4e6154d
DC
10(defvar *foo* nil)
11
12(defvar *standard-layers* '(viewer editor creator one-line as-string))
2b0fd9c8
DC
13
14(define-attributes (lol-test-class)
a4e6154d
DC
15 (test-getter t
16 :label "Getter"
17 :getter (constantly "Hello World"))
18 (test-getter/setter t
19 :label "Getter/Setter:"
20 :getter (lambda ()
21 *foo*)
22 :setter #'(lambda (value)
23 (setf *foo* value)))
24 (test-slot-value t)
25 (test-string string :label "String" :documentation))
d0301620
DC
26
27(defcomponent test-component ()
a4e6154d
DC
28 (current-layer :accessor current-type :initform 'viewer)
29 (layer-spec :accessor layer-spec :initform nil)
d0301620
DC
30 (instance :accessor instance :initform (make-instance 'test-class))))
31
32(defmethod render ((self test-component))
33 (let ((test (instance self)))
34 (<:h1 (<:as-html "Lisp on Lines Test Component"))
35 (with-component (self)
36 (<ucw:form
37 :action (refresh-component self)
a4e6154d 38 (<ucw:select :accessor (current-layer self)
d0301620
DC
39 (dolist* (type (display-types self))
40 (<ucw:option :value type (<:as-html type))))
41 (<:input :type "Submit" :value "update")
42 (<:fieldset
43 (<:legend (<:as-html (current-type self)))
a4e6154d 44 (display test :type (current-type self)))))))
d0301620
DC
45
46
47(defcomponent standard-display-component ()
48 ((display-function :accessor display-function :initarg :display)))
49
50(defmethod render ((self standard-display-component))
51 (funcall (display-function self) self))