getopt-gnu-style contributed code.

From: Russell McManus <>
Date: Fri, 27 Sep 1996 11:29:56 -0400

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?


--- 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)))
             (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)
                (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)))
           (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

(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

This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST