()
(:type-name integer))
+(defattribute integer-attribute (number-attribute integer-field)
+ ()
+ (:in-layer editor)
+ (:type-name integer))
+
(define-layered-method (setf attribute-value) ((value string) object (attribute integer-attribute))
(let ((*read-eval* nil))
(in-package :lisp-on-lines)
+;;;; A few layers related to attributes
(deflayer omit-nil-attributes)
(defdisplay :in-layer omit-nil-attributes
(when (attribute-value object attribute)
(call-next-method)))
-(deflayer label-attributes)
+(deflayer show-attribute-labels)
-(defdisplay :in-layer label-attributes
- :around ((attribute standard-attribute) object)
+(defdisplay
+ :in-layer show-attribute-labels
+ :around ((attribute standard-attribute) object)
+
+ (<:span
+ :class "lol-label"
+ (<:as-html (or (label attribute) (attribute.name attribute)) " "))
+ (<:span
+ :class "lol-attribute"
+ (call-next-method)))
+
+(deflayer use-pretty-labels)
+
+(define-layered-method label
+ :in-layer use-pretty-labels
+ :around (standard-attribute)
+ (let ((label (call-next-method)))
+ (when label
+ (string-capitalize
+ (substitute #\Space #\- label)))))
+
+(defattribute display ()
+ ()
+ (:documentation "Apply the display function to this object"))
- (<:span
- :class "lol-label"
- (<:as-html (or (label attribute) (attribute.name attribute))))
- (<:span
- :class "lol-attribute"
- (call-next-method)))
+(defdisplay ((attribute display) object)
+ (apply #'display self (attribute-value object attribute)
+ (description.properties attribute)))
;;;; * Base Types
(defdisplay ((base base-attribute) object)
(<:as-html (attribute-value object base)))
-
-(defattribute base-attribute ()
+(defattribute base-attribute (ucw::string-field)
()
(:in-layer editor)
(:default-properties
:callback nil))
+(defmethod ucw:client-value ((self base-attribute))
+ (attribute-value (object self) self))
+
+(defmethod (setf ucw:client-value) (value (attribute base-attribute))
+ (setf (attribute-value (object attribute) attribute) value))
+
+
+(defmethod render ((field base-attribute))
+ "this can only be used within a display-using-description call in the editor context,
+ it is a hack to integrate lol with ucw's new form stuff"
+ (call-next-method))
+
+ #+ (or)
+(LET ((value (attribute-value (object field) field)))
+ (<:as-html "asd" value)
+ (<:input
+ :NAME
+ (callback field)
+ :VALUE (escape-as-html value)
+ :TYPE
+ "text"
+ :ID
+ (DOM-ID FIELD)
+ :SIZE
+ (ucw::INPUT-SIZE FIELD)))
+
+
+
+(defdisplay
+ :in-layer editor ((string base-attribute) object)
+ (render string))
+
+
(defdisplay
:in-layer editor :around ((string base-attribute) object)
(dletf (((callback string) (ucw::make-new-callback
#'(lambda (val)
- (setf (attribute-value object string) val)))))
+ (setf (attribute-value object string) val))))
+ ((object string) object))
(call-next-method)))
;;;; Strings
-(defattribute string-attribute ()
+(defattribute string-attribute (base-attribute)
()
(:type-name string)
(:default-properties
:size nil
:max-length nil))
-(defdisplay
- :in-layer editor ((string base-attribute) object)
- (<:input
- :type "text"
- :id (id string)
- :name (callback string)
- :value (or (attribute-value object string) "")))
-
-
(defdisplay :in-layer omit-nil-attributes
:around ((attribute string-attribute) object)
(when (< 0 (length (attribute-value object attribute)))
(deflayer viewer)
(deflayer editor)
+(define-layered-method label (anything)
+ nil)
+
(defdisplay
:in-layer editor :around (description object)
- "It is useful to remove the viewer layer when in the editing layer.
+ "It is useful to remove the viewer layer when in the editing layer.
This allows us to dispatch to a subclasses editor."
- (with-inactive-layers (viewer)
- (call-next-method)))
+ (with-inactive-layers (viewer)
+ (call-next-method)))
-(deflayer creator)
+;;;; These layers affect the layout of the object
(deflayer one-line)
(deflayer as-table)
-
-
-
(deflayer as-string)
(defdisplay
:in-layer as-string (d o)
- (with-inactive-layers (editor viewer creator one-line as-table label-attributes)
+ (with-inactive-layers (editor viewer one-line as-table show-attribute-labels)
(do-attributes (a d)
(display-attribute a o)
(<:as-is " "))))
(defcomponent standard-display-component ()
((context :accessor context :initarg :context)
- (object :accessor object :initarg :object)
+ (object :accessor object-of :initarg :object)
(args :accessor args :initarg :args)))
(defmethod render ((self standard-display-component))
- (apply #'display self (object self) (args self)))
+ (apply #'display self (object-of self) (args self)))
;;;; * Object displays.
;;;; ** One line
(defdisplay
- :in-layer one-line (description object)
- "The one line presentation just displays the attributes with a #\Space between them"
- (do-attributes (attribute description)
- (display-attribute attribute object)
- (<:as-html " ")))
+ :in-layer one-line (description object)
+ "The one line presentation just displays the attributes with a #\Space between them"
+ (do-attributes (attribute description)
+ (display-attribute attribute object)
+ (<:as-html " ")))
;;;; ** as-table
(<:td (display-attribute a object))))))
;;;; List Displays
+
+(deflayer list-display-layer)
+
+(define-layered-class description
+ :in-layer list-display-layer ()
+ ((list-item :initarg :list-item :initform nil :special t :accessor list-item)))
+
(defdisplay (desc (list list))
- (<:ul
- (dolist* (item list)
- (<:li (display* item)
- (<:as-html item)))))
+ (with-active-layers (list-display-layer)
+
+ (<:ul
+ (dolist* (item list)
+ (<:li (apply #'display* item (list-item desc)))))))
;;;; Attributes
(defdisplay
(<ucw:a :action (call-display self object link)
(call-next-method)))))))
-
-
;;; wrap-a-form
(deflayer wrap-form)
-(defdisplay ((description t) (button (eql 'standard-form-buttons)))
- (<ucw:submit :action (ok self)
- :value "Ok."))
+(define-layered-class description
+ :in-layer wrap-form ()
+ ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)))
+
+
+(defdisplay ((description (eql 'standard-form-buttons)) description-object)
+ (macrolet ((submit (&key action value )
+ `(<ucw::simple-submit
+ :action (funcall ,action)
+
+ (<:as-html ,value))))
+ (loop for button in (form-buttons description-object)
+ do
+ (let ((button button))
+ (with-properties (button)
+ (let ((action (.get :action)))
+ (submit :value (.get :value)
+ :action action)))))))
+
+
-(defdisplay :in-layer wrap-form :around (object description)
+(defdisplay :in-layer wrap-form :around (description object)
(<ucw:form
:action (refresh-component self)
(with-inactive-layers (wrap-form)
(call-next-method)
- ;(display* 'standard-form-buttons)
- )))
+ (display-attribute 'standard-form-buttons description))))
;;;; wrap a DIV