#!/usr/local/bin/guile \
-e main -s
!#
;;;; g-wrap-config --- utility for linking programs with g-wrap
;;;;
;;;; 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 *program-version* "1.1.9")

(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: " #\newline)
    (pr "--version                     - show version information")
    (pr "--help                        - show this message")
    (pr "--c-compile-args LANGUAGE     - C compile args for LANGUAGE")
    (pr "--c-link-args LANGUAGE        - C link args for LANGUAGE")
    (pr "--c-static-link-args LANGUAGE - C static link args for LANGUAGE")
    (pr "--guile-module-directory      - Location of guile module dir")))

(define (c-link-args language static?)
  (let* ((lib-list '(("guile" . "g-wrap-runtime-guile")
                     ("rscheme" . "gwraprs")))
         (lib (assoc language lib-list)))
                   
    (if lib
        (begin
          (if static?
              (stdout "/usr/local/lib/lib" (cdr lib) ".a" #\newline)
              (stdout "-L/usr/local/lib -l" (cdr lib) #\newline))
          #t)
        (begin
          (stderr *program-name* ": unknown LANGUAGE \"" language "\" given.")
          (stderr #\newline)
          (usage-msg)
          #f))))

(define (c-compile-args language)
  (stdout "-I/usr/local/include" #\newline)
  #t)

(define (main args)

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

  ;; Right now we do dirt-stupid argument processing.
  (let ((rest (cdr args))
        (status #t))
    
    (cond
     ((null? rest)
      (usage-msg)
      (set! status #f))

     ;; --version
     ((equal? '("--version") rest)
      (stdout "g-wrap-config " *program-version* #\newline))

     ;; --c-compile-args LANGUAGE
     ((and (string=? "--c-compile-args" (car rest))
           (= (length rest) 2))
      (set! status (c-compile-args (cadr rest))))

     ;; --c-link-args LANGUAGE
     ((and (string=? "--c-link-args" (car rest))
           (= (length rest) 2))
      (set! status (c-link-args (cadr rest) #f)))

     ;; --c-static-link-args LANGUAGE
     ((and (string=? "--c-static-link-args" (car rest))
           (= (length rest) 2))
      (set! status (c-link-args (cadr rest) #t)))

     ;; --c-static-link-args LANGUAGE
     ((and (string=? "--guile-module-directory" (car rest))
           (= (length rest) 1))
      (stdout "/usr/local/share/guile" #\newline)
      (set! status 0))

     (else
      (usage-msg)
      (set! status #f)))
    
    (quit (if status 0 1))))

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