guile/guile-core/scripts use2dot

[Thien-Thi Nguyen]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Thien-Thi Nguyen <address@hidden>       01/11/28 19:19:13

Modified files:
        guile-core/scripts: use2dot 

Log message:
        (ferret): New proc.
        (grok): Use `ferret'.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/scripts/use2dot.diff?cvsroot=OldCVS&tr1=1.5&tr2=1.6&r1=text&r2=text

Patches:
Index: guile/guile-core/scripts/use2dot
diff -u guile/guile-core/scripts/use2dot:1.5 
guile/guile-core/scripts/use2dot:1.6
--- guile/guile-core/scripts/use2dot:1.5        Wed Aug  1 01:09:30 2001
+++ guile/guile-core/scripts/use2dot    Wed Nov 28 19:19:13 2001
@@ -97,7 +97,7 @@
          (format #t "  \"~A\" -> \"~A\"~A;\n" module use etc-spec))))
 
 (define (header)
-  (format #t "digraph use2dot {")
+  (format #t "digraph use2dot {\n")
   (for-each (lambda (s) (format #t "  ~A;\n" s))
             (map vv `((label . ,(q "Guile Module Dependencies"))
                       ;(rankdir . LR)
@@ -106,6 +106,12 @@
                       ;(nodesep . ,(q "0.05"))
                       ))))
 
+(define (ferret use)                    ; handle "((foo bar) :select ...)"
+  (let ((maybe (car use)))
+    (if (list? maybe)
+        maybe
+        use)))
+
 (define (grok filename)
   (let* ((p (open-file filename "r"))
          (next (lambda () (read p)))
@@ -121,7 +127,7 @@
                          (or (null? ls)
                              (case (car ls)
                                ((:use-module)
-                                (spew module (cadr ls))
+                                (spew module (ferret (cadr ls)))
                                 (loop (cddr ls)))
                                ((:autoload)
                                 (spew module (cadr ls)
@@ -133,7 +139,8 @@
                                (else (loop (cdr ls))))))))
                     ((use-modules)
                      (for-each (lambda (use)
-                                 (spew (or curmod default-module) use))
+                                 (spew (or curmod default-module)
+                                       (ferret use)))
                                (cdr form)))
                     ((load primitive-load)
                      (spew (or curmod default-module)