diff options
author | Andy Wingo <wingo@pobox.com> | 2011-07-25 18:26:37 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-07-25 18:26:37 +0200 |
commit | ab4bc85398a14b62b58694bab83c63be286b2fd5 (patch) | |
tree | 84bfe7b0b6064016bcfadb76ec95d07410654fe8 /module/scripts | |
parent | f29c300507da21a667f5b82e75300f8009eab9cc (diff) | |
parent | f4b7d918eff9770f09893b023fd834f5c0bc33d1 (diff) | |
download | guile-ab4bc85398a14b62b58694bab83c63be286b2fd5.tar.gz |
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts:
GUILE-VERSION
test-suite/tests/srfi-4.test
Diffstat (limited to 'module/scripts')
-rw-r--r-- | module/scripts/PROGRAM.scm | 40 | ||||
-rw-r--r-- | module/scripts/api-diff.scm | 5 | ||||
-rw-r--r-- | module/scripts/autofrisk.scm | 5 | ||||
-rw-r--r-- | module/scripts/compile.scm | 2 | ||||
-rw-r--r-- | module/scripts/disassemble.scm | 4 | ||||
-rw-r--r-- | module/scripts/display-commentary.scm | 4 | ||||
-rw-r--r-- | module/scripts/doc-snarf.scm | 4 | ||||
-rw-r--r-- | module/scripts/frisk.scm | 5 | ||||
-rw-r--r-- | module/scripts/generate-autoload.scm | 5 | ||||
-rw-r--r-- | module/scripts/help.scm | 148 | ||||
-rw-r--r-- | module/scripts/lint.scm | 3 | ||||
-rw-r--r-- | module/scripts/list.scm | 11 | ||||
-rw-r--r-- | module/scripts/punify.scm | 3 | ||||
-rw-r--r-- | module/scripts/read-rfc822.scm | 5 | ||||
-rw-r--r-- | module/scripts/read-scheme-source.scm | 5 | ||||
-rw-r--r-- | module/scripts/read-text-outline.scm | 5 | ||||
-rw-r--r-- | module/scripts/scan-api.scm | 5 | ||||
-rw-r--r-- | module/scripts/snarf-check-and-output-texi.scm | 5 | ||||
-rw-r--r-- | module/scripts/snarf-guile-m4-docs.scm | 5 | ||||
-rw-r--r-- | module/scripts/summarize-guile-TODO.scm | 5 | ||||
-rw-r--r-- | module/scripts/use2dot.scm | 4 |
21 files changed, 221 insertions, 57 deletions
diff --git a/module/scripts/PROGRAM.scm b/module/scripts/PROGRAM.scm deleted file mode 100644 index 56e5cf334..000000000 --- a/module/scripts/PROGRAM.scm +++ /dev/null @@ -1,40 +0,0 @@ -;;; PROGRAM --- Does something - -;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU Lesser General Public License -;; as published by the Free Software Foundation; either version 3, 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 -;; Lesser General Public License for more details. -;; -;; You should have received a copy of the GNU Lesser General Public -;; License along with this software; see the file COPYING.LESSER. If -;; not, write to the Free Software Foundation, Inc., 51 Franklin -;; Street, Fifth Floor, Boston, MA 02110-1301 USA - -;;; Author: J.R.Hacker - -;;; Commentary: - -;; Usage: PROGRAM [ARGS] -;; -;; PROGRAM does something. -;; -;; TODO: Write it! - -;;; Code: - -(define-module (scripts PROGRAM) - :export (PROGRAM)) - -(define (PROGRAM . args) - #t) - -(define main PROGRAM) - -;;; PROGRAM ends here diff --git a/module/scripts/api-diff.scm b/module/scripts/api-diff.scm index b842b03ff..b2527b9e9 100644 --- a/module/scripts/api-diff.scm +++ b/module/scripts/api-diff.scm @@ -1,6 +1,6 @@ ;;; api-diff --- diff guile-api.alist files -;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -46,6 +46,9 @@ :autoload (srfi srfi-13) (string-tokenize) :export (api-diff)) +(define %include-in-guild-list #f) +(define %summary "Show differences between two scan-api files.") + (define (read-alist-file file) (with-input-from-file file (lambda () (read)))) diff --git a/module/scripts/autofrisk.scm b/module/scripts/autofrisk.scm index 943c90227..9bce06e2a 100644 --- a/module/scripts/autofrisk.scm +++ b/module/scripts/autofrisk.scm @@ -1,6 +1,6 @@ ;;; autofrisk --- Generate module checks for use with auto* tools -;; Copyright (C) 2002, 2006, 2009 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006, 2009, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -62,6 +62,9 @@ :use-module (scripts frisk) :export (autofrisk)) +(define %include-in-guild-list #f) +(define %summary "Generate snippets for use in configure.ac files.") + (define *recognized-keys* '(files-glob non-critical-external non-critical-internal diff --git a/module/scripts/compile.scm b/module/scripts/compile.scm index f9d6cca99..0651c6804 100644 --- a/module/scripts/compile.scm +++ b/module/scripts/compile.scm @@ -37,6 +37,8 @@ #:use-module (ice-9 format) #:export (compile)) +(define %summary "Compile a file.") + (define (fail . messages) (format (current-error-port) "error: ~{~a~}~%" messages) diff --git a/module/scripts/disassemble.scm b/module/scripts/disassemble.scm index 8907f6d08..7dab2dde9 100644 --- a/module/scripts/disassemble.scm +++ b/module/scripts/disassemble.scm @@ -1,6 +1,6 @@ ;;; Disassemble --- Disassemble .go files into something human-readable -;; Copyright 2005, 2008, 2009 Free Software Foundation, Inc. +;; Copyright 2005, 2008, 2009, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -32,6 +32,8 @@ #:renamer (symbol-prefix-proc 'asm:)) #:export (disassemble)) +(define %summary "Disassemble a compiled .go file.") + (define (disassemble . files) (for-each (lambda (file) (asm:disassemble (load-objcode file))) diff --git a/module/scripts/display-commentary.scm b/module/scripts/display-commentary.scm index 5bd249ce9..81d7907af 100644 --- a/module/scripts/display-commentary.scm +++ b/module/scripts/display-commentary.scm @@ -1,6 +1,6 @@ ;;; display-commentary --- As advertized -;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -33,6 +33,8 @@ :use-module (ice-9 documentation) :export (display-commentary)) +(define %summary "Display the Commentary section from a file or module.") + (define (display-commentary-one file) (format #t "~A commentary:\n~A" file (file-commentary file))) diff --git a/module/scripts/doc-snarf.scm b/module/scripts/doc-snarf.scm index b7fbc996e..fa3dfb312 100644 --- a/module/scripts/doc-snarf.scm +++ b/module/scripts/doc-snarf.scm @@ -1,6 +1,6 @@ ;;; doc-snarf --- Extract documentation from source files -;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -83,6 +83,8 @@ This procedure foos, or bars, depending on the argument @var{braz}. :use-module (ice-9 rdelim) :export (doc-snarf)) +(define %summary "Snarf out documentation from a file.") + (define command-synopsis '((version (single-char #\v) (value #f)) (help (single-char #\h) (value #f)) diff --git a/module/scripts/frisk.scm b/module/scripts/frisk.scm index c452ede25..a8f79232d 100644 --- a/module/scripts/frisk.scm +++ b/module/scripts/frisk.scm @@ -1,6 +1,6 @@ ;;; frisk --- Grok the module interfaces of a body of files -;; Copyright (C) 2002, 2006, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006, 2010, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -103,6 +103,9 @@ mod-up-ls mod-down-ls mod-int? edge-type edge-up edge-down)) +(define %include-in-guild-list #f) +(define %summary "Show dependency information for a module.") + (define *default-module* '(guile-user)) (define (grok-proc default-module note-use!) diff --git a/module/scripts/generate-autoload.scm b/module/scripts/generate-autoload.scm index 781931015..90f524b06 100644 --- a/module/scripts/generate-autoload.scm +++ b/module/scripts/generate-autoload.scm @@ -1,6 +1,6 @@ ;;; generate-autoload --- Display define-module form with autoload info -;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -59,6 +59,9 @@ (define-module (scripts generate-autoload) :export (generate-autoload)) +(define %include-in-guild-list #f) +(define %summary "Generate #:autoload clauses for a module.") + (define (autoload-info file) (let ((p (open-input-file file))) (let loop ((form (read p)) (module-name #f) (exports '())) diff --git a/module/scripts/help.scm b/module/scripts/help.scm new file mode 100644 index 000000000..107d39485 --- /dev/null +++ b/module/scripts/help.scm @@ -0,0 +1,148 @@ +;;; Help --- Show help on guild commands + +;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library 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 +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free +;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;;;; Boston, MA 02110-1301 USA + +;;; Commentary: + +;; Usage: help +;; +;; Show help for Guild scripts. + +;;; Code: + +(define-module (scripts help) + #:use-module (ice-9 format) + #:use-module (ice-9 documentation) + #:use-module ((srfi srfi-1) #:select (fold append-map)) + #:export (main)) + +(define %summary "Show a brief help message.") + + +(define (directory-files dir) + (if (and (file-exists? dir) (file-is-directory? dir)) + (let ((dir-stream (opendir dir))) + (let loop ((new (readdir dir-stream)) + (acc '())) + (if (eof-object? new) + (begin + (closedir dir-stream) + acc) + (loop (readdir dir-stream) + (if (or (string=? "." new) ; ignore + (string=? ".." new)) ; ignore + acc + (cons new acc)))))) + '())) + +(define (strip-extensions path) + (or-map (lambda (ext) + (and + (string-suffix? ext path) + ;; We really can't be adding e.g. ChangeLog-2008 to the set + ;; of runnable scripts, just because "" is a valid + ;; extension, by default. So hack around that here. + (not (string-null? ext)) + (substring path 0 + (- (string-length path) (string-length ext))))) + (append %load-compiled-extensions %load-extensions))) + +(define (unique l) + (cond ((null? l) l) + ((null? (cdr l)) l) + ((equal? (car l) (cadr l)) (unique (cdr l))) + (else (cons (car l) (unique (cdr l)))))) + +(define (find-submodules head) + (let ((shead (map symbol->string head))) + (unique + (sort + (append-map (lambda (path) + (fold (lambda (x rest) + (let ((stripped (strip-extensions x))) + (if stripped (cons stripped rest) rest))) + '() + (directory-files + (fold (lambda (x y) (in-vicinity y x)) path shead)))) + %load-path) + string<?)))) + +(define (list-commands all?) + (display "\ +Usage: guild COMMAND [ARGS] +Run command-line scripts provided by GNU Guile and related programs. + +Commands: +") + + (for-each + (lambda (name) + (let* ((modname `(scripts ,(string->symbol name))) + (mod (resolve-module modname #:ensure #f)) + (summary (and mod (and=> (module-variable mod '%summary) + variable-ref)))) + (if (and mod + (or all? + (let ((v (module-variable mod '%include-in-guild-list))) + (if v (variable-ref v) #t)))) + (if summary + (format #t " ~A ~23t~a\n" name summary) + (format #t " ~A\n" name))))) + (find-submodules '(scripts))) + (format #t " +For help on a specific command, try \"guild help COMMAND\". + +Report guild bugs to ~a +GNU Guile home page: <http://www.gnu.org/software/guile/> +General help using GNU software: <http://www.gnu.org/gethelp/> +For complete documentation, run: info guile 'Using Guile Tools' +" %guile-bug-report-address)) + +(define (module-commentary mod) + (file-commentary + (%search-load-path (module-filename mod)))) + +(define (main . args) + (cond + ((null? args) + (list-commands #f)) + ((or (equal? args '("--all")) (equal? args '("-a"))) + (list-commands #t)) + ((not (string-prefix? "-" (car args))) + ;; help for particular command + (let* ((name (car args)) + (mod (resolve-module `(scripts ,(string->symbol name)) + #:ensure #f))) + (if mod + (let ((commentary (module-commentary mod))) + (if commentary + (display commentary) + (format #t "No documentation found for command \"~a\".\n" + name))) + (begin + (format #t "No command named \"~a\".\n" name) + (exit 1))))) + (else + (display "Usage: guild help + guild help --all + guild help COMMAND + +Show a help on guild commands. With --all, show arcane incantations as +well. With COMMAND, show more detailed help for a particular command. +") + (exit 1)))) diff --git a/module/scripts/lint.scm b/module/scripts/lint.scm index aa74fb6a7..cea425ea9 100644 --- a/module/scripts/lint.scm +++ b/module/scripts/lint.scm @@ -105,6 +105,9 @@ #:use-module (ice-9 format) #:export (lint)) +(define %include-in-guild-list #f) +(define %summary "Check for bugs and style errors in a Scheme file.") + (define (lint filename) (let ((module-name (scan-file-for-module-name filename)) (free-vars (uniq (scan-file-for-free-variables filename)))) diff --git a/module/scripts/list.scm b/module/scripts/list.scm index c4891b6a8..0f1d715dd 100644 --- a/module/scripts/list.scm +++ b/module/scripts/list.scm @@ -26,9 +26,11 @@ ;;; Code: (define-module (scripts list) - #:use-module ((srfi srfi-1) #:select (fold append-map)) #:export (list-scripts)) +(define %include-in-guild-list #f) +(define %summary "An alias for \"help\".") + (define (directory-files dir) (if (and (file-exists? dir) (file-is-directory? dir)) @@ -50,6 +52,10 @@ (or-map (lambda (ext) (and (string-suffix? ext path) + ;; We really can't be adding e.g. ChangeLog-2008 to the set + ;; of runnable scripts, just because "" is a valid + ;; extension, by default. So hack around that here. + (not (string-null? ext)) (substring path 0 (- (string-length path) (string-length ext))))) (append %load-compiled-extensions %load-extensions))) @@ -80,4 +86,5 @@ (format #t "~A\n" x)) (find-submodules '(scripts)))) -(define main list-scripts) +(define (main . args) + (apply (@@ (scripts help) main) args)) diff --git a/module/scripts/punify.scm b/module/scripts/punify.scm index 1627722d3..6b33ac5ee 100644 --- a/module/scripts/punify.scm +++ b/module/scripts/punify.scm @@ -41,6 +41,9 @@ (define-module (scripts punify) :export (punify)) +(define %include-in-guild-list #f) +(define %summary "Strip comments and whitespace from a Scheme file.") + (define (write-punily form) (cond ((and (list? form) (not (null? form))) (let ((first (car form))) diff --git a/module/scripts/read-rfc822.scm b/module/scripts/read-rfc822.scm index c0a54f28c..08f3fb9a1 100644 --- a/module/scripts/read-rfc822.scm +++ b/module/scripts/read-rfc822.scm @@ -1,6 +1,6 @@ ;;; read-rfc822 --- Validate RFC822 file by displaying it to stdout -;; Copyright (C) 2002, 2004, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2004, 2006, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -49,6 +49,9 @@ :autoload (srfi srfi-13) (string-join) :export (read-rfc822 read-rfc822-silently)) +(define %include-in-guild-list #f) +(define %summary "Validate an RFC822-style file.") + (define from-line-rx (make-regexp "^From ")) (define header-name-rx (make-regexp "^([^:]+):[ \t]*")) (define header-cont-rx (make-regexp "^[ \t]+")) diff --git a/module/scripts/read-scheme-source.scm b/module/scripts/read-scheme-source.scm index b48a88f9b..1bca6a4c4 100644 --- a/module/scripts/read-scheme-source.scm +++ b/module/scripts/read-scheme-source.scm @@ -1,6 +1,6 @@ ;;; read-scheme-source --- Read a file, recognizing scheme forms and comments -;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -91,6 +91,9 @@ quoted? clump)) +(define %include-in-guild-list #f) +(define %summary "Print a parsed representation of a Scheme file.") + ;; Try to figure out what FORM is and its various attributes. ;; Call proc NOTE! with key (a symbol) and value. ;; diff --git a/module/scripts/read-text-outline.scm b/module/scripts/read-text-outline.scm index 64221fbe1..d0933bb0b 100644 --- a/module/scripts/read-text-outline.scm +++ b/module/scripts/read-text-outline.scm @@ -1,6 +1,6 @@ ;;; read-text-outline --- Read a text outline and display it as a sexp -;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -118,6 +118,9 @@ :autoload (ice-9 rdelim) (read-line) :autoload (ice-9 getopt-long) (getopt-long)) +(define %include-in-guild-list #f) +(define %summary "Convert textual outlines to s-expressions.") + (define (?? symbol) (let ((name (symbol->string symbol))) (string=? "?" (substring name (1- (string-length name)))))) diff --git a/module/scripts/scan-api.scm b/module/scripts/scan-api.scm index 9236f8742..86d07fc3e 100644 --- a/module/scripts/scan-api.scm +++ b/module/scripts/scan-api.scm @@ -1,6 +1,6 @@ ;;; scan-api --- Scan and group interpreter and libguile interface elements -;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -65,6 +65,9 @@ :use-module (ice-9 regex) :export (scan-api)) +(define %include-in-guild-list #f) +(define %summary "Generate an API description for a Guile extension.") + (define put set-object-property!) (define get object-property) diff --git a/module/scripts/snarf-check-and-output-texi.scm b/module/scripts/snarf-check-and-output-texi.scm index f92c833ed..6ca07a1f4 100644 --- a/module/scripts/snarf-check-and-output-texi.scm +++ b/module/scripts/snarf-check-and-output-texi.scm @@ -1,6 +1,6 @@ ;;; snarf-check-and-output-texi --- called by the doc snarfer. -;; Copyright (C) 2001, 2002, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2006, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -26,6 +26,9 @@ :use-module (ice-9 match) :export (snarf-check-and-output-texi)) +(define %include-in-guild-list #f) +(define %summary "Transform snarfed .doc files into texinfo documentation.") + ;;; why aren't these in some module? (define-macro (when cond . body) diff --git a/module/scripts/snarf-guile-m4-docs.scm b/module/scripts/snarf-guile-m4-docs.scm index 05c305ebd..4e59f536d 100644 --- a/module/scripts/snarf-guile-m4-docs.scm +++ b/module/scripts/snarf-guile-m4-docs.scm @@ -1,6 +1,6 @@ ;;; snarf-guile-m4-docs --- Parse guile.m4 comments for texi documentation -;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -35,6 +35,9 @@ :use-module (ice-9 rdelim) :export (snarf-guile-m4-docs)) +(define %include-in-guild-list #f) +(define %summary "Snarf out texinfo documentation from .m4 files.") + (define (display-texi lines) (display "@deffn {Autoconf Macro}") (for-each (lambda (line) diff --git a/module/scripts/summarize-guile-TODO.scm b/module/scripts/summarize-guile-TODO.scm index ee4f88c1f..8b119e0ec 100644 --- a/module/scripts/summarize-guile-TODO.scm +++ b/module/scripts/summarize-guile-TODO.scm @@ -1,6 +1,6 @@ ;;; summarize-guile-TODO --- Display Guile TODO list in various ways -;; Copyright (C) 2002, 2006, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006, 2010, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -73,6 +73,9 @@ :autoload (ice-9 common-list) (remove-if-not) :export (summarize-guile-TODO)) +(define %include-in-guild-list #f) +(define %summary "A quaint relic of the past.") + (define put set-object-property!) (define get object-property) diff --git a/module/scripts/use2dot.scm b/module/scripts/use2dot.scm index ab97afbc7..975a9c4a4 100644 --- a/module/scripts/use2dot.scm +++ b/module/scripts/use2dot.scm @@ -1,6 +1,6 @@ ;;; use2dot --- Display module dependencies as a DOT specification -;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License @@ -53,6 +53,8 @@ :select (make-frisker edge-type edge-up edge-down)) :export (use2dot)) +(define %summary "Print a module's dependencies in graphviz format.") + (define *default-module* '(guile-user)) (define (q s) ; quote |