Commit | Line | Data |
---|---|---|
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)) |