f397031ab1cdae525403b2ede30e4084e610222a
[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 util)
23   #:export (display-error
24             display-help))
25
26
27 (define (get-type-description option)
28   "Return allowed type for the value in the option"
29   (assoc-ref (option-type option) 'description))
30
31
32 (define (get-title target)
33   "Return the title for the help message"
34   (cond ((procedure? target)
35          (procedure-documentation target))
36         (else
37          target)))
38
39
40 (define* (display-help program-name target option-spec #:optional (commands '()))
41   (format #t "Usage: ~a [OPTIONS]
42
43   ~a
44
45 Options:
46 " program-name (get-title target))
47
48   (let* ((options (map (lambda (option)
49                          (cons (format #f
50                                        "--~a~a~a"
51                                        (car option)
52                                        (let ((single-char
53                                               (option-property option 'single-char)))
54                                          (if single-char
55                                              (format #f ", -~a" single-char)
56                                              ""))
57                                        (let ((value
58                                               (not (option-property option 'flag))))
59                                          (if value
60                                              (format #f " ~a" (get-type-description option))
61                                              "")))
62                                (option-property option 'help "")))
63                        option-spec))
64          (sep (+ 2 (apply max (map (lambda (option)
65                                      (string-length (car option)))
66                                    options)))))
67     (for-each (lambda (option)
68                 (format #t
69                         "  ~a~v_~a~%"
70                         (car option)
71                         (- sep (string-length (car option)))
72                         (cdr option)))
73               options)))
74
75
76 (define (display-error wrong-option)
77   (format #t "Usage: ~a [OPTIONS]
78 Try '~a --help' for help.
79
80 Error: No such option: ~a
81 " (program-name) (program-name) wrong-option))