X-Git-Url: https://git.jsancho.org/?p=guile-click.git;a=blobdiff_plain;f=click.scm;fp=click.scm;h=d2da6ac577e9154be5ad7a278f704ae4258030d7;hp=6a2d25323113da8c030307ab52452aff4d6e0ef0;hb=ebf74b7c3fda8ead57a398bb6a1555067150d06f;hpb=ee290f19711b9e4fb789a0b2a164635e7140a8e5

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