From 073c34d72f94adf6c4c307239b1de0d14bdb60f3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 1 Nov 2012 00:50:01 +0100 Subject: 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. --- guix/ui.scm | 75 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 75 insertions(+) create mode 100644 guix/ui.scm (limited to 'guix') 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 +;;; +;;; 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 . + +(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 -- cgit v1.2.3