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 :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 ;;; wrap-a-form
  44 (deflayer wrap-form)
  45
  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
  66
  67 (defdisplay :in-layer wrap-form :around (description object)
  68   (<ucw:form
  69    :action (refresh-component self)
  70    (with-inactive-layers (wrap-form)
  71
  72      (call-next-method)
  73      (display-attribute 'standard-form-buttons description))))
  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