Commit | Line | Data |
---|---|---|
28c31342 TTN |
1 | #!/bin/sh |
2 | # aside from this initial boilerplate, this is actually -*- scheme -*- code | |
3 | main='(module-ref (resolve-module '\''(scripts use2dot)) '\'main')' | |
8c914f6b | 4 | exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" |
28c31342 TTN |
5 | !# |
6 | ;;; use2dot --- Display module dependencies as a DOT specification | |
7 | ||
8 | ;; Copyright (C) 2001 Free Software Foundation, Inc. | |
9 | ;; | |
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. | |
14 | ;; | |
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. | |
19 | ;; | |
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 | |
92205699 MV |
22 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
23 | ;; Boston, MA 02110-1301 USA | |
28c31342 | 24 | |
61897afe TTN |
25 | ;;; Author: Thien-Thi Nguyen |
26 | ||
28c31342 TTN |
27 | ;;; Commentary: |
28 | ||
29 | ;; Usage: use2dot [OPTIONS] [FILE ...] | |
30 | ;; Display to stdout a DOT specification that describes module dependencies | |
31 | ;; in FILEs. | |
32 | ;; | |
33 | ;; A top-level `use-modules' form or a `:use-module' `define-module'-component | |
34 | ;; results in a "solid" style edge. | |
35 | ;; | |
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 | |
454c700e | 38 | ;; autoload. [The "N" label is not implemented.] |
28c31342 TTN |
39 | ;; |
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. | |
43 | ;; | |
44 | ;; Options: | |
7c8ce087 TTN |
45 | ;; -m, --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-user)'. | |
28c31342 TTN |
51 | |
52 | ;;; Code: | |
53 | ||
54 | (define-module (scripts use2dot) | |
7c8ce087 TTN |
55 | :autoload (ice-9 getopt-long) (getopt-long) |
56 | :use-module ((srfi srfi-13) :select (string-join)) | |
454c700e | 57 | :use-module ((scripts frisk) |
7c8ce087 TTN |
58 | :select (make-frisker edge-type edge-up edge-down)) |
59 | :export (use2dot)) | |
454c700e TTN |
60 | |
61 | (define *default-module* '(guile-user)) | |
28c31342 | 62 | |
28c31342 TTN |
63 | (define (q s) ; quote |
64 | (format #f "~S" s)) | |
65 | ||
7c8ce087 TTN |
66 | (define (vv pairs) ; => ("var=val" ...) |
67 | (map (lambda (pair) | |
68 | (format #f "~A=~A" (car pair) (cdr pair))) | |
69 | pairs)) | |
28c31342 | 70 | |
454c700e | 71 | (define (>>header) |
e0902d95 | 72 | (format #t "digraph use2dot {\n") |
28c31342 | 73 | (for-each (lambda (s) (format #t " ~A;\n" s)) |
7c8ce087 TTN |
74 | (vv `((label . ,(q "Guile Module Dependencies")) |
75 | ;;(rankdir . LR) | |
76 | ;;(size . ,(q "7.5,10")) | |
77 | (ratio . fill) | |
78 | ;;(nodesep . ,(q "0.05")) | |
79 | )))) | |
28c31342 | 80 | |
454c700e TTN |
81 | (define (>>body edges) |
82 | (for-each | |
83 | (lambda (edge) | |
84 | (format #t " \"~A\" -> \"~A\"" (edge-down edge) (edge-up edge)) | |
85 | (cond ((case (edge-type edge) | |
86 | ((autoload) '((style . dotted) (fontsize . 5))) | |
87 | ((computed) '((style . bold))) | |
88 | (else #f)) | |
89 | => (lambda (etc) | |
7c8ce087 | 90 | (format #t " [~A]" (string-join (vv etc) ","))))) |
454c700e TTN |
91 | (format #t ";\n")) |
92 | edges)) | |
93 | ||
94 | (define (>>footer) | |
28c31342 TTN |
95 | (format #t "}")) |
96 | ||
7c8ce087 TTN |
97 | (define (>> edges) |
98 | (>>header) | |
99 | (>>body edges) | |
100 | (>>footer)) | |
101 | ||
28c31342 | 102 | (define (use2dot . args) |
7c8ce087 TTN |
103 | (let* ((parsed-args (getopt-long (cons "use2dot" args) ;;; kludge |
104 | '((default-module | |
105 | (single-char #\m) (value #t))))) | |
106 | (=m (option-ref parsed-args 'default-module *default-module*)) | |
107 | (scan (make-frisker `(default-module . ,=m))) | |
108 | (files (option-ref parsed-args '() '()))) | |
109 | (>> (reverse ((scan files) 'edges))))) | |
28c31342 TTN |
110 | |
111 | (define main use2dot) | |
112 | ||
113 | ;;; use2dot ends here |