#!/usr/bin/guile \
-e main -s
!#
;;;; g-wrap --- main g-wrap command
;;;;
;;;; Copyright 2000 Rob Browning <rlb@cs.utexas.edu>
;;;; 
;;;; 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
;;;;

(define *program-name* #f)

(define (stderr . args)
  (let ((ep (current-error-port)))
    (for-each (lambda (arg) (display arg ep)) args)))

(define (stdout . args)
  (for-each display args))

(define (usage-msg)
  (let ((pr (lambda ( . msg)
              (stderr "  " *program-name* " ")
              (apply stderr msg)
              (stderr #\newline))))
    (stderr "Usage: g-wrap [options] file" #\newline)
    (pr "--version          - show version information")
    (pr "--help             - show this message")
    (pr "--api LANGUAGE     - language of the API being wrapped")
    (pr "--target LANGUAGE  - language for which wrappers are being generated")
    (stderr #\newline)
    (stderr "  Example: g-wrap --api c --target guile foo.gwp")))

(define (g-wrap api-language target-language spec-filename)
  ;; Right now we only support C->guile and C->rscheme, so there's not
  ;; much to consider...
  (let ((executable
         (case target-language
           ((guile) "/usr/libexec/g-wrap-guile")
           ((rscheme) "/usr/libexec/g-wrap-rs")
           (else #f))))
    
    (if (not executable)
        #f
        (execlp executable executable spec-filename))))

(define (main args)
  
  (set! *program-name* (basename (car args)))

  ;; Right now we do dirt-stupid argument processing.
  (let* ((rest (cdr args))
         (command-args (if (= (length rest) 5)
                           (reverse (cdr (reverse rest)))
                           #f))
         (spec-filename (if (= (length rest) 5)
                            (car (reverse rest))
                            #f)))
    
    (quit
     (cond
      ((null? rest)
       (usage-msg)
       1)
      
      ;; --version
      ((equal? '("--version") rest)
       (stdout "g-wrap " *program-version* #\newline))
      
      ;; wrapping for guile
      ((or (equal? '("--api" "c" "--target" "guile") command-args)
           (equal? '("--target" "guile" "--api" "c") command-args))
       (g-wrap 'c 'guile spec-filename))
      
      ;; wrapping for rscheme
      ((or (equal? '("--api" "c" "--target" "rscheme") command-args)
           (equal? '("--target" "rscheme" "--api" "c") command-args))
       (g-wrap 'c 'rscheme spec-filename))
      
      (else
       (usage-msg)
       (set! status #f))))))

;;; Local Variables:
;;; mode: scheme
;;; End:
