summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-04-12 17:13:26 +0200
committerLudovic Courtès <ludo@gnu.org>2019-04-12 17:56:23 +0200
commitc7dc604253631588c659c1022256af98ec9262af (patch)
treedc20b5022928f4e3f59405696315952444821b64
parent126d4c12ce18a35a0d971778133f05b7c6ad81b3 (diff)
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.
-rw-r--r--gnu/installer.scm15
-rw-r--r--gnu/system/install.scm52
2 files changed, 55 insertions, 12 deletions
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