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