meta/guild.in

   1 #!/bin/sh
   2 # -*- scheme -*-
   3 prefix="@prefix@"
   4 exec_prefix="@exec_prefix@"
   5 exec ${GUILE:-@bindir@/@guile_program_name@} $GUILE_FLAGS -e '(@@ (guild) main)' -s "$0" "$@"
   6 !#
   7
   8 ;;;; guild --- running scripts bundled with Guile
   9 ;;;; Andy Wingo <wingo@pobox.com> --- April 2009
  10 ;;;;
  11 ;;;;    Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
  12 ;;;;
  13 ;;;; This library is free software; you can redistribute it and/or
  14 ;;;; modify it under the terms of the GNU Lesser General Public
  15 ;;;; License as published by the Free Software Foundation; either
  16 ;;;; version 3 of the License, or (at your option) any later version.
  17 ;;;;
  18 ;;;; This library is distributed in the hope that it will be useful,
  19 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;;;; Lesser General Public License for more details.
  22 ;;;;
  23 ;;;; You should have received a copy of the GNU Lesser General Public
  24 ;;;; License along with this library; if not, write to the Free
  25 ;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;;;; Boston, MA 02110-1301 USA
  27
  28 (define-module (guild)
  29   #:use-module (ice-9 getopt-long)
  30   #:use-module (ice-9 command-line)
  31   #:autoload (ice-9 format) (format))
  32
  33 ;; Hack to provide scripts with the bug-report address.
  34 (module-define! the-scm-module
  35                 '%guile-bug-report-address
  36                 "@PACKAGE_BUGREPORT@")
  37
  38
  39 (define *option-grammar*
  40   '((help (single-char #\h))
  41     (version (single-char #\v))))
  42
  43 (define (display-version)
  44   (version-etc "@PACKAGE_NAME@"
  45                (version)
  46                #:command-name "guild"
  47                #:license *LGPLv3+*))
  48
  49 (define (find-script s)
  50   (resolve-module (list 'scripts (string->symbol s)) #:ensure #f))
  51
  52 (define (main args)
  53   (if (defined? 'setlocale)
  54       (catch 'system-error
  55         (lambda ()
  56           (setlocale LC_ALL ""))
  57         (lambda args
  58           (format (current-error-port)
  59                   "warning: failed to install locale: ~a~%"
  60                   (strerror (system-error-errno args))))))
  61
  62   (let* ((options (getopt-long args *option-grammar*
  63                                #:stop-at-first-non-option #t))
  64          (args (option-ref options '() '())))
  65     (cond
  66      ((option-ref options 'help #f)
  67       (apply (module-ref (resolve-module '(scripts help)) 'main) args)
  68       (exit 0))
  69      ((option-ref options 'version #f)
  70       (display-version)
  71       (exit 0))
  72      ((find-script (if (null? args) "help" (car args)))
  73       => (lambda (mod)
  74            (exit (apply (module-ref mod 'main) (if (null? args)
  75                                                    '()
  76                                                    (cdr args))))))
  77      (else
  78       (format (current-error-port)
  79               "guild: unknown script ~s~%" (car args))
  80       (format (current-error-port)
  81               "Try `guild help' for more information.~%")
  82       (exit 1)))))