;; 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
((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)