[bug#35394,4/4,v4] Grub i18n

From e9f3c255c13abc14e1f0decf5460b7a2f9a2d162 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miguel=20=C3=81ngel=20Arruga=20Vivas?=
 <rosen644835@gmail.com>
Date: Sat, 17 Oct 2020 21:27:51 +0200
Subject: [PATCH] system: nls for boot labels.

* gnu/bootloader/extlinux.scm (extlinux-configuration-file): Add
keyword locale.
[translate-label]: New function that formats the label after
translation.
[menu-entry->gexp]: Use translate-label.
[init-gettext]: Init gettext with the language provided through the
configuration.
[builder]: Use init-gettext, define G_ and translate strings.
* gnu/bootloader/grub.scm (eye-candy): Translate string.
(grub-configuration-file)[translate-label]: New function.
[menu-entry->gexp]: Use translate-label.
[init-gettext]: New g-exp variable.
[locale-config]: Translate string.
[builder]: Use init-gettext, define G_ and translate strings.
* gnu/system.scm (kernel->boot-label): Modify return type, and
document it, to allow correct translation of the labels.
* po/guix/POTFILES.in: Add gnu/bootloader/grub.scm.
* tests/boot-parameters.scm (%default-label): Update to the new
format.
(%old-label): Renamed from old %default-label.
(read old format): New test case.
---
 gnu/bootloader/extlinux.scm | 52 +++++++++++++++++++++++++---
 gnu/bootloader/grub.scm     | 68 ++++++++++++++++++++++++++++++++-----
 gnu/system.scm              | 21 ++++++------
 po/guix/POTFILES.in         |  2 ++
 tests/boot-parameters.scm   |  6 +++-
 5 files changed, 123 insertions(+), 26 deletions(-)

diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index 6b5ff298e7..36d0bcdae4 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -19,14 +19,19 @@ 
 
 (define-module (gnu bootloader extlinux)
   #:use-module (gnu bootloader)
+  #:use-module (gnu packages base)
   #:use-module (gnu packages bootloaders)
+  #:use-module (gnu packages package-management)
+  #:use-module (gnu system locale)
   #:use-module (guix gexp)
   #:use-module (guix utils)
+  #:use-module (ice-9 match)
   #:export (extlinux-bootloader
             extlinux-bootloader-gpt))
 
 (define* (extlinux-configuration-file config entries
                                       #:key
+                                      (locale #f)
                                       (system (%current-system))
                                       (old-entries '())
                                       #:allow-other-keys)
@@ -38,8 +43,38 @@  corresponding to old generations of the system."
   (define all-entries
     (append entries (bootloader-configuration-menu-entries config)))
 
+  (define (translate-label label)
+    (match label
+      (('hurd name version)
+       ;; TRANSLATORS: The first parameter is the capitalized package name
+       ;; for the Hurd kernel, which uses the definite article in English.
+       ;; The second parameter contains the version string.
+       #~(format #f (G_ "GNU with the ~a ~a") package version))
+      (('linux name version)
+       ;; TRANSLATORS: The first parameter is the capitalized package name
+       ;; for Linux kernel, which doesn't use the definite article in
+       ;; English.  The second parameter contains the version string.
+       #~(format #f (G_ "GNU with ~a ~a") package version))
+      (('unknown)
+       ;; TRANSLATORS: This is the label for an unknown system to be booted.
+       #~(G_ "GNU"))
+      ((? string? old-format)
+       ;; We cannot translate properly the old format.
+       old-format)))
+
+  (define init-gettext
+    #~(let ((locale #$(and locale
+                           (locale-definition-name
+                            (locale-name->definition locale)))))
+        (when locale
+          (setenv "GUIX_LOCPATH" (string-append #$glibc-locales
+                                                "/lib/locale/"))
+          (bindtextdomain "guix" (string-append #$guix "/share/locale"))
+          (textdomain "guix")
+          (setlocale LC_ALL locale))))
+
   (define (menu-entry->gexp entry)
-    (let ((label (menu-entry-label entry))
+    (let ((label (translate-label (menu-entry-label entry)))
           (kernel (menu-entry-linux entry))
           (kernel-arguments (menu-entry-linux-arguments entry))
           (initrd (menu-entry-initrd entry)))
@@ -57,13 +92,20 @@  corresponding to old generations of the system."
   (define builder
     #~(call-with-output-file #$output
         (lambda (port)
+          #$init-gettext
+          ;; Ensure xgettext extracts translatable messages
+          ;; with our current keywords.
+          (define G_ gettext)
           (let ((timeout #$(bootloader-configuration-timeout config)))
-            (format port "# This file was generated from your Guix configuration.  Any changes
-# will be lost upon reconfiguration.
-UI menu.c32
-MENU TITLE GNU Guix Boot Options
+            (format port "~aUI menu.c32
+MENU TITLE ~a
 PROMPT ~a
 TIMEOUT ~a~%"
+                    (G_ "\
+# This file was generated from your Guix configuration.  Any changes
+# will be lost upon reconfiguration.
+") ;; Keep line break to not duplicate grub.scm message.
+                    (G_ "GNU Guix Boot Options")
                     (if (> timeout 0) 1 0)
                     ;; timeout is expressed in 1/10s of seconds.
                     (* 10 timeout))
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 611580a350..e4df9b5009 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -35,8 +35,10 @@ 
   #:use-module (gnu system file-systems)
   #:use-module (gnu system keyboard)
   #:use-module (gnu system locale)
+  #:use-module (gnu packages base)
   #:use-module (gnu packages bootloaders)
   #:autoload   (gnu packages gtk) (guile-cairo guile-rsvg)
+  #:use-module (gnu packages package-management)
   #:autoload   (gnu packages xorg) (xkeyboard-config)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
@@ -182,7 +184,7 @@  fi~%"
 
   (and image
        #~(format #$port "
-# Set 'root' to the partition that contains /gnu/store.
+# ~a
 ~a
 
 ~a
@@ -196,6 +198,8 @@  else
   set menu_color_normal=cyan/blue
   set menu_color_highlight=white/blue
 fi~%"
+                 (G_
+		  "Set 'root' to the partition that contains /gnu/store.")
                  #$(grub-root-search store-device font-file)
                  #$(setup-gfxterm config font-file)
                  #$(grub-setup-io config)
@@ -348,8 +352,28 @@  STORE-DIRECTORY-PREFIX may be used to specify a store prefix, as is required
 when booting a root file system on a Btrfs subvolume."
   (define all-entries
     (append entries (bootloader-configuration-menu-entries config)))
+
+  (define (translate-label label)
+    (match label
+      (('hurd name version)
+       ;; TRANSLATORS: The first parameter is the capitalized package name
+       ;; for the Hurd kernel, which uses the definite article in English.
+       ;; The second parameter contains the version string.
+       #~(format #f (G_ "GNU with the ~a ~a") package version))
+      (('linux name version)
+       ;; TRANSLATORS: The first parameter is the capitalized package name
+       ;; for Linux kernel, which doesn't use the definite article in
+       ;; English.  The second parameter contains the version string.
+       #~(format #f (G_ "GNU with ~a ~a") package version))
+      (('unknown)
+       ;; TRANSLATORS: This is the label for an unknown system to be booted.
+       #~(G_ "GNU"))
+      ((? string? old-format)
+       ;; We cannot translate properly the old format.
+       old-format)))
+
   (define (menu-entry->gexp entry)
-    (let ((label (menu-entry-label entry))
+    (let ((label (translate-label (menu-entry-label entry)))
           (linux (menu-entry-linux entry))
           (device (menu-entry-device entry))
           (device-mount-point (menu-entry-device-mount-point entry)))
@@ -401,19 +425,36 @@  menuentry ~s {
                  #:store-directory-prefix store-directory-prefix
                  #:port #~port)))
 
+  (define init-gettext
+    #~(let ((locale #$(and locale
+                           (locale-definition-name
+                            (locale-name->definition locale)))))
+        (when locale
+          (setenv "GUIX_LOCPATH" (string-append #$glibc-locales
+                                                "/lib/locale/"))
+          (bindtextdomain "guix" (string-append #$guix "/share/locale"))
+          (textdomain "guix")
+          (setlocale LC_ALL locale))))
+
   (define locale-config
     #~(let ((locale #$(and locale
                            (locale-definition-source
                             (locale-name->definition locale)))))
         (when locale
           (format port "\
-# Localization configuration.
+# ~a
 if search --file --set boot_partition /grub/grub.cfg; then
     set locale_dir=(${boot_partition})/grub/locale
 else
     set locale_dir=/boot/grub/locale
 fi
-set lang=~a~%" locale))))
+set lang=~a~%"
+                  ;; XXX: This should sanitized with a function that
+                  ;; inserts # at the beginning of each line.
+                  ;; TRANSLATORS: This must be one line or start each line
+                  ;; with #.
+                  (G_ "Localization configuration.")
+                  locale))))
 
   (define keyboard-layout-config
     (let* ((layout (bootloader-configuration-keyboard-layout config))
@@ -434,10 +475,17 @@  keymap ~a~%" #$keymap))))
   (define builder
     #~(call-with-output-file #$output
         (lambda (port)
+          #$init-gettext
+          ;; Ensure xgettext extracts translatable messages
+          ;; with our current keywords.
+          (define G_ gettext)
           (format port
-                  "# This file was generated from your Guix configuration.  Any changes
+                  ;; XXX: This should sanitized with a function to
+                  ;; ensure the # at the beginning of each line.
+                  (G_ "\
+# This file was generated from your Guix configuration.  Any changes
 # will be lost upon reconfiguration.
-")
+"))
           #$(sugar)
           #$locale-config
           #$keyboard-layout-config
@@ -450,16 +498,18 @@  set timeout=~a~%"
 
           #$@(if (pair? old-entries)
                  #~((format port "
-submenu \"GNU system, old configurations...\" {~%")
+submenu \"~a\" {~%"
+                            (G_ "GNU system, old configurations..."))
                     #$@(map menu-entry->gexp old-entries)
                     (format port "}~%"))
                  #~())
           (format port "
 if [ \"${grub_platform}\" == efi ]; then
-  menuentry \"Firmware setup\" {
+  menuentry \"~a\" {
     fwsetup
   }
-fi~%"))))
+fi~%"
+                  (G_ "Firmware setup")))))
 
   ;; Since this file is rather unique, there's no point in trying to
   ;; substitute it.
diff --git a/gnu/system.scm b/gnu/system.scm
index a3122eaa65..1257aa6223 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1194,20 +1194,19 @@  listed in OS.  The C library expects to find it under
                     #:libcs (operating-system-locale-libcs os)))
 
 (define* (kernel->boot-label kernel #:key hurd)
-  "Return a label for the bootloader menu entry that boots KERNEL."
+  "Return a label for the bootloader menu entry that boots KERNEL.
+Label is a list that contains the kernel identifier, @code{'hurd} or
+@code{'linux}, its title name and the version, or @code{'unknown}."
   (cond ((package? hurd)
-         (string-append "GNU with the "
-                        (string-titlecase (package-name hurd)) " "
-                        (package-version hurd)))
+         (list 'hurd (string-titlecase (package-name hurd))
+               (package-version hurd)))
         ((package? kernel)
-         (string-append "GNU with "
-                        (string-titlecase (package-name kernel)) " "
-                        (package-version kernel)))
+         (list 'linux (string-titlecase (package-name kernel))
+               (package-version kernel)))
         ((inferior-package? kernel)
-         (string-append "GNU with "
-                        (string-titlecase (inferior-package-name kernel)) " "
-                        (inferior-package-version kernel)))
-        (else "GNU")))
+         (list 'linux (string-titlecase (inferior-package-name kernel))
+               (inferior-package-version kernel)))
+        (else '(unknown))))
 
 (define (operating-system-default-label os)
   "Return the default label for OS, as it will appear in the bootloader menu
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index b877fac9df..4386c8763d 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -40,6 +40,8 @@  gnu/installer/user.scm
 gnu/installer/utils.scm
 gnu/machine/ssh.scm
 gnu/packages/bootstrap.scm
+gnu/bootloader/grub.scm
+gnu/bootloader/extlinux.scm
 guix/build/utils.scm
 guix/scripts.scm
 guix/scripts/build.scm
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index d7e579bc89..678de1475f 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -34,7 +34,8 @@ 
   #:use-module (srfi srfi-64)
   #:use-module (rnrs bytevectors))
 
-(define %default-label "GNU with Linux-libre 99.1.2")
+(define %old-label "GNU with Linux-libre 99.1.2")
+(define %default-label '(linux "Linux-libre" "99.1.2"))
 (define %default-kernel-path
   (string-append (%store-prefix)
                  "/zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz-linux-libre-99.1.2"))
@@ -156,6 +157,9 @@ 
                                   #:with-store #false
                                   #:locale #false)))
 
+(test-assert "read, read old format"
+  (test-read-boot-parameters #:label %old-label))
+
 (test-equal "read, default equality"
   %grub-boot-parameters
   (test-read-boot-parameters))
-- 
2.28.0