here is a little snippet that i find very useful;
maybe someone else can make use of it as well.
is there a better place to contribute code than
the mailing list?
-russ
--- cut here ---
;;;
;;; file: getopt-gnu-style.stk
;;; author: russ mcmanus
;;; copyright: GNU GPL
;;;
;;; getopt-gnu-style takes a list of option specifications
;;; and a list of command line arguments. option specifications
;;; are symbols.
;;;
;;; it returns a cons pair whose car is an alist of option/value
;;; pairs and whose cdr is the list of arguments that did not match
;;; any of the option specifications. argument specifications are
;;; gnu-style:
;;; e.g.
;;; (getopt-gnu-style '(arg1 arg2) '("--arg1=fast" "foo" "--arg2=reallyfast"))
;;; returns:
;;; (((arg1 . "fast") (arg2 . "reallyfast")) "foo")
;;;
;;; also, an argument of the form "--" is special. no option
;;; processing happens on any any arguments that appear in the
;;; argument list after the "--" argument.
;;; e.g.
;;; (getopt-gnu-style '(arg1 arg2) '("--arg1=fast" "foo" "--" "--arg2=reallyfast"))
;;; returns:
;;; (((arg2 . #f) (arg1 . "fast")) "foo" "--arg2=reallyfast")
;;;
(define (getopt-gnu-style spec-ls arg-ls)
;; given an arg-ls, decide which part to process
;; for options. everything before an arg of "--"
;; is fair game, everything after it should not be
;; processed. the "--" is discarded. a cons pair
;; is returned whose car is the list to process for
;; options, and whose cdr is the list to not process.
(define (split-arg-ls arg-ls)
(let loop ((process-ls '())
(not-process-ls arg-ls))
(cond ((null? not-process-ls)
(cons process-ls '()))
((equal? "--" (car not-process-ls))
(cons process-ls (cdr not-process-ls)))
(#t
(loop (cons (car not-process-ls) process-ls)
(cdr not-process-ls))))))
;; loop through the argument list looking for
;; arguments that match the given specification.
;; return a list whose car is the value of the
;; specified argument, and whose cdr is the
;; remaining argument list.
(define (process-arg-gnu-style spec arg-ls)
(let loop ((value #f)
(arg-ls arg-ls)
(ret-ls '()))
(if (null? arg-ls)
(cons value ret-ls)
(let* ((regexp (string->regexp (string-append "^--" spec "=(.*)")))
(arg (car arg-ls))
(match-result (regexp arg)))
(if match-result
(loop (apply substring (cons arg (cadr match-result)))
(cdr arg-ls)
ret-ls)
(loop value
(cdr arg-ls)
(cons arg ret-ls)))))))
;; given a list of options specifications, an alist of option
;; name/value pairs, and a list of arguments, returns a list
;; whose car is the option alist, and whose cdr is the list
;; of arguments that didn't match.
(define (process-args-gnu-style spec-ls opt-alist arg-ls)
(if (null? spec-ls)
(cons opt-alist arg-ls)
(let* ((spec (symbol->string (car spec-ls)))
(spec-result-ls (process-arg-gnu-style spec arg-ls))
(spec-value (car spec-result-ls)))
(process-args-gnu-style
(cdr spec-ls)
(cons (cons (string->symbol spec) spec-value) opt-alist)
(cdr spec-result-ls)))))
(let* ((split-ret-ls (split-arg-ls arg-ls))
(process-arg-ls (car split-ret-ls))
(not-process-arg-ls (cdr split-ret-ls)))
(append (process-args-gnu-style
spec-ls ;; the list of option specifications
'() ;; the option alist
process-arg-ls) ;; the argument list to chug through
not-process-arg-ls)))
(provide "getopt-gnu-style")
--- cut here ---
--
Russell D. McManus
Goldman, Sachs & Co.
Intl. Equities Technology
Received on Fri Sep 27 1996 - 17:32:20 CEST