Autoload module (ice-9 getopt-long).
authorThien-Thi Nguyen <ttn@gnuvola.org>
Sat, 12 Jan 2002 04:27:16 +0000 (04:27 +0000)
committerThien-Thi Nguyen <ttn@gnuvola.org>
Sat, 12 Jan 2002 04:27:16 +0000 (04:27 +0000)
Use module (srfi srfi-13).
Export `use2dot'.

(string-append/separator, mapconcat): Delete.
(vv): Now take list of pairs, and return the mapping..
(>>header): Use `string-join'.
(>>): New proc.
(use2dot): Use `getopt-long'.  Use `>>'.

scripts/use2dot

index 5a6d0b4..dff3417 100755 (executable)
@@ -42,60 +42,41 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
 ;; string, or "[computed in FILE]" otherwise.
 ;;
 ;; Options:
-;; --default-module MOD  -- Set MOD as the default module (for top-level
-;;                          `use-modules' forms that do not follow some
-;;                          `define-module' form in a file).  MOD should be
-;;                          be a list or `#f', in which case such top-level
-;;                          `use-modules' forms are effectively ignored.
-;;                          Default value: `(guile-user)'.
-;;
-;; TODO: Use `(ice-9 format)'.
+;;  -m, --default-module MOD -- Set MOD as the default module (for top-level
+;;                              `use-modules' forms that do not follow some
+;;                              `define-module' form in a file).  MOD should be
+;;                              be a list or `#f', in which case such top-level
+;;                              `use-modules' forms are effectively ignored.
+;;                              Default value: `(guile-user)'.
 
 ;;; Code:
 
 (define-module (scripts use2dot)
+  :autoload (ice-9 getopt-long) (getopt-long)
+  :use-module ((srfi srfi-13) :select (string-join))
   :use-module ((scripts frisk)
-               :select (make-frisker edge-type edge-up edge-down)))
+               :select (make-frisker edge-type edge-up edge-down))
+  :export (use2dot))
 
 (define *default-module* '(guile-user))
 
-(define (string-append/separator separator strings)
-  ;; from (ttn stringutils) -- todo: use srfi-13
-  ;;   "Append w/ SEPARATOR a list of STRINGS.
-  ;; SEPARATOR can be a character or a string."
-  (let ((rev (reverse strings))
-        (sep (if (char? separator)
-                 (make-string 1 separator)
-                 separator)))
-    (apply string-append
-           (let loop ((s (cdr rev))
-                      (acc (list (car rev))))
-             (if (null? s)
-                 acc
-                 (loop (cdr s)
-                       (cons (car s)
-                             (cons sep acc))))))))
-
-(define (mapconcat proc ls sep)
-  ;; from (ttn stringutils) -- todo: use srfi-13
-  ;; "Map PROC over LS, concatening resulting strings with separator SEP."
-  (string-append/separator sep (map proc ls)))
-
 (define (q s)                           ; quote
   (format #f "~S" s))
 
-(define (vv pair)                       ; var=val
-  (format #f "~A=~A" (car pair) (cdr pair)))
+(define (vv pairs)                      ; => ("var=val" ...)
+  (map (lambda (pair)
+         (format #f "~A=~A" (car pair) (cdr pair)))
+       pairs))
 
 (define (>>header)
   (format #t "digraph use2dot {\n")
   (for-each (lambda (s) (format #t "  ~A;\n" s))
-            (map vv `((label . ,(q "Guile Module Dependencies"))
-                      ;;(rankdir . LR)
-                      ;;(size . ,(q "7.5,10"))
-                      (ratio . fill)
-                      ;;(nodesep . ,(q "0.05"))
-                      ))))
+            (vv `((label . ,(q "Guile Module Dependencies"))
+                  ;;(rankdir . LR)
+                  ;;(size . ,(q "7.5,10"))
+                  (ratio . fill)
+                  ;;(nodesep . ,(q "0.05"))
+                  ))))
 
 (define (>>body edges)
   (for-each
@@ -106,28 +87,26 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
               ((computed) '((style . bold)))
               (else #f))
             => (lambda (etc)
-                 (format #t " [~A]" (mapconcat vv etc ",")))))
+                 (format #t " [~A]" (string-join (vv etc) ",")))))
      (format #t ";\n"))
    edges))
 
 (define (>>footer)
   (format #t "}"))
 
+(define (>> edges)
+  (>>header)
+  (>>body edges)
+  (>>footer))
+
 (define (use2dot . args)
-  (let* ((override (cond ((member "--default-module" args)
-                          => (lambda (ls)
-                               (with-input-from-string
-                                   (cadr ls)
-                                 (lambda () (read)))))
-                         (else #f)))
-         (files (if override (cddr args) args)))
-    (>>header)
-    (>>body (reverse
-             (((make-frisker
-                `(default-module . ,(or override *default-module*)))
-               files)
-              'edges)))
-    (>>footer)))
+  (let* ((parsed-args (getopt-long (cons "use2dot" args)    ;;; kludge
+                                   '((default-module
+                                       (single-char #\m) (value #t)))))
+         (=m (option-ref parsed-args 'default-module *default-module*))
+         (scan (make-frisker `(default-module . ,=m)))
+         (files (option-ref parsed-args '() '())))
+    (>> (reverse ((scan files) 'edges)))))
 
 (define main use2dot)