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 | |
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 |