Nested commands

diff --git a/click.scm b/click.scm
index 1f6c69a7c4f50ec63eedff6f3e074c68580b3954..c4f16b01884687a0ac26f097530937a6caadcc06 100644 (file)
--- a/click.scm
+++ b/click.scm
@@ -18,6 +18,7 @@
 
 
 (define-module (click)
 
 
 (define-module (click)

+  #:use-module (ice-9 getopt-long)

   #:use-module (srfi srfi-1)
   #:use-module (click args)
   #:use-module (click command)
   #:use-module (srfi srfi-1)
   #:use-module (click args)
   #:use-module (click command)


@@ -42,11 +43,12 @@
          (new-command (make-command name click-option-spec help procedure commands)))
     (let ((click-manager
            (lambda (args)
          (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)
              (let ((values (parse-args args click-option-spec)))
                ;; Call current command
                (cond ((option-ref values 'help #f)

-                      (let ((program-name (car args)))
-                        (display-help program-name new-command)))
+                     (display-help new-command))

                      (else
                       (when procedure
                         (apply procedure (map cdr (get-values option-spec values))))
                      (else
                       (when procedure
                         (apply procedure (map cdr (get-values option-spec values))))


@@ -61,6 +63,7 @@
   (let ((next-command-args (cdar values)))
     (when (not (null? next-command-args))
       (let* ((next-command-name (car next-command-args))
   (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) (
-        (display next-command-args)(newline)
-        (display next-command-name) (newline)))))
+             (next-command (find (lambda (command)
+                                  (equal? (command-name command) next-command-name))
+                                commands)))
+       (next-command next-command-args)))))

diff --git a/click/help.scm b/click/help.scm
index 9d0c5cc05e9134d41cf7f0f0acb12fc138d35b09..786c933080e8e4de776e4149620f7a6729cf0c71 100644 (file)
--- a/click/help.scm
+++ b/click/help.scm
@@ -72,11 +72,11 @@
               options)))
 
 
               options)))
 
 

-(define* (display-help program-name command)
+(define* (display-help command)

   "Display help message"
 
   ;; Usage
   "Display help message"
 
   ;; Usage

-  (format #t "Usage: ~a [OPTIONS]" program-name)
+  (format #t "Usage: ~a [OPTIONS]" (program-name))

   (when (group? command)
     (format #t " COMMAND [ARGS]..."))
   (format #t "~%~%")
   (when (group? command)
     (format #t " COMMAND [ARGS]..."))
   (format #t "~%~%")

diff --git a/click/util.scm b/click/util.scm
index 1699014e23a0791df373afd576691c6a05c758fe..827a4a9b2e12885fa179317b56dbdfe5d2334638 100644 (file)
--- a/click/util.scm
+++ b/click/util.scm
@@ -21,7 +21,8 @@
   #:use-module (click constant)
   #:export (getopt-long-option-spec
             option-property
   #:use-module (click constant)
   #:export (getopt-long-option-spec
             option-property

-            option-type))
+            option-type
+           program-name))

 
 
 (define (getopt-long-option-spec option-spec)
 
 
 (define (getopt-long-option-spec option-spec)


@@ -43,6 +44,9 @@
         default)))
 
 
         default)))
 
 

+(define program-name (make-parameter #f))
+
+

 ;; Types
 (define TYPE-TEXT
   `((description . "TEXT")
 ;; Types
 (define TYPE-TEXT
   `((description . "TEXT")

diff --git a/examples/nested.scm b/examples/nested.scm
index 414e5896b931f0dd9db958f0c30e21b46b7263ca..3b07ae6497c19fcefd4a44ce09ef784d015d3fbc 100755 (executable)
--- a/examples/nested.scm
+++ b/examples/nested.scm
@@ -28,14 +28,14 @@
    #:name "initdb"
    #:help "Init database."
    #:procedure (lambda ()
    #:name "initdb"
    #:help "Init database."
    #:procedure (lambda ()

-                 (format #t "Initialized the database"))))
+                 (format #t "Initialize the database.~%"))))

 
 (define dropdb
   (command
    #:name "dropdb"
    #:help "Drop database."
    #:procedure (lambda ()
 
 (define dropdb
   (command
    #:name "dropdb"
    #:help "Drop database."
    #:procedure (lambda ()

-                 (format #t "Dropped the database"))))
+                 (format #t "Drop the database.~%"))))

 
 (define cli
   (group
 
 (define cli
   (group