minor fixes
[clinton/lisp-on-lines.git] / src / standard-wrappers.lisp
CommitLineData
d1b0ed7c
DC
1(in-package :lisp-on-lines)
2
3;;;;; Wrap a display in "back buttons"
4(deflayer wrap-back-buttons)
5
a4e6154d
DC
6(defvar *back-buttons-wrapped-p* nil)
7
2b0fd9c8 8(defdisplay
a4e6154d
DC
9 :in-layer wrap-back-buttons :around
10 (description object)
11 (if *back-buttons-wrapped-p*
12 (call-next-method)
13 (let ((*back-buttons-wrapped-p* t))
14
15 (<ucw:a :class "wiz-button previous" :action (ok self t)
16 (<:as-html "Go Back"))
17 (<:div :style "clear:both;"
18 (call-next-method))
19 (<ucw:a :class "wiz-button previous" :action (ok self t)
20 (<:as-html "Go Back")))))
d1b0ed7c
DC
21
22;;;; Wrap an object display in with a link to the object
23
24(deflayer wrap-link)
25
2b0fd9c8
DC
26(defvar *link-wrapped-p* nil)
27
28(define-layered-class description
29 :in-layer wrap-link ()
ff1e971a 30 ((link :initarg :link-action
31 :initarg :action
32 :initform nil :special t :accessor link-action)))
2b0fd9c8 33
ff1e971a 34(defaction call-action-with--component-and-object ((self component) action-id object)
35 (funcall (ucw::find-action (ucw::context.current-frame *context*) action-id)
36 self
37 object))
2b0fd9c8 38
ff1e971a 39(defdisplay
40 :in-layer wrap-link :around (description object)
41 (let ((link (link-action description)))
42
43 (with-inactive-layers (wrap-link)
44 (if *link-wrapped-p*
45 (call-next-method)
46 (let ((*link-wrapped-p* t))
47 (<ucw:a :action (call-action-with--component-and-object
48 self
49 (ucw::make-new-action
50 (ucw::context.current-frame *context*)
51 (if (consp link)
52 (eval link)
53 link))
54 object)
55 (call-next-method)))))))
2b0fd9c8 56
2b0fd9c8
DC
57;;; wrap-a-form
58(deflayer wrap-form)
59
e1645f63 60(define-layered-class description
61 :in-layer wrap-form ()
62 ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)))
63
ff1e971a 64(defattribute form-button-attribute ()
65 ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)))
e1645f63 66
ff1e971a 67(defdisplay ((description form-button-attribute) object)
e1645f63 68 (macrolet ((submit (&key action value )
69 `(<ucw::simple-submit
ff1e971a 70 :action (funcall ,action self object)
e1645f63 71
72 (<:as-html ,value))))
ff1e971a 73 (loop for button in (form-buttons description)
e1645f63 74 do
75 (let ((button button))
76 (with-properties (button)
77 (let ((action (.get :action)))
78 (submit :value (.get :value)
79 :action action)))))))
80
81
2b0fd9c8 82
e1645f63 83(defdisplay :in-layer wrap-form :around (description object)
2b0fd9c8
DC
84 (<ucw:form
85 :action (refresh-component self)
86 (with-inactive-layers (wrap-form)
2b0fd9c8 87 (call-next-method)
ff1e971a 88 (with-inactive-layers (show-attribute-labels)
89 (display-attribute
90 (make-instance
91 'form-button-attribute
92 :form-buttons
93 (form-buttons description))
94 object)))))
a4e6154d
DC
95
96;;;; wrap a DIV
97
98
99(deflayer wrap-div)
100
101(define-layered-class description
102 :in-layer wrap-div ()
103 ((div-attributes :accessor div-attributes :initarg :div :special t :initform nil)))
104
ff1e971a 105(defdisplay :in-layer wrap-div :wrap-around (description object)
a4e6154d
DC
106 (let ((args (div-attributes description)))
107 (with-inactive-layers (wrap-div)
108 (yaclml::funcall-with-tag
109 (cons '<:div args)
110 (lambda ()
111 (call-next-method))))))
112
113