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