diff options
-rw-r--r-- | scripts/ChangeLog | 5 | ||||
-rw-r--r-- | scripts/Makefile.am | 40 | ||||
-rwxr-xr-x | scripts/PROGRAM | 45 | ||||
-rw-r--r-- | scripts/README | 76 | ||||
-rwxr-xr-x | scripts/display-commentary | 47 | ||||
-rwxr-xr-x | scripts/doc-snarf | 442 | ||||
-rwxr-xr-x | scripts/generate-autoload | 138 | ||||
-rwxr-xr-x | scripts/punify | 81 | ||||
-rwxr-xr-x | scripts/use2dot | 166 |
9 files changed, 1040 insertions, 0 deletions
diff --git a/scripts/ChangeLog b/scripts/ChangeLog new file mode 100644 index 000000000..22e913b13 --- /dev/null +++ b/scripts/ChangeLog @@ -0,0 +1,5 @@ +2001-04-29 Thien-Thi Nguyen <ttn@revel.glug.org> + + * Makefile.am, PROGRAM, README, display-commentary, + doc-snarf, generate-autoload, punify, use2dot: New file + diff --git a/scripts/Makefile.am b/scripts/Makefile.am new file mode 100644 index 000000000..cca40e458 --- /dev/null +++ b/scripts/Makefile.am @@ -0,0 +1,40 @@ +## Process this file with automake to produce Makefile.in. +## +## Copyright (C) 2001 Free Software Foundation, Inc. +## +## This file is part of GUILE. +## +## GUILE 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. +## +## GUILE 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 GUILE; see the file COPYING. If not, write +## to the Free Software Foundation, Inc., 59 Temple Place, Suite +## 330, Boston, MA 02111-1307 USA + +AUTOMAKE_OPTIONS = foreign + +# These should be installed and distributed. +scripts_sources = \ + PROGRAM \ + display-commentary \ + doc-snarf \ + generate-autoload \ + punify \ + use2dot + +subpkgdatadir = $(pkgdatadir)/$(VERSION)/scripts +subpkgdata_SCRIPTS = $(scripts_sources) + +EXTRA_DIST = $(scripts_sources) + +overview: + @GUILE_LOAD_PATH=`(cd .. ; pwd)` \ + ./display-commentary $(scripts_sources) diff --git a/scripts/PROGRAM b/scripts/PROGRAM new file mode 100755 index 000000000..ea0146f15 --- /dev/null +++ b/scripts/PROGRAM @@ -0,0 +1,45 @@ +#!/bin/sh +# aside from this initial boilerplate, this is actually -*- scheme -*- code +main='(module-ref (resolve-module '\''(scripts PROGRAM)) '\'main')' +exec ${GUILE-guile} -c "(apply $main (cdr (command-line)))" "$@" +!# +;;; PROGRAM --- Does something + +;; 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 + +;;; Commentary: + +;; Usage: PROGRAM [ARGS] +;; +;; PROGRAM does something. +;; +;; TODO: Write it! +;; +;; Author: J.R.Hacker + +;;; Code: + +(define-module (scripts PROGRAM) + :export (PROGRAM)) + +(define (PROGRAM . args) + #t) + +(define main PROGRAM) + +;;; PROGRAM ends here diff --git a/scripts/README b/scripts/README new file mode 100644 index 000000000..c1a3ef998 --- /dev/null +++ b/scripts/README @@ -0,0 +1,76 @@ +Overview and Usage +------------------ + +This directory contains Scheme programs, some useful in maintaining Guile. +On "make install", these programs are copied to PKGDATADIR/VERSION/scripts. + +You can invoke a program from the shell, or alternatively, load its file +as a Guile Scheme module, and use its exported procedure(s) from Scheme code. +Typically for any PROGRAM: + + (use-modules (scripts PROGRAM)) + (PROGRAM ARG1 ARG2 ...) + +For programs that write to stdout, you might try, instead: + + (use-modules (scripts PROGRAM)) + (with-output-to-string (lambda () (PROGRAM ARG1 ARG2 ...))) + +Note that all args must be strings. + +To see PROGRAM's commentary, which may or may not be helpful: + + (help (scripts PROGRAM)) + +To see all commentaries and module dependencies, try: "make overview". + +If you want to try the programs before installing Guile, you will probably +need to set environment variable GUILE_LOAD_PATH to be the parent directory. +This can be done in Bourne-compatible shells like so: + + GUILE_LOAD_PATH=`(cd .. ; pwd)` + export GUILE_LOAD_PATH + +[FIXME: Can someone supply the csh-compatible equivalent?] + + + +How to Contribute +----------------- + +See template file PROGRAM for a quick start. + +Programs must follow the "executable module" convention, documented here: + +- The file name must not end in ".scm". + +- The file must be executable (chmod +x). + +- The module name must be "(scripts PROGRAM)". A procedure named PROGRAM w/ + signature "(PROGRAM . args)" must be exported. Basically, use some variant + of the form: + + (define-module (scripts PROGRAM) + :export (PROGRAM)) + + Feel free to export other definitions useful in the module context. + +- There must be the alias: + + (define main PROGRAM) + + However, `main' must NOT be exported. + +- The beginning of the file must use the following invocation sequence: + + #!/bin/sh + main='(module-ref (resolve-module '\''(scripts PROGRAM)) '\'main')' + exec ${GUILE-guile} -c "(apply $main (cdr (command-line)))" "$@" + !# + +Following these conventions allows the program file to be used as module +(scripts PROGRAM) in addition to as a standalone executable. Please also +include a helpful Commentary section w/ some usage info. + + +[README ends here] diff --git a/scripts/display-commentary b/scripts/display-commentary new file mode 100755 index 000000000..537ef2ca8 --- /dev/null +++ b/scripts/display-commentary @@ -0,0 +1,47 @@ +#!/bin/sh +# aside from this initial boilerplate, this is actually -*- scheme -*- code +main='(module-ref (resolve-module '\''(scripts display-commentary)) '\'main')' +exec ${GUILE-guile} -c "(apply $main (cdr (command-line)))" "$@" +!# +;;; display-commentary --- As advertized + +;; 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 + +;;; Commentary: + +;; Usage: display-commentary FILE1 FILE2 ... +;; +;; Display Commentary section from FILE1, FILE2 and so on. +;; +;; Author: Thien-Thi Nguyen + +;;; Code: + +(define-module (scripts display-commentary) + :use-module (ice-9 documentation) + :export (display-commentary)) + +(define (display-commentary-one file) + (format #t "~A commentary:\n~A" file (file-commentary file))) + +(define (display-commentary . files) + (for-each display-commentary-one files)) + +(define main display-commentary) + +;;; display-commentary ends here diff --git a/scripts/doc-snarf b/scripts/doc-snarf new file mode 100755 index 000000000..ae417c0f2 --- /dev/null +++ b/scripts/doc-snarf @@ -0,0 +1,442 @@ +#!/bin/sh +# aside from this initial boilerplate, this is actually -*- scheme -*- code +main='(module-ref (resolve-module '\''(scripts doc-snarf)) '\'main')' +exec ${GUILE-guile} -c "(apply $main (cdr (command-line)))" "$@" +!# +;;; doc-snarf --- Extract documentation from source files + +;; 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 + +;;; Commentary: + +;; Usage: doc-snarf FILE +;; +;; This program reads in a Scheme source file and extracts docstrings +;; in the format specified below. Additionally, a procedure protoype +;; is infered from the procedure definition line starting with +;; (define... ). +;; +;; Currently, two output modi are implemented: texinfo and plaintext. +;; Default is plaintext, texinfo can be switched on with the +;; `--texinfo, -t' command line option. +;; +;; Format: A docstring can span multiple lines and a docstring line +;; begins with `;; ' (two semicoli and a space). A docstring is ended +;; by either a line beginning with (define ...) or one or more lines +;; beginning with `;;-' (two semicoli and a dash). These lines are +;; called `options' and begin with a keyword, followed by a colon and +;; a string. +;; +;; Additionally, "standard internal docstrings" (for Scheme source) are +;; recognized and output as "options". The output formatting is likely +;; to change in the future. +;; +;; Example: + +;; This procedure foos, or bars, depending on the argument @var{braz}. +;;-Author: Martin Grabmueller +(define (foo/bar braz) + (if braz 'foo 'bar)) + +;;; Which results in the following docstring if texinfo output is +;;; enabled: +#! +foo/bar +@deffn procedure foo/bar braz +This procedure foos, or bars, depending on the argument @var{braz}. +@c Author: Martin Grabmueller +@end deffn +!# + +;;; Or in this if plaintext output is used: +#! +Procedure: foo/bar braz +This procedure foos, or bars, depending on the argument @var{braz}. +;; Author: Martin Grabmueller +^L +!# + +;; TODO: Convert option lines to alist. +;; More parameterization. +;; ../libguile/guile-doc-snarf emulation + +;;; Author: Martin Grabmueller + +(define doc-snarf-version "0.0.2") ; please update before publishing! + +;;; Code: + +(define-module (scripts doc-snarf) + :use-module (ice-9 getopt-long) + :use-module (ice-9 regex) + :use-module (ice-9 string-fun) + :use-module (ice-9 rdelim) + :export (doc-snarf)) + +(define command-synopsis + '((version (single-char #\v) (value #f)) + (help (single-char #\h) (value #f)) + (output (single-char #\o) (value #t)) + (texinfo (single-char #\t) (value #f)) + (lang (single-char #\l) (value #t)))) + +;; Display version information and exit. +;;-ttn-mod: use var +(define (display-version) + (display "doc-snarf ") (display doc-snarf-version) (newline)) + +;; Display the usage help message and exit. +;;-ttn-mod: change option "source" to "lang" +(define (display-help) + (display "Usage: doc-snarf [options...] inputfile\n") + (display " --help, -h Show this usage information\n") + (display " --version, -v Show version information\n") + (display + " --output=FILE, -o Specify output file [default=stdout]\n") + (display " --texinfo, -t Format output as texinfo\n") + (display " --lang=[c,scheme], -l Specify the input language\n")) + +;; Main program. +;;-ttn-mod: canonicalize lang +(define (doc-snarf . args) + (let ((options (getopt-long (cons "doc-snarf" args) command-synopsis))) + (let ((help-wanted (option-ref options 'help #f)) + (version-wanted (option-ref options 'version #f)) + (texinfo-wanted (option-ref options 'texinfo #f)) + (lang (string->symbol + (string-downcase (option-ref options 'lang "scheme"))))) + (cond + (version-wanted (display-version)) + (help-wanted (display-help)) + (else + (let ((input (option-ref options '() #f)) + (output (option-ref options 'output #f))) + (if + ;; Bonard B. Timmons III says `(pair? input)' alone is sufficient. + ;; (and input (pair? input)) + (pair? input) + (snarf-file (car input) output texinfo-wanted lang) + (display-help)))))))) + +(define main doc-snarf) + +;; Supported languages and their parameters. Each element has form: +;; (LANG DOC-START DOC-END DOC-PREFIX OPT-PREFIX SIG-START STD-INT-DOC?) +;; LANG is a symbol, STD-INT-DOC? is a boolean indicating whether or not +;; LANG supports "standard internal docstring" (a string after the formals), +;; everything else is a string specifying a regexp. +;;-ttn-mod: new var +(define supported-languages + '((c + "^/\\*(.*)" + "^ \\*/" + "^ \\* (.*)" + "^ \\*-(.*)" + "NOTHING AT THIS TIME!!!" + #f + ) + (scheme + "^;; (.*)" + "^;;\\." + "^;; (.*)" + "^;;-(.*)" + "^\\(define" + #t + ))) + +;; Get @var{lang}'s @var{parameter}. Both args are symbols. +;;-ttn-mod: new proc +(define (lang-parm lang parm) + (list-ref (assq-ref supported-languages lang) + (case parm + ((docstring-start) 0) + ((docstring-end) 1) + ((docstring-prefix) 2) + ((option-prefix) 3) + ((signature-start) 4) + ((std-int-doc?) 5)))) + +;; Snarf all docstrings from the file @var{input} and write them to +;; file @var{output}. Use texinfo format for the output if +;; @var{texinfo?} is true. +;;-ttn-mod: don't use string comparison, consult table instead +(define (snarf-file input output texinfo? lang) + (or (memq lang (map car supported-languages)) + (error "doc-snarf: input language must be c or scheme.")) + (write-output (snarf input lang) output + (if texinfo? format-texinfo format-plain))) + +;; fixme: this comment is required to trigger standard internal +;; docstring snarfing... ideally, it wouldn't be necessary. +;;-ttn-mod: new proc, from snarf-docs (aren't these names fun?) +(define (find-std-int-doc line input-port) + "Unread @var{line} from @var{input-port}, then read in the entire form and +return the standard internal docstring if found. Return #f if not." + (unread-string line input-port) ; ugh + (let ((form (read input-port))) + (cond ((and (list? form) ; (define (PROC ARGS) "DOC" ...) + (< 3 (length form)) + (eq? 'define (car form)) + (pair? (cadr form)) + (symbol? (caadr form)) + (string? (caddr form))) + (caddr form)) + ((and (list? form) ; (define VAR (lambda ARGS "DOC" ...)) + (< 2 (length form)) + (eq? 'define (car form)) + (symbol? (cadr form)) + (list? (caddr form)) + (< 3 (length (caddr form))) + (eq? 'lambda (car (caddr form))) + (string? (caddr (caddr form)))) + (caddr (caddr form))) + (else #f)))) + +;; Split @var{string} into lines, adding @var{prefix} to each. +;;-ttn-mod: new proc +(define (split-prefixed string prefix) + (separate-fields-discarding-char + #\newline string + (lambda lines + (map (lambda (line) + (string-append prefix line)) + lines)))) + +;; snarf input-file output-file +;; Extract docstrings from the input file @var{input}, presumed +;; to be written in language @var{lang}. +;;-Author: Martin Grabmueller <mgrabmue@cs.tu-berlin.de> +;;-Created: 2001-02-17 +;;-ttn-mod: regluarize lang parm lookup, add "std int doc" snarfing (2 places) +(define (snarf input-file lang) + (let* ((i-p (open-input-file input-file)) + (parm-regexp (lambda (parm) (make-regexp (lang-parm lang parm)))) + (docstring-start (parm-regexp 'docstring-start)) + (docstring-end (parm-regexp 'docstring-end)) + (docstring-prefix (parm-regexp 'docstring-prefix)) + (option-prefix (parm-regexp 'option-prefix)) + (signature-start (parm-regexp 'signature-start)) + (augmented-options + (lambda (line i-p options) + (let ((int-doc (and (lang-parm lang 'std-int-doc?) + (let ((d (find-std-int-doc line i-p))) + (and d (split-prefixed d "internal: ")))))) + (if int-doc + (append (reverse int-doc) options) + options))))) + + (let lp ((line (read-line i-p)) (state 'neutral) (doc-strings '()) + (options '()) (entries '()) (lno 0)) + (cond + ((eof-object? line) + (close-input-port i-p) + (reverse entries)) + + ;; State 'neutral: we're currently not within a docstring or + ;; option section + ((eq? state 'neutral) + (let ((m (regexp-exec docstring-start line))) + (if m + (lp (read-line i-p) 'doc-string + (list (match:substring m 1)) '() entries (+ lno 1)) + (lp (read-line i-p) state '() '() entries (+ lno 1))))) + + ;; State 'doc-string: we have started reading a docstring and + ;; are waiting for more, for options or for a define. + ((eq? state 'doc-string) + (let ((m0 (regexp-exec docstring-prefix line)) + (m1 (regexp-exec option-prefix line)) + (m2 (regexp-exec signature-start line)) + (m3 (regexp-exec docstring-end line))) + (cond + (m0 + (lp (read-line i-p) 'doc-string + (cons (match:substring m0 1) doc-strings) '() entries + (+ lno 1))) + (m1 + (lp (read-line i-p) 'options + doc-strings (cons (match:substring m1 1) options) entries + (+ lno 1))) + (m2 + (let ((options (augmented-options line i-p options))) ; ttn-mod + (lp (read-line i-p) 'neutral '() '() + (cons (parse-entry doc-strings options line input-file lno) + entries) + (+ lno 1)))) + (m3 + (lp (read-line i-p) 'neutral '() '() + (cons (parse-entry doc-strings options #f input-file lno) + entries) + (+ lno 1))) + (else + (lp (read-line i-p) 'neutral '() '() entries (+ lno 1)))))) + + ;; State 'options: We're waiting for more options or for a + ;; define. + ((eq? state 'options) + (let ((m1 (regexp-exec option-prefix line)) + (m2 (regexp-exec signature-start line)) + (m3 (regexp-exec docstring-end line))) + (cond + (m1 + (lp (read-line i-p) 'options + doc-strings (cons (match:substring m1 1) options) entries + (+ lno 1))) + (m2 + (let ((options (augmented-options line i-p options))) ; ttn-mod + (lp (read-line i-p) 'neutral '() '() + (cons (parse-entry doc-strings options line input-file lno) + entries) + (+ lno 1)))) + (m3 + (lp (read-line i-p) 'neutral '() '() + (cons (parse-entry doc-strings options #f input-file lno) + entries) + (+ lno 1))) + (else + (lp (read-line i-p) 'neutral '() '() entries (+ lno 1)))))))))) + +(define (make-entry symbol signature docstrings options filename line) + (vector 'entry symbol signature docstrings options filename line)) +(define (entry-symbol e) + (vector-ref e 1)) +(define (entry-signature e) + (vector-ref e 2)) +(define (entry-docstrings e) + (vector-ref e 3)) +(define (entry-options e) + (vector-ref e 4)) +(define (entry-filename e) + (vector-ref e 5)) +(define (entry-line e) + "This docstring will not be snarfed, unfortunately..." + (vector-ref e 6)) + +;; Create a docstring entry from the docstring line list +;; @var{doc-strings}, the option line list @var{options} and the +;; define line @var{def-line} +(define (parse-entry docstrings options def-line filename line-no) +; (write-line docstrings) + (cond + (def-line + (make-entry (get-symbol def-line) + (make-prototype def-line) (reverse docstrings) + (reverse options) filename + (+ (- line-no (length docstrings) (length options)) 1))) + ((> (length docstrings) 0) + (make-entry (string->symbol (car (reverse docstrings))) + (car (reverse docstrings)) + (cdr (reverse docstrings)) + (reverse options) filename + (+ (- line-no (length docstrings) (length options)) 1))) + (else + (make-entry 'foo "" (reverse docstrings) (reverse options) filename + (+ (- line-no (length docstrings) (length options)) 1))))) + +;; Create a string which is a procedure prototype. The necessary +;; information for constructing the prototype is taken from the line +;; @var{def-line}, which is a line starting with @code{(define...}. +(define (make-prototype def-line) + (call-with-input-string + def-line + (lambda (s-p) + (let* ((paren (read-char s-p)) + (keyword (read s-p)) + (tmp (read s-p))) + (cond + ((pair? tmp) + (join-symbols tmp)) + ((symbol? tmp) + (symbol->string tmp)) + (else + "")))))) + +(define (get-symbol def-line) + (call-with-input-string + def-line + (lambda (s-p) + (let* ((paren (read-char s-p)) + (keyword (read s-p)) + (tmp (read s-p))) + (cond + ((pair? tmp) + (car tmp)) + ((symbol? tmp) + tmp) + (else + 'foo)))))) + +;; Append the symbols in the string list @var{s}, separated with a +;; space character. +(define (join-symbols s) + (cond ((null? s) + "") + ((symbol? s) + (string-append ". " (symbol->string s))) + ((null? (cdr s)) + (symbol->string (car s))) + (else + (string-append (symbol->string (car s)) " " (join-symbols (cdr s)))))) + +;; Write @var{entries} to @var{output-file} using @var{writer}. +;; @var{writer} is a proc that takes one entry. +;; If @var{output-file} is #f, write to stdout. +;;-ttn-mod: new proc +(define (write-output entries output-file writer) + (with-output-to-port (cond (output-file (open-output-file output-file)) + (else (current-output-port))) + (lambda () (for-each writer entries)))) + +;; Write an @var{entry} using texinfo format. +;;-ttn-mod: renamed from `texinfo-output', distilled +(define (format-texinfo entry) + (display "\n\f") + (display (entry-symbol entry)) + (newline) + (display "@c snarfed from ") + (display (entry-filename entry)) + (display ":") + (display (entry-line entry)) + (newline) + (display "@deffn procedure ") + (display (entry-signature entry)) + (newline) + (for-each (lambda (s) (write-line s)) + (entry-docstrings entry)) + (for-each (lambda (s) (display "@c ") (write-line s)) + (entry-options entry)) + (write-line "@end deffn")) + +;; Write an @var{entry} using plain format. +;;-ttn-mod: renamed from `texinfo-output', distilled +(define (format-plain entry) + (display "Procedure: ") + (display (entry-signature entry)) + (newline) + (for-each (lambda (s) (write-line s)) + (entry-docstrings entry)) + (for-each (lambda (s) (display ";; ") (write-line s)) + (entry-options entry)) + (display "Snarfed from ") + (display (entry-filename entry)) + (display ":") + (display (entry-line entry)) + (newline) + (write-line "\f")) + +;;; doc-snarf ends here diff --git a/scripts/generate-autoload b/scripts/generate-autoload new file mode 100755 index 000000000..523b6049d --- /dev/null +++ b/scripts/generate-autoload @@ -0,0 +1,138 @@ +#!/bin/sh +# aside from this initial boilerplate, this is actually -*- scheme -*- code +main='(module-ref (resolve-module '\''(scripts generate-autoload)) '\'main')' +exec ${GUILE-guile} -c "(apply $main (cdr (command-line)))" "$@" +!# +;;; generate-autoload --- Display define-module form with autoload info + +;; 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 + +;;; Commentary: + +;; Usage: generate-autoload [OPTIONS] FILE1 FILE2 ... +;; +;; The autoload form is displayed to standard output: +;; +;; (define-module (guile-user) +;; :autoload (ZAR FOO) (FOO-1 FOO-2 ...) +;; : +;; : +;; :autoload (ZAR BAR) (BAR-1 BAR-2 ...)) +;; +;; For each file, a symbol triggers an autoload if it is found in one +;; of these situations: +;; - in the `:export' clause of a `define-module' form; +;; - in a top-level `export' or `export-syntax' form; +;; - in a `define-public' form. +;; +;; The module name is inferred from the `define-module' form. If either the +;; module name or the exports list cannot be determined, no autoload entry is +;; generated for that file. +;; +;; Options: +;; --target MODULE-NAME -- Use MODULE-NAME instead of `(guile-user)'. +;; Note that some shells may require you to +;; quote the argument to handle parentheses +;; and spaces. +;; +;; Usage examples from Scheme code as a module: +;; (use-modules (scripts generate-autoload)) +;; (generate-autoload "generate-autoload") +;; (generate-autoload "--target" "(my module)" "generate-autoload") +;; (apply generate-autoload "--target" "(my module)" '("foo" "bar" "baz")) +;; +;; Author: Thien-Thi Nguyen + +;;; Code: + +(define-module (scripts generate-autoload) + :export (generate-autoload)) + +(define (autoload-info file) + (let ((p (open-input-file file))) + (let loop ((form (read p)) (module-name #f) (exports '())) + (if (eof-object? form) + (and module-name + (not (null? exports)) + (list module-name exports)) ; ret + (cond ((and (list? form) + (< 1 (length form)) + (eq? 'define-module (car form))) + (loop (read p) + (cadr form) + (cond ((member ':export form) + => (lambda (val) + (append (cadr val) exports))) + (else exports)))) + ((and (list? form) + (< 1 (length form)) + (memq (car form) '(export export-syntax))) + (loop (read p) + module-name + (append (cdr form) exports))) + ((and (list? form) + (< 2 (length form)) + (eq? 'define-public (car form)) + (list? (cadr form)) + (symbol? (caadr form))) + (loop (read p) + module-name + (cons (caadr form) exports))) + ((and (list? form) + (< 2 (length form)) + (eq? 'define-public (car form)) + (symbol? (cadr form))) + (loop (read p) + module-name + (cons (cadr form) exports))) + (else (loop (read p) module-name exports))))))) + +(define (generate-autoload . args) + (let* ((module-count 0) + (syms-count 0) + (target-override (cond ((member "--target" args) => cadr) + (else #f))) + (files (if target-override (cddr args) (cdr args)))) + (display ";;; do not edit --- generated ") + (display (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time)))) + (newline) + (display "(define-module ") + (display (or target-override "(guile-user)")) + (for-each (lambda (file) + (cond ((autoload-info file) + => (lambda (info) + (and info + (apply (lambda (module-name exports) + (set! module-count (1+ module-count)) + (set! syms-count (+ (length exports) + syms-count)) + (for-each display + (list "\n :autoload " + module-name " " + exports))) + info)))))) + files) + (display ")") + (newline) + (for-each display (list " ;;; " + syms-count " symbols in " + module-count " modules\n")))) + +(define main generate-autoload) + +;;; generate-autoload ends here diff --git a/scripts/punify b/scripts/punify new file mode 100755 index 000000000..e5b0f9d78 --- /dev/null +++ b/scripts/punify @@ -0,0 +1,81 @@ +#!/bin/sh +# aside from this initial boilerplate, this is actually -*- scheme -*- code +main='(module-ref (resolve-module '\''(scripts punify)) '\'main')' +exec ${GUILE-guile} -c "(apply $main (cdr (command-line)))" "$@" +!# +;;; punify --- Display Scheme code w/o unnecessary comments / whitespace + +;; 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 + +;;; Commentary: + +;; Usage: punify FILE1 FILE2 ... +;; +;; Each file's forms are read and written to stdout. +;; The effect is to remove comments and much non-essential whitespace. +;; This is useful when installing Scheme source to space-limited media. +;; +;; Example: +;; $ wc ./punify ; ./punify ./punify | wc +;; 81 355 2622 ./punify +;; 0 34 694 +;; +;; TODO: Read from stdin. +;; Handle vectors. +;; Identifier punification. +;; +;; Author: Thien-Thi Nguyen + +;;; Code: + +(define-module (scripts punify) + :export (punify)) + +(define (write-punily form) + (if (and (list? form) (not (null? form))) + (let ((first (car form))) + (display "(") + (write-punily first) + (let loop ((ls (cdr form)) (last-was-list? (list? first))) + (if (null? ls) + (display ")") + (let* ((new-first (car ls)) + (this-is-list? (list? new-first))) + (and (not last-was-list?) + (not this-is-list?) + (display " ")) + (write-punily new-first) + (loop (cdr ls) this-is-list?))))) + (write form))) + +(define (punify-one file) + (with-input-from-file file + (lambda () + (let ((toke (lambda () (read (current-input-port))))) + (let loop ((form (toke))) + (or (eof-object? form) + (begin + (write-punily form) + (loop (toke))))))))) + +(define (punify . args) + (for-each punify-one args)) + +(define main punify) + +;;; punify ends here diff --git a/scripts/use2dot b/scripts/use2dot new file mode 100755 index 000000000..1b59519ae --- /dev/null +++ b/scripts/use2dot @@ -0,0 +1,166 @@ +#!/bin/sh +# aside from this initial boilerplate, this is actually -*- scheme -*- code +main='(module-ref (resolve-module '\''(scripts use2dot)) '\'main')' +exec ${GUILE-guile} -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 + +;;; 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. +;; +;; 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)'. +;; +;; TODO +;; - add `--load-synonyms' option +;; - add `--ignore-module' option +;; - handle arbitrary command-line key/value configuration +;; +;; Author: Thien-Thi Nguyen based on PERL script by Keisuke Nishida + +;;; Code: + +(define-module (scripts use2dot) + :use-module (ice-9 regex)) + +(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 default-module '(guile)) + +(define (q s) ; quote + (format #f "~S" s)) + +(define (vv pair) ; var=val + (format #f "~A=~A" (car pair) (cdr pair))) + +(define (spew module use . etc) + (and module + (let ((etc-spec (if (null? etc) + "" + (format #f " [~A]" (mapconcat vv etc ","))))) + (format #t " \"~A\" -> \"~A\"~A;\n" module use etc-spec)))) + +(define (header) + (format #t "digraph use2dot {") + (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 (grok filename) + (let* ((p (open-file filename "r")) + (next (lambda () (read p))) + (curmod #f)) + (let loop ((form (next))) + (cond ((eof-object? form)) + ((not (list? form)) (loop (next))) + (else (case (car form) + ((define-module) + (let ((module (cadr form))) + (set! curmod module) + (let loop ((ls form)) + (or (null? ls) + (case (car ls) + ((:use-module) + (spew module (cadr ls)) + (loop (cddr ls))) + ((:autoload) + (spew module (cadr ls) + '(style . dotted) + '(fontsize . 5) + (let ((len (length (caddr ls)))) + `(label . ,(q (number->string len))))) + (loop (cdddr ls))) + (else (loop (cdr ls)))))))) + ((use-modules) + (for-each (lambda (use) + (spew (or curmod default-module) use)) + (cdr form))) + ((load primitive-load) + (spew (or curmod default-module) + (let ((file (cadr form))) + (if (string? file) + file + (format #f "[computed in ~A]" filename))) + '(style . bold)))) + (loop (next))))))) + +(define (body files) + (for-each grok files)) + +(define (footer) + (format #t "}")) + +(define (use2dot . args) + (header) + (let* ((override (cond ((member "--default-module" args) => cadr) + (else #f))) + (files (if override (cddr args) args))) + (and override + (set! default-module + (with-input-from-string override (lambda () (read))))) + (body files)) + (footer)) + +(define main use2dot) + +;;; use2dot ends here |