From 26a2021a1f7951818539353531d56d2e8338966e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 9 Apr 2019 23:44:36 +0200
Subject: ui: Make diagnostic message prefix translatable.

* guix/ui.scm (define-diagnostic): Expect PREFIX to be enclosed in
'G_'.   Emit call to 'gettext' on PREFIX.
(warning, info, report-error): Wrap prefix in 'G_'.
---
 guix/ui.scm | 63 ++++++++++++++++++++++++++++++++++---------------------------
 1 file changed, 35 insertions(+), 28 deletions(-)

(limited to 'guix/ui.scm')

diff --git a/guix/ui.scm b/guix/ui.scm
index c57d206184..953cf9ea7f 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -124,35 +124,42 @@
 ;;;
 ;;; Code:
 
-(define-syntax-rule (define-diagnostic name prefix)
-  "Create a diagnostic macro (i.e., NAME), which will prepend PREFIX to all
+(define-syntax define-diagnostic
+  (syntax-rules ()
+    "Create a diagnostic macro (i.e., NAME), which will prepend PREFIX to all
 messages."
-  (define-syntax name
-    (lambda (x)
-      (syntax-case x ()
-        ((name (underscore fmt) args (... ...))
-         (and (string? (syntax->datum #'fmt))
-              (free-identifier=? #'underscore #'G_))
-         #'(begin
-             (format (guix-warning-port) "~:[~*~;guix ~a: ~]~a"
-                     (program-name) (program-name) prefix)
-             (format (guix-warning-port) (gettext fmt)
-                     args (... ...))))
-        ((name (N-underscore singular plural n) args (... ...))
-         (and (string? (syntax->datum #'singular))
-              (string? (syntax->datum #'plural))
-              (free-identifier=? #'N-underscore #'N_))
-         #'(begin
-             (format (guix-warning-port) "~:[~*~;guix ~a: ~]~a"
-                     (program-name) (program-name) prefix)
-             (format (guix-warning-port)
-                     (ngettext singular plural n %gettext-domain)
-                     args (... ...))))))))
-
-(define-diagnostic warning "warning: ") ; emit a warning
-(define-diagnostic info "")
-
-(define-diagnostic report-error "error: ")
+    ((_ name (G_ prefix))
+     (define-syntax name
+       (lambda (x)
+         (syntax-case x ()
+           ((name (underscore fmt) args (... ...))
+            (and (string? (syntax->datum #'fmt))
+                 (free-identifier=? #'underscore #'G_))
+            #'(begin
+                (format (guix-warning-port) "~:[~*~;guix ~a: ~]~a"
+                        (program-name) (program-name)
+                        (gettext prefix %gettext-domain))
+                (format (guix-warning-port) (gettext fmt %gettext-domain)
+                        args (... ...))))
+           ((name (N-underscore singular plural n) args (... ...))
+            (and (string? (syntax->datum #'singular))
+                 (string? (syntax->datum #'plural))
+                 (free-identifier=? #'N-underscore #'N_))
+            #'(begin
+                (format (guix-warning-port) "~:[~*~;guix ~a: ~]~a"
+                        (program-name) (program-name)
+                        (gettext prefix %gettext-domain))
+                (format (guix-warning-port)
+                        (ngettext singular plural n %gettext-domain)
+                        args (... ...))))))))))
+
+;; XXX: This doesn't work well for right-to-left languages.
+;; TRANSLATORS: The goal is to emit "warning:" followed by a short phrase;
+;; "~a" is a placeholder for that phrase.
+(define-diagnostic warning (G_ "warning: "))    ;emit a warning
+(define-diagnostic info (G_ ""))
+
+(define-diagnostic report-error (G_ "error: "))
 (define-syntax-rule (leave args ...)
   "Emit an error message and exit."
   (begin
-- 
cgit v1.2.3