1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
guile/module/scripts/help.scm
Maxim Cournoyer 3e7c80a62f scripts: help: Fix reference to the "Using Guile Tools" node.
Fixes <https://bugs.gnu.org/28835>.

* module/scripts/help.scm (list-commands): Fix reference to the "Using
Guile Tools" node.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
2017-11-22 16:21:59 +01:00

188 lines
6.3 KiB
Scheme
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; 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 (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)
(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 (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))
((and (null? (cdr args)) (not (string-prefix? "-" (car args))))
;; help for particular command
(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
(show-help %mod (current-error-port))
(exit 1))))