src/ucw/html-description.lisp

   1 (in-package :lisp-on-lines)
   2
   3 (export '(html-description) (find-package :lisp-on-lines))
   4
   5 (defvar *escape-html* t)
   6
   7 (defmethod generic-format ((display lol-ucw:component) string &rest args)
   8   (<:as-html (with-output-to-string (stream)
   9                (apply #'call-next-method stream string args))))
  10
  11
  12 (define-description html-description ()
  13   ())
  14
  15 (define-description t ()
  16   ((css-class  :value "lol-description" :activep nil)
  17    (dom-id :function (lambda (x)
  18                        (declare (ignore x))
  19                        (symbol-name
  20                         (gensym "DOM-ID-")))
  21            :activep nil))
  22   (:in-description html-description))
  23
  24 (define-layered-class html-attribute ()
  25   ((css-class :accessor attribute-css-class
  26               :initform "lol-attribute")
  27    (dom-id :accessor attribute-dom-id :initform nil)))
  28
  29 (define-layered-class standard-attribute
  30   :in-layer #.(defining-description 'html-description)
  31  (html-attribute)
  32  ())
  33
  34 (define-layered-function display-html-attribute-label (object attribute)
  35   (:method (object attribute)
  36     (let ((label (attribute-label attribute)))
  37            (<:label
  38             :class "lol-attribute-label"
  39             (when label
  40               (<:as-html
  41                (with-output-to-string (*display*)
  42                  (display-attribute-label attribute)))))))
  43   (:method
  44       :in-layer #.(defining-description 'inline)
  45       (object attribute)
  46     (let ((label (attribute-label attribute)))
  47       (when label
  48                  (<:as-html
  49           (with-output-to-string (*display*)
  50             (display-attribute-label attribute)))))))
  51
  52 (define-layered-function display-html-attribute-value (object attribute)
  53   (:method (object attribute)
  54     (<:span
  55         :class "lol-attribute-value"
  56         (<:as-html
  57          (display-attribute-value attribute))))
  58
  59   (:method
  60     :in-layer #.(defining-description 'inline) (object attribute)
  61     (display-attribute-value attribute)))
  62
  63 (define-layered-function display-html-attribute (object attribute)
  64
  65   (:method (object attribute)
  66     (<:div
  67      :class (attribute-css-class attribute)
  68      (when (attribute-dom-id attribute)
  69        :id (attribute-dom-id attribute))
  70      (display-html-attribute-label object attribute)
  71      (display-html-attribute-value object attribute)))
  72
  73   (:method
  74       :in-layer #.(defining-description 'inline)
  75       (object attribute)
  76       (<:span
  77        :class (attribute-css-class attribute)
  78        (when (attribute-dom-id attribute)
  79          :id (attribute-dom-id attribute))
  80        (display-html-attribute-label object attribute)
  81        (display-html-attribute-value object attribute))))
  82
  83 (define-layered-method display-using-description
  84   :in-layer #.(defining-description 'html-description)
  85   :around ((attribute standard-attribute) display object &rest args)
  86  (declare (ignore args))
  87  (display-html-attribute object attribute))
  88
  89
  90
  91 (define-layered-method display-html-attribute-value
  92   :in-layer #.(defining-description 'editable) (object attribute)
  93
  94     (<:span
  95         :class "lol-attribute-value"
  96     (if (attribute-editp object attribute)
  97     (<lol:input :reader (attribute-value attribute)
  98                 :writer (let ((obj (described-object (attribute-description attribute))))
  99                           (lambda (val)
 100                             (dletf (((described-object attribute) obj))
 101                               (setf (attribute-value attribute) val)))))
 102     (call-next-method))
 103 ))
 104
 105 (define-layered-function display-html-description (description display object &optional next-method)
 106   (:method (description display object &optional (next-method #'display-using-description))
 107     (<:style
 108      (<:as-html "
 109
 110 div.lol-description .lol-attribute-label,
 111 div.lol-description .lol-attribute-value {
 112       display: block;
 113       width: 69%;
 114       float: left;
 115       margin-bottom: 1em;
 116
 117 }
 118 div.lol-description
 119 .lol-attribute-label {
 120      text-align: right;
 121      width: 24%;
 122      padding-right: 20px;
 123 }
 124
 125
 126 div.lol-description
 127 br {
 128 clear: left;
 129 }"))
 130
 131     (with-attributes (css-class dom-id) description
 132
 133
 134       (<:div
 135        :class (list (attribute-value css-class) "lol-description" "t")
 136        :id    (attribute-value dom-id)
 137        (funcall next-method)))))
 138
 139
 140 (define-layered-method display-html-description
 141   :in-layer #.(defining-description 'inline) (description display object &optional next-method)
 142   (with-attributes (css-class dom-id) description
 143     (<:span
 144      :class (list (attribute-value css-class) "lol-description")
 145      :id    (attribute-value dom-id)
 146      (funcall next-method))))
 147
 148
 149 (define-display
 150   :in-description html-description ((description t)
 151                                     (display lol-ucw:component)
 152                                     object)
 153   (display-html-description description display object (lambda ()
 154                                                          (call-next-method))))
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164