;;;; -*- lisp -*- (in-package :lisp-on-lines) (defcomponent presentation () ((css-class :accessor css-class :initarg :css-class :initform nil)) (:documentation "The super class of all UCW presentations. A presentation object is a UCW component which knows how to read/write different kinds of data types. There are three major kinds of presentations: 1) object-presentation - Managing a single object. 2) slot-presentation - Managing the single parts (slots) which make up an object. 3) collection-presentation - Managing multiple objects. Presentations are independant of the underlying application specific lisp objects they manage. A presentation can be created once and reused or modified before and aftre it has been used. Presentations fulfill two distinct roles: on the one hand they create, given a lisp object, a grahpical (html) rendering of that object, they also deal with whatever operations the user might wish to perform on that object. * Creating Presentation Objects Presentation objects are created by making an instance of either an object-presentation or a collection-presentation and then filling the slots property of this object.")) (defgeneric present (presentation) (:documentation "Render PRESENTATION (generally called from render-on).")) (defmacro present-object (object &key using presentation) (assert (xor using presentation) (using presentation) "Must specify exactly one of :USING and :PRESENTATION.") (if using (destructuring-bind (type &rest args) (ensure-list using) `(call ',type ,@args 'instance ,object)) (rebinding (presentation) `(progn (setf (slot-value ,presentation 'instance) ,object) (call-component self ,presentation))))) (defmacro present-collection (presentation-type &rest initargs) `(call ',presentation-type ,@initargs)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; object-presentation (defcomponent object-presentation (presentation) ((slots :accessor slots :initarg :slots :initform nil) (instance :initform nil :initarg instance :accessor instance)) (:documentation "Presentations for single objects.")) (defmethod render-on ((res response) (o object-presentation)) (unless (slot-value o 'instance) (error "Attempting to render the presentation ~S, but it has no instance object to present." o)) (present o)) (defmethod present ((pres object-presentation)) (<:table :class (css-class pres) (dolist (slot (slots pres)) (<:tr :class "presentation-slot-row" (<:td :class "presentation-slot-label" (<:as-html (label slot))) (<:td :class "presentation-slot-value" (present-slot slot (instance pres))))) (render-options pres (instance pres)))) (defmethod render-options ((pres object-presentation) instance) (declare (ignore instance pres)) #| (<:tr (<:td :colspan 2 :align "center" ( slot-value number-input)) :label "~A is greater than:" :render-on-prefix "~A > ") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Integers (defslot-presentation integer-slot-presentation (number-slot-presentation) () (:type-name integer)) (defmethod presentation-slot-value ((slot integer-slot-presentation) instance) (declare (ignore instance)) (or (call-next-method) "")) (defmethod (setf presentation-slot-value) ((value string) (slot integer-slot-presentation) instance) (unless (string= "" value) (let ((i (parse-integer value :junk-allowed t))) (when i (setf (presentation-slot-value slot instance) (parse-integer value)))))) (defmethod present-slot ((slot integer-slot-presentation) instance) (if (editablep slot) (