summaryrefslogtreecommitdiff
path: root/gnu/installer
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer')
-rw-r--r--gnu/installer/final.scm8
-rw-r--r--gnu/installer/keymap.scm8
-rw-r--r--gnu/installer/newt/final.scm9
-rw-r--r--gnu/installer/newt/keymap.scm32
-rw-r--r--gnu/installer/newt/locale.scm30
-rw-r--r--gnu/installer/newt/page.scm7
-rw-r--r--gnu/installer/newt/timezone.scm5
-rw-r--r--gnu/installer/services.scm51
-rw-r--r--gnu/installer/steps.scm26
-rw-r--r--gnu/installer/utils.scm14
10 files changed, 135 insertions, 55 deletions
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index e1c62f5ce0..07946f72c3 100644
--- a/gnu/installer/final.scm
+++ b/gnu/installer/final.scm
@@ -24,13 +24,15 @@
#:use-module (guix build utils)
#:export (install-system))
-(define (install-system)
+(define (install-system locale)
"Start COW-STORE service on target directory and launch guix install command
-in a subshell."
+in a subshell. LOCALE must be the locale name under which that command will
+run, or #f."
(let ((install-command
(format #f "guix system init ~a ~a"
(%installer-configuration-file)
(%installer-target-dir))))
(mkdir-p (%installer-target-dir))
(start-service 'cow-store (list (%installer-target-dir)))
- (false-if-exception (run-shell-command install-command))))
+ (false-if-exception (run-shell-command install-command
+ #:locale locale))))
diff --git a/gnu/installer/keymap.scm b/gnu/installer/keymap.scm
index d66b376d9c..df9fc5e441 100644
--- a/gnu/installer/keymap.scm
+++ b/gnu/installer/keymap.scm
@@ -36,6 +36,7 @@
make-x11-keymap-layout
x11-keymap-layout?
x11-keymap-layout-name
+ x11-keymap-layout-synopsis
x11-keymap-layout-description
x11-keymap-layout-variants
@@ -60,7 +61,8 @@
x11-keymap-layout make-x11-keymap-layout
x11-keymap-layout?
(name x11-keymap-layout-name) ;string
- (description x11-keymap-layout-description) ;string
+ (synopsis x11-keymap-layout-synopsis) ;string (e.g., "en")
+ (description x11-keymap-layout-description) ;string (a whole phrase)
(variants x11-keymap-layout-variants)) ;list of <x11-keymap-variant>
(define-record-type* <x11-keymap-variant>
@@ -117,6 +119,8 @@ Configuration Database, describing possible XKB configurations."
(variantList ,[variant -> v] ...))
(x11-keymap-layout
(name name)
+ (synopsis (car
+ (assoc-ref rest-layout 'shortDescription)))
(description (car
(assoc-ref rest-layout 'description)))
(variants (list v ...)))]
@@ -126,6 +130,8 @@ Configuration Database, describing possible XKB configurations."
. ,rest-layout))
(x11-keymap-layout
(name name)
+ (synopsis (car
+ (assoc-ref rest-layout 'shortDescription)))
(description (car
(assoc-ref rest-layout 'description)))
(variants '()))]))
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index 645c1e8689..f492c5dbb7 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/final.scm
@@ -65,22 +65,23 @@ press the button to reboot.")))
(G_ "The final system installation step failed. You can retry the \
last step, or restart the installer.")))
-(define (run-install-shell)
+(define (run-install-shell locale)
(clear-screen)
(newt-suspend)
- (let ((install-ok? (install-system)))
+ (let ((install-ok? (install-system locale)))
(newt-resume)
install-ok?))
(define (run-final-page result prev-steps)
- (let* ((configuration (format-configuration prev-steps result))
+ (let* ((configuration (format-configuration prev-steps result))
(user-partitions (result-step result 'partition))
+ (locale (result-step result 'locale))
(install-ok?
(with-mounted-partitions
user-partitions
(configuration->file configuration)
(run-config-display-page)
- (run-install-shell))))
+ (run-install-shell locale))))
(if install-ok?
(run-install-success-page)
(run-install-failed-page))))
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
index 948b54783c..2908ba7f0e 100644
--- a/gnu/installer/newt/keymap.scm
+++ b/gnu/installer/newt/keymap.scm
@@ -28,6 +28,7 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (ice-9 i18n)
#:use-module (ice-9 match)
#:export (run-keymap-page
keyboard-layout->configuration))
@@ -64,14 +65,29 @@
(define (sort-layouts layouts)
"Sort LAYOUTS list by putting the US layout ahead and return it."
+ (define (layout<? layout1 layout2)
+ (let ((text1 (x11-keymap-layout-description layout1))
+ (text2 (x11-keymap-layout-description layout2)))
+ ;; XXX: We're calling 'gettext' more than once per item.
+ (string-locale<? (gettext text1 "xkeyboard-config")
+ (gettext text2 "xkeyboard-config"))))
+
+ (define preferred
+ ;; Two-letter language tag for the preferred keyboard layout.
+ (or (getenv "LANGUAGE") "us"))
+
(call-with-values
(lambda ()
(partition
(lambda (layout)
- (let ((name (x11-keymap-layout-name layout)))
- (string=? name "us")))
+ ;; The 'synopsis' field is usually a language code (e.g., "en")
+ ;; while the 'name' field is a country code (e.g., "us").
+ (or (string=? (x11-keymap-layout-name layout) preferred)
+ (string=? (x11-keymap-layout-synopsis layout) preferred)))
layouts))
- (cut append <> <>)))
+ (lambda (main others)
+ (append (sort main layout<?)
+ (sort others layout<?)))))
(define (sort-variants variants)
"Sort VARIANTS list by putting the international variant ahead and return it."
@@ -97,7 +113,8 @@ names of the selected keyboard layout and variant."
(run-layout-page
(sort-layouts layouts)
(lambda (layout)
- (x11-keymap-layout-description layout))))))
+ (gettext (x11-keymap-layout-description layout)
+ "xkeyboard-config"))))))
;; Propose the user to select a variant among those supported by the
;; previously selected layout.
(installer-step
@@ -111,15 +128,16 @@ names of the selected keyboard layout and variant."
(run-variant-page
(sort-variants variants)
(lambda (variant)
- (x11-keymap-variant-description
- variant))))))))))
+ (gettext (x11-keymap-variant-description variant)
+ "xkeyboard-config"))))))))))
(define (format-result result)
(let ((layout (x11-keymap-layout-name
(result-step result 'layout)))
(variant (and=> (result-step result 'variant)
(lambda (variant)
- (x11-keymap-variant-name variant)))))
+ (gettext (x11-keymap-variant-name variant)
+ "xkeyboard-config")))))
(list layout (or variant ""))))
(format-result
(run-installer-steps #:steps keymap-steps)))
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
index b819d06691..7108e2960b 100644
--- a/gnu/installer/newt/locale.scm
+++ b/gnu/installer/newt/locale.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -30,9 +31,9 @@
#:export (run-locale-page))
(define (run-language-page languages language->text)
- (let ((title (G_ "Locale language")))
+ (define result
(run-listbox-selection-page
- #:title title
+ #:title (G_ "Locale language")
#:info-text (G_ "Choose the language to use for the \
installation process and for the installed system.")
#:info-textbox-width 70
@@ -44,7 +45,13 @@ installation process and for the installed system.")
(lambda _
(raise
(condition
- (&installer-step-abort)))))))
+ (&installer-step-abort))))))
+
+ ;; Immediately install the chosen language so that the territory page that
+ ;; comes after (optionally) is displayed in the chosen language.
+ (setenv "LANGUAGE" result)
+
+ result)
(define (run-territory-page territories territory->text)
(let ((title (G_ "Locale location")))
@@ -155,7 +162,13 @@ glibc locale string and return it."
(run-language-page
(sort-languages
(delete-duplicates (map locale-language supported-locales)))
- (cut language-code->language-name iso639-languages <>)))))
+ (lambda (language)
+ (let ((english (language-code->language-name iso639-languages
+ language)))
+ (setenv "LANGUAGE" language)
+ (let ((native (gettext english "iso_639-3")))
+ (unsetenv "LANGUAGE")
+ native)))))))
(installer-step
(id 'territory)
(compute
@@ -169,10 +182,11 @@ glibc locale string and return it."
;; supported by the previously selected language.
(run-territory-page
(delete-duplicates (map locale-territory locales))
- (lambda (territory-code)
- (if territory-code
- (territory-code->territory-name iso3166-territories
- territory-code)
+ (lambda (territory)
+ (if territory
+ (let ((english (territory-code->territory-name
+ iso3166-territories territory)))
+ (gettext english "iso_3166-1"))
(G_ "No location"))))))))
(installer-step
(id 'codeset)
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 8b3fd488e9..5c650652bd 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -21,6 +21,7 @@
#:use-module (gnu installer utils)
#:use-module (gnu installer newt utils)
#:use-module (guix i18n)
+ #:use-module (ice-9 i18n)
#:use-module (ice-9 match)
#:use-module (ice-9 receive)
#:use-module (srfi srfi-1)
@@ -223,7 +224,7 @@ be selected (using the <SPACE> key). It that case, a list containing the
selected items will be returned.
If SORT-LISTBOX-ITEMS? is set to #t, the listbox items are sorted using
-'string<=' procedure (after being converted to text).
+'string-locale<?' procedure (after being converted to text).
If ALLOW-DELETE? is #t, the form will return if the <DELETE> key is pressed,
otherwise nothing will happen.
@@ -249,7 +250,7 @@ ITEM was inserted into LISTBOX."
items))
(define (sort-listbox-items listbox-items)
- "Return LISTBOX-ITEMS sorted using the 'string<=' procedure on the text
+ "Return LISTBOX-ITEMS sorted using the 'string-locale<?' procedure on the text
corresponding to each item in the list."
(let* ((items (map (lambda (item)
(cons item (listbox-item->text item)))
@@ -258,7 +259,7 @@ corresponding to each item in the list."
(sort items (lambda (a b)
(let ((text-a (cdr a))
(text-b (cdr b)))
- (string<= text-a text-b))))))
+ (string-locale<? text-a text-b))))))
(map car sorted-items)))
;; Store the last selected listbox item's key.
diff --git a/gnu/installer/newt/timezone.scm b/gnu/installer/newt/timezone.scm
index 63b44af729..67bf41ff84 100644
--- a/gnu/installer/newt/timezone.scm
+++ b/gnu/installer/newt/timezone.scm
@@ -50,12 +50,15 @@ returned."
(define (run-page timezone-tree)
(define (loop path)
+ ;; XXX: Translation of time zones isn't perfect here because the
+ ;; "iso_3166-1" domain contains translation for "territories" (like
+ ;; "Antarctic") but not for continents (like "Africa").
(let ((timezones (locate-children timezone-tree path)))
(run-listbox-selection-page
#:title (G_ "Timezone")
#:info-text (G_ "Please select a timezone.")
#:listbox-items timezones
- #:listbox-item->text identity
+ #:listbox-item->text (cut gettext <> "iso_3166-1")
#:button-text (if (null? path)
(G_ "Exit")
(G_ "Back"))
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index 4dbfe74bf9..6d9d65e8c5 100644
--- a/gnu/installer/services.scm
+++ b/gnu/installer/services.scm
@@ -20,7 +20,6 @@
(define-module (gnu installer services)
#:use-module (guix records)
#:use-module (srfi srfi-1)
- #:use-module (ice-9 match)
#:export (system-service?
system-service-name
system-service-type
@@ -37,7 +36,10 @@
system-service?
(name system-service-name) ;string
(type system-service-type) ;'desktop | 'networking
- (snippet system-service-snippet)) ;sexp
+ (snippet system-service-snippet ;list of sexps
+ (default '()))
+ (packages system-service-packages ;list of sexps
+ (default '())))
;; This is the list of desktop environments supported as services.
(define %system-services
@@ -51,26 +53,38 @@
(list
(desktop-environment
(name "GNOME")
- (snippet '(service gnome-desktop-service-type)))
+ (snippet '((service gnome-desktop-service-type))))
(desktop-environment
(name "Xfce")
- (snippet '(service xfce-desktop-service-type)))
+ (snippet '((service xfce-desktop-service-type))))
(desktop-environment
(name "MATE")
- (snippet '(service mate-desktop-service-type)))
+ (snippet '((service mate-desktop-service-type))))
(desktop-environment
(name "Enlightenment")
- (snippet '(service enlightenment-desktop-service-type)))
+ (snippet '((service enlightenment-desktop-service-type))))
+ (desktop-environment
+ (name "Openbox")
+ (packages '((specification->package "openbox"))))
+ (desktop-environment
+ (name "awesome")
+ (packages '((specification->package "awesome"))))
+ (desktop-environment
+ (name "i3")
+ (packages '((specification->package "i3-wm"))))
+ (desktop-environment
+ (name "ratpoison")
+ (packages '((specification->package "ratpoison"))))
;; Networking.
(system-service
(name (G_ "OpenSSH secure shell daemon (sshd)"))
(type 'networking)
- (snippet '(service openssh-service-type)))
+ (snippet '((service openssh-service-type))))
(system-service
(name (G_ "Tor anonymous network router"))
(type 'networking)
- (snippet '(service tor-service-type)))
+ (snippet '((service tor-service-type))))
;; Network connectivity management.
(system-service
@@ -86,7 +100,7 @@
(system-service
(name (G_ "DHCP client (dynamic IP address assignment)"))
(type 'network-management)
- (snippet '(service dhcp-client-service-type))))))
+ (snippet '((service dhcp-client-service-type)))))))
(define (desktop-system-service? service)
"Return true if SERVICE is a desktop environment service."
@@ -98,20 +112,21 @@
(define (system-services->configuration services)
"Return the configuration field for SERVICES."
- (let* ((snippets (append-map (lambda (service)
- (match (system-service-snippet service)
- ((and lst (('service _ ...) ...))
- lst)
- (sexp
- (list sexp))))
- services))
+ (let* ((snippets (append-map system-service-snippet services))
+ (packages (append-map system-service-packages services))
(desktop? (find desktop-system-service? services))
(base (if desktop?
'%desktop-services
'%base-services)))
(if (null? snippets)
- `((services ,base))
- `((services (append (list ,@snippets
+ `(,@(if (null? packages)
+ '()
+ `((packages (list ,@packages))))
+ (services ,base))
+ `(,@(if (null? packages)
+ '()
+ `((packages (list ,@packages))))
+ (services (append (list ,@snippets
,@(if desktop?
;; XXX: Assume 'keyboard-layout' is in
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index 1483cdc3db..039dd0ca10 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -113,16 +113,24 @@ return the accumalated result so far."
(define* (skip-to-step step result
#:key todo-steps done-steps)
- (match (list todo-steps done-steps)
- (((todo . rest-todo) (prev-done ... last-done))
- (if (eq? (installer-step-id todo)
- (installer-step-id step))
+ (match todo-steps
+ ((todo . rest-todo)
+ (let ((found? (eq? (installer-step-id todo)
+ (installer-step-id step))))
+ (cond
+ (found?
(run result
#:todo-steps todo-steps
- #:done-steps done-steps)
- (skip-to-step step (pop-result result)
- #:todo-steps (cons last-done todo-steps)
- #:done-steps prev-done)))))
+ #:done-steps done-steps))
+ ((and (not found?)
+ (null? done-steps))
+ (error (format #f "Step ~a not found" (installer-step-id step))))
+ (else
+ (match done-steps
+ ((prev-done ... last-done)
+ (skip-to-step step (pop-result result)
+ #:todo-steps (cons last-done todo-steps)
+ #:done-steps prev-done)))))))))
(define* (run result #:key todo-steps done-steps)
(match todo-steps
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index e91f90a84d..256722729c 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -54,9 +54,21 @@ number. If no percentage is found, return #f"
(and result
(string->number (match:substring result 1)))))
-(define (run-shell-command command)
+(define* (run-shell-command command #:key locale)
+ "Run COMMAND, a string, with Bash, and in the given LOCALE."
(call-with-temporary-output-file
(lambda (file port)
+ (when locale
+ (let ((supported? (false-if-exception
+ (setlocale LC_ALL locale))))
+ ;; If LOCALE is not supported, then set LANGUAGE, which might at
+ ;; least give us translated messages.
+ (if supported?
+ (format port "export LC_ALL=\"~a\"~%" locale)
+ (format port "export LANGUAGE=\"~a\"~%"
+ (string-take locale
+ (string-index locale #\_))))))
+
(format port "~a~%" command)
;; (format port "exit~%")
(close port)
generated by cgit v1.2.3 (git 2.44.0) at 2024-07-08 19:22:31 +0000