? ChangeLog
? Apps/Inspector/disassembly.fasl
? Apps/Inspector/inspector.fasl
? Apps/Inspector/package.fasl
? Backends/Null
? Doc/Guided-Tour/draw-frame-commands
? Doc/Guided-Tour/draw-frame-def-app
? Doc/Guided-Tour/draw-frame-interfacing
? Doc/Guided-Tour/file-browser-all
? Doc/Guided-Tour/guided-tour.aux
? Doc/Guided-Tour/guided-tour.bbl
? Doc/Guided-Tour/guided-tour.blg
? Doc/Guided-Tour/guided-tour.dvi
? Doc/Guided-Tour/guided-tour.log
? Doc/Guided-Tour/guided-tour.ps
? Doc/Guided-Tour/hello-world-def-app
? Doc/Guided-Tour/hello-world-defclass
? Doc/Guided-Tour/hello-world-handle-repaint
? Doc/Guided-Tour/scheduler-part1
? Doc/Guided-Tour/scheduler-part2
? Doc/Guided-Tour/techno-dep.pstex
? Doc/Guided-Tour/techno-dep.pstex_t
? Experimental/freetype/freetype-fonts.fasl
? Experimental/freetype/freetype-package.fasl
? docs/guided-tour/draw-frame-commands
? docs/guided-tour/draw-frame-def-app
? docs/guided-tour/draw-frame-interfacing
? docs/guided-tour/guided-tour.aux
? docs/guided-tour/guided-tour.bbl
? docs/guided-tour/guided-tour.blg
? docs/guided-tour/guided-tour.dvi
? docs/guided-tour/guided-tour.log
? docs/guided-tour/guided-tour.ps
? docs/guided-tour/hello-world-def-app
? docs/guided-tour/hello-world-defclass
? docs/guided-tour/hello-world-handle-repaint
? docs/guided-tour/scheduler-part1
? docs/guided-tour/scheduler-part2
? docs/guided-tour/techno-dep.pstex
? docs/guided-tour/techno-dep.pstex_t
Index: graph-formatting.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/graph-formatting.lisp,v
retrieving revision 1.17
diff -u -r1.17 graph-formatting.lisp
--- graph-formatting.lisp	10 Mar 2006 21:58:13 -0000	1.17
+++ graph-formatting.lisp	14 Mar 2006 17:16:14 -0000
@@ -240,6 +240,8 @@
     :initarg :graph-children
     :initform nil
     :accessor graph-node-children)
+   (edges-from :initform (make-hash-table))
+   (edges-to   :initform (make-hash-table))
    (object
     :initarg :object
     :reader graph-node-object)
@@ -405,6 +407,15 @@
                                (incf v within-generation-separation)))
                            (graph-root-nodes graph-output-record)))))))))))
 
+;;;; Edges
+
+(defclass standard-edge-output-record (standard-sequence-output-record)
+  ((stream)
+   (arc-drawer)
+   (arc-drawing-options)
+   (from-node :initarg :from-node)
+   (to-node :initarg :to-node)))
+
 
 (defmethod layout-graph-nodes ((graph-output-record dag-graph-output-record)
                                stream arc-drawer arc-drawing-options)
@@ -526,7 +537,7 @@
   (with-slots (root-nodes orientation) graph-output-record
     (let ((hash (make-hash-table)))
       (labels ((walk (node)
-                 (unless (gethash node hash)
+		 (unless (gethash node hash)
                    (setf (gethash node hash) t)
                    (dolist (k (graph-node-children node))
                      (with-bounding-rectangle* (x1 y1 x2 y2) node
@@ -551,6 +562,55 @@
                      (walk k)))))
         (map nil #'walk root-nodes)))))
 
+(defun layout-edges (graph node stream arc-drawer arc-drawing-options)
+  (dolist (k (graph-node-children node))
+    (layout-edge graph node k stream arc-drawer arc-drawing-options)))
+
+(defun ensure-edge-record (graph major-node minor-node)
+  (let ((edges-from (slot-value major-node 'edges-from))
+	(edges-to   (slot-value minor-node 'edges-to)))
+    (assert (eq (gethash minor-node edges-from)
+		(gethash major-node edges-to)))
+    (or (gethash minor-node edges-from)
+	(let ((record (make-instance 'standard-edge-output-record
+				     :from-node major-node :to-node minor-node)))
+	  (setf (gethash minor-node edges-from) record
+		(gethash major-node edges-to) record)
+	  (add-output-record record graph)
+	  record))))
+
+(defun layout-edge-1 (graph major-node minor-node)
+  (let ((edge-record (ensure-edge-record graph major-node minor-node)))    
+    (with-slots (stream arc-drawer arc-drawing-options) edge-record
+      (with-bounding-rectangle* (x1 y1 x2 y2) major-node
+        (with-bounding-rectangle* (u1 v1 u2 v2) minor-node
+          (clear-output-record edge-record)  ;;; FIXME: repaint?
+           (letf (((stream-current-output-record stream) edge-record))
+            (ecase (slot-value graph 'orientation)
+	      ((:horizontal)
+	       (multiple-value-bind (from to) (if (< x1 u1)
+						  (values x2 u1)
+					          (values x1 u2))
+		 (apply arc-drawer stream major-node minor-node
+			from (/ (+ y1 y2) 2)
+			to   (/ (+ v1 v2) 2)
+			arc-drawing-options)))
+	      ((:vertical)
+	       (multiple-value-bind (from to) (if (< y1 v1)
+						  (values y2 v1)
+				     	          (values y1 v2))
+		 (apply arc-drawer stream major-node minor-node
+			(/ (+ x1 x2) 2) from
+			(/ (+ u1 u2) 2) to
+			arc-drawing-options))))))))))
+
+(defun layout-edge (graph major-node minor-node stream arc-drawer arc-drawing-options)
+  (let ((edge-record (ensure-edge-record graph major-node minor-node)))
+    (setf (slot-value edge-record 'stream) stream
+	  (slot-value edge-record 'arc-drawer) arc-drawer
+	  (slot-value edge-record 'arc-drawing-options) arc-drawing-options)
+    (layout-edge-1 graph major-node minor-node)))
+
 (defmethod layout-graph-edges ((graph standard-graph-output-record)
                                stream arc-drawer arc-drawing-options)
   (with-slots (orientation) graph
@@ -562,26 +622,7 @@
     (traverse-graph-nodes graph
                           (lambda (node children continuation)
                             (unless (eq node graph)
-                              (dolist (k children)
-                                (with-bounding-rectangle* (x1 y1 x2 y2) node
-                                  (with-bounding-rectangle* (u1 v1 u2 v2) k
-                                    (ecase orientation
-                                      ((:horizontal)
-                                       (multiple-value-bind (from to) (if (< x1 u1)
-                                                                          (values x2 u1)
-                                                                          (values x1 u2))
-                                         (apply arc-drawer stream node k
-                                                from (/ (+ y1 y2) 2)
-                                                to   (/ (+ v1 v2) 2)
-                                                arc-drawing-options)))
-                                      ((:vertical)
-                                       (multiple-value-bind (from to) (if (< y1 v1)
-                                                                          (values y2 v1)
-                                                                          (values y1 v2))
-                                         (apply arc-drawer stream node k
-                                                (/ (+ x1 x2) 2) from
-                                                (/ (+ u1 u2) 2) to
-                                                arc-drawing-options))))))))
+			      (layout-edges graph node stream arc-drawer arc-drawing-options))
                             (map nil continuation children))))))
 
 (defmethod layout-graph-edges :around ((graph-output-record tree-graph-output-record)
Index: mcclim.asd
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/mcclim.asd,v
retrieving revision 1.8
diff -u -r1.8 mcclim.asd
--- mcclim.asd	10 Mar 2006 21:58:13 -0000	1.8
+++ mcclim.asd	14 Mar 2006 17:16:14 -0000
@@ -244,6 +244,18 @@
                (:file "graft" :depends-on ("port" "package"))
                (:file "frame-manager" :depends-on ("medium" "port" "package"))))))
 
+(defsystem :clim-null
+    :depends-on (:clim)
+    :components
+    ((:module "Backends/Null"
+	      :pathname #.(make-pathname :directory '(:relative "Backends" "Null"))
+	      :components
+	      ((:file "package")
+	       (:file "port" :depends-on ("package"))
+	       (:file "medium" :depends-on ("port" "package"))
+	       (:file "graft" :depends-on ("port" "package"))
+	       (:file "frame-manager" :depends-on ("medium" "port" "package"))))))
+
 ;;; TODO/asf: I don't have the required libs to get :clim-opengl to load. tough.
 (clim-defsystem (:clim-opengl :depends-on (:clim))
    "Backends/OpenGL/opengl-x-frame-manager"
@@ -297,6 +309,9 @@
                  ;; But until it's ready, it's no use forcing users to
                  ;; cope with possible bugs.
                  ;; #+(or openmcl mcl)          :clim-beagle
+
+		 ;; null backend
+		 :clim-null
                  )
     :components ((:file "Looks/pixie"
                         :pathname #.(make-pathname :directory '(:relative "Looks") :name "pixie" :type "lisp"))))
Index: ports.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/ports.lisp,v
retrieving revision 1.50
diff -u -r1.50 ports.lisp
--- ports.lisp	10 Mar 2006 21:58:13 -0000	1.50
+++ ports.lisp	14 Mar 2006 17:16:14 -0000
@@ -25,7 +25,7 @@
 
 (defvar *default-server-path* nil)
 
-(defvar *server-path-search-order* '(:genera :ms-windows :gtk :clx :x11 :opengl :beagle))
+(defvar *server-path-search-order* '(:genera :ms-windows :gtk :clx :x11 :opengl :beagle :null))
 
 (defun find-default-server-path ()
   (loop for port in *server-path-search-order*
Index: Experimental/freetype/mcclim-freetype.asd
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Experimental/freetype/mcclim-freetype.asd,v
retrieving revision 1.4
diff -u -r1.4 mcclim-freetype.asd
--- Experimental/freetype/mcclim-freetype.asd	6 Feb 2006 13:42:09 -0000	1.4
+++ Experimental/freetype/mcclim-freetype.asd	14 Mar 2006 17:16:14 -0000
@@ -12,13 +12,20 @@
 (defpackage :mcclim-freetype-system (:use :cl :asdf))
 (in-package :mcclim-freetype-system)
 
-(defclass uncompiled-cl-source-file (cl-source-file) ())
+(defclass uncompiled-cl-source-file (source-file) ())
 
 (defmethod perform ((o compile-op) (f uncompiled-cl-source-file))
   t)
-
+(defmethod perform ((o load-op) (f uncompiled-cl-source-file))
+  (mapcar #'load (input-files o f)))
 (defmethod output-files ((operation compile-op) (c uncompiled-cl-source-file))
+  nil)
+(defmethod input-files ((operation load-op) (c uncompiled-cl-source-file))
   (list (component-pathname c)))
+(defmethod operation-done-p ((operation compile-op) (c uncompiled-cl-source-file))
+  t)
+(defmethod source-file-type ((c uncompiled-cl-source-file) (s module))
+  "lisp")
 
 (defsystem :mcclim-freetype
   :depends-on (:clim-clx)
