From: Javier Sancho <jsancho@apsl.net>
Date: Mon, 18 Oct 2021 22:18:35 +0000 (+0200)
Subject: Nested commands
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;p=guile-click.git

Nested commands
---

diff --git a/click.scm b/click.scm
index 1f6c69a..c4f16b0 100644
--- a/click.scm
+++ b/click.scm
@@ -18,6 +18,7 @@
 
 
 (define-module (click)
+  #:use-module (ice-9 getopt-long)
   #: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)
+	     (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 ((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))))
@@ -61,6 +63,7 @@
   (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 9d0c5cc..786c933 100644
--- a/click/help.scm
+++ b/click/help.scm
@@ -72,11 +72,11 @@
               options)))
 
 
-(define* (display-help program-name command)
+(define* (display-help command)
   "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 "~%~%")
diff --git a/click/util.scm b/click/util.scm
index 1699014..827a4a9 100644
--- a/click/util.scm
+++ b/click/util.scm
@@ -21,7 +21,8 @@
   #:use-module (click constant)
   #:export (getopt-long-option-spec
             option-property
-            option-type))
+            option-type
+	    program-name))
 
 
 (define (getopt-long-option-spec option-spec)
@@ -43,6 +44,9 @@
         default)))
 
 
+(define program-name (make-parameter #f))
+
+
 ;; Types
 (define TYPE-TEXT
   `((description . "TEXT")
diff --git a/examples/nested.scm b/examples/nested.scm
index 414e589..3b07ae6 100755
--- a/examples/nested.scm
+++ b/examples/nested.scm
@@ -28,14 +28,14 @@
    #: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 ()
-                 (format #t "Dropped the database"))))
+                 (format #t "Drop the database.~%"))))
 
 (define cli
   (group