#!/usr/local/bin/guile \
-e main -s
!#
;;;; g-wrap-config --- utility for linking programs with g-wrap
;;;;
;;;; Copyright 2000 Rob Browning <rlb@defaultvalue.org>
;;;; 
;;;; This program 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, 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
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser 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.3.4")

(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" "gwrap-wct" "gwrap-glib")
                     ("rscheme" "gwraprs")))
         (libs (assoc language lib-list)))
                   
    (if libs
        (begin
          (if static?
              (for-each
               (lambda (lib) (stdout " /usr/local/lib/lib" lib ".a"))
               (cdr libs))
              (begin
                (stdout "-L/usr/local/lib")
                (for-each
                 (lambda (lib) (stdout " -l" lib))
                 (cdr libs))))
          (stdout #\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/g-wrap" #\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:
