diff options
| -rw-r--r-- | .dir-locals.el | 3 | ||||
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | guix-build.in | 21 | ||||
| -rw-r--r-- | guix-download.in | 10 | ||||
| -rw-r--r-- | guix/ui.scm | 75 | ||||
| -rw-r--r-- | po/POTFILES.in | 1 |
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 |