]> git.jsancho.org Git - guile-click.git/blob - click/help.scm
Nested commands
[guile-click.git] / click / help.scm
1 ;;; Click --- Command Line Interface Creation Kit for GNU Guile
2 ;;; Copyright © 2021 Javier Sancho <jsf@jsancho.org>
3 ;;;
4 ;;; This file is part of Click.
5 ;;;
6 ;;; Click is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or
9 ;;; (at your option) any later version.
10 ;;;
11 ;;; Click is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14 ;;; General Public License for more details.
15 ;;;
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with Click.  If not, see <http://www.gnu.org/licenses/>.
18
19
20 (define-module (click help)
21   #:use-module (ice-9 format)
22   #:use-module (click command)
23   #:use-module (click util)
24   #:export (display-error
25             display-help))
26
27
28 (define (get-type-description option)
29   "Return allowed type for the value in the option"
30   (assoc-ref (option-type option) 'description))
31
32
33 (define* (get-help-text procedure #:optional (help-text ""))
34   "Return the title for the help message"
35   (cond ((> (string-length help-text) 0)
36          help-text)
37         ((procedure? procedure)
38          (let ((doc-text (procedure-documentation procedure)))
39            (and (string? doc-text)
40                 (> (string-length doc-text) 0)
41                 doc-text)))
42         (else
43          help-text)))
44
45
46 (define (get-help-text command)
47   "Return the title for the help message"
48   (let ((procedure (command-procedure command))
49         (help-text (command-help-text command)))
50     (cond ((> (string-length help-text) 0)
51            help-text)
52           ((procedure? procedure)
53            (let ((doc-text (procedure-documentation procedure)))
54              (and (string? doc-text)
55                   (> (string-length doc-text) 0)
56                   doc-text)))
57           (else
58            help-text))))
59
60
61 (define (display-options options)
62   "Display options in tabular way"
63   (let ((sep (+ 2 (apply max (map (lambda (option)
64                                     (string-length (car option)))
65                                   options)))))
66     (for-each (lambda (option)
67                 (format #t
68                         "  ~a~v_~a~%"
69                         (car option)
70                         (- sep (string-length (car option)))
71                         (cdr option)))
72               options)))
73
74
75 (define* (display-help command)
76   "Display help message"
77
78   ;; Usage
79   (format #t "Usage: ~a [OPTIONS]" (program-name))
80   (when (group? command)
81     (format #t " COMMAND [ARGS]..."))
82   (format #t "~%~%")
83
84   ;; Title
85   (let ((title (get-help-text command)))
86     (when title
87       (format #t "  ~a~%~%" title)))
88
89   ;; Options
90   (format #t "Options:~%")
91   (let ((options (map (lambda (option)
92                         (cons (format #f
93                                       "--~a~a~a"
94                                       (car option)
95                                       (let ((single-char
96                                              (option-property option 'single-char)))
97                                         (if single-char
98                                             (format #f ", -~a" single-char)
99                                             ""))
100                                       (let ((value
101                                              (not (option-property option 'flag))))
102                                         (if value
103                                             (format #f " ~a" (get-type-description option))
104                                             "")))
105                               (option-property option 'help "")))
106                       (command-option-spec command))))
107     (display-options options))
108
109   ;; Commands
110   (when (group? command)
111     (format #t "~%Commands:~%")
112     (let ((options (map (lambda (command)
113                           (cons (or (command-name command) "")
114                                 (or (get-help-text command) "")))
115                         (command-commands command))))
116       (display-options options))))
117
118
119 (define (display-error wrong-option)
120   (format #t "Usage: ~a [OPTIONS]
121 Try '~a --help' for help.
122
123 Error: No such option: ~a
124 " (program-name) (program-name) wrong-option))