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