06/09: ui: Make diagnostic message prefix translatable.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 26a2021a1f7951818539353531d56d2e8338966e
Author: Ludovic Courtès <address@hidden>
Date:   Tue Apr 9 23:44:36 2019 +0200

    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(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index c57d206..953cf9e 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