X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/19531fbd947da15a17f8e5557a1a1492eab2bca3..687d5f1cf0e27ab020a2a91d3495ec6edcef0c9f:/src/mewa/presentations.lisp

diff --git a/src/mewa/presentations.lisp b/src/mewa/presentations.lisp
new file mode 100644
index 0000000..3763c27
--- /dev/null
+++ b/src/mewa/presentations.lisp
@@ -0,0 +1,50 @@
+(in-package :mewa)
+
+;;;one-line objects
+(defcomponent mewa-one-line-presentation (mewa one-line-presentation)
+  ()
+  (:default-initargs :attributes-getter #'one-line-attributes-getter))
+
+(defmethod one-line-attributes-getter ((self mewa))
+  (or (meta-model:list-keys (instance self))))
+
+;;;objects
+(defcomponent mewa-object-presentation (mewa ucw:object-presentation) ())
+
+;;;lists
+(defcomponent mewa-list-presentation (mewa ucw: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)))
+
+(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 (ucw::editablep listing)
+	(let ((object object))
+	  (<ucw:input :type "submit"
+		      :action (edit-from-listing listing object index)
+		      :value (ucw::edit-label listing))))
+      (<:as-is " ")
+      (when (ucw::deleteablep listing)
+	(let ((index index))
+	  (<ucw:input :type "submit"
+		      :action (delete-from-listing listing object index)
+		      :value (ucw::delete-label listing))))
+      (when (selectablep listing)
+	(let ((index index))
+	  (<ucw:input :type "submit"
+		      :action (select-from-listing listing object index)
+		      :value (select-label listing)))))
+    (dolist (slot (slots listing))
+      (<:td :class "data-cell" (present-slot slot object)))
+    (<:td :class "index-number-cell"
+      (<:i (<:as-html index)))
+    ))
+
+(defmethod get-all-instances ((self mewa-list-presentation))
+  (instances self))