Form types
[clinton/lisp-on-lines.git] / src / standard-wrappers.lisp
1 (in-package :lisp-on-lines)
2
3 ;;;;; Wrap a display in "back buttons"
4 (deflayer wrap-back-buttons)
5
6 (defvar *back-buttons-wrapped-p* nil)
7
8 (defdisplay
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")))))
21
22 ;;;; Wrap an object display in with a link to the object
23
24 (deflayer wrap-link)
25
26 (defvar *link-wrapped-p* nil)
27
28 (define-layered-class description
29 :in-layer wrap-link ()
30 ((link :initarg :link-action
31 :initarg :action
32 :initform nil :special t :accessor link-action)))
33
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))
38
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)))))))
56
57 ;;; wrap-a-form
58 (deflayer wrap-form)
59
60 (defvar *in-form-p* nil)
61
62 (define-layered-class description
63 :in-layer wrap-form ()
64 ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)
65 (form-type :initarg :form-type :initform '<ucw:simple-form :special t :accessor form-type)))
66
67 (defattribute form-button-attribute ()
68 ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)))
69
70 (defdisplay ((description form-button-attribute) object)
71 (macrolet ((submit (&key action value )
72 `(<ucw::value-submit
73 :action (funcall ,action self object)
74
75 :value ,value)))
76 (loop for button in (form-buttons description)
77 do
78 (let ((button button))
79 (with-properties (button)
80 (let ((action (.get :action)))
81 (submit :value (.get :value)
82 :action (if (consp action)
83 (eval action)
84 action))))))))
85
86
87 (defdisplay
88 :in-layer wrap-form
89 :around (description object)
90 (flet ((body ()
91 (with-inactive-layers (wrap-form)
92 (call-next-method)
93 (with-inactive-layers (show-attribute-labels)
94 (display-attribute
95 (make-instance
96 'form-button-attribute
97 :form-buttons
98 (form-buttons description))
99 object)))))
100 (ecase (form-type description)
101 ('<ucw:simple-form
102 (<ucw:simple-form
103 :action (refresh-component self)
104 (body)))
105 ('<ucw:form
106 (<ucw:form
107 :action (refresh-component self)
108 (body))))))
109
110 ;;;; wrap a DIV
111
112
113 (deflayer wrap-div)
114
115 (define-layered-class description
116 :in-layer wrap-div ()
117 ((div-attributes :accessor div-attributes :initarg :div :special t :initform nil)))
118
119 (defdisplay :in-layer wrap-div :wrap-around (description object)
120 (let ((args (div-attributes description)))
121 (with-inactive-layers (wrap-div)
122 (yaclml::funcall-with-tag
123 (cons '<:div args)
124 (lambda ()
125 (call-next-method))))))
126
127