Major patch touching a lot, representing the new lol. is mostly drop-in backwards...
[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 (defdisplay
7 :in-layer wrap-back-buttons :around
8 (description object)
9
10 (<ucw:a :class "wiz-button previous" :action (ok component t)
11 (<:as-html "Go Back"))
12 (<:div :style "clear:both;"
13 (call-next-method))
14 (<ucw:a :class "wiz-button previous" :action (ok component t)
15 (<:as-html "Go Back")))
16
17 ;;;; Wrap an object display in with a link to the object
18
19 (deflayer wrap-link)
20
21 (defvar *link-wrapped-p* nil)
22
23 (define-layered-class description
24 :in-layer wrap-link ()
25 ((link :initarg :link :initform nil :special t :accessor link)))
26
27 (defdisplay
28 :in-layer wrap-link :around (description object)
29 (let ((link (link description)))
30
31 (with-inactive-layers (wrap-link)
32 (if *link-wrapped-p*
33 (call-next-method)
34 (let ((*link-wrapped-p* t))
35 (<ucw:a :action (call-display self object link)
36 (call-next-method)))))))
37
38
39
40 ;;; wrap-a-form
41 (deflayer wrap-form)
42
43 (defdisplay ((description t) (button (eql 'standard-form-buttons)))
44 (<ucw:submit :action (ok self)
45 :value "Ok."))
46
47 (defdisplay :in-layer wrap-form :around (object description)
48 (<ucw:form
49 :action (refresh-component self)
50 (with-inactive-layers (wrap-form)
51
52 (call-next-method)
53 ;(display* 'standard-form-buttons)
54 )))