(declaim (optimize (speed 0) (space 3) (safety 0))) (in-package :lisp-on-lines) (defmethod render ((self mewa)) (lol::present self)) (defaction edit-instance ((self mewa)) (call-presentation (instance self) :type :editor)) ;;;one-line objects (defcomponent mewa-one-line-presentation (mewa lol::one-line-presentation) () (:default-initargs :attributes-getter #'one-line-attributes-getter :global-properties '(:editablep nil))) (defmethod one-line-attributes-getter ((self mewa)) (or (meta-model::find-slots-of-type (instance self)) (meta-model::list-keys (instance self)))) ;;;objects (defcomponent mewa-object-presentation (mewa lol::object-presentation) ((instance :accessor instance :initarg :instance :initform nil))) (defcomponent mewa-viewer (mewa-object-presentation) () (:default-initargs :global-properties '(:editablep nil))) (defcomponent mewa-editor (mewa-object-presentation) () (:default-initargs :global-properties '(:editablep t))) (defcomponent mewa-creator (mewa-editor) ()) (defmethod present ((pres mewa-object-presentation)) (<:table :class (css-class pres) (dolist (slot (slots pres)) (<:tr :class "presentation-slot-row" (present-slot-as-row pres slot)))) (render-options pres (instance pres))) (defmethod present-slot-as-row ((pres mewa-object-presentation) (slot slot-presentation)) (<:td :class "presentation-slot-label" (<:as-html (label slot))) (<:td :class "presentation-slot-value" (present-slot slot (instance pres)))) (defcomponent two-column-presentation (mewa-object-presentation) ()) (defmethod present ((pres two-column-presentation)) (<:table :class (css-class pres) (loop for slot on (slots pres) by #'cddr do (<:tr :class "presentation-slot-row" (<:td :class "presentation-slot-label" (<:as-html (label (first slot)))) (<:td :class "presentation-slot-value" (present-slot (first slot) (instance pres))) (when (second slot) (<:td :class "presentation-slot-label" (<:as-html (label (second slot)))) (<:td :class "presentation-slot-value" (present-slot (second slot) (instance pres)))))) (render-options pres (instance pres)))) ;;;lists (defcomponent mewa-list-presentation (mewa list-presentation) ((instances :accessor instances :initarg :instances :initform nil) (instance :accessor instance) (select-label :accessor select-label :initform "select" :initarg :select-label) (selectablep :accessor selectablep :initform t :initarg :selectablep) (deleteablep :accessor deletablep :initarg :deletablep :initform nil) (viewablep :accessor viewablep :initarg :viewablep :initform nil))) (defaction select-from-listing ((listing mewa-list-presentation) object index) (answer object)) (defmethod render-list-row ((listing mewa-list-presentation) object index) (<:tr :class "item-row" (<:td :align "center" :valign "top" (when (editablep listing) (let ((object object)) ( (number-input self))) (def-search-expr ((self number-equal-to)) (meta-model:expr-= (number-input self))) (defcomponent mewa-presentation-search (presentation-search) ((display-results-p :accessor display-results-p :initarg :display-results-p :initform nil) (criteria-input :accessor criteria-input :initform "") (new-criteria :accessor new-criteria :initform nil))) (defmethod instance ((self mewa:mewa-presentation-search)) (instance (search-presentation self))) (defmethod search-expr ((self mewa:mewa-presentation-search) instance) (apply #'meta-model:expr-and instance (mapcan (lambda (c) (let ((e (search-expr c instance))) (if (listp e) e (list e)))) (criteria self)))) (defmethod search-query ((self mewa:mewa-presentation-search)) (search-expr self (instance self))) (defmethod valid-instances ((self mewa:mewa-presentation-search)) (meta-model:select-instances (instance self) (search-query self))) (defmethod get-all-instances ((self mewa-presentation-search)) (meta-model:select-instances (instance self))) (defmethod ok ((self mewa-presentation-search) &optional arg) (declare (ignore arg)) (setf (instances (list-presentation self)) (valid-instances self)) (setf (display-results-p self) t)) (defmethod set-search-input-for-criteria ((criteria criteria) (input t)) (error "No search-input-for-criteria method for ~A : ~A" criteria input)) (defmethod set-search-input-for-criteria ((c string-criteria) input) (setf (search-text c) input)) (defmethod set-search-input-for-criteria ((c negated-criteria) i) nil) (defmethod mewa-add-criteria ((self component) (criteria criteria)) (set-search-input-for-criteria criteria (criteria-input self)) (add-criteria self criteria)) (defmethod find-default-criteria (c mewa-string-slot-presentation) 'string-contains) (defmethod render-criteria ((res response) (s mewa-presentation-search)) (setf (criteria-input s) "") (<:ul (dolist (c (criteria s)) (<:li (render-on res c) (let ((c c)) (