fixed up display mechanism

darcs-hash:20060530011658-39164-3d2220d2e247f16250296bb7f21303835aa8a8db.gz

diff --git a/lisp-on-lines.asd b/lisp-on-lines.asd
index 2e4eb26..99b9a69 100644 (file)
--- a/lisp-on-lines.asd
+++ b/lisp-on-lines.asd
@@ -19,7 +19,6 @@
                                     (:file "properties")                                      
                                     (:file "mewa")
                                     (:file "validation")
-                              
                                     (:file "lisp-on-lines")  
                                     (:file "defdisplay")
                                     (:file "standard-display")

diff --git a/src/defdisplay.lisp b/src/defdisplay.lisp
index ae74b8c..8dac5be 100644 (file)
--- a/src/defdisplay.lisp
+++ b/src/defdisplay.lisp
@@ -2,6 +2,7 @@
 
 (define-layered-function display-using-description (description object component)
 ;  (:argument-precedence-order )
+  (:method-combination wrapping-standard)
   (:documentation
    "Render the object in component, 
     using DESCRIPTION, which is an occurence, an attribute, or something else entirely."))
@@ -33,13 +34,10 @@
 
 The default display calls out via FUNCALL-WITH-LAYERS to tche DISPLAY-USING-DESCRIPTION method."
 
-  (let* ((occurence (find-occurence object))
-        (description (or (find-display-attribute
-                          occurence
-                          (setf type (or type (description.type occurence))))
-                         occurence)))
+  (let* ((description (find-occurence object)))
+
     (if description
-       (dletf (((description.type occurence) type)
+       (dletf (((description.type description) type)
                ((attributes description) (or
                                           (attributes description)
                                           (list-slots object))))
@@ -87,18 +85,31 @@ The default display calls out via FUNCALL-WITH-LAYERS to tche DISPLAY-USING-DESC
     #'(lambda ()
        ,@body)))
 
-(defmacro do-attributes ((var description &optional (attributes `(attributes ,description))) &body body)
+(define-layered-function find-do-attributes (desc))
+
+(define-layered-method find-do-attributes ((description description))
+
+  (loop
+     :for att
+     :in (attributes description)
+     :collect (let ((default (find (car (ensure-list att))
+                                  (default-attributes description)
+                                  :key #'car)))
+               (or default att))))
+
+(defmacro do-attributes ((var description &optional (attributes `(find-do-attributes ,description))) &body body)
   (with-unique-names (att properties type)
     `(dolist* (,att  ,attributes)
-      (let* ((,att (ensure-list ,att))
-                (,properties (rest ,att))
-                (,type (getf ,properties :type))
-                (,var (let ((a (find-attribute ,description (first ,att))))
-                       (if ,type
-                           (apply #'make-attribute :name (first ,att) :type ,type ,properties)
-                           (if a a (make-attribute :name (first ,att) :slot-name (first ,att)))))))
-       (funcall-with-description ,var ,properties
-         #'(lambda () ,@body))))))
+       (let* ((,att (ensure-list ,att))
+             (,properties (rest ,att))
+             (,type (getf ,properties :type))
+             (,var (let ((a (find-attribute ,description (first ,att))))
+                     (if ,type
+                         (apply #'make-attribute :name (first ,att) :type ,type ,properties)
+                         (if a a (make-attribute :name (first ,att) :slot-name (first ,att)))))))
+        (funcall-with-description ,var ,properties
+                                  #'(lambda ()
+                                      ,@body))))))
 
 (defmacro with-component ((component) &body body)
   `(let ((self ,component))

diff --git a/src/lines.lisp b/src/lines.lisp
index 8b26923..55763dd 100644 (file)
--- a/src/lines.lisp
+++ b/src/lines.lisp
@@ -1,12 +1,12 @@
 (in-package :lisp-on-lines)
 
+(define-layered-function line-in (name)
+  (:method-combination append)
+  (:method append (thing)
+    '()))
+
 (defmacro defline (name (specializer &rest layers-and-combination-keywords) &body docstring-and-body)
   `(progn
-    ,(eval-when
-      (:compile-toplevel :load-toplevel :execute)
-      (unless (fboundp (contextl::get-layered-function-definer-name name)) 
-       `(define-layered-function ,name (arg)
-         (:method-combination append))))
     (define-layered-method
        ,name
       ,@layers-and-combination-keywords
@@ -21,16 +21,4 @@
        
        ,(or (cdr docstring-and-body) (car docstring-and-body)))))
 
-(defun line-out (component object &rest args &key (line #'line-in) &allow-other-keys )
-  (apply #'display component object (append args (funcall line object))))
-
-(defline line-in (thing)
-  '())
-
-
-(defmacro call-line (from line &rest args)
-  (with-unique-names (lines object)
-    `(multiple-value-bind (,lines ,object)
-        (funcall ,line)
-       (call-display-with-context ,from ,object nil (append ,args ,lines)))))