From 98eb8cbe8d0bdebde0e151bfb309aa27abaef4d7 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
Date: Sun, 21 Apr 2013 08:08:40 +0000
Subject: ui: Add a 'define-diagnostic' macro.

* guix/ui.scm (define-diagnostic): New macro, which is based on the
  previous version of 'warning'.
  (warning, leave): Redefine using 'define-diagnostic'.
  (report-error): New macro.
  (install-locale): Use 'warning' instead of 'format'.
  (call-with-error-handling): Adjust 'leave'.
* gnu/packages.scm (package-files): Use 'warning' instead of 'format'.
* guix/gnu-maintenance.scm (http-fetch): Use 'warning' and 'leave'.
* guix/scripts/build.scm (derivations-from-package-expressions, guix-build):
  Adjust 'leave'.
* guix/scripts/download.scm (guix-download): Adjust 'leave'.
* guix/scripts/gc.scm (size->number, %options): Adjust 'leave'.
* guix/scripts/package.scm (roll-back, guix-package): Adjust 'leave'.
* po/POTFILES.in: Add 'guix/gnu-maintenance.scm'.
---
 guix/scripts/build.scm    | 14 +++++++-------
 guix/scripts/download.scm |  4 ++--
 guix/scripts/gc.scm       |  7 +++----
 guix/scripts/package.scm  |  5 ++---
 4 files changed, 14 insertions(+), 16 deletions(-)

(limited to 'guix/scripts')

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index f296f3031f..0bf154dd41 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -43,12 +43,11 @@
 When SOURCE? is true, return the derivations of the package sources."
   (let ((p (read/eval-package-expression str)))
     (if source?
-        (let ((source (package-source p))
-              (loc    (package-location p)))
+        (let ((source (package-source p)))
           (if source
               (package-source-derivation (%store) source)
-              (leave (_ "~a: error: package `~a' has no source~%")
-                     (location->string loc) (package-name p))))
+              (leave (_ "package `~a' has no source~%")
+                     (package-name p))))
         (package-derivation (%store) p system))))
 
 
@@ -169,7 +168,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
             (add-indirect-root (%store) root))
            ((paths ...)
             (fold (lambda (path count)
-                    (let ((root (string-append root "-" (number->string count))))
+                    (let ((root (string-append root
+                                               "-"
+                                               (number->string count))))
                       (symlink path root)
                       (add-indirect-root (%store) root))
                     (+ 1 count))
@@ -177,8 +178,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                   paths))))
        (lambda args
          (leave (_ "failed to create GC root `~a': ~a~%")
-                root (strerror (system-error-errno args)))
-         (exit 1)))))
+                root (strerror (system-error-errno args)))))))
 
   (define newest-available-packages
     (memoize find-newest-available-packages))
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 7c00312c74..c5c56c5054 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -114,7 +114,7 @@ and the hash of its contents.\n"))
            (store (open-connection))
            (arg   (assq-ref opts 'argument))
            (uri   (or (string->uri arg)
-                      (leave (_ "guix-download: ~a: failed to parse URI~%")
+                      (leave (_ "~a: failed to parse URI~%")
                              arg)))
            (path  (case (uri-scheme uri)
                     ((file)
@@ -127,7 +127,7 @@ and the hash of its contents.\n"))
                                       (basename (uri-path uri))))))
            (hash  (call-with-input-file
                       (or path
-                          (leave (_ "guix-download: ~a: download failed~%")
+                          (leave (_ "~a: download failed~%")
                                  arg))
                     (compose sha256 get-bytevector-all)))
            (fmt   (assq-ref opts 'format)))
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 3d918923f8..7625bc46e6 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -87,9 +87,8 @@ interpreted."
              ("TB"  (expt 10 12))
              (""    1)
              (_
-              (leave (_ "error: unknown unit: ~a~%") unit)
-              (exit 1))))
-        (leave (_ "error: invalid number: ~a") numstr))))
+              (leave (_ "unknown unit: ~a~%") unit))))
+        (leave (_ "invalid number: ~a~%") numstr))))
 
 (define %options
   ;; Specification of the command-line options.
@@ -110,7 +109,7 @@ interpreted."
                       (let ((amount (size->number arg)))
                         (if arg
                             (alist-cons 'min-freed amount result)
-                            (leave (_ "error: invalid amount of storage: ~a~%")
+                            (leave (_ "invalid amount of storage: ~a~%")
                                    arg))))
                      (#f result)))))
         (option '(#\d "delete") #f #f
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 4295abaf57..c5656efc14 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -208,7 +208,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
       (switch-symlinks profile previous-profile))
 
     (cond ((not (file-exists? profile))           ; invalid profile
-           (leave (_ "error: profile `~a' does not exist~%")
+           (leave (_ "profile `~a' does not exist~%")
                   profile))
           ((zero? number)                         ; empty profile
            (format (current-error-port)
@@ -477,8 +477,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
     (define (ensure-output p sub-drv)
       (if (member sub-drv (package-outputs p))
           p
-          (leave (_ "~a: error: package `~a' lacks output `~a'~%")
-                 (location->string (package-location p))
+          (leave (_ "package `~a' lacks output `~a'~%")
                  (package-full-name p)
                  sub-drv)))
 
-- 
cgit v1.2.3