From: Javier Sancho Date: Mon, 18 Oct 2021 22:18:35 +0000 (+0200) Subject: Nested commands X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;ds=sidebyside;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