| 1 | ;;; use2dot --- Display module dependencies as a DOT specification |
| 2 | |
| 3 | ;; Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc. |
| 4 | ;; |
| 5 | ;; This program is free software; you can redistribute it and/or |
| 6 | ;; modify it under the terms of the GNU Lesser General Public License |
| 7 | ;; as published by the Free Software Foundation; either version 3, or |
| 8 | ;; (at your option) any later version. |
| 9 | ;; |
| 10 | ;; This program is distributed in the hope that it will be useful, |
| 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| 13 | ;; Lesser General Public License for more details. |
| 14 | ;; |
| 15 | ;; You should have received a copy of the GNU Lesser General Public |
| 16 | ;; License along with this software; see the file COPYING.LESSER. If |
| 17 | ;; not, write to the Free Software Foundation, Inc., 51 Franklin |
| 18 | ;; Street, Fifth Floor, Boston, MA 02110-1301 USA |
| 19 | |
| 20 | ;;; Author: Thien-Thi Nguyen |
| 21 | |
| 22 | ;;; Commentary: |
| 23 | |
| 24 | ;; Usage: use2dot [OPTIONS] [FILE ...] |
| 25 | ;; Display to stdout a DOT specification that describes module dependencies |
| 26 | ;; in FILEs. |
| 27 | ;; |
| 28 | ;; A top-level `use-modules' form or a `:use-module' `define-module'-component |
| 29 | ;; results in a "solid" style edge. |
| 30 | ;; |
| 31 | ;; An `:autoload' `define-module'-component results in a "dotted" style edge |
| 32 | ;; with label "N" indicating that N names are responsible for triggering the |
| 33 | ;; autoload. [The "N" label is not implemented.] |
| 34 | ;; |
| 35 | ;; A top-level `load' or `primitive-load' form results in a a "bold" style |
| 36 | ;; edge to a node named with either the file name if the `load' argument is a |
| 37 | ;; string, or "[computed in FILE]" otherwise. |
| 38 | ;; |
| 39 | ;; Options: |
| 40 | ;; -m, --default-module MOD -- Set MOD as the default module (for top-level |
| 41 | ;; `use-modules' forms that do not follow some |
| 42 | ;; `define-module' form in a file). MOD should be |
| 43 | ;; be a list or `#f', in which case such top-level |
| 44 | ;; `use-modules' forms are effectively ignored. |
| 45 | ;; Default value: `(guile-user)'. |
| 46 | |
| 47 | ;;; Code: |
| 48 | |
| 49 | (define-module (scripts use2dot) |
| 50 | :autoload (ice-9 getopt-long) (getopt-long) |
| 51 | :use-module ((srfi srfi-13) :select (string-join)) |
| 52 | :use-module ((scripts frisk) |
| 53 | :select (make-frisker edge-type edge-up edge-down)) |
| 54 | :export (use2dot)) |
| 55 | |
| 56 | (define %summary "Print a module's dependencies in graphviz format.") |
| 57 | |
| 58 | (define *default-module* '(guile-user)) |
| 59 | |
| 60 | (define (q s) ; quote |
| 61 | (format #f "~S" s)) |
| 62 | |
| 63 | (define (vv pairs) ; => ("var=val" ...) |
| 64 | (map (lambda (pair) |
| 65 | (format #f "~A=~A" (car pair) (cdr pair))) |
| 66 | pairs)) |
| 67 | |
| 68 | (define (>>header) |
| 69 | (format #t "digraph use2dot {\n") |
| 70 | (for-each (lambda (s) (format #t " ~A;\n" s)) |
| 71 | (vv `((label . ,(q "Guile Module Dependencies")) |
| 72 | ;;(rankdir . LR) |
| 73 | ;;(size . ,(q "7.5,10")) |
| 74 | (ratio . fill) |
| 75 | ;;(nodesep . ,(q "0.05")) |
| 76 | )))) |
| 77 | |
| 78 | (define (>>body edges) |
| 79 | (for-each |
| 80 | (lambda (edge) |
| 81 | (format #t " \"~A\" -> \"~A\"" (edge-down edge) (edge-up edge)) |
| 82 | (cond ((case (edge-type edge) |
| 83 | ((autoload) '((style . dotted) (fontsize . 5))) |
| 84 | ((computed) '((style . bold))) |
| 85 | (else #f)) |
| 86 | => (lambda (etc) |
| 87 | (format #t " [~A]" (string-join (vv etc) ","))))) |
| 88 | (format #t ";\n")) |
| 89 | edges)) |
| 90 | |
| 91 | (define (>>footer) |
| 92 | (format #t "}")) |
| 93 | |
| 94 | (define (>> edges) |
| 95 | (>>header) |
| 96 | (>>body edges) |
| 97 | (>>footer)) |
| 98 | |
| 99 | (define (use2dot . args) |
| 100 | (let* ((parsed-args (getopt-long (cons "use2dot" args) ;;; kludge |
| 101 | '((default-module |
| 102 | (single-char #\m) (value #t))))) |
| 103 | (=m (option-ref parsed-args 'default-module *default-module*)) |
| 104 | (scan (make-frisker `(default-module . ,=m))) |
| 105 | (files (option-ref parsed-args '() '()))) |
| 106 | (>> (reverse ((scan files) 'edges))))) |
| 107 | |
| 108 | (define main use2dot) |
| 109 | |
| 110 | ;;; use2dot ends here |