diff options
Diffstat (limited to 'getopt.scm')
| -rw-r--r-- | getopt.scm | 34 |
1 files changed, 17 insertions, 17 deletions
@@ -1,5 +1,5 @@ ;;; "getopt.scm" POSIX command argument processing -;Copyright (C) 1993, 1994 Aubrey Jaffer +;Copyright (C) 1993, 1994, 2002 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -8,7 +8,7 @@ ;1. Any copy made of this software must include this copyright notice ;in full. ; -;2. I have made no warrantee or representation that the operation of +;2. I have made no warranty or representation that the operation of ;this software will be error-free, and I am under no obligation to ;provide any services, by way of maintenance, update, or otherwise. ; @@ -19,19 +19,21 @@ (define getopt:scan #f) (define getopt:char #\-) +;@ (define getopt:opt #f) +(define *argv* *argv*) (define *optind* 1) (define *optarg* 0) - -(define (getopt argc argv optstring) +;@ +(define (getopt optstring) (let ((opts (string->list optstring)) (place #f) (arg #f) - (argref (lambda () ((if (vector? argv) vector-ref list-ref) - argv *optind*)))) + (argref (lambda () ((if (vector? *argv*) vector-ref list-ref) + *argv* *optind*)))) (and (cond ((and getopt:scan (not (string=? "" getopt:scan))) #t) - ((>= *optind* argc) #f) + ((>= *optind* (length *argv*)) #f) (else (set! arg (argref)) (cond ((or (<= (string-length arg) 1) @@ -42,8 +44,7 @@ (set! *optind* (+ *optind* 1)) #f) (else - (set! getopt:scan - (substring arg 1 (string-length arg))) + (set! getopt:scan (substring arg 1 (string-length arg))) #t)))) (begin (set! getopt:opt (string-ref getopt:scan 0)) @@ -59,22 +60,21 @@ (set! *optind* (+ *optind* 1)) (set! getopt:scan #f) getopt:opt) - ((< *optind* argc) + ((< *optind* (length *argv*)) (set! *optarg* (argref)) (set! *optind* (+ *optind* 1)) getopt:opt) ((and (not (null? opts)) (char=? #\: (car opts))) #\:) (else #\?)))))) - -(define (getopt-- argc argv optstring) - (let* ((opt (getopt argc argv (string-append optstring "-:"))) +;@ +(define (getopt-- optstring) + (let* ((opt (getopt (string-append optstring "-:"))) (optarg *optarg*)) (cond ((eqv? #\- opt) ;long option (do ((l (string-length *optarg*)) (i 0 (+ 1 i))) ((or (>= i l) (char=? #\= (string-ref optarg i))) - (cond - ((>= i l) (set! *optarg* #f) optarg) - (else (set! *optarg* (substring optarg (+ 1 i) l)) - (substring optarg 0 i)))))) + (cond ((>= i l) (set! *optarg* #f) optarg) + (else (set! *optarg* (substring optarg (+ 1 i) l)) + (substring optarg 0 i)))))) (else opt)))) |