keyword.ss
;;;
;;; Time-stamp: <2004-11-17 21:23:19 noel>
;;;
;;; Copyright (C) 2004 by Noel Welsh.
;;;

;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.

;;; Web testingis distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;; License for more details.

;;; You should have received a copy of the GNU Lesser
;;; General Public License along with Web testing; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA

;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:

;; A dead simple keyword argument system

(module keyword mzscheme

  (require (lib "plt-match.ss")
           (lib "etc.ss"))

  (provide get-keyword-arg
           get-positional-args)

  ;; get-keyword-arg : symbol (list-of any) [missing]
  ;;                    -> (U any #f)
  ;;
  ;; Given a keyword and a list of arguments returns the
  ;; argument that follows that keyword, or missing
  ;; (defaults to #f) is no argument is found.
  (define get-keyword-arg
    (opt-lambda (keyword args (missing #f))
      (match (member keyword args)
             (#f missing) ;; not found
             ((list-rest key val rest) val) ;; found
             ((list key) missing)))) ;; found but with no value

  ;; get-positional-args : (list-of symbol) (list-of any) [missing
  ;;                         -> (list-of any)
  ;;
  ;; Get all the positional (non-keyword) arguments, returng
  ;; missing (defaults to '()) if none found.
  (define get-positional-args
    (opt-lambda (keywords args (missing '()))
      (let ((result
             (let loop ((args args))
               (if (null? args)
                   '()
                   (let ((head (car args)))
                     (if (member head keywords)
                         (loop (cddr args))
                         (cons head (loop (cdr args)))))))))
        (if (null? result)
            missing
            result))))
  )