Merge commit '5af307de43e4b65eec7f235b48a8908f2a00f134'

[bpt/guile.git] / meta / guild.in

diff --git a/meta/guild.in b/meta/guild.in
index bb9c37e..a68e0ff 100755 (executable)
--- a/meta/guild.in
+++ b/meta/guild.in
@@ -1,12 +1,12 @@
 #!/bin/sh
 # -*- scheme -*-
-exec guile $GUILE_FLAGS -e '(@@ (guild) main)' -s "$0" "$@"
+exec ${GUILE:-@installed_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.
+;;;;   Copyright (C) 2009, 2010, 2011, 2013, 2014 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
@@ -25,6 +25,7 @@ exec guile $GUILE_FLAGS -e '(@@ (guild) main)' -s "$0" "$@"
 
 (define-module (guild)
   #:use-module (ice-9 getopt-long)
+  #:use-module (ice-9 command-line)
   #:autoload (ice-9 format) (format))
 
 ;; Hack to provide scripts with the bug-report address.
@@ -37,52 +38,43 @@ exec guile $GUILE_FLAGS -e '(@@ (guild) main)' -s "$0" "$@"
   '((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)))
+  (version-etc "@PACKAGE_NAME@"
+               (version)
+               #:command-name "guild"
+               #:license *LGPLv3+*))
 
 (define (find-script s)
   (resolve-module (list 'scripts (string->symbol s)) #:ensure #f))
 
 (define (main args)
   (if (defined? 'setlocale)
-      (setlocale LC_ALL ""))
+      (catch 'system-error
+        (lambda ()
+          (setlocale LC_ALL ""))
+        (lambda args
+          (format (current-error-port)
+                  "warning: failed to install locale: ~a~%"
+                  (strerror (system-error-errno args))))))
 
-  (let ((options (getopt-long args *option-grammar*
-                              #:stop-at-first-non-option #t)))
+  (let* ((options (getopt-long args *option-grammar*
+                               #:stop-at-first-non-option #t))
+         (args (option-ref options '() '())))
     (cond
      ((option-ref options 'help #f)
-      (display-help)
+      (apply (module-ref (resolve-module '(scripts help)) 'main) args)
       (exit 0))
      ((option-ref options 'version #f)
       (display-version)
       (exit 0))
+     ((find-script (if (null? args) "help" (car args)))
+      => (lambda (mod)
+           (exit (apply (module-ref mod 'main) (if (null? args)
+                                                   '()
+                                                   (cdr args))))))
      (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))))))))
+      (format (current-error-port)
+              "guild: unknown script ~s~%" (car args))
+      (format (current-error-port)
+              "Try `guild help' for more information.~%")
+      (exit 1)))))