Commit | Line | Data |
---|---|---|
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 | |
fb04c0a8 | 34 | (defaction call-action-with-component-and-object ((self component) action-id object) |
ff1e971a | 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)) | |
fb04c0a8 | 47 | (<ucw:a :action (call-action-with-component-and-object |
ff1e971a | 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 | ||
e9c16372 | 60 | (defvar *in-form-p* nil) |
61 | ||
e1645f63 | 62 | (define-layered-class description |
63 | :in-layer wrap-form () | |
e9c16372 | 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))) | |
e1645f63 | 66 | |
ff1e971a | 67 | (defattribute form-button-attribute () |
68 | ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons))) | |
e1645f63 | 69 | |
ff1e971a | 70 | (defdisplay ((description form-button-attribute) object) |
e1645f63 | 71 | (macrolet ((submit (&key action value ) |
fb04c0a8 | 72 | `(<ucw::value-submit |
ff1e971a | 73 | :action (funcall ,action self object) |
e1645f63 | 74 | |
fb04c0a8 | 75 | :value ,value))) |
ff1e971a | 76 | (loop for button in (form-buttons description) |
e1645f63 | 77 | do |
78 | (let ((button button)) | |
79 | (with-properties (button) | |
80 | (let ((action (.get :action))) | |
81 | (submit :value (.get :value) | |
fb04c0a8 | 82 | :action (if (consp action) |
83 | (eval action) | |
84 | action)))))))) | |
e1645f63 | 85 | |
86 | ||
e9c16372 | 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)))))) | |
a4e6154d DC |
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 | ||
ff1e971a | 119 | (defdisplay :in-layer wrap-div :wrap-around (description object) |
a4e6154d DC |
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 |