2 # aside from this initial boilerplate, this is actually -*- scheme -*- code
3 main
='(module-ref (resolve-module '\''(scripts use2dot)) '\'main
')'
4 exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
6 ;;; use2dot
--- Display module dependencies as a DOT specification
8 ;; Copyright
(C
) 2001 Free Software Foundation
, Inc.
10 ;; This program is free software
; you can redistribute it and
/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation
; either version
2, or
13 ;; (at your option
) any later version.
15 ;; This program is distributed
in the hope that it will be useful
,
16 ;; but WITHOUT ANY WARRANTY
; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License
for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this software
; see the
file COPYING. If not
, write to
22 ;; the Free Software Foundation
, Inc.
, 59 Temple Place
, Suite
330,
23 ;; Boston
, MA
02111-1307 USA
25 ;;; Author
: Thien-Thi Nguyen
29 ;; Usage
: use2dot
[OPTIONS
] [FILE ...
]
30 ;; Display to stdout a DOT specification that describes module dependencies
33 ;; A top-level
`use-modules' form or a `:use-module
' `define-module'-component
34 ;; results
in a
"solid" style edge.
36 ;; An
`:autoload' `define-module
'-component results in a "dotted" style edge
37 ;; with label "N" indicating that N names are responsible for triggering the
40 ;; A top-level `load' or
`primitive-load' form results in a a "bold" style
41 ;; edge to a node named with either the file name if the `load
' argument is a
42 ;; string, or "[computed in FILE]" otherwise.
45 ;; --default-module MOD -- Set MOD as the default module (for top-level
46 ;; `use-modules' forms that
do not follow some
47 ;; `define-module' form in a file). MOD should be
48 ;; be a list or `#f', in which case such top-level
49 ;; `use-modules' forms are effectively ignored.
50 ;; Default value: `(guile
)'.
53 ;; - add `--load-synonyms' option
54 ;; - add
`--ignore-module' option
55 ;; - handle arbitrary command-line key/value configuration
59 (define-module (scripts use2dot)
60 :use-module (ice-9 regex))
62 (define (string-append/separator separator strings)
63 ;; from (ttn stringutils) -- todo: use srfi-13
64 ;; "Append w/ SEPARATOR a list of STRINGS.
65 ;; SEPARATOR can be a character or a string."
66 (let ((rev (reverse strings))
67 (sep (if (char? separator)
68 (make-string 1 separator)
71 (let loop ((s (cdr rev))
72 (acc (list (car rev))))
79 (define (mapconcat proc ls sep)
80 ;; from (ttn stringutils) -- todo: use srfi-13
81 ;; "Map PROC over LS, concatening resulting strings with separator SEP."
82 (string-append/separator sep (map proc ls)))
84 (define default-module '(guile))
89 (define (vv pair) ; var=val
90 (format #f "~A=~A" (car pair) (cdr pair)))
92 (define (spew module use . etc)
94 (let ((etc-spec (if (null? etc)
96 (format #f " [~A]" (mapconcat vv etc ",")))))
97 (format #t " \"~A\" -> \"~A\"~A;\n" module use etc-spec))))
100 (format #t "digraph use2dot {")
101 (for-each (lambda (s) (format #t " ~A;\n" s))
102 (map vv `((label .
,(q
"Guile Module Dependencies"))
104 ;(size .
,(q
"7.5,10"))
106 ;(nodesep .
,(q
"0.05"))
109 (define
(grok filename
)
110 (let* ((p
(open-file filename
"r"))
111 (next
(lambda
() (read p
)))
113 (let loop
((form
(next
)))
114 (cond
((eof-object? form
))
115 ((not
(list? form
)) (loop
(next
)))
116 (else (case (car form
)
118 (let ((module
(cadr form
)))
120 (let loop
((ls form
))
124 (spew module
(cadr
ls))
127 (spew module
(cadr
ls)
130 (let ((len
(length
(caddr
ls))))
131 `(label . ,(q (number->string len)))))
133 (else (loop (cdr ls))))))))
135 (for-each (lambda (use)
136 (spew (or curmod default-module) use))
138 ((load primitive-load)
139 (spew (or curmod default-module)
140 (let ((file (cadr form)))
143 (format #f "[computed in ~A]" filename)))
148 (for-each grok files))
153 (define (use2dot . args)
155 (let* ((override (cond ((member "--default-module" args) => cadr)
157 (files (if override (cddr args) args)))
160 (with-input-from-string override (lambda () (read)))))
164 (define main use2dot)
166 ;;; use2dot ends here