From c7dc604253631588c659c1022256af98ec9262af Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 12 Apr 2019 17:13:26 +0200
Subject: installer: Choosing a locale opens the translated manual on tty2.

Suggested by Florian Pelz.

* gnu/system/install.scm (%installation-node-names): New variable.
(log-to-info): Expect the chosen locale as an argument.  Compute the
language, Info file name, and node name.  Install the locale.
(documentation-shepherd-service): Add 'locale' parameter to the 'start'
action and honor it.  Set GUIX_LOCPATH and TERM as environment variables
for the process.
* gnu/installer.scm (apply-locale): Use (gnu services herd).  Call
'stop-service' and 'start-service' with the chosen locale.
---
 gnu/installer.scm      | 15 ++++++++++++---
 gnu/system/install.scm | 52 +++++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 55 insertions(+), 12 deletions(-)

(limited to 'gnu')

diff --git a/gnu/installer.scm b/gnu/installer.scm
index 50e2e7d85e..6a7a556271 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -91,9 +91,17 @@ version of this file."
 
 (define apply-locale
   ;; Install the specified locale.
-  #~(lambda (locale-name)
-      (false-if-exception
-       (setlocale LC_ALL locale-name))))
+  (with-imported-modules (source-module-closure '((gnu services herd)))
+    #~(lambda (locale)
+        (false-if-exception
+         (setlocale LC_ALL locale))
+
+        ;; Restart the documentation viewer so it displays the manual in
+        ;; language that corresponds to LOCALE.
+        (with-error-to-port (%make-void-port "w")
+          (lambda ()
+            (stop-service 'term-tty2)
+            (start-service 'term-tty2 (list locale)))))))
 
 (define* (compute-locale-step #:key
                               locales-name
@@ -323,6 +331,7 @@ selected keymap."
                          (gnu installer newt)
                          ((gnu installer newt keymap)
                           #:select (keyboard-layout->configuration))
+                         (gnu services herd)
                          (guix i18n)
                          (guix build utils)
                          (ice-9 match))
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 71a9c2f19b..d37315810d 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -77,12 +77,32 @@
 ;;; Documentation service.
 ;;;
 
+(define %installation-node-names
+  ;; Translated name of the "System Installation" node of the manual.  Ideally
+  ;; we'd extract it from the 'guix-manual' gettext domain, but that one is
+  ;; usually not available at run time, hence this hack.
+  '(("de" . "Systeminstallation")
+    ("en" . "System Installation")
+    ("fr" . "Installation du système")))
+
 (define (log-to-info tty user)
   "Return a script that spawns the Info reader on the right section of the
 manual."
   (program-file "log-to-info"
-                #~(let ((tty (open-file #$(string-append "/dev/" tty)
-                                        "r0+")))
+                #~(let* ((tty      (open-file #$(string-append "/dev/" tty)
+                                              "r0+"))
+                         (locale   (cadr (command-line)))
+                         (language (string-take locale
+                                                (string-index locale #\_)))
+                         (infodir  "/run/current-system/profile/share/info")
+                         (per-lang (string-append infodir "/guix." language
+                                                  ".info.gz"))
+                         (file     (if (file-exists? per-lang)
+                                       per-lang
+                                       (string-append infodir "/guix.info")))
+                         (node     (or (assoc-ref '#$%installation-node-names
+                                                  language)
+                                       "System Installation")))
                     (redirect-port tty (current-output-port))
                     (redirect-port tty (current-error-port))
                     (redirect-port tty (current-input-port))
@@ -94,18 +114,32 @@ manual."
                     ;; 'gunzip' is needed to decompress the doc.
                     (setenv "PATH" (string-append #$gzip "/bin"))
 
-                    (execl (string-append #$info-reader "/bin/info") "info"
-                           "-d" "/run/current-system/profile/share/info"
-                           "-f" (string-append #$guix "/share/info/guix.info")
-                           "-n" "System Installation"))))
+                    ;; Change this process' locale so that command-line
+                    ;; arguments to 'info' are properly encoded.
+                    (catch #t
+                      (lambda ()
+                        (setlocale LC_ALL locale)
+                        (setenv "LC_ALL" locale))
+                      (lambda _
+                        ;; Sometimes LOCALE itself is not available.  In that
+                        ;; case pick the one UTF-8 locale that's known to work
+                        ;; instead of failing.
+                        (setlocale LC_ALL "en_US.utf8")
+                        (setenv "LC_ALL" "en_US.utf8")))
+
+                    (execl #$(file-append info-reader "/bin/info")
+                           "info" "-d" infodir "-f" file "-n" node))))
 
 (define (documentation-shepherd-service tty)
   (list (shepherd-service
          (provision (list (symbol-append 'term- (string->symbol tty))))
          (requirement '(user-processes host-name udev virtual-terminal))
-
-         (start #~(make-forkexec-constructor
-                   (list #$(log-to-info tty "documentation"))))
+         (start #~(lambda* (#:optional (locale "en_US.utf8"))
+                    (fork+exec-command
+                     (list #$(log-to-info tty "documentation") locale)
+                     #:environment-variables
+                     `("GUIX_LOCPATH=/run/current-system/locale"
+                       "TERM=linux"))))
          (stop #~(make-kill-destructor)))))
 
 (define %documentation-users
-- 
cgit v1.2.3