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.master
parent
126d4c12ce
commit
c7dc604253
|
@ -91,9 +91,17 @@ version of this file."
|
||||||
|
|
||||||
(define apply-locale
|
(define apply-locale
|
||||||
;; Install the specified locale.
|
;; Install the specified locale.
|
||||||
#~(lambda (locale-name)
|
(with-imported-modules (source-module-closure '((gnu services herd)))
|
||||||
(false-if-exception
|
#~(lambda (locale)
|
||||||
(setlocale LC_ALL locale-name))))
|
(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
|
(define* (compute-locale-step #:key
|
||||||
locales-name
|
locales-name
|
||||||
|
@ -323,6 +331,7 @@ selected keymap."
|
||||||
(gnu installer newt)
|
(gnu installer newt)
|
||||||
((gnu installer newt keymap)
|
((gnu installer newt keymap)
|
||||||
#:select (keyboard-layout->configuration))
|
#:select (keyboard-layout->configuration))
|
||||||
|
(gnu services herd)
|
||||||
(guix i18n)
|
(guix i18n)
|
||||||
(guix build utils)
|
(guix build utils)
|
||||||
(ice-9 match))
|
(ice-9 match))
|
||||||
|
|
|
@ -77,12 +77,32 @@
|
||||||
;;; Documentation service.
|
;;; 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)
|
(define (log-to-info tty user)
|
||||||
"Return a script that spawns the Info reader on the right section of the
|
"Return a script that spawns the Info reader on the right section of the
|
||||||
manual."
|
manual."
|
||||||
(program-file "log-to-info"
|
(program-file "log-to-info"
|
||||||
#~(let ((tty (open-file #$(string-append "/dev/" tty)
|
#~(let* ((tty (open-file #$(string-append "/dev/" tty)
|
||||||
"r0+")))
|
"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-output-port))
|
||||||
(redirect-port tty (current-error-port))
|
(redirect-port tty (current-error-port))
|
||||||
(redirect-port tty (current-input-port))
|
(redirect-port tty (current-input-port))
|
||||||
|
@ -94,18 +114,32 @@ manual."
|
||||||
;; 'gunzip' is needed to decompress the doc.
|
;; 'gunzip' is needed to decompress the doc.
|
||||||
(setenv "PATH" (string-append #$gzip "/bin"))
|
(setenv "PATH" (string-append #$gzip "/bin"))
|
||||||
|
|
||||||
(execl (string-append #$info-reader "/bin/info") "info"
|
;; Change this process' locale so that command-line
|
||||||
"-d" "/run/current-system/profile/share/info"
|
;; arguments to 'info' are properly encoded.
|
||||||
"-f" (string-append #$guix "/share/info/guix.info")
|
(catch #t
|
||||||
"-n" "System Installation"))))
|
(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)
|
(define (documentation-shepherd-service tty)
|
||||||
(list (shepherd-service
|
(list (shepherd-service
|
||||||
(provision (list (symbol-append 'term- (string->symbol tty))))
|
(provision (list (symbol-append 'term- (string->symbol tty))))
|
||||||
(requirement '(user-processes host-name udev virtual-terminal))
|
(requirement '(user-processes host-name udev virtual-terminal))
|
||||||
|
(start #~(lambda* (#:optional (locale "en_US.utf8"))
|
||||||
(start #~(make-forkexec-constructor
|
(fork+exec-command
|
||||||
(list #$(log-to-info tty "documentation"))))
|
(list #$(log-to-info tty "documentation") locale)
|
||||||
|
#:environment-variables
|
||||||
|
`("GUIX_LOCPATH=/run/current-system/locale"
|
||||||
|
"TERM=linux"))))
|
||||||
(stop #~(make-kill-destructor)))))
|
(stop #~(make-kill-destructor)))))
|
||||||
|
|
||||||
(define %documentation-users
|
(define %documentation-users
|
||||||
|
|
Reference in New Issue