From 487cd0d4c6c0ee9681cc132e5316ded7fc5dd0f7 Mon Sep 17 00:00:00 2001
From: Javier Sancho <jsancho@apsl.net>
Date: Tue, 19 Oct 2021 00:18:35 +0200
Subject: [PATCH] Nested commands
---
click.scm | 13 ++++++++-----
click/help.scm | 4 ++--
click/util.scm | 6 +++++-
examples/nested.scm | 4 ++--
4 files changed, 17 insertions(+), 10 deletions(-)
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
--
2.39.5