ui: Add a `warning' macro.

* guix/ui.scm (program-name, guix-warning-port): New variables.
  (warning): New macro.
  (guix-main): Parametrize PROGRAM-NAME.
* guix/scripts/build.scm, guix/scripts/download.scm,
  guix/scripts/gc.scm, guix/scripts/package.scm: Adjust to use `leave'
  and `warning' consistently.

4 files changed, 19 insertions, 35 deletions

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index a49bfdbeb8..339ad0d06f 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -176,9 +176,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                   0
                   paths))))
        (lambda args
-         (format (current-error-port)
-                 (_ "failed to create GC root `~a': ~a~%")
-                 root (strerror (system-error-errno args)))
+         (leave (_ "failed to create GC root `~a': ~a~%")
+                root (strerror (system-error-errno args)))
          (exit 1)))))
 
   (define newest-available-packages
@@ -202,13 +201,10 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
         ((p)                                      ; one match
          p)
         ((p x ...)                                ; several matches
-         (format (current-error-port)
-                 (_ "warning: ambiguous package specification `~a'~%")
-                 request)
-         (format (current-error-port)
-                 (_ "warning: choosing ~a from ~a~%")
-                 (package-full-name p)
-                 (location->string (package-location p)))
+         (warning (_ "ambiguous package specification `~a'~%") request)
+         (warning (_ "choosing ~a from ~a~%")
+                  (package-full-name p)
+                  (location->string (package-location p)))
          p)
         (_                                        ; no matches
          (if version
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 3f989a3494..7c00312c74 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -81,8 +81,7 @@ and the hash of its contents.\n"))
                       ((or "base16" "hex" "hexadecimal")
                        bytevector->base16-string)
                       (x
-                       (format (current-error-port)
-                               "unsupported hash format: ~a~%" arg))))
+                       (leave (_ "unsupported hash format: ~a~%") arg))))
 
                   (alist-cons 'format fmt-proc
                               (alist-delete 'format result))))
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 12d80fd171..3d918923f8 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -87,13 +87,9 @@ interpreted."
              ("TB"  (expt 10 12))
              (""    1)
              (_
-              (format (current-error-port) (_ "error: unknown unit: ~a~%")
-                      unit)
+              (leave (_ "error: unknown unit: ~a~%") unit)
               (exit 1))))
-        (begin
-          (format (current-error-port)
-                  (_ "error: invalid number: ~a") numstr)
-          (exit 1)))))
+        (leave (_ "error: invalid number: ~a") numstr))))
 
 (define %options
   ;; Specification of the command-line options.
@@ -114,11 +110,8 @@ interpreted."
                       (let ((amount (size->number arg)))
                         (if arg
                             (alist-cons 'min-freed amount result)
-                            (begin
-                              (format (current-error-port)
-                                      (_ "error: invalid amount of storage: ~a~%")
-                                      arg)
-                              (exit 1)))))
+                            (leave (_ "error: invalid amount of storage: ~a~%")
+                                   arg))))
                      (#f result)))))
         (option '(#\d "delete") #f #f
                 (lambda (opt name arg result)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 6de2f1beb6..89708ccc49 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -208,12 +208,10 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
       (switch-symlinks profile previous-profile))
 
     (cond ((not (file-exists? profile))           ; invalid profile
-           (format (current-error-port)
-                   (_ "error: profile `~a' does not exist~%")
-                   profile))
+           (leave (_ "error: profile `~a' does not exist~%")
+                  profile))
           ((zero? number)                         ; empty profile
-           (format (current-error-port)
-                   (_ "nothing to do: already at the empty profile~%")))
+           (leave (_ "nothing to do: already at the empty profile~%")))
           ((or (zero? previous-number)            ; going to emptiness
                (not (file-exists? previous-profile)))
            (let*-values (((drv-path drv)
@@ -465,13 +463,11 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
          (list name (package-version p) sub-drv (ensure-output p sub-drv)
                (package-transitive-propagated-inputs p)))
         ((p p* ...)
-         (format (current-error-port)
-                 (_ "warning: ambiguous package specification `~a'~%")
-                 request)
-         (format (current-error-port)
-                 (_ "warning: choosing ~a from ~a~%")
-                 (package-full-name p)
-                 (location->string (package-location p)))
+         (warning (_ "ambiguous package specification `~a'~%")
+                  request)
+         (warning (_ "choosing ~a from ~a~%")
+                  (package-full-name p)
+                  (location->string (package-location p)))
          (list name (package-version p) sub-drv (ensure-output p sub-drv)
                (package-transitive-propagated-inputs p)))
         (()