1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

a prettier `guild list'

* module/scripts/list.scm (strip-extensions): Don't list programs
  without extensions.
  (main): Be prettier.  Parse out a %summary from modules, for a brief
  synopsis.
This commit is contained in:
Andy Wingo 2011-07-23 13:52:51 +02:00
parent 9957641b60
commit 5d48015adf

View file

@ -26,6 +26,7 @@
;;; Code:
(define-module (scripts list)
#:use-module (ice-9 format)
#:use-module ((srfi srfi-1) #:select (fold append-map))
#:export (list-scripts))
@ -50,6 +51,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)))
@ -74,10 +79,30 @@
%load-path)
string<?))))
(define (list-scripts . args)
(for-each (lambda (x)
;; would be nice to show a summary.
(format #t "~A\n" x))
(find-submodules '(scripts))))
(define (main . args)
(display "\
Usage: guild COMMAND [ARGS]
(define main list-scripts)
guild runs command-line scripts provided by GNU Guile and related
programs. See \"Using Guile Tools\" in the Guile manual, for more
information.
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 summary
(format #t " ~A ~32t~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.
"))