Bugs item #428069, was updated on 2001-05-28 14:10
You can respond by visiting:
http://sourceforge.net/tracker/?func=detail&atid=110493&aid=428069&group_id=10493
Category: run-time
Group: None
Status: Open
Resolution: None
Priority: 5
Submitted By: Brian D. Carlstrom (bdc)
Assigned to: Olin Shivers (olin-shivers)
Summary: getopts ?
Initial Comment:
From: David Rush <kumo@bellsouth.net>
To: scsh-news@zurich.ai.mit.edu
Subject: Re: getopts ?
Date: 18 May 2000 14:43:03 +0100
phm@a2e.de (PILCH Hartmut) writes:
> I miss a facility like getopts for commandline
option parsing.
> Is there any ready code somewhere?
Sorry for the delay in answering, but when you posted
your request I
was deep in the throes of developing an elaborate hack
to rationalize
my argument handling in an optional-argument heavy
program. You can
have what I've built, but the usual disclaimers apply.
I'd appreciate
any bugfixes/enhancements to be shipped back to me.
Caveat programmer:
There may still be bugs, but I doubt it. I've got it
working in my
code but I haven't tested all the boundary cases; in
particular, I've
not tested multi-argument options (e.g. "--foo blom
bang" where "blom"
and "bang" are values needed when option "--foo" is
specified). Also,
the package allows multiple (else ...) clauses, but it
will only use the
first one declared in the (option-table ...) form.
It also makes use of SRFI-1 procedures (fold & take I
think). IIRC,
Scsh has them in structure list-lib (? - help me out
Olin).
Example Usage:
(load "options.scm")
(define program-options
(option-table
(option "--foo" ((bar "whisky"))
(if (equal? bar "whiskey")
(display "wrong country!")
(order! bar)))
(option "--help" () (usage))
(else (junk "usefule info")
(display junk)
(newline))))
(define (main argv)
(option-grovel program-options (cdr argv))
; your-program-here
)
(define (usage)
(option-map (lambda (o) (display (option-usage o))
(newline))))
; options.scm -----------------------------------------
-----
; why is this not in R5RS?
(define (vector-map f v)
(let* ((len (vector-length v))
(nv (make-vector len)))
(let map ((i 0))
(if (< i len)
(begin
(vector-set! nv i (f (vector-ref v i)))
(map (+ i 1)))
nv))))
; an (sorta) ultimately unique value
(define (unit) unit)
(define (unit? x) (eq? unit x))
(define-syntax expand-option
(syntax-rules (option else)
; (else (option-var description) code...)
; Used when nothing else consumes the
corresponding command-line
; arg. 'description' should be a (very) brief
description of
; what unflagged arguments mean
((expand-option (else (name desc) e0 e+ ...))
(vector unit desc 1 (lambda (name) e0 e+ ...)))
; (option flag-text (arg-specs...) code ...)
; The next two cases build the option-table
entries for
; space-separated, flagged command-line
arguments. 'flag' is the
; string which will be matched (using EQUAL?)
against the
; command-line text. Each flag has a list of
arguments
; associated with it and each argument has a
(very) brief
; descriptive text associated with it. The
descriptive text may
; be explicitly specified or generated by a
thunk invocation
; (useful for introspective programs).
; the order of these clauses is important!
((expand-option (option flag ((arg (usage-
thunk)) ...) e0 e+ ...))
(vector flag
(option-args (list (usage-thunk) ...))
(length '(arg ...))
(lambda (arg ...) e0 e+ ...)))
((expand-option (option flag ((arg usage) ...)
e0 e+ ...))
(vector flag
(option-args (list usage ...))
(length '(arg ...))
(lambda (arg ...) e0 e+ ...)))
))
(define-syntax option-table
(syntax-rules ()
((option-table options ...)
(vector (expand-option options) ...))
))
(define (option-flag o) (vector-ref o 0))
(define (option-values o) (vector-ref o 1))
(define (option-n-args o) (vector-ref o 2))
(define (option-action o) (vector-ref o 3))
(define (option-args arg-desc-list)
(if (null? arg-desc-list) ""
(apply string-append
(cdr
(fold (lambda (desc l) (append
(list " " desc) l))
'()
arg-desc-list)))))
(define (option-usage o)
(let ((flag (option-flag o)))
(if (unit? flag) ""
(string-append flag " " (option-values o)))
))
(define (option-map f v) (vector-map f v))
(define (option-grovel option-table argv-list)
(let* ((n-options (vector-length option-table))
(else-option
(let find-else ((index 1))
(if (>= index n-options)
unit
(let ((check (vector-ref option-
table index)))
(if (unit? (option-flag check))
check
(find-else (+ 1 index))))
))))
(let grovel ((option-list argv-list)
(unused '()))
(if (null? option-list)
(reverse unused)
(let ((maybe-flag (car option-list))
(maybe-values (cdr option-list)))
(let search ((index 1))
(if (< index n-options)
(let ((option (vector-ref
option-table index)))
(if (equal? maybe-flag
(option-flag option))
(let* ((n-args (option-n-
args option))
(option-values
(take maybe-
values n-args))
(unused-options
(list-tail maybe-
values n-args)))
(apply (option-action
option)
option-values)
(grovel unused-
options))
(search (+ index 1))))
(if (unit? else-option)
(grovel maybe-values (cons
maybe-flag unused))
((option-action else-option)
maybe-flag)))))
))
))
----------------------------------------------------------------------
You can respond by visiting:
http://sourceforge.net/tracker/?func=detail&atid=110493&aid=428069&group_id=10493
|