From: Gary King <gwking@metabang.com>
Date: Sun, 16 Mar 2008 16:49:39 +0000 (-0400)
Subject: prevent top-level export
X-Git-Url: http://repo.macrolet.net/gitweb/?p=cl-graph.git;a=commitdiff_plain;h=234cdb04a311bab3cb6f75569f6ef3e146839e6e

prevent top-level export

darcs-hash:20080316164939-3cc5d-f889d41b451b36f8efb9cb5a2f39ee07cb7b0e0f.gz
---

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
diff --git a/dev/graphviz/graphviz-support.lisp b/dev/graphviz/graphviz-support.lisp
index df13254..f9fa261 100644
--- a/dev/graphviz/graphviz-support.lisp
+++ b/dev/graphviz/graphviz-support.lisp
@@ -354,7 +354,7 @@ B--D []
 (defmacro defpixel-inch-accessors (name attr type)
   (bind ((actual-name (form-symbol name "-IN-PIXELS")))
     `(progn
-      (export ',actual-name)
+       (eval-always (export ',actual-name))
       (defmethod ,actual-name ((thing ,type))
         "Return the attribute in pixels assuming 72 dpi"
         (awhen (dot-attribute-value ,attr thing)