From 986fe49efb25343011f28262cd2b7afbf81dd78e Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Sun, 17 Oct 2021 20:29:40 +0200 Subject: [PATCH] WIP: Nested commands --- .gitignore | 1 + Makefile.am | 6 +++--- click.scm | 32 +++++++++++++++++++++---------- click/{value.scm => args.scm} | 13 +++++++++++-- tests/{util.scm => test-args.scm} | 28 +++++++++++++++++++++++++++ 5 files changed, 65 insertions(+), 15 deletions(-) rename click/{value.scm => args.scm} (86%) rename tests/{util.scm => test-args.scm} (50%) diff --git a/.gitignore b/.gitignore index ac5a5d7..d44304a 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ *.go +*.log aclocal.m4 autom4te.cache/ build-aux/ diff --git a/Makefile.am b/Makefile.am index 976d004..837f1d3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -40,14 +40,14 @@ godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache SOURCES = \ click.scm \ + click/args.scm \ click/command.scm \ click/constant.scm \ click/help.scm \ - click/util.scm \ - click/value.scm + click/util.scm TESTS = \ - tests/util.scm + tests/test-args.scm TEST_EXTENSIONS = .scm SCM_LOG_COMPILER = $(top_builddir)/test-env $(GUILE) diff --git a/click.scm b/click.scm index e8f8c09..1f6c69a 100644 --- a/click.scm +++ b/click.scm @@ -18,14 +18,12 @@ (define-module (click) - #:use-module (ice-9 getopt-long) - #:use-module (srfi srfi-9) - #:use-module (srfi srfi-9 gnu) + #: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)) @@ -44,11 +42,25 @@ (new-command (make-command name click-option-spec help procedure commands))) (let ((click-manager (lambda (args) - (let ((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 new-command)) - (apply procedure (map cdr (get-values option-spec values)))))))) + (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))) + (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) ( + (display next-command-args)(newline) + (display next-command-name) (newline))))) diff --git a/click/value.scm b/click/args.scm similarity index 86% rename from click/value.scm rename to click/args.scm index f42eb2f..b59914d 100644 --- a/click/value.scm +++ b/click/args.scm @@ -17,12 +17,21 @@ ;;; along with Click. If not, see . -(define-module (click value) +(define-module (click args) #:use-module (ice-9 getopt-long) #:use-module (ice-9 readline) #:use-module (click util) #:export (get-option-default-value - get-values)) + get-values + parse-args)) + + +(define (parse-args args click-option-spec) + "Parse args using an option-spec click formatted" + (let ((values (getopt-long args + (getopt-long-option-spec click-option-spec) + #:stop-at-first-non-option #t))) + values)) (define (get-values option-spec values) diff --git a/tests/util.scm b/tests/test-args.scm similarity index 50% rename from tests/util.scm rename to tests/test-args.scm index 9a7574d..d41abe2 100644 --- a/tests/util.scm +++ b/tests/test-args.scm @@ -15,3 +15,31 @@ ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with Click. If not, see . + + +(define-module (tests test-args) + #:use-module (srfi srfi-64) + #:use-module (click args)) + + +(test-begin "test-args") + +(define option-spec + '((count (single-char #\c) (default 1)) + (name (prompt "Your name")) + (help (flag #t)))) + +(test-error #t (parse-args '("program" "--count") option-spec)) + +(test-error #t (parse-args '("program" "-x") option-spec)) + +(test-equal (parse-args '("program" "-c" "2" "--name" "joe") option-spec) + '((()) (name . "joe") (count . "2"))) + +(test-equal (parse-args '("program" "-c" "2" "command" "-x") option-spec) + '((() "command" "-x") (count . "2"))) + +(test-equal (get-values option-spec '((()) (name . "joe") (count . "2"))) + '((count . 2) (name . "joe") (help . #f))) + +(test-end "test-args") -- 2.39.2