4 exec_prefix
="@exec_prefix@"
5 exec ${GUILE:-@bindir@/@guile_program_name@} $GUILE_FLAGS -e '(@@ (guild) main)' -s "$0" "$@"
8 ;;;; guild
--- running scripts bundled with Guile
9 ;;;; Andy Wingo
<wingo@pobox.com
> --- April
2009
11 ;;;; Copyright
(C
) 2009, 2010, 2011 Free Software Foundation
, Inc.
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.
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.
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
28 (define-module
(guild
)
29 #:use-module (ice-9 getopt-long)
30 #:use-module (ice-9 command-line)
31 #:autoload (ice-9 format) (format))
33 ;; Hack to provide scripts with the bug-report address.
34 (module-define
! the-scm-module
35 '%guile-bug-report-address
36 "@PACKAGE_BUGREPORT@")
39 (define *option-grammar*
40 '((help (single-char
#\h))
41 (version
(single-char
#\v))))
43 (define
(display-version
)
44 (version-etc
"@PACKAGE_NAME@"
46 #:command-name "guild"
49 (define
(find-script s
)
50 (resolve-module
(list
'scripts (string->symbol s)) #:ensure #f))
53 (if (defined? 'setlocale
)
54 (setlocale LC_ALL
""))
56 (let* ((options
(getopt-long args
*option-grammar
*
57 #:stop-at-first-non-option #t))
58 (args
(option-ref options
'() '())))
60 ((option-ref options
'help #f)
61 (apply (module-ref (resolve-module '(scripts
help)) 'main) args)
63 ((option-ref options 'version
#f)
66 ((find-script
(if (null? args
) "help" (car args
)))
68 (exit (apply
(module-ref mod
'main) (if (null? args)
72 (format
(current-error-port
)
73 "guild: unknown script ~s~%" (car args
))
74 (format
(current-error-port
)
75 "Try `guild help' for more information.~%")