[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/ice-9 getopt-long.scm
From: |
Thien-Thi Nguyen |
Subject: |
guile/guile-core/ice-9 getopt-long.scm |
Date: |
Fri, 07 Sep 2001 19:35:53 -0700 |
CVSROOT: /cvs
Module name: guile
Branch: branch_release-1-6
Changes by: Thien-Thi Nguyen <address@hidden> 01/09/07 19:35:53
Modified files:
guile-core/ice-9: getopt-long.scm
Log message:
(process-options, getopt-long): Fix omission
bug: Handle multiple occurrances of an option.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/getopt-long.scm.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.4.2.2&tr2=1.4.2.3&r1=text&r2=text
Patches:
Index: guile/guile-core/ice-9/getopt-long.scm
diff -u guile/guile-core/ice-9/getopt-long.scm:1.6
guile/guile-core/ice-9/getopt-long.scm:1.7
--- guile/guile-core/ice-9/getopt-long.scm:1.6 Sun Aug 12 11:56:39 2001
+++ guile/guile-core/ice-9/getopt-long.scm Fri Sep 7 19:30:20 2001
@@ -301,7 +301,14 @@
(let loop ((argument-ls argument-ls) (found '()) (etc '()))
(let ((eat! (lambda (spec ls)
(let ((val!loop (lambda (val n-ls n-found n-etc)
- (set-option-spec-value! spec val)
+ (set-option-spec-value!
+ spec
+ ;; handle multiple occurrances
+ (cond ((option-spec->value spec)
+ => (lambda (cur)
+ ((if (list? cur) cons list)
+ val cur)))
+ (else val)))
(loop n-ls n-found n-etc)))
(ERR:no-arg (lambda ()
(error (string-append
@@ -417,10 +424,22 @@
(and pred (pred name val)))))
specifications)
(cons (cons '() rest-ls)
- (map (lambda (spec)
- (cons (string->symbol (option-spec->name spec))
- (option-spec->value spec)))
- found))))
+ (let ((multi-count (map (lambda (desc)
+ (cons (car desc) 0))
+ option-desc-list)))
+ (map (lambda (spec)
+ (let ((name (string->symbol (option-spec->name spec))))
+ (cons name
+ ;; handle multiple occurrances
+ (let ((maybe-ls (option-spec->value spec)))
+ (if (list? maybe-ls)
+ (let* ((look (assq name multi-count))
+ (idx (cdr look))
+ (val (list-ref maybe-ls idx)))
+ (set-cdr! look (1+ idx)) ; ugh!
+ val)
+ maybe-ls)))))
+ found)))))
(define (option-ref options key default)
"Return value in alist OPTIONS using KEY, a symbol; or DEFAULT if not found.