3 exec 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 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
)
52 (setlocale LC_ALL
""))
54 (let* ((options
(getopt-long args
*option-grammar
*
55 #:stop-at-first-non-option #t))
56 (args
(option-ref options
'() '())))
58 ((option-ref options
'help #f)
59 (apply (module-ref (resolve-module '(scripts
help)) 'main) args)
61 ((option-ref options 'version
#f)
64 ((find-script
(if (null? args
) "help" (car args
)))
66 (exit (apply
(module-ref mod
'main) (if (null? args)
70 (format
(current-error-port
)
71 "guild: unknown script ~s~%" (car args
))
72 (format
(current-error-port
)
73 "Try `guild help' for more information.~%")