X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/f9b119564f7d0c0d352fa1b13be5ef5b5fb8b872..e9c163726f466dee83a8dbe7d952f6aaff4345b6:/src/defdisplay.lisp

diff --git a/src/defdisplay.lisp b/src/defdisplay.lisp
index 8dac5be..cb50cf5 100644
--- a/src/defdisplay.lisp
+++ b/src/defdisplay.lisp
@@ -11,9 +11,33 @@
     display-using-description (d o c)
     (<:as-html "default :" o))
 
-(defmethod find-layer-for-type (type)
-  type)
-
+(defun make-display-function (component object
+			      &rest properties
+			      &key type (line #'line-in)
+			      &allow-other-keys)
+  "returns a function that expects a 3 argument function as its argument
+
+The function (which is usually display-using-description) will be called with the proper environment for display all set up nice n pretty like."
+
+  (lambda (function)
+    (let* ((description (find-occurence object)))
+
+      (if description
+	  (dletf (((description.type description) type)
+		  ((attributes description) (or
+					     (attributes description)
+					     (list-slots object))))
+	    ;; apply the default line to the description
+	    (funcall-with-description
+	     description
+	     (funcall line object)
+	     ;; apply the passed in arguments and call display-using-description
+	     #'(lambda ()		 
+		 (funcall-with-description
+		  description
+		  properties
+		  function description object component))))
+	  (error "no description for ~A" object)))))
 
 (define-layered-function display (component object &rest args)
   (:documentation
@@ -76,8 +100,6 @@ The default display calls out via FUNCALL-WITH-LAYERS to tche DISPLAY-USING-DESC
 		  (apply function args))))))
       (apply function args)))
 
-
-
 (defmacro with-description ((description &rest properties) &body body)
   `(funcall-with-description ,description (if ',(cdr properties)
 					       (list ,@properties)