[plt-scheme] PLT Source Browser

On 2/5/06, Jens Axel Søgaard <jensaxel at soegaard.net> wrote:
> Robby Findler wrote:
> > I've put together a first cut at building the module pictures. You'll
> > need the latest svn version of DrScheme to run the attached script, but
> > you can look at the pictures here:
> >
> >   http://www.cs.uchicago.edu/~robby/tmp/mgi/
> >
> > I generated the files using module-graph-dot.ss and dot (in the
> > graphviz package available via fink for mac os x and also available
> > under linux somehow, I'm sure).
> >
> >   ./module-graph-dot.ss ~/svn/plt/collects/mzlib/etc.ss > etc.dot
> >   dot -Tps etc.dot > etc.ps
> >   epstopdf etc.ps
> >
> > It doesn't seem to work well for the very large files, however, since
> > the graphs get kind of klunky (many more edges than nodes). The "-n"
> > flag helps a little (it avoid following `lib' paths) but it isn't
> > enough for the big files. To see, try framework.ss.
> >
> > Anyways, I hope someone else can take it from here.
>
> For the time being I'll experiment with a text sidebar
> listing the various types of requires. I like you
> dot-example though, for one it made the code in module-overview.ss
> easier to understand.
>
> I noticed at the Graphviz gallery page, that it can produce
> SVG files, which is in XML format. Maybe one could use such
> manipulate such an output file and turn the nodes into links?
>
> Any volunteers?

Sure.  This script wraps the SVG nodes with links to the filenames in
the "title" elements.  This is probably a job for XSL though :)


#!/bin/sh
#|
exec mzscheme -C "$0" "$@"
|#

(require (lib "xml.ss" "xml"))
(require (lib "plt-match.ss")
         ;(lib "pretty.ss")
         (lib "list.ss")
         (lib "etc.ss"))

(define (main args)
  (define arg (cadr args))
  (let* ([svg (read-svg-file arg)]
         [svg2 (svg+links svg)]
         [xml (xexpr->xml svg2)])
     (write-xml/content xml)
     ;(pretty-print svg2)
     (newline)))

(define (read-svg-file fname)
  (with-input-from-file fname
     (lambda ()
       (xml->xexpr (document-element (read-xml))))))

(define (svg+links svg)
  (match svg
    [(list-rest 'svg attrs content)
     (svg-content+links attrs content)]
    [x x]))

(define (svg-content+links attrs content)
  `(svg ,attrs
        ,@(map (match-lambda
                 [(list-rest 'g attrs graph-content)
                  (svg-graph+links attrs graph-content)]
                 [x x])
               content)))

(define (svg-graph+links attrs graph-content)
  `(g ,attrs
      ,@(map (match-lambda
               [(list-rest 'g attrs content)
                (if (string=? "node" (find-attrib attrs 'class))
                   (svg-node+links attrs content)
                   (svg-edge+links attrs content))]
               [x x])
             graph-content)))

(define (svg-node+links attrs node-content)
  (define fname
    (let loop ([c node-content])
      (match c
        ['() (error 'svg-node+links "Node has no title.")]
        [(list-rest (list-rest 'title attrs content) more)
         (apply string-append content)]
        [(list-rest x more) (loop more)])))
 `(a ([xlink:href ,fname])
    (g ,attrs , at node-content)))

(define (svg-edge+links attrs edge-content)
  `(g ,attrs , at edge-content))


(define (find-attrib attrs attrname)
  (define attrstr (symbol->string attrname))
  (let loop ([in attrs])
    (cond
      [(empty? in) #f]
      [(string-ci=? (symbol->string (first (first in)))
                    attrstr)
          (second (first in))]
      [else (loop (rest in))])))