Programming Praxis

Internal function parse-options parses the option string, returning two lists of characters, one for the options that don’t require an argument and one for the options that do. Then getopt loops through the command-line arguments. The cond expressions has five clauses. The first recognizes the end of the options when it reaches the end of the command line or a non-option argument that doesn’t start with a dash. The second recognizes the explicit double-dash end of options. The third handles options without arguments, and the fourth handles options with arguments. The final clause reports an error for unrecognized options:

(define (getopt defn msg args) ; => (values (list opt/arg ...) (list file ...))
  (define (parse-options defn)
    (let loop ((options (string->list defn)) (lones '()) (args '()))
      (cond ((null? options) (values lones args))
            ((null? (cdr options)) (values (cons (car options) lones) args))
            ((char=? (cadr options) #\:)
              (loop (cddr options) lones (cons (car options) args)))
            (else (loop (cdr options) (cons (car options) lones) args)))))
  (let-values (((lone-options arg-options) (parse-options defn)))
    (let loop ((args args) (xs '()))
      (cond ((or (null? args) (not (char=? (string-ref (car args) 0) #\-)))
              (values (reverse xs) args))
            ((string=? (car args) "--") (values (reverse xs) (cdr args)))
            ((member (string-ref (car args) 1) lone-options)
              (let* ((len (string-length (car args)))
                     (arg (string-ref (car args) 1))
                     (rest (substring (car args) 2 len)))
                (if (= len 2)
                    (loop (cdr args) (cons (list arg) xs))
                    (loop (cons (string-append "-" rest) (cdr args)) (cons (list arg) xs)))))
            ((member (string-ref (car args) 1) arg-options)
              (let* ((len (string-length (car args)))
                     (arg (string-ref (car args) 1))
                     (rest (substring (car args) 2 len)))
                (cond ((and (= len 2) (null? (cdr args))) (error 'getopt msg))
                      ((= len 2) (loop (cddr args) (cons (cons arg (cadr args)) xs)))
                      (else (loop (cdr args) (cons (cons arg rest) xs))))))
            (else ((error 'getopt msg)))))))

How you call getopt depends on how your Scheme implementation handles command-line arguments. Chez Scheme, which is normally used by Programming Praxis, makes the command-line arguments available by calling (command-line). Thus, a program that implements the diff command might look something like this:

#! /usr/bin/scheme --script

(let-values (((opts files) (getopt "befhmnD:"
                                   "usage: [-befhmn] [-D string] file1 file2"
                                   (cdr (command-line)))))
  ... body of program ...
  (exit status))

You can see getopt at http://programmingpraxis.codepad.org/5Pt0x3q4.

Pages: 1 2