Add (guix ui).

* guix/ui.scm: New file.
* Makefile.am (MODULES): Add it.
* po/POTFILES.in: Add it.

* guix-build.in: Use it.
  (_, N_, leave): Remove.
  (guix-build): Use `with-error-handling' instead of the `guard' form.
* guix-download.in: Use it.
  (_, N_, leave): Remove.

6 files changed, 82 insertions, 29 deletions

diff --git a/.dir-locals.el b/.dir-locals.el
index f04fdc6fc7..cbf60b5da1 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -10,7 +10,8 @@
    (eval . (put 'substitute* 'scheme-indent-function 1))
    (eval . (put 'with-directory-excursion 'scheme-indent-function 1))
    (eval . (put 'package 'scheme-indent-function 1))
-   (eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))))
+   (eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))
+   (eval . (put 'with-error-handling 'scheme-indent-function 0))))
  (emacs-lisp-mode . ((indent-tabs-mode . nil)))
  (texinfo-mode    . ((indent-tabs-mode . nil)
                      (fill-column . 72))))
diff --git a/Makefile.am b/Makefile.am
index 75e479ddc4..daec24460a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -30,6 +30,7 @@ MODULES =					\
   guix/ftp-client.scm				\
   guix/http.scm					\
   guix/store.scm				\
+  guix/ui.scm					\
   guix/build/gnu-build-system.scm		\
   guix/build/ftp.scm				\
   guix/build/http.scm				\
diff --git a/guix-build.in b/guix-build.in
index 7089a74731..961545b146 100644
--- a/guix-build.in
+++ b/guix-build.in
@@ -30,6 +30,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
 ;;; along with Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix-build)
+  #:use-module (guix ui)
   #:use-module (guix store)
   #:use-module (guix derivations)
   #:use-module (guix packages)
@@ -43,9 +44,6 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
   #:autoload   (distro) (find-packages-by-name)
   #:export (guix-build))
 
-(define _ (cut gettext <> "guix"))
-(define N_ (cut ngettext <> <> <> "guix"))
-
 (define %store
   (open-connection))
 
@@ -73,12 +71,6 @@ When SOURCE? is true, return the derivations of the package sources."
   `((system . ,(%current-system))
     (substitutes? . #t)))
 
-(define-syntax-rule (leave fmt args ...)
-  "Format FMT and ARGS to the error port and exit."
-  (begin
-    (format (current-error-port) fmt args ...)
-    (exit 1)))
-
 (define (show-version)
   (display "guix-build (@PACKAGE_NAME@) @PACKAGE_VERSION@\n"))
 
@@ -206,16 +198,7 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
   (setvbuf (current-output-port) _IOLBF)
   (setvbuf (current-error-port) _IOLBF)
 
-  (guard (c ((package-input-error? c)
-             (let* ((package  (package-error-package c))
-                    (input    (package-error-invalid-input c))
-                    (location (package-location package))
-                    (file     (location-file location))
-                    (line     (location-line location))
-                    (column   (location-column location)))
-               (leave (_ "~a:~a:~a: error: package `~a' has an invalid input: ~s~%")
-                      file line column
-                      (package-full-name package) input))))
+  (with-error-handling
     (let* ((opts (parse-options))
            (src? (assoc-ref opts 'source?))
            (sys  (assoc-ref opts 'system))
diff --git a/guix-download.in b/guix-download.in
index 3892b2efe3..b574c962b4 100644
--- a/guix-download.in
+++ b/guix-download.in
@@ -32,6 +32,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
 (define-module (guix-download)
   #:use-module (web uri)
   #:use-module (web client)
+  #:use-module (guix ui)
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix ftp-client)
@@ -44,9 +45,6 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
   #:use-module (rnrs io ports)
   #:export (guix-download))
 
-(define _ (cut gettext <> "guix"))
-(define N_ (cut ngettext <> <> <> "guix"))
-
 (define (call-with-temporary-output-file proc)
   (let* ((template (string-copy "guix-download.XXXXXX"))
          (out      (mkstemp! template)))
@@ -90,12 +88,6 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
   ;; Alist of default option values.
   `((format . ,bytevector->nix-base32-string)))
 
-(define-syntax-rule (leave fmt args ...)
-  "Format FMT and ARGS to the error port and exit."
-  (begin
-    (format (current-error-port) fmt args ...)
-    (exit 1)))
-
 (define (show-version)
   (display "guix-download (@PACKAGE_NAME@) @PACKAGE_VERSION@\n"))
 
diff --git a/guix/ui.scm b/guix/ui.scm
new file mode 100644
index 0000000000..cb78a21bd8
--- /dev/null
+++ b/guix/ui.scm
@@ -0,0 +1,75 @@
+;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
+;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of Guix.
+;;;
+;;; Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix ui)
+  #:use-module (guix utils)
+  #:use-module (guix store)
+  #:use-module (guix packages)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:export (_
+            N_
+            leave
+            call-with-error-handling
+            with-error-handling))
+
+;;; Commentary:
+;;;
+;;; User interface facilities for command-line tools.
+;;;
+;;; Code:
+
+(define %gettext-domain
+  "guix")
+
+(define _ (cut gettext <> %gettext-domain))
+(define N_ (cut ngettext <> <> <> %gettext-domain))
+
+(define-syntax-rule (leave fmt args ...)
+  "Format FMT and ARGS to the error port and exit."
+  (begin
+    (format (current-error-port) fmt args ...)
+    (exit 1)))
+
+(define (call-with-error-handling thunk)
+  "Call THUNK within a user-friendly error handler."
+  (guard (c ((package-input-error? c)
+             (let* ((package  (package-error-package c))
+                    (input    (package-error-invalid-input c))
+                    (location (package-location package))
+                    (file     (location-file location))
+                    (line     (location-line location))
+                    (column   (location-column location)))
+               (leave (_ "~a:~a:~a: error: package `~a' has an invalid input: ~s~%")
+                      file line column
+                      (package-full-name package) input)))
+            ((nix-protocol-error? c)
+             ;; FIXME: Server-provided error messages aren't i18n'd.
+             (leave (_ "error: build failed: ~a~%")
+                    (nix-protocol-error-message c))))
+    (thunk)))
+
+(define-syntax with-error-handling
+  (syntax-rules ()
+    "Run BODY within a user-friendly error condition handler."
+    ((_ body ...)
+     (call-with-error-handling
+      (lambda ()
+        body ...)))))
+
+;;; ui.scm ends here
diff --git a/po/POTFILES.in b/po/POTFILES.in
index b0dc7ac4c4..887b7106ee 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -4,5 +4,6 @@ distro/packages/base.scm
 distro/packages/databases.scm
 distro/packages/guile.scm
 distro/packages/typesetting.scm
+guix/ui.scm
 guix-build.in
 guix-download.in