src/ucw-test-component.lisp

   1 (in-package :lisp-on-lines)
   2
   3 ;;;; LoL CLOS Test Class
   4 (defclass lol-test-class ()
   5   ((test-string :initform "test string"))
   6   (:documentation "foo"))
   7
   8 (set-default-attributes 'lol-test-class)
   9
  10 (define-attributes (lol-test-class)
  11   (test-string t :label "String :"))
  12
  13 (defcomponent test-component ()
  14   ((display-types :accessor display-types :initform (list 'viewer 'editor 'creator 'one-line 'as-string))
  15    (current-type :accessor current-type :initform 'viewer)
  16    (instance :accessor instance :initform (make-instance 'test-class))))
  17
  18 (defmethod render ((self test-component))
  19   (let ((test (instance self)))
  20     (<:h1 (<:as-html "Lisp on Lines Test Component"))
  21     (with-component (self)
  22       (<ucw:form
  23        :action (refresh-component self)
  24        (<ucw:select :accessor (current-type self)
  25                     (dolist* (type (display-types self))
  26                       (<ucw:option :value type (<:as-html type))))
  27        (<:input :type "Submit" :value "update")
  28        (<:fieldset
  29         (<:legend (<:as-html (current-type self)))
  30         (display test :type (current-type self)))))
  31
  32     (<:div
  33      (<:h2
  34       (<:as-html "UCW Presentation based displays (the old school"))
  35      (dolist (type '(:viewer :editor :creator :one-line :as-string))
  36        (<:h3 (<:as-html type))
  37        (present-view (test type self))
  38        (<ucw:a :action (call-view (test type self))
  39                (<:as-html "Call to " type))))))
  40
  41
  42 (defcomponent standard-display-component ()
  43   ((display-function :accessor display-function :initarg :display)))
  44
  45 (defmethod render ((self standard-display-component))
  46   (funcall (display-function self) self))