mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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:
parent
126d4c12ce
commit
c7dc604253
2 changed files with 55 additions and 12 deletions
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue