Nested commands

[guile-click.git] / click.scm

diff --git a/click.scm b/click.scm
index d2da6ac577e9154be5ad7a278f704ae4258030d7..c4f16b01884687a0ac26f097530937a6caadcc06 100644 (file)
--- a/click.scm
+++ b/click.scm
@@ -19,34 +19,51 @@
 
 (define-module (click)
   #:use-module (ice-9 getopt-long)
+  #:use-module (srfi srfi-1)
+  #:use-module (click args)
+  #:use-module (click command)
   #:use-module (click constant)
   #:use-module (click help)
   #:use-module (click util)
-  #:use-module (click value)
   #:export (command
             group))
 
 
-(define (command option-spec procedure)
+(define* (command #:key (name #f) (option-spec '()) (help "") (procedure #f))
   "Define a new command for the procedure"
-  (lambda (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)
-          (let ((program-name (car args)))
-            (display-help program-name procedure click-option-spec))
-          (apply procedure (map cdr (get-values option-spec values)))))))
+  (group #:name name
+         #:option-spec option-spec
+         #:help help
+         #:procedure procedure))
 
 
-(define (group option-spec target . commands)
+(define* (group #:key (name #f) (option-spec '()) (help "") (procedure #f) (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)))))))
+  (let* ((click-option-spec (append option-spec (list HELP_OPTION)))
+         (new-command (make-command name click-option-spec help procedure commands)))
+    (let ((click-manager
+           (lambda (args)
+            (when (not (program-name))
+              (program-name (car args)))
+             (let ((values (parse-args args click-option-spec)))
+               ;; Call current command
+               (cond ((option-ref values 'help #f)
+                     (display-help new-command))
+                     (else
+                      (when procedure
+                        (apply procedure (map cdr (get-values option-spec values))))
+                      ;; Call nested command (if exists)
+                      (call-nested-command commands values)))))))
+               
+      (set-command-click-manager! new-command click-manager)
+      new-command)))
+
+
+(define (call-nested-command commands values)
+  (let ((next-command-args (cdar values)))
+    (when (not (null? next-command-args))
+      (let* ((next-command-name (car next-command-args))
+             (next-command (find (lambda (command)
+                                  (equal? (command-name command) next-command-name))
+                                commands)))
+       (next-command next-command-args)))))