From ebf74b7c3fda8ead57a398bb6a1555067150d06f Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Thu, 16 Sep 2021 18:33:27 +0200 Subject: [PATCH] Groups support --- Makefile.am | 2 +- click.scm | 33 +++++++++++++++++------- click/{display.scm => help.scm} | 18 ++++++++++--- click/util.scm | 9 +------ examples/nested.scm | 45 +++++++++++++++++++++++++++++++++ 5 files changed, 85 insertions(+), 22 deletions(-) rename click/{display.scm => help.scm} (89%) create mode 100755 examples/nested.scm diff --git a/Makefile.am b/Makefile.am index 0e24758..8a78d8d 100644 --- a/Makefile.am +++ b/Makefile.am @@ -41,7 +41,7 @@ godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache SOURCES = \ click.scm \ click/constant.scm \ - click/display.scm \ + click/help.scm \ click/util.scm \ click/value.scm diff --git a/click.scm b/click.scm index 6a2d253..d2da6ac 100644 --- a/click.scm +++ b/click.scm @@ -20,18 +20,33 @@ (define-module (click) #:use-module (ice-9 getopt-long) #:use-module (click constant) - #:use-module (click display) + #:use-module (click help) #:use-module (click util) #:use-module (click value) - #:export (command)) + #:export (command + group)) (define (command option-spec procedure) + "Define a new command for the procedure" (lambda (args) - (with-fluids ((%program-name (car args))) - (let* ((click-option-spec (append option-spec (list HELP_OPTION))) - (values (getopt-long args - (getopt-long-option-spec click-option-spec)))) - (if (option-ref values 'help #f) - (display-help procedure click-option-spec) - (apply procedure (map cdr (get-values option-spec values)))))))) + (let* ((click-option-spec (append option-spec (list HELP_OPTION))) + (values (getopt-long args + (getopt-long-option-spec click-option-spec)))) + (if (option-ref values 'help #f) + (let ((program-name (car args))) + (display-help program-name procedure click-option-spec)) + (apply procedure (map cdr (get-values option-spec values))))))) + + +(define (group option-spec target . commands) + "Define a new group with a list of commands associated" + (lambda (args) + (let* ((click-option-spec (append option-spec (list HELP_OPTION))) + (values (getopt-long args + (getopt-long-option-spec click-option-spec)))) + (if (or (null? (cdr args)) + (option-ref values 'help #f)) + (let ((program-name (car args))) + (display-help program-name target click-option-spec commands)) + (apply target (map cdr (get-values option-spec values))))))) diff --git a/click/display.scm b/click/help.scm similarity index 89% rename from click/display.scm rename to click/help.scm index 968a063..f397031 100644 --- a/click/display.scm +++ b/click/help.scm @@ -17,7 +17,7 @@ ;;; along with Click. If not, see . -(define-module (click display) +(define-module (click help) #:use-module (ice-9 format) #:use-module (click util) #:export (display-error @@ -27,14 +27,23 @@ (define (get-type-description option) "Return allowed type for the value in the option" (assoc-ref (option-type option) 'description)) - -(define (display-help procedure option-spec) + + +(define (get-title target) + "Return the title for the help message" + (cond ((procedure? target) + (procedure-documentation target)) + (else + target))) + + +(define* (display-help program-name target option-spec #:optional (commands '())) (format #t "Usage: ~a [OPTIONS] ~a Options: -" (program-name) (procedure-documentation procedure)) +" program-name (get-title target)) (let* ((options (map (lambda (option) (cons (format #f @@ -63,6 +72,7 @@ Options: (cdr option))) options))) + (define (display-error wrong-option) (format #t "Usage: ~a [OPTIONS] Try '~a --help' for help. diff --git a/click/util.scm b/click/util.scm index c3ac062..1699014 100644 --- a/click/util.scm +++ b/click/util.scm @@ -21,14 +21,7 @@ #:use-module (click constant) #:export (getopt-long-option-spec option-property - option-type - program-name - %program-name)) - - -(define %program-name (make-fluid "guile")) -(define (program-name) - (fluid-ref %program-name)) + option-type)) (define (getopt-long-option-spec option-spec) diff --git a/examples/nested.scm b/examples/nested.scm new file mode 100755 index 0000000..023e1ef --- /dev/null +++ b/examples/nested.scm @@ -0,0 +1,45 @@ +#!/usr/bin/guile-3.0 --no-auto-compile +-*- scheme -*- +!# +;;; Click --- Command Line Interface Creation Kit for GNU Guile +;;; Copyright © 2021 Javier Sancho +;;; +;;; This file is part of Click. +;;; +;;; Click is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; Click 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 +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Click. If not, see . + + +(use-modules (click)) + + +(define initdb + (command + '() + (lambda () + (format #t "Initialized the database")))) + +(define dropdb + (command + '() + (lambda () + (format #t "Dropped the database")))) + +(define cli + (group + '() + "Database Tools" + initdb + dropdb)) + +(cli (command-line)) -- 2.39.2