1 files changed, 75 insertions, 0 deletions
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