fixed up wrappers .. we are this close to being fully functional!
[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 (define-layered-class description
61 :in-layer wrap-form ()
62 ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)))
63
64 (defattribute form-button-attribute ()
65 ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)))
66
67 (defdisplay ((description form-button-attribute) object)
68 (macrolet ((submit (&key action value )
69 `(<ucw::simple-submit
70 :action (funcall ,action self object)
71
72 (<:as-html ,value))))
73 (loop for button in (form-buttons description)
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
82
83 (defdisplay :in-layer wrap-form :around (description object)
84 (<ucw:form
85 :action (refresh-component self)
86 (with-inactive-layers (wrap-form)
87 (call-next-method)
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)))))
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
105 (defdisplay :in-layer wrap-div :wrap-around (description object)
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