src/ucw/standard-components.lisp

   1 (in-package :lisp-on-lines-ucw)
   2
   3 (defclass described-component-class (standard-component-class described-class)
   4   ())
   5
   6 (defmacro defaction (&rest args-and-body)
   7   `(arnesi:defmethod/cc ,@args-and-body))
   8
   9 (defun make-action (lambda &rest args)
  10   (let ((ucw::*default-action-class* 'basic-action))
  11     (apply #'ucw::make-action lambda args)))
  12
  13 (defclass standard-application (ucw:basic-application)
  14   ())
  15
  16 (defclass standard-request-context (ucw::standard-request-context)
  17   ())
  18
  19 (defmethod ucw:request-context-class list ((application standard-application))
  20   'standard-request-context)
  21
  22 (defvar +action-compound-name-delimiter+ #\|)
  23
  24 (defmethod ucw::find-action-id :around ((context standard-request-context))
  25   (or
  26    (let (id)
  27      (ucw::find-parameter
  28       (context.request context) ucw::+action-parameter-name+
  29       :test (lambda (name parameter)
  30               (declare (ignore name))
  31               (destructuring-bind (param-name &optional action-id)
  32                   (split-sequence:split-sequence
  33                    +action-compound-name-delimiter+ parameter)
  34                 (when (and action-id
  35                            (string= ucw::+action-parameter-name+ param-name))
  36                   (setf id action-id)))))
  37      id)
  38    (call-next-method)))
  39
  40 (defcomponent standard-window-component
  41   (ucw:basic-window-component)
  42   ((body
  43     :initform nil
  44     :accessor window-body
  45     :component t
  46     :initarg :body)))
  47
  48 (defmethod render-html-body ((window standard-window-component))
  49   (ucw:render (window-body window)))