nuke more cruft

[clinton/lisp-on-lines.git] / src / defdisplay.lisp

diff --git a/src/defdisplay.lisp b/src/defdisplay.lisp
deleted file mode 100644 (file)
index efafa2e..0000000
--- a/src/defdisplay.lisp
+++ /dev/null
@@ -1,139 +0,0 @@
-(in-package :lisp-on-lines)
-
-(define-layered-function display-using-description (description object component)
-  (:method-combination wrapping-standard)
-  (:documentation
-   "Render the object in component, 
-    using DESCRIPTION, which is an occurence, an attribute, or something else entirely."))
-
-(defun make-display-function (component object
-                             &rest properties
-                             &key  (line #'line-in)
-                             &allow-other-keys)
-  "returns a function that expects a 3 argument function as its argument
-
-The function argument (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 (((attributes description) 
-                  (or
-                   (attributes description)
-                   (list-attributes description))))
-           ;; 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
-   "Displays OBJECT in COMPONENT."))
-
-(define-layered-method display ((component t) (object t)
-                               &rest properties)
-  " The default display dispatch method
-
-  DISPLAY takes two required arguments, 
-  COMPONENT : The component to display FROM (not neccesarily 'in')
-  OBJECT : The 'thing' we want to display... in this case it's the component
-
-  DISPLAY also takes keywords arguments which modify the DESCRIPTION,
-  that is to say the parameters that come together to create the output.
-
-The default display calls out via FUNCALL-WITH-LAYERS to tche DISPLAY-USING-DESCRIPTION method."
-  (funcall (apply 'make-display-function component object properties)
-          'display-using-description))
-
-;;;;; Macros
-
-(defun funcall-with-layers (layers thunk)
-  (let ((context (current-layer-context)))
-    (loop :for (op layer) 
-       :on layers :by #'cddr
-       :do (setf context 
-                (case op
-                  (+ (adjoin-layer layer context))
-                  (- (remove-layer layer context)))))
-    (funcall-with-layer-context context thunk)))
-                 
-
-(defun funcall-with-description (description properties function &rest args)  
-  (if description
-      (dletf* (((description-type description) 
-               (or
-                (getf properties :type)
-                (description-type description)))
-           
-              ((description-layers description) 
-               (append 
-                (description-layers description)
-                (getf properties :layers)))
-              ((description-properties description) (append (description-properties description) properties)))
-       (funcall-with-layers 
-        (description-layers description)
-        (lambda ()
-          (contextl::funcall-with-special-initargs
-           (list (cons description properties))
-           #'(lambda ()
-               (apply function args))))))
-      (apply function args)))
-
-(defmacro with-description ((description &rest properties) &body body)
-  `(funcall-with-description ,description (if ',(cdr properties)
-                                              (list ,@properties)
-                                              ,(car properties))
-    #'(lambda ()
-       ,@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))))))
-
-(defmacro with-component ((component) &body body)
-  `(let ((self ,component))
-    (declare (ignorable self))
-    (flet ((display* (thing &rest args)
-            (apply #'display ,component thing args))
-          (display-attribute (attribute obj &rest
-                                        props)
-            (if props
-                (funcall-with-description
-                 attribute props
-                 #'display-using-description attribute obj ,component)
-                (display-using-description attribute obj ,component))))
-      (declare (ignorable #'display* #'display-attribute))
-      ,@body)))
-
-
-
-