add (scripts help)

* meta/guild.in (display-version): Use (ice-9 command-line)'s
  version-etc.
  (main): Dispatch --help to guild help.

* module/scripts/help.scm: New file, a copy of list.scm, but with a
  better name.

* module/Makefile.am: Add help.scm to the list.

* module/scripts/list.scm: Change to be an alias to "help".
  (list-scripts): Restore this API.

2 files changed, 117 insertions, 35 deletions

diff --git a/module/scripts/help.scm b/module/scripts/help.scm
new file mode 100644
index 000000000..9bb6ace9c
--- /dev/null
+++ b/module/scripts/help.scm
@@ -0,0 +1,109 @@
+;;; 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 ((srfi srfi-1) #:select (fold append-map)))
+
+(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 (main . args)
+  (display "\
+Usage: guild COMMAND [ARGS]
+
+  guild runs command-line scripts provided by GNU Guile and related
+  programs.  See \"Using Guile Tools\" in the Guile manual, for more
+  information.
+
+Commands:
+")
+
+  (let ((all? (or (equal? args '("--all"))
+                  (equal? args '("-a")))))
+    (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)))))
diff --git a/module/scripts/list.scm b/module/scripts/list.scm
index 55dbef264..0f1d715dd 100644
--- a/module/scripts/list.scm
+++ b/module/scripts/list.scm
@@ -26,12 +26,10 @@
 ;;; Code:
 
 (define-module (scripts list)
-  #:use-module (ice-9 format)
-  #:use-module ((srfi srfi-1) #:select (fold append-map))
   #:export (list-scripts))
 
 (define %include-in-guild-list #f)
-(define %summary "List available guild commands.")
+(define %summary "An alias for \"help\".")
 
 
 (define (directory-files dir)
@@ -82,36 +80,11 @@
                   %load-path)
       string<?))))
 
-(define (main . args)
-  (display "\
-Usage: guild COMMAND [ARGS]
-
-  guild runs command-line scripts provided by GNU Guile and related
-  programs.  See \"Using Guile Tools\" in the Guile manual, for more
-  information.
-
-Commands:
-")
+(define (list-scripts . args)
+  (for-each (lambda (x)
+              ;; would be nice to show a summary.
+              (format #t "~A\n" x))
+            (find-submodules '(scripts))))
 
-  (let ((all? (or (equal? args '("--all"))
-                  (equal? args '("-a")))))
-    (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))))
-
-  (display "\
-
-If COMMAND is \"list\" or omitted, display available scripts, otherwise
-COMMAND is run with ARGS.
-"))
+(define (main . args)
+  (apply (@@ (scripts help) main) args))