[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.2-50-gb8287e8

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=b8287e882316bce594c0be0c9db7c5be12c27b96

The branch, stable-2.0 has been updated
       via  b8287e882316bce594c0be0c9db7c5be12c27b96 (commit)
      from  6b1c5d9d67acd35a2b0c6e994dea21c3b5d8d39a (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit b8287e882316bce594c0be0c9db7c5be12c27b96
Author: Andy Wingo <address@hidden>
Date:   Fri Aug 19 12:04:46 2011 +0200

    better guild help FOO
    
    * module/scripts/help.scm (show-help, show-summary, show-usage): Grovel
      for %synopsis and %help variables as well, and show them
      appropriately.  Export these routines for other script modules to
      use.  Needs documentation.

-----------------------------------------------------------------------

Summary of changes:
 module/scripts/help.scm |   82 +++++++++++++++++++++++++++++++++++------------
 1 files changed, 61 insertions(+), 21 deletions(-)

diff --git a/module/scripts/help.scm b/module/scripts/help.scm
index 107d394..4e0f47c 100644
--- a/module/scripts/help.scm
+++ b/module/scripts/help.scm
@@ -29,9 +29,14 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 documentation)
   #:use-module ((srfi srfi-1) #:select (fold append-map))
-  #:export (main))
+  #:export (show-help show-summary show-usage main))
 
 (define %summary "Show a brief help message.")
+(define %synopsis "help\nhelp --all\nhelp COMMAND")
+(define %help "
+Show help on guild commands.  With --all, show arcane incantations as
+well.  With COMMAND, show more detailed help for a particular command.
+")
 
 
 (define (directory-files dir)
@@ -117,32 +122,67 @@ For complete documentation, run: info guile 'Using Guile 
Tools'
   (file-commentary
    (%search-load-path (module-filename mod))))
 
+(define (module-command-name mod)
+  (symbol->string (car (last-pair (module-name mod)))))
+
+(define* (show-usage mod #:optional (port (current-output-port)))
+  (let ((usages (string-split
+                 (let ((var (module-variable mod '%synopsis)))
+                   (if var
+                       (variable-ref var)
+                       (string-append (module-command-name mod)
+                                      " OPTION...")))
+                 #\newline)))
+    (display "Usage: guild " port)
+    (display (car usages))
+    (newline port)
+    (for-each (lambda (u)
+                (display "       guild " port)
+                (display u port)
+                (newline port))
+              (cdr usages))))
+
+(define* (show-summary mod #:optional (port (current-output-port)))
+  (let ((var (module-variable mod '%summary)))
+    (if var
+        (begin
+          (display (variable-ref var) port)
+          (newline port)))))
+
+(define* (show-help mod #:optional (port (current-output-port)))
+  (show-usage mod port)
+  (show-summary mod port)
+  (cond
+   ((module-variable mod '%help)
+    => (lambda (var)
+         (display (variable-ref var) port)
+         (newline port)))
+   ((module-commentary mod)
+    => (lambda (commentary)
+         (newline port)
+         (display commentary port)))
+   (else
+    (format #t "No documentation found for command \"~a\".\n"
+            (module-command-name mod)))))
+
+(define %mod (current-module))
 (define (main . args)
   (cond
    ((null? args)
     (list-commands #f))
    ((or (equal? args '("--all")) (equal? args '("-a")))
     (list-commands #t))
-   ((not (string-prefix? "-" (car args)))
+   ((and (null? (cdr args)) (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)))))
+    (let ((name (car args)))
+      (cond
+       ((resolve-module `(scripts ,(string->symbol name)) #:ensure #f)
+        => (lambda (mod)
+             (show-help mod)
+             (exit 0)))
+       (else
+        (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.
-")
+    (show-help %mod (current-error-port))
     (exit 1))))


hooks/post-receive
-- 
GNU Guile