Added standard-wrappers.lisp for 'wrapper' displays

darcs-hash:20060112121115-5417e-fbe0957735ab483058ef5a57556123f656fe0e39.gz

diff --git a/lisp-on-lines.asd b/lisp-on-lines.asd
index ae3ef09..d0dbdb1 100644 (file)
--- a/lisp-on-lines.asd
+++ b/lisp-on-lines.asd
@@ -22,6 +22,7 @@
                                       (:file "slot-presentations/date")
                                       (:file "standard-display")
                                       (:file "standard-attributes")
+                                      (:file "standard-wrappers")
                                       (:file "relational-attributes"))
                          :serial t)
                 (:module :components

diff --git a/src/standard-display.lisp b/src/standard-display.lisp
index 6f5a096..57347f8 100644 (file)
--- a/src/standard-display.lisp
+++ b/src/standard-display.lisp
@@ -25,8 +25,20 @@
             (apply #'display ,component thing args)))
       ,@body)))
 
-(defmacro call-display (object &rest args)
-  `(call-component self (make-instance 'standard-display-component
+
+(define-layered-function find-display-type (object))
+
+(define-layered-method find-display-type (object)
+  'viewer)
+
+(define-layered-function find-display-layers (object))
+
+(define-layered-method find-display-layers (object)
+  "layered function"
+  nil)
+
+(defmacro call-display (component object &rest args)
+  `(call-component ,component (make-instance 'standard-display-component
                         :display #'(lambda (component)
                                      (with-component (component)
                                        (<:as-html ,object)

diff --git a/src/standard-wrappers.lisp b/src/standard-wrappers.lisp
new file mode 100644 (file)
index 0000000..e0f44f6
--- /dev/null
+++ b/src/standard-wrappers.lisp
@@ -0,0 +1,28 @@
+(in-package :lisp-on-lines)
+
+;;;;; Wrap a display in "back buttons"
+(deflayer wrap-back-buttons)
+
+(defdisplay (:in-layer
+            wrap-back-buttons
+            :combination :around)
+  (<ucw:a :class "wiz-button previous" :action (ok component t)
+         (<:as-html "Go Back"))
+  (<:div :style "clear:both;"
+        (call-next-method))
+  (<ucw:a :class "wiz-button previous" :action (ok component t)
+         (<:as-html "Go Back")))
+
+;;;; Wrap an object display in with a link to the object
+
+(deflayer wrap-link)
+
+(defdisplay (:in-layer
+            wrap-link
+            :combination :around)
+  (let ((layers  (find-display-layers object)))
+    (<ucw:a :action (call-display component object
+                                 :type (find-display-type object)
+                                 :layers layers)
+                                
+           (call-next-method))))
\ No newline at end of file