Changeset 5797 in project


Ignore:
Timestamp:
08/29/07 00:01:13 (13 years ago)
Author:
Mario Domenech Goulart
Message:

Experimental dependencies graph generation.

Location:
nest-tool/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • nest-tool/trunk/chicken-nest-tool.scm

    r4589 r5797  
    11(use tool nest-tool (srfi 13))
    22
    3 (define-flag '(#\d "omit-date") "omit release date" omit-date)
    4 (define-flag '(#\D "omit-deps") "omit dependencies" omit-dependencies)
    5 (define-flag '(#\f "omit-file") "omit egg filename" omit-file)
     3(define-flag '(#\d "omit-date") "omit release date when showing search results" omit-date)
     4(define-flag '(#\D "omit-deps") "omit dependencies when showing search results" omit-dependencies)
     5(define-flag '(#\f "omit-file") "omit egg filename when showing search results" omit-file)
     6
     7(define dep-graph-dir ".")
     8(define dep-graph-format 'png)
    69
    710(define (show egg date file deps)
     
    2427    (exit 0)))
    2528 
    26 (define-option '(#\s "search") "search eggs names"
     29(define-option '(#\s "search")
     30  "search eggs names"
    2731  (search nest-tool:search-names))
    2832
    29 (define-option '(#\S "search-deps") "search eggs dependencies"
     33(define-option '(#\S "search-deps")
     34  "search eggs dependencies"
    3035  (search nest-tool:search-dependencies))
    3136
    32 (define-option '(#\R "repository") "specify a repository file (HTTP URLs are also accepted)"
     37(define-option '(#\R "repository")
     38  "specify a repository file (HTTP URLs are also accepted)"
    3339  (lambda (opt name arg seeds)
    3440    (nest-tool:repository arg)))
    35  
     41
     42(define-option '(#\G "dep-graph-dir")
     43  "directory where to save dependencies graphs files (default = .)"
     44  (lambda (opt name arg seeds)
     45    (set! dep-graph-dir arg)))
     46
     47(define-option '(#\F "dep-graph-format")
     48  "format of output graphs graphic files (default = png)"
     49  (lambda (opt name arg seeds)
     50    (set! dep-graph-format arg)))
     51
     52(define-option '(#\g "generate-dep-graph")
     53  "generate dependencies graphs. Its argument is a comma-separated list of eggs or nothing, which indicates that all the dependencies graphs should be generated"
     54  (lambda (opt name arg seeds)
     55    (let ((eggs (if (string? arg) (string-split arg ",") #f)))
     56      (nest-tool:all-dep-graphs->graphic eggnames: eggs
     57                                         output-dir: dep-graph-dir
     58                                         format: dep-graph-format))
     59    (exit 0)))
     60
    3661(tool-name "chicken-nest-tool")
    3762(tool-help "Provides operations on CHICKEN extensions repository listings")
  • nest-tool/trunk/nest-tool.scm

    r4589 r5797  
    5050            (not (null? (grep pattern (map symbol->string (nest-tool:egg-dependencies egg))))))
    5151          (nest-tool:raw)))
     52
     53(define (nest-tool:dep-graph->dot eggname #!key (raw #f))
     54  (define labels "")
     55  (define links '())
     56 
     57  (define (scm->dot name)
     58    (cond ((eq? name 'digraph) "digraph_")
     59          ((equal? name "digraph") "digraph_")
     60          (else (string-translate (->string name) "-" "_"))))
     61
     62  (define (add-link! from to)
     63    (unless (member (cons from to) links)
     64      (set! links (cons (cons from to) links))))
     65
     66  (define (links->string)
     67    (string-intersperse
     68     (map (lambda (link)
     69            (string-append (scm->dot (car link)) " -> "
     70                           (scm->dot (cdr link)) ";\n"))
     71          links)))
     72   
     73  (define (link-dependencies egg)
     74    (let ((deps (filter (lambda (egg)
     75                          (not (memq egg ##sys#core-library-modules)))
     76                        (nest-tool:egg-dependencies (car (nest-tool:search-names (->string egg) raw))))))
     77      (with-output-to-string
     78        (lambda ()
     79          (let ((dot-egg (scm->dot egg)))
     80            (set! labels (string-append labels dot-egg " [label=\"" (->string egg) "\"]\n"))
     81            (for-each (lambda (egg-dep)
     82                        (add-link! egg egg-dep)
     83                        (link-dependencies egg-dep))
     84                      deps))))))
     85  (link-dependencies eggname)
     86  (string-append "digraph eggs {\n" labels "\n" (links->string) "\n}"))
     87
     88(define (nest-tool:dep-graphs->graphic eggname #!key (output-dir ".") (raw #f) (format 'png))
     89  (with-output-to-file  (make-pathname output-dir (->string eggname) "dot")
     90    (lambda ()
     91      (print (nest-tool:dep-graph->dot eggname raw: raw))))
     92  (system (conc "dot -T" format " "
     93                " -o " (make-pathname output-dir eggname (->string format)) " "
     94                (make-pathname output-dir eggname "dot")
     95                " &")))
     96
     97(define (nest-tool:all-dep-graphs->graphic #!key (eggnames #f) (output-dir ".") (format 'png))
     98  (let ((raw (nest-tool:raw)))
     99    (for-each (lambda (egg)
     100                (nest-tool:dep-graphs->graphic egg output-dir: output-dir raw: raw format: format))
     101              (map ->string (or eggnames (nest-tool:names))))))
Note: See TracChangeset for help on using the changeset viewer.