Use 'formatted-message' instead of '&message' where appropriate.

* gnu.scm (%try-use-modules): Use 'formatted-message' instead of
'&message'.
* gnu/machine/digital-ocean.scm (maybe-raise-unsupported-configuration-error):
Likewise.
* gnu/machine/ssh.scm (machine-check-file-system-availability): Likewise.
(machine-check-building-for-appropriate-system): Likewise.
(deploy-managed-host): Likewise.
(maybe-raise-unsupported-configuration-error): Likewise.
* gnu/packages.scm (search-patch): Likewise.
* gnu/services.scm (%service-with-default-value): Likewise.
(files->etc-directory): Likewise.
(fold-services): Likewise.
* gnu/system.scm (locale-name->definition*): Likewise.
* gnu/system/mapped-devices.scm (check-device-initrd-modules): Likewise.
(check-luks-device): Likewise.
* guix/channels.scm (latest-channel-instance): Likewise.
* guix/cve.scm (json->cve-items): Likewise.
* guix/git-authenticate.scm (commit-signing-key): Likewise.
(commit-authorized-keys): Likewise.
(authenticate-commit): Likewise.
(verify-introductory-commit): Likewise.
* guix/remote.scm (remote-pipe-for-gexp): Likewise.
* guix/scripts/graph.scm (assert-package): Likewise.
* guix/scripts/offload.scm (private-key-from-file*): Likewise.
* guix/ssh.scm (authenticate-server*): Likewise.
(open-ssh-session): Likewise.
(remote-inferior): Likewise.
* guix/ui.scm (matching-generations): Likewise.
* guix/upstream.scm (package-update): Likewise.
* tests/channels.scm ("latest-channel-instances, missing introduction for 'guix'"):
Catch 'formatted-message?'.
("authenticate-channel, wrong first commit signer"): Likewise.
* tests/lint.scm ("patches: not found"): Adjust message string.
* tests/packages.scm ("patch not found yields a run-time error"): Catch
'formatted-message?'.
* guix/lint.scm (check-patch-file-names): Handle 'formatted-message?'.
(check-derivation): Ditto.

10 files changed, 97 insertions, 103 deletions

