#!/bin/sh # aside from this initial boilerplate, this is actually -*- scheme -*- code main='(module-ref (resolve-module '\''(scripts use2dot)) '\'main')' exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; use2dot --- Display module dependencies as a DOT specification ;; Copyright (C) 2001 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation; either version 2, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this software; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, ;; Boston, MA 02111-1307 USA ;;; Author: Thien-Thi Nguyen ;;; Commentary: ;; Usage: use2dot [OPTIONS] [FILE ...] ;; Display to stdout a DOT specification that describes module dependencies ;; in FILEs. ;; ;; A top-level `use-modules' form or a `:use-module' `define-module'-component ;; results in a "solid" style edge. ;; ;; An `:autoload' `define-module'-component results in a "dotted" style edge ;; with label "N" indicating that N names are responsible for triggering the ;; autoload. [The "N" label is not implemented.] ;; ;; A top-level `load' or `primitive-load' form results in a a "bold" style ;; edge to a node named with either the file name if the `load' argument is a ;; 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)'. ;;; Code: (define-module (scripts use2dot) :use-module ((scripts frisk) :select (make-frisker edge-type edge-up edge-down))) (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 (>>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")) )))) (define (>>body edges) (for-each (lambda (edge) (format #t " \"~A\" -> \"~A\"" (edge-down edge) (edge-up edge)) (cond ((case (edge-type edge) ((autoload) '((style . dotted) (fontsize . 5))) ((computed) '((style . bold))) (else #f)) => (lambda (etc) (format #t " [~A]" (mapconcat vv etc ","))))) (format #t ";\n")) edges)) (define (>>footer) (format #t "}")) (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))) (define main use2dot) ;;; use2dot ends here