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

diff --git a/dev/examples/class-hierarchy-to-dot.lisp b/dev/examples/class-hierarchy-to-dot.lisp
index 0cc5f32..0b586fa 100644
--- a/dev/examples/class-hierarchy-to-dot.lisp
+++ b/dev/examples/class-hierarchy-to-dot.lisp
@@ -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