diff --git a/guix/channels.scm b/guix/channels.scm
index 21a2fdb631..ad2442f50e 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -378,16 +378,16 @@ their relation.  When AUTHENTICATE? is false, CHANNEL is not authenticated."
             ;; TODO: Warn for all the channels once the authentication interface
             ;; is public.
             (when (guix-channel? channel)
-              (raise (condition
-                      (&message
-                       (message (format #f (G_ "channel '~a' lacks an \
+              (raise (make-compound-condition
+                      (formatted-message (G_ "channel '~a' lacks an \
 introduction and cannot be authenticated~%")
-                                        (channel-name channel))))
-                      (&fix-hint
-                       (hint (G_ "Add the missing introduction to your
+                                         (channel-name channel))
+                      (condition
+                       (&fix-hint
+                        (hint (G_ "Add the missing introduction to your
 channels file to address the issue.  Alternatively, you can pass
 @option{--disable-authentication}, at the risk of running unauthenticated and
-thus potentially malicious code.")))))))
+thus potentially malicious code."))))))))
         (warning (G_ "channel authentication disabled~%")))
 
     (when (guix-channel? channel)
diff --git a/guix/cve.scm b/guix/cve.scm
index 7dd9005f09..ae9cca2341 100644
--- a/guix/cve.scm
+++ b/guix/cve.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +21,7 @@
   #:use-module (guix http-client)
   #:use-module (guix json)
   #:use-module (guix i18n)
+  #:use-module ((guix diagnostics) #:select (formatted-message))
   #:use-module (json)
   #:use-module (web uri)
   #:use-module (srfi srfi-1)
@@ -194,15 +195,11 @@ records."
       (raise (condition (&message
                          (message "invalid CVE feed")))))
     (unless (equal? format "MITRE")
-      (raise (condition
-              (&message
-               (message (format #f (G_ "unsupported CVE format: '~a'")
-                                format))))))
+      (raise (formatted-message (G_ "unsupported CVE format: '~a'")
+                                format)))
     (unless (equal? version "4.0")
-      (raise (condition
-              (&message
-               (message (format #f (G_ "unsupported CVE data version: '~a'")
-                                version))))))
+      (raise (formatted-message (G_ "unsupported CVE data version: '~a'")
+                                version)))
 
     (map json->cve-item
          (vector->list (assoc-ref alist "CVE_Items")))))
diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm
index 6cfc7fabe1..4ab5419bd6 100644
--- a/guix/git-authenticate.scm
+++ b/guix/git-authenticate.scm
@@ -24,6 +24,7 @@
   #:use-module ((guix git)
                 #:select (commit-difference false-if-git-not-found))
   #:use-module (guix i18n)
+  #:use-module ((guix diagnostics) #:select (formatted-message))
   #:use-module (guix openpgp)
   #:use-module ((guix utils)
                 #:select (cache-directory with-atomic-file-output))
@@ -105,23 +106,21 @@ not in KEYRING."
                   (lambda _
                     (values #f #f)))))
     (unless signature
-      (raise (condition
-              (&unsigned-commit-error (commit commit-id))
-              (&message
-               (message (format #f (G_ "commit ~a lacks a signature")
-                                (oid->string commit-id)))))))
+      (raise (make-compound-condition
+              (condition (&unsigned-commit-error (commit commit-id)))
+              (formatted-message (G_ "commit ~a lacks a signature")
+                                 (oid->string commit-id)))))
 
     (let ((signature (string->openpgp-packet signature)))
       (when (memq (openpgp-signature-hash-algorithm signature)
                   `(,@disallowed-hash-algorithms md5))
-        (raise (condition
-                (&unsigned-commit-error (commit commit-id))
-                (&message
-                 (message (format #f (G_ "commit ~a has a ~a signature, \
+        (raise (make-compound-condition
+                (condition (&unsigned-commit-error (commit commit-id)))
+                (formatted-message (G_ "commit ~a has a ~a signature, \
 which is not permitted")
-                                  (oid->string commit-id)
-                                  (openpgp-signature-hash-algorithm
-                                   signature)))))))
+                                   (oid->string commit-id)
+                                   (openpgp-signature-hash-algorithm
+                                    signature)))))
 
       (with-fluids ((%default-port-encoding "UTF-8"))
         (let-values (((status data)
@@ -130,23 +129,22 @@ which is not permitted")
           (match status
             ('bad-signature
              ;; There's a signature but it's invalid.
-             (raise (condition
-                     (&signature-verification-error (commit commit-id)
-                                                    (signature signature)
-                                                    (keyring keyring))
-                     (&message
-                      (message (format #f (G_ "signature verification failed \
+             (raise (make-compound-condition
+                     (condition
+                      (&signature-verification-error (commit commit-id)
+                                                     (signature signature)
+                                                     (keyring keyring)))
+                     (formatted-message (G_ "signature verification failed \
 for commit ~a")
-                                       (oid->string commit-id)))))))
+                                        (oid->string commit-id)))))
             ('missing-key
-             (raise (condition
-                     (&missing-key-error (commit commit-id)
-                                         (signature signature))
-                     (&message
-                      (message (format #f (G_ "could not authenticate \
+             (raise (make-compound-condition
+                     (condition (&missing-key-error (commit commit-id)
+                                                    (signature signature)))
+                     (formatted-message (G_ "could not authenticate \
 commit ~a: key ~a is missing")
-                                       (oid->string commit-id)
-                                       (openpgp-format-fingerprint data)))))))
+                                        (oid->string commit-id)
+                                        (openpgp-format-fingerprint data)))))
             ('good-signature data)))))))
 
 (define (read-authorizations port)
@@ -179,13 +177,13 @@ does not specify anything, fall back to DEFAULT-AUTHORIZATIONS."
     ;; If COMMIT removes the '.guix-authorizations' file found in one of its
     ;; parents, raise an error.
     (when (parents-have-authorizations-file? commit)
-      (raise (condition
-              (&unauthorized-commit-error (commit (commit-id commit))
-                                          (signing-key #f))
-              (&message
-               (message (format #f (G_ "commit ~a attempts \
+      (raise (make-compound-condition
+              (condition
+               (&unauthorized-commit-error (commit (commit-id commit))
+                                           (signing-key #f)))
+              (formatted-message (G_ "commit ~a attempts \
 to remove '.guix-authorizations' file")
-                                (oid->string (commit-id commit)))))))))
+                                 (oid->string (commit-id commit)))))))
 
   (define (commit-authorizations commit)
     (catch 'git-error
@@ -234,16 +232,16 @@ not specify anything, fall back to DEFAULT-AUTHORIZATIONS."
   (unless (member (openpgp-public-key-fingerprint signing-key)
                   (commit-authorized-keys repository commit
                                           default-authorizations))
-    (raise (condition
-            (&unauthorized-commit-error (commit id)
-                                        (signing-key signing-key))
-            (&message
-             (message (format #f (G_ "commit ~a not signed by an authorized \
+    (raise (make-compound-condition
+            (condition
+             (&unauthorized-commit-error (commit id)
+                                         (signing-key signing-key)))
+            (formatted-message (G_ "commit ~a not signed by an authorized \
 key: ~a")
-                              (oid->string id)
-                              (openpgp-format-fingerprint
-                               (openpgp-public-key-fingerprint
-                                signing-key))))))))
+                               (oid->string id)
+                               (openpgp-format-fingerprint
+                                (openpgp-public-key-fingerprint
+                                 signing-key))))))
 
   signing-key)
 
@@ -366,13 +364,11 @@ EXPECTED-SIGNER."
      (commit-signing-key repository (commit-id commit) keyring)))
 
   (unless (bytevector=? expected-signer actual-signer)
-    (raise (condition
-            (&message
-             (message (format #f (G_ "initial commit ~a is signed by '~a' \
+    (raise (formatted-message (G_ "initial commit ~a is signed by '~a' \
 instead of '~a'")
                               (oid->string (commit-id commit))
                               (openpgp-format-fingerprint actual-signer)
-                              (openpgp-format-fingerprint expected-signer))))))))
+                              (openpgp-format-fingerprint expected-signer)))))
 
 (define* (authenticate-repository repository start signer
                                   #:key
diff --git a/guix/lint.scm b/guix/lint.scm
index e7855678ca..8a55f3e744 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -668,7 +668,12 @@ patch could not be found."
               ;; Use %make-warning, as condition-mesasge is already
               ;; translated.
               (%make-warning package (condition-message c)
-                             #:field 'patch-file-names))))
+                             #:field 'patch-file-names)))
+            ((formatted-message? c)
+             (list (%make-warning package
+                                  (apply format #f
+                                         (G_ (formatted-message-string c))
+                                         (formatted-message-arguments c))))))
     (define patches
       (match (package-source package)
         ((? origin? origin) (origin-patches origin))
@@ -955,7 +960,14 @@ descriptions maintained upstream."
                    (make-warning package
                                  (G_ "failed to create ~a derivation: ~a")
                                  (list system
-                                       (condition-message c)))))
+                                       (condition-message c))))
+                  ((formatted-message? c)
+                   (let ((str (apply format #f
+                                     (formatted-message-string c)
+                                     (formatted-message-arguments c))))
+                     (make-warning package
+                                   (G_ "failed to create ~a derivation: ~a")
+                                   (list system str)))))
           (parameterize ((%graft? #f))
             (package-derivation store package system #:graft? #f)
 
diff --git a/guix/remote.scm b/guix/remote.scm
index a227540728..f6adb22846 100644
--- a/guix/remote.scm
+++ b/guix/remote.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +20,7 @@
   #:use-module (guix ssh)
   #:use-module (guix gexp)
   #:use-module (guix i18n)
+  #:use-module ((guix diagnostics) #:select (formatted-message))
   #:use-module (guix inferior)
   #:use-module (guix store)
   #:use-module (guix monads)
@@ -72,11 +73,9 @@ BECOME-COMMAND is given, use that to invoke the remote Guile REPL."
     (when (eof-object? (peek-char pipe))
       (let ((status (channel-get-exit-status pipe)))
         (close-port pipe)
-        (raise (condition
-                (&message
-                 (message (format #f (G_ "remote command '~{~a~^ ~}' failed \
+        (raise (formatted-message (G_ "remote command '~{~a~^ ~}' failed \
 with status ~a")
-                                  repl-command status)))))))
+                                  repl-command status))))
     pipe))
 
 (define* (%remote-eval lowered session #:optional become-command)
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 489931d5bb..73d9269de2 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -32,7 +32,8 @@
   #:use-module ((guix build-system gnu) #:select (standard-packages))
   #:use-module (gnu packages)
   #:use-module (guix sets)
-  #:use-module ((guix utils) #:select (location-file))
+  #:use-module ((guix diagnostics)
+                #:select (location-file formatted-message))
   #:use-module ((guix scripts build)
                 #:select (show-transformation-options-help
                           options->transformation
@@ -90,10 +91,8 @@ name."
      package)
     (x
      (raise
-      (condition
-       (&message
-        (message (format #f (G_ "~a: invalid argument (package name expected)")
-                         x))))))))
+      (formatted-message (G_ "~a: invalid argument (package name expected)")
+                         x)))))
 
 (define nodes-from-package
   ;; The default conversion method.
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index e81b6c25f2..77ff3d2694 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -33,11 +33,12 @@
   #:use-module ((guix serialization)
                 #:select (nar-error? nar-error-file))
   #:use-module (guix nar)
-  #:use-module (guix utils)
+  #:use-module ((guix utils) #:select (%current-system))
   #:use-module ((guix build syscalls)
                 #:select (fcntl-flock set-thread-name))
   #:use-module ((guix build utils) #:select (which mkdir-p))
   #:use-module (guix ui)
+  #:use-module (guix diagnostics)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -156,10 +157,9 @@ can interpret meaningfully."
     (lambda ()
       (private-key-from-file file))
     (lambda (key proc str . rest)
-      (raise (condition
-              (&message (message (format #f (G_ "failed to load SSH \
+      (raise (formatted-message (G_ "failed to load SSH \
 private key from '~a': ~a")
-                                         file str))))))))
+                                file str)))))
 
 (define* (open-ssh-session machine #:optional (max-silent-time -1))
   "Open an SSH session for MACHINE and return it.  Throw an error on failure."
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 418443992b..a36f72bb67 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -20,7 +20,7 @@
   #:use-module (guix store)
   #:use-module (guix inferior)
   #:use-module (guix i18n)
-  #:use-module ((guix diagnostics) #:select (&fix-hint))
+  #:use-module ((guix diagnostics) #:select (&fix-hint formatted-message))
   #:use-module (gcrypt pk-crypto)
   #:use-module (ssh session)
   #:use-module (ssh auth)
@@ -88,14 +88,12 @@ actual key does not match."
       ;; provided its Ed25519 key when we where expecting its RSA key.  XXX:
       ;; Guile-SSH 0.10.1 doesn't know about ed25519 keys and 'get-key-type'
       ;; returns #f in that case.
-      (raise (condition
-              (&message
-               (message (format #f (G_ "server at '~a' returned host key \
+      (raise (formatted-message (G_ "server at '~a' returned host key \
 '~a' of type '~a' instead of '~a' of type '~a'~%")
                                 (session-get session 'host)
                                 (public-key->string server)
                                 (get-key-type server)
-                                key type))))))))
+                                key type)))))
 
 (define* (open-ssh-session host #:key user port identity
                            host-key
@@ -148,12 +146,10 @@ Throw an error on failure."
            (match (authenticate-server session)
              ('ok #f)
              (reason
-              (raise (condition
-                      (&message
-                       (message (format #f (G_ "failed to authenticate \
+              (raise (formatted-message (G_ "failed to authenticate \
 server at '~a': ~a")
                                         (session-get session 'host)
-                                        reason))))))))
+                                        reason)))))
 
        ;; Use public key authentication, via the SSH agent if it's available.
        (match (userauth-public-key/auto! session)
@@ -173,10 +169,8 @@ server at '~a': ~a")
                                        host (get-error session)))))))))))
       (x
        ;; Connection failed or timeout expired.
-       (raise (condition
-               (&message
-                (message (format #f (G_ "SSH connection to '~a' failed: ~a~%")
-                                 host (get-error session))))))))))
+       (raise (formatted-message (G_ "SSH connection to '~a' failed: ~a~%")
+                                 host (get-error session)))))))
 
 (define* (remote-inferior session #:optional become-command)
   "Return a remote inferior for the given SESSION.  If BECOME-COMMAND is
@@ -187,11 +181,9 @@ given, use that to invoke the remote Guile REPL."
     (when (eof-object? (peek-char pipe))
       (let ((status (channel-get-exit-status pipe)))
         (close-port pipe)
-        (raise (condition
-                (&message
-                 (message (format #f (G_ "remote command '~{~a~^ ~}' failed \
+        (raise (formatted-message (G_ "remote command '~{~a~^ ~}' failed \
 with status ~a")
-                                  repl-command status)))))))
+                                  repl-command status))))
     (port->inferior pipe)))
 
 (define* (inferior-remote-eval exp session #:optional become-command)
diff --git a/guix/ui.scm b/guix/ui.scm
index 162eb35d26..420c9689ae 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1796,9 +1796,7 @@ DURATION-RELATION with the current time."
          filter-by-duration)
         (else
          (raise
-          (condition (&message
-                      (message (format #f (G_ "invalid syntax: ~a~%")
-                                       str))))))))
+          (formatted-message (G_ "invalid syntax: ~a~%") str)))))
 
 (define (display-generation profile number)
   "Display a one-line summary of generation NUMBER of PROFILE."
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 70cbfb45e8..ca184601b2 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -417,12 +417,13 @@ values: 'always', 'never', and 'interactive' (default)."
                       #f))))
        (match (assq method %method-updates)
          (#f
-          (raise (condition (&message
-                             (message (format #f (G_ "cannot download for \
+          (raise (make-compound-condition
+                  (formatted-message (G_ "cannot download for \
 this method: ~s")
-                                              method)))
-                            (&error-location
-                             (location (package-location package))))))
+                                     method)
+                  (condition
+                   (&error-location
+                    (location (package-location package)))))))
          ((_ . update)
           (update store package source
                   #:key-download key-download)))))