src/ucw/standard-components.lisp

   1 (in-package :lisp-on-lines-ucw)
   2
   3 (defclass lisp-on-lines-action (ucw-standard::standard-action)
   4   ((layer-context :accessor action-layer-context
   5                   :initform nil
   6                   :initarg :layer-context))
   7   (:metaclass closer-mop:funcallable-standard-class))
   8
   9
  10 (setf ucw-core::*default-action-class* 'lisp-on-lines-action)
  11
  12
  13 (defmethod ucw-core:call-action :around ((action lisp-on-lines-action) application session frame)
  14   (let ((next-method (lambda ()
  15                        (layered-call-action
  16                         action application session frame
  17                         (lambda ()
  18                           (call-next-method))))))
  19     (let ((layer-context (action-layer-context action)))
  20       (if layer-context
  21           (contextl:funcall-with-layer-context layer-context next-method)
  22           (funcall next-method)))
  23     ))
  24
  25 (defmethod ucw-core:handle-action :wrap-around ((action lisp-on-lines-action) application session frame)
  26      (let ((lol::*invalid-objects* (make-hash-table)))
  27        (handler-bind ((lol::validation-condition
  28                        (lambda (c)
  29                          (let ((object (lol::validation-condition-object c))
  30                                (attribute (lol::validation-condition-attribute c)))
  31
  32
  33                            (setf (gethash object lol::*invalid-objects*)
  34                                  (cons (cons attribute c)
  35                                        (gethash object lol::*invalid-objects*)))))))
  36        (call-next-method))))
  37
  38
  39 (contextl:define-layered-function layered-call-action (action application session frame next-method)
  40   (:method (action application session frame next-method)
  41     (funcall next-method)))
  42
  43
  44 (contextl:define-layered-method layered-call-action
  45    :in-layer #.(lol::defining-description 'lol::validate)
  46    :around ((action lisp-on-lines-action) application session frame next-method)
  47    (call-next-method)
  48
  49    )
  50
  51
  52
  53 (defclass described-component-class (described-class standard-component-class )
  54   ())
  55
  56
  57
  58 ;; (defcomponent standard-window-component
  59 ;;   (ucw-standard::basic-window-component)
  60 ;;   ((body
  61 ;;     :initform nil
  62 ;;     :accessor window-body
  63 ;;     :component t
  64 ;;     :initarg :body)))
  65
  66 ;; (defmethod render-html-head ((window standard-window-component))
  67 ;;   (let* ((app (context.application *context*))
  68 ;;       (url-prefix (application.url-prefix app)))
  69 ;;     (<:meta :http-equiv "Content-Type" :content (window-component.content-type window))
  70 ;;     (awhen (window-component.title window)
  71 ;;       (<:title (if (functionp it)
  72 ;;                 (funcall it window)
  73 ;;                 (<:as-html it))))
  74 ;;     (awhen (window-component.icon window)
  75 ;;       (<:link :rel "icon"
  76 ;;            :type "image/x-icon"
  77 ;;            :href (concatenate 'string url-prefix it)))
  78 ;;     (dolist (stylesheet (effective-window-stylesheets window))
  79 ;;       (<:link :rel "stylesheet"
  80 ;;            :href stylesheet
  81 ;;            :type "text/css"))))
  82
  83 ;; (defmethod render-html-body ((window standard-window-component))
  84 ;;   (render (window-body window)))
  85
  86 ;; (defcomponent info-message ()
  87 ;;   ((message :accessor message :initarg :message)))
  88
  89 ;; (defmethod render ((m info-message))
  90 ;;   (<:div
  91 ;;    :class "info-mssage"
  92 ;;    (<:as-html (message m)))
  93 ;;    (<ucw:a :action (answer-component m nil) "Ok"))
  94
  95