;;; let-args.scm --- let-args syntactic form for Guile
;;; written by Jorgen Schaefer <address@hidden>
;;;
;;;    Copyright (C) 2000 Jorgen Schaefer
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; This program is 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 General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this software; see the file COPYING.  If not, write to
;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;; Boston, MA 02111-1307 USA
;;;
;;; This file implements a very easy interface to (ice-9 getopt-long)
;;; similar to a simple let.
;;;
;;; (let-args ARGS GRAMMAR BODY ...)
;;; This is equivalent to the getopt-long form, except that the
;;; GRAMMAR shouldn't be quoted.  let-args will bind the values of the
;;; options (#t if the option doesn't have a value, #f if the option
;;; wasn't given) to the variables named like the long form of the
;;; options.  Additionally, you can specify an element of GRAMMAR as
;;; (rest-args #t), where rest-args will be bound to a list of
;;; remaining args.  BODY ... will be evaluated in a environment with
;;; these variables bound as specified.
;;;
;;; Note that the grammar will be quasi-quoted for passing it to
;;; getopt-long, so you can use unquote to get variables into the
;;; list.
;;; 
;;; For example, you can write
;;; 
;;; (define foo-single-char #\f)
;;; (let-args (command-line)
;;;      ((version)
;;;	  (help)
;;;	  (foo (single-char ,foo-single-char)
;;;	       (value #t))
;;;	  (rest-args #t))
;;;   (if version
;;;       (display-version))
;;;   (if help
;;;	  (display-help))
;;;   (format #t "The parameter to --foo (or -f) was ~S\n" foo)
;;;   (format #t "Remaining arguments: ~S\n" rest-args))

(use-modules (ice-9 getopt-long))

(define-syntax let-args
  (syntax-rules ()
    ((_ args ((option properties ...) ...)
	body ...)
     (let-args-auxiliary 1 args () ((option properties ...) ...) body ...))))
     
(define-syntax let-args-auxiliary
  (syntax-rules ()
    ; Phase 1: reverse option list
    ((_ 1 args options () body ...)
     (let-args-auxiliary 2 args #f () options body ...))
    ((_ 1 args options (option1 option2 ...) body ...)
     (let-args-auxiliary 1 args (option1 . options) (option2 ...) body ...))

    ; Phase 2: reverse and find rest-args
    ((_ 2 args rest-args options () body ...)
     (let-args-auxiliary 3 args rest-args options body ...))
    ((_ 2 args #f options ((rest-args #t) option ...) body ...)
     (let-args-auxiliary 2 args rest-args options (option ...) body ...))
    ((_ 2 args rest-args options (option1 option2 ...) body ...)
     (let-args-auxiliary 2 args rest-args (option1 . options)
			 (option2 ...) body ...))

    ; Phase 3: build final construct
    ((_ 3 args #f ((option properties ...) ...)
	body ...)
     (let ((parsed-args (getopt-long args `((option properties ...)
					    ...))))
       (let ((option (assq-ref parsed-args 'option))
	     ...)
	 body ...)))
	   
    ((_ 3 args rest-args ((option properties ...) ...)
	body ...)
     (let ((parsed-args (getopt-long args `((option properties ...)
					    ...))))
       (let ((option (assq-ref parsed-args 'option))
	     ...
	     (rest-args (assq-ref parsed-args '())))
	 body ...)))))