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.
This commit is contained in:
Ludovic Courtès 2019-04-12 17:13:26 +02:00
parent 126d4c12ce
commit c7dc604253
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 55 additions and 12 deletions

View file

@ -91,9 +91,17 @@ (define builder
(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 @@ (define installer-builder
(gnu installer newt)
((gnu installer newt keymap)
#:select (keyboard-layout->configuration))
(gnu services herd)
(guix i18n)
(guix build utils)
(ice-9 match))

View file

@ -77,12 +77,32 @@ (define-module (gnu system install)
;;; 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 @@ (define (log-to-info tty user)
;; '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