mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

getopt-long cleanups

Browse source 
* module/ice-9/getopt-long.scm (process-options): Use `match' in the
  loop.  Clean up `eat' to not take the option being processed.
This commit is contained in:
Andy Wingo 2011-02-10 11:40:24 +01:00
parent cafb15e96e
commit 13f607c175
1 changed files with 36 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

74
module/ice-9/getopt-long.scm
View file

@ -272,48 +272,46 @@
(option-spec->name spec)))
(cond
((eq? 'optional (option-spec->value-policy spec))
(if (or (null? (cdr ls))
(looks-like-an-option (cadr ls)))
(val!loop #t (cdr ls) (cons spec found) etc)
(val!loop (cadr ls) (cddr ls) (cons spec found) etc)))
(if (or (null? ls)
(looks-like-an-option (car ls)))
(val!loop #t ls (cons spec found) etc)
(val!loop (car ls) (cdr ls) (cons spec found) etc)))
((eq? #t (option-spec->value-policy spec))
(if (or (null? (cdr ls))
(looks-like-an-option (cadr ls)))
(if (or (null? ls)
(looks-like-an-option (car ls)))
(ERR:no-arg)
(val!loop (cadr ls) (cddr ls) (cons spec found) etc)))
(val!loop (car ls) (cdr ls) (cons spec found) etc)))
(else
(val!loop #t (cdr ls) (cons spec found) etc))))
(val!loop #t ls (cons spec found) etc))))
(if (null? argument-ls)
(cons found (reverse etc)) ;;; retval
(cond ((regexp-exec short-opt-rx (car argument-ls))
=> (lambda (match)
(let* ((c (match:substring match 1))
(spec (or (assoc-ref sc-idx c)
(error "no such option:" c))))
(eat! spec argument-ls))))
((regexp-exec long-opt-no-value-rx (car argument-ls))
=> (lambda (match)
(let* ((opt (match:substring match 1))
(spec (or (assoc-ref idx opt)
(error "no such option:" opt))))
(eat! spec argument-ls))))
((regexp-exec long-opt-with-value-rx (car argument-ls))
=> (lambda (match)
(let* ((opt (match:substring match 1))
(spec (or (assoc-ref idx opt)
(error "no such option:" opt))))
(if (option-spec->value-policy spec)
(eat! spec (append
(list 'ignored
(match:substring match 2))
(cdr argument-ls)))
(error "option does not support argument:"
opt)))))
(else
(loop (cdr argument-ls)
found
(cons (car argument-ls) etc))))))))
(match argument-ls
(()
(cons found (reverse etc)))
((opt . rest)
(cond
((regexp-exec short-opt-rx opt)
=> (lambda (match)
(let* ((c (match:substring match 1))
(spec (or (assoc-ref sc-idx c)
(error "no such option:" c))))
(eat! spec rest))))
((regexp-exec long-opt-no-value-rx opt)
=> (lambda (match)
(let* ((opt (match:substring match 1))
(spec (or (assoc-ref idx opt)
(error "no such option:" opt))))
(eat! spec rest))))
((regexp-exec long-opt-with-value-rx opt)
=> (lambda (match)
(let* ((opt (match:substring match 1))
(spec (or (assoc-ref idx opt)
(error "no such option:" opt))))
(if (option-spec->value-policy spec)
(eat! spec (cons (match:substring match 2) rest))
(error "option does not support argument:"
opt)))))
(else
(loop rest found (cons opt etc)))))))))
(define (getopt-long program-arguments option-desc-list)
"Process options, handling both long and short options, similar to