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 program-name 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))