X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=dev%2Fexamples%2Fclass-hierarchy-to-dot.lisp;h=0b586fa9a0c1d96cd4db2fd9ca06fe8f51877850;hb=0ec08e089c622f794599177c80020692447ce9fd;hp=e70380abcf70bcdd8fa3dc77a73b684d9c157f43;hpb=438d1e0593dc62fe7b975a5865ec27955afcb7a1;p=cl-graph.git

diff --git a/dev/examples/class-hierarchy-to-dot.lisp b/dev/examples/class-hierarchy-to-dot.lisp
index e70380a..0b586fa 100644
--- a/dev/examples/class-hierarchy-to-dot.lisp
+++ b/dev/examples/class-hierarchy-to-dot.lisp
@@ -1,4 +1,4 @@
-(in-package metabang.graph)
+(in-package #:metabang.graph)
 
 (defun roots-and-child-function->graph (roots child-function max-depth)
   (let ((g (make-graph 'graph-container)))
@@ -49,4 +49,29 @@
                         containers::transforming-iterator-mixin
                         containers::basic-filtered-iterator-mixin
                         containers::circular-iterator-mixin)
-                      "thousand-parsers:iterators.dot")
\ No newline at end of file
+                      "thousand-parsers:iterators.dot")
+
+#+(or)
+;; very sucky
+(let ((op (make-instance 'asdf:load-op)))
+  (graph->dot
+   (roots-and-child-function->graph 
+    (list (asdf:find-system 'cl-graph))
+    (lambda (node)
+      (print node)
+      (typecase node
+	(asdf:component
+	 (asdf:component-depends-on op node))
+	(cons
+	 (let ((op (car node)))
+	   (loop for name in (rest node) 
+	      when (asdf:find-system name nil) append
+	     (asdf:component-depends-on op (asdf:find-system name)))))))
+    4)
+   #p"/tmp/out.dot"
+   :vertex-labeler (lambda (v s)
+		     (princ (or (ignore-errors 
+				  (asdf:component-name (element v)))
+				(element v)) s))
+   :edge-labeler (lambda (e s)
+		   (declare (ignore e s)))))
\ No newline at end of file