#!/bin/sh
# -*- scheme -*-
exec guile $GUILE_FLAGS -e '(@@ (guild) main)' -s "$0" "$@"
!#

;;;; guild --- running scripts bundled with Guile
;;;; Andy Wingo <wingo@pobox.com> --- April 2009
;;;; 
;;;; 	Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
;;;; 
;;;; 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 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library 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 library; if not, write to the Free
;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA

(define-module (guild)
  #:use-module (ice-9 getopt-long)
  #:autoload (ice-9 format) (format))

;; Hack to provide scripts with the bug-report address.
(module-define! the-scm-module
                '%guile-bug-report-address
                "@PACKAGE_BUGREPORT@")


(define *option-grammar*
  '((help (single-char #\h))
    (version (single-char #\v))))

(define (display-help)
  (display "\
Usage: guild --version
       guild --help
       guild PROGRAM [ARGS]

If PROGRAM is \"list\" or omitted, display available scripts, otherwise
PROGRAM is run with ARGS.
"))

(define (display-version)
  (format #t "guild (GNU Guile ~A) ~A
Copyright (C) 2010 Free Software Foundation, Inc.
License LGPLv3+: GNU LGPL version 3 or later <http://gnu.org/licenses/lgpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
" (version) (effective-version)))

(define (find-script s)
  (resolve-module (list 'scripts (string->symbol s)) #:ensure #f))

(define (main args)
  (if (defined? 'setlocale)
      (setlocale LC_ALL ""))

  (let ((options (getopt-long args *option-grammar*
                              #:stop-at-first-non-option #t)))
    (cond
     ((option-ref options 'help #f)
      (display-help)
      (exit 0))
     ((option-ref options 'version #f)
      (display-version)
      (exit 0))
     (else
      (let ((args (option-ref options '() '())))
        (cond ((find-script (if (null? args)
                                "list"
                                (car args)))
               => (lambda (mod)
                    (exit (apply (module-ref mod 'main) (if (null? args)
                                                            '()
                                                            (cdr args))))))
              (else
               (format (current-error-port)
                       "guild: unknown script ~s~%" (car args))
               (format (current-error-port)
                       "Try `guild --help' for more information.~%")
               (exit 1))))))))