1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

Autoload module (ice-9 getopt-long).

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 `>>'.
This commit is contained in:
Thien-Thi Nguyen 2002-01-12 04:27:16 +00:00
parent b51e36348a
commit 7c8ce087f9

View file

@ -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)