From: Neil Jerram <neil@ossau.uklinux.net>
To: guile-devel@gnu.org
Cc: Neil Jerram <neil@ossau.uklinux.net>
Subject: [PATCH 3/5] Handle short option unclumping progressively, instead of all upfront
Date: Sun, 8 May 2011 23:18:15 +0100 [thread overview]
Message-ID: <1304893097-10889-4-git-send-email-neil@ossau.uklinux.net> (raw)
In-Reply-To: <1304893097-10889-1-git-send-email-neil@ossau.uklinux.net>
This is needed as a prerequisite for the following
don't know how far through the command line we should go with unclumping.
* module/ice-9/getopt-long.scm (expand-clumped-singles): Delete.
(process-options): Add a loop variable to indicate how many elements
at the start of `argument-ls' are known not to be clumped. When we
see a short option and this variable is <= 0, perform unclumping
(using code that used to be in expand-clumped-singles) and loop with
the variable > 0.
(getopt-long): Don't call expand-clumped-singles upfront here.
---
module/ice-9/getopt-long.scm | 57 ++++++++++++++++++-----------------------
1 files changed, 25 insertions(+), 32 deletions(-)
diff --git a/module/ice-9/getopt-long.scm b/module/ice-9/getopt-long.scm
index 5c73f9a..0c2d835 100644
--- a/module/ice-9/getopt-long.scm
+++ b/module/ice-9/getopt-long.scm
@@ -226,27 +226,6 @@
(define long-opt-no-value-rx (make-regexp "^--([^=]+)$"))
(define long-opt-with-value-rx (make-regexp "^--([^=]+)=(.*)"))
-(define (expand-clumped-singles opt-ls)
- ;; example: ("--xyz" "-abc5d") => ("--xyz" "-a" "-b" "-c" "5d")
- (let loop ((opt-ls opt-ls) (ret-ls '()))
- (cond ((null? opt-ls)
- (reverse ret-ls)) ;;; retval
- ((regexp-exec short-opt-rx (car opt-ls))
- => (lambda (match)
- (let ((singles (reverse
- (map (lambda (c)
- (string-append "-" (make-string 1 c)))
- (string->list
- (match:substring match 1)))))
- (extra (match:substring match 2)))
- (loop (cdr opt-ls)
- (append (if (string=? "" extra)
- singles
- (cons extra singles))
- ret-ls)))))
- (else (loop (cdr opt-ls)
- (cons (car opt-ls) ret-ls))))))
-
(define (looks-like-an-option string)
(or (regexp-exec short-opt-rx string)
(regexp-exec long-opt-with-value-rx string)
@@ -264,22 +243,22 @@
(cons (make-string 1 (option-spec->single-char spec))
spec))
(remove-if-not option-spec->single-char specs))))
- (let loop ((argument-ls argument-ls) (found '()) (etc '()))
+ (let loop ((unclumped 0) (argument-ls argument-ls) (found '()) (etc '()))
(define (eat! spec ls)
(cond
((eq? 'optional (option-spec->value-policy spec))
(if (or (null? ls)
(looks-like-an-option (car ls)))
- (loop ls (acons spec #t found) etc)
- (loop (cdr ls) (acons spec (car ls) found) etc)))
+ (loop (- unclumped 1) ls (acons spec #t found) etc)
+ (loop (- unclumped 2) (cdr ls) (acons spec (car ls) found) etc)))
((eq? #t (option-spec->value-policy spec))
(if (or (null? ls)
(looks-like-an-option (car ls)))
(fatal-error "option must be specified with argument: --~a"
(option-spec->name spec))
- (loop (cdr ls) (acons spec (car ls) found) etc)))
+ (loop (- unclumped 2) (cdr ls) (acons spec (car ls) found) etc)))
(else
- (loop ls (acons spec #t found) etc))))
+ (loop (- unclumped 1) ls (acons spec #t found) etc))))
(match argument-ls
(()
@@ -288,10 +267,24 @@
(cond
((regexp-exec short-opt-rx opt)
=> (lambda (match)
- (let* ((c (match:substring match 1))
- (spec (or (assoc-ref sc-idx c)
- (fatal-error "no such option: -~a" c))))
- (eat! spec rest))))
+ (if (> unclumped 0)
+ ;; Next option is known not to be clumped.
+ (let* ((c (match:substring match 1))
+ (spec (or (assoc-ref sc-idx c)
+ (fatal-error "no such option: -~a" c))))
+ (eat! spec rest))
+ ;; Expand a clumped group of short options.
+ (let* ((extra (match:substring match 2))
+ (unclumped-opts
+ (append (map (lambda (c)
+ (string-append "-" (make-string 1 c)))
+ (string->list
+ (match:substring match 1)))
+ (if (string=? "" extra) '() (list extra)))))
+ (loop (length unclumped-opts)
+ (append unclumped-opts rest)
+ found
+ etc)))))
((regexp-exec long-opt-no-value-rx opt)
=> (lambda (match)
(let* ((opt (match:substring match 1))
@@ -308,7 +301,7 @@
(fatal-error "option does not support argument: --~a"
opt)))))
(else
- (loop rest found (cons opt etc)))))))))
+ (loop (- unclumped 1) rest found (cons opt etc)))))))))
(define (getopt-long program-arguments option-desc-list)
"Process options, handling both long and short options, similar to
@@ -344,7 +337,7 @@ to add a `single-char' clause to the option description."
(with-fluids ((%program-name (car program-arguments)))
(let* ((specifications (map parse-option-spec option-desc-list))
(pair (split-arg-list (cdr program-arguments)))
- (split-ls (expand-clumped-singles (car pair)))
+ (split-ls (car pair))
(non-split-ls (cdr pair))
(found/etc (process-options specifications split-ls))
(found (car found/etc))
--
1.7.4.1
next prev parent reply other threads:[~2011-05-08 22:18 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-05-08 22:18 [PATCH] Simplifying guile-tools Neil Jerram
2011-05-08 22:18 ` [PATCH 1/5] Fix "occurrances" typos in getopt-long code and test Neil Jerram
2011-05-08 22:18 ` [PATCH 2/5] Simplify getopt-long handling of option values, esp with multiple occurrences Neil Jerram
2011-05-08 22:18 ` Neil Jerram [this message]
2011-05-08 22:18 ` [PATCH 4/5] Implement #:stop-at-first-non-option option for getopt-long Neil Jerram
2011-05-08 22:18 ` [PATCH 5/5] Reveal guile-tools's inner simplicity Neil Jerram
2011-05-09 21:43 ` Neil Jerram
2011-05-23 22:23 ` [PATCH] Simplifying guile-tools Neil Jerram
2011-05-24 7:54 ` Andy Wingo
2011-05-26 20:20 ` Neil Jerram
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1304893097-10889-4-git-send-email-neil@ossau.uklinux.net \
--to=neil@ossau.uklinux.net \
--cc=guile-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).