fixed up display mechanism
[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 ()
30 ((link :initarg :link :initform nil :special t :accessor link)))
31
32(defdisplay
33 :in-layer wrap-link :around (description object)
34 (let ((link (link description)))
35
36 (with-inactive-layers (wrap-link)
37 (if *link-wrapped-p*
38 (call-next-method)
39 (let ((*link-wrapped-p* t))
40 (<ucw:a :action (call-display self object link)
41 (call-next-method)))))))
42
2b0fd9c8
DC
43;;; wrap-a-form
44(deflayer wrap-form)
45
e1645f63 46(define-layered-class description
47 :in-layer wrap-form ()
48 ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)))
49
50
51(defdisplay ((description (eql 'standard-form-buttons)) description-object)
52 (macrolet ((submit (&key action value )
53 `(<ucw::simple-submit
54 :action (funcall ,action)
55
56 (<:as-html ,value))))
57 (loop for button in (form-buttons description-object)
58 do
59 (let ((button button))
60 (with-properties (button)
61 (let ((action (.get :action)))
62 (submit :value (.get :value)
63 :action action)))))))
64
65
2b0fd9c8 66
e1645f63 67(defdisplay :in-layer wrap-form :around (description object)
2b0fd9c8
DC
68 (<ucw:form
69 :action (refresh-component self)
70 (with-inactive-layers (wrap-form)
71
72 (call-next-method)
e1645f63 73 (display-attribute 'standard-form-buttons description))))
a4e6154d
DC
74
75;;;; wrap a DIV
76
77
78(deflayer wrap-div)
79
80(define-layered-class description
81 :in-layer wrap-div ()
82 ((div-attributes :accessor div-attributes :initarg :div :special t :initform nil)))
83
84(defdisplay :in-layer wrap-div :around (description object)
85 (let ((args (div-attributes description)))
86 (with-inactive-layers (wrap-div)
87 (yaclml::funcall-with-tag
88 (cons '<:div args)
89 (lambda ()
90 (call-next-method))))))
91
92