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

["Miguel Ángel Arruga Vivas" <rosen644835@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1311 bytes --]

Hi Ludo,

Ludovic Courtès <ludo@gnu.org> writes:
> Sounds good.  I think the way you split patches in v3 was fine too (the
> added test was also a nice bonus), so I actually have a slight
> preference for v3.
> (...)
> This (and v3) LGTM!  We’ll have to do another round of testing before
> 1.2.

I plan to push them today.  The code is the same as v4 (as it contained
the code for roll-back in ssh.scm) plus the test from v3, with only
cosmetic changes to avoid touching other lines and an update for
multiboot-modules in the test.  Thank you very much for your review.

Nonetheless, I have a nice last minute addition for this to keep this
open for a bit more. :-)

It brings the whole glibc-locales to the grub and extlinux configuration
builders, and changes again boot-parameters.  It would be optimal to
create a minimal locale with the desired locale, as glibc-utf8-locales
doesn't work with my to-go test target (es_ES.utf8) because setlocale
raises an exception.

I have in my TODO list to extract translate-label somewhere else, even
though I'm not sure where could it fit, and to sanitize some inputs to
ensure the correct generation.  The latter should be ready this week,
the first depends on finding (or creating) the right place.

WDYT?

Happy hacking!
Miguel

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-system-nls-for-boot-labels.patch --]
[-- Type: text/x-patch, Size: 13365 bytes --]

From e21128a7ed6557198ee74706921a0a24bbbc7b65 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 | 48 +++++++++++++++++++++++---
 gnu/bootloader/grub.scm     | 68 ++++++++++++++++++++++++++++++++-----
 gnu/system.scm              | 21 ++++++------
 po/guix/POTFILES.in         |  2 ++
 tests/boot-parameters.scm   |  6 +++-
 5 files changed, 119 insertions(+), 26 deletions(-)

diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index 6b5ff298e7..40e02319f0 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -27,6 +27,7 @@
 
 (define* (extlinux-configuration-file config entries
                                       #:key
+                                      (locale #f)
                                       (system (%current-system))
                                       (old-entries '())
                                       #:allow-other-keys)
@@ -38,8 +39,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 +88,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..d05abf9bc9 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