Groups support

diff --git a/Makefile.am b/Makefile.am
index 0e24758815c53311e989d45eaf57deebeb8fd293..8a78d8dd33915900bb07fcd593d8287565440764 100644 (file)
--- a/Makefile.am
+++ b/Makefile.am
@@ -41,7 +41,7 @@ godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
 SOURCES =                                      \
   click.scm                                     \
   click/constant.scm                            \
 SOURCES =                                      \
   click.scm                                     \
   click/constant.scm                            \

-  click/display.scm                             \
+  click/help.scm                                \

   click/util.scm                                \
   click/value.scm
 
   click/util.scm                                \
   click/value.scm
 

diff --git a/click.scm b/click.scm
index 6a2d25323113da8c030307ab52452aff4d6e0ef0..d2da6ac577e9154be5ad7a278f704ae4258030d7 100644 (file)
--- a/click.scm
+++ b/click.scm
@@ -20,18 +20,33 @@
 (define-module (click)
   #:use-module (ice-9 getopt-long)
   #:use-module (click constant)
 (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)
   #:use-module (click util)
   #:use-module (click value)

-  #:export (command))
+  #:export (command
+            group))

 
 
 (define (command option-spec procedure)
 
 
 (define (command option-spec procedure)

+  "Define a new command for the procedure"

   (lambda (args)
   (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/display.scm
deleted file mode 100644 (file)
index 968a063..0000000
--- a/click/display.scm
+++ /dev/null
@@ -1,71 +0,0 @@
-;;; Click --- Command Line Interface Creation Kit for GNU Guile
-;;; Copyright © 2021 Javier Sancho <jsf@jsancho.org>
-;;;
-;;; 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 <http://www.gnu.org/licenses/>.
-
-
-(define-module (click display)
-  #:use-module (ice-9 format)
-  #:use-module (click util)
-  #:export (display-error
-            display-help))
-
-
-(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)
-  (format #t "Usage: ~a [OPTIONS]
-
-  ~a
-
-Options:
-" (program-name) (procedure-documentation procedure))
-
-  (let* ((options (map (lambda (option)
-                         (cons (format #f
-                                       "--~a~a~a"
-                                       (car option)
-                                       (let ((single-char
-                                              (option-property option 'single-char)))
-                                         (if single-char
-                                             (format #f ", -~a" single-char)
-                                             ""))
-                                       (let ((value
-                                              (not (option-property option 'flag))))
-                                         (if value
-                                             (format #f " ~a" (get-type-description option))
-                                             "")))
-                               (option-property option 'help "")))
-                       option-spec))
-         (sep (+ 2 (apply max (map (lambda (option)
-                                     (string-length (car option)))
-                                   options)))))
-    (for-each (lambda (option)
-                (format #t
-                        "  ~a~v_~a~%"
-                        (car option)
-                        (- sep (string-length (car option)))
-                        (cdr option)))
-              options)))
-
-(define (display-error wrong-option)
-  (format #t "Usage: ~a [OPTIONS]
-Try '~a --help' for help.
-
-Error: No such option: ~a
-" (program-name) (program-name) wrong-option))

diff --git a/click/help.scm b/click/help.scm
new file mode 100644 (file)
index 0000000..f397031
--- /dev/null
+++ b/click/help.scm
@@ -0,0 +1,81 @@
+;;; Click --- Command Line Interface Creation Kit for GNU Guile
+;;; Copyright © 2021 Javier Sancho <jsf@jsancho.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+
+(define-module (click help)
+  #:use-module (ice-9 format)
+  #:use-module (click util)
+  #:export (display-error
+            display-help))
+
+
+(define (get-type-description option)
+  "Return allowed type for the value in the option"
+  (assoc-ref (option-type option) 'description))
+
+
+(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 (get-title target))
+
+  (let* ((options (map (lambda (option)
+                         (cons (format #f
+                                       "--~a~a~a"
+                                       (car option)
+                                       (let ((single-char
+                                              (option-property option 'single-char)))
+                                         (if single-char
+                                             (format #f ", -~a" single-char)
+                                             ""))
+                                       (let ((value
+                                              (not (option-property option 'flag))))
+                                         (if value
+                                             (format #f " ~a" (get-type-description option))
+                                             "")))
+                               (option-property option 'help "")))
+                       option-spec))
+         (sep (+ 2 (apply max (map (lambda (option)
+                                     (string-length (car option)))
+                                   options)))))
+    (for-each (lambda (option)
+                (format #t
+                        "  ~a~v_~a~%"
+                        (car option)
+                        (- sep (string-length (car option)))
+                        (cdr option)))
+              options)))
+
+
+(define (display-error wrong-option)
+  (format #t "Usage: ~a [OPTIONS]
+Try '~a --help' for help.
+
+Error: No such option: ~a
+" (program-name) (program-name) wrong-option))

diff --git a/click/util.scm b/click/util.scm
index c3ac062cd606aeff46bf46a1bfc03cc58d35055a..1699014e23a0791df373afd576691c6a05c758fe 100644 (file)
--- a/click/util.scm
+++ b/click/util.scm
@@ -21,14 +21,7 @@
   #:use-module (click constant)
   #:export (getopt-long-option-spec
             option-property
   #: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)
 
 
 (define (getopt-long-option-spec option-spec)

diff --git a/examples/nested.scm b/examples/nested.scm
new file mode 100755 (executable)
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 <jsf@jsancho.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+
+(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))