massive refactoring in preparation of release.
[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
43
44
45;;; wrap-a-form
46(deflayer wrap-form)
47
48(defdisplay ((description t) (button (eql 'standard-form-buttons)))
49 (<ucw:submit :action (ok self)
50 :value "Ok."))
51
52(defdisplay :in-layer wrap-form :around (object description)
53 (<ucw:form
54 :action (refresh-component self)
55 (with-inactive-layers (wrap-form)
56
57 (call-next-method)
58 ;(display* 'standard-form-buttons)
a4e6154d
DC
59 )))
60
61;;;; wrap a DIV
62
63
64(deflayer wrap-div)
65
66(define-layered-class description
67 :in-layer wrap-div ()
68 ((div-attributes :accessor div-attributes :initarg :div :special t :initform nil)))
69
70(defdisplay :in-layer wrap-div :around (description object)
71 (let ((args (div-attributes description)))
72 (with-inactive-layers (wrap-div)
73 (yaclml::funcall-with-tag
74 (cons '<:div args)
75 (lambda ()
76 (call-next-method))))))
77
78