diff options
Diffstat (limited to 'gnu/installer')
| -rw-r--r-- | gnu/installer/final.scm | 8 | ||||
| -rw-r--r-- | gnu/installer/keymap.scm | 8 | ||||
| -rw-r--r-- | gnu/installer/newt/final.scm | 9 | ||||
| -rw-r--r-- | gnu/installer/newt/keymap.scm | 32 | ||||
| -rw-r--r-- | gnu/installer/newt/locale.scm | 30 | ||||
| -rw-r--r-- | gnu/installer/newt/page.scm | 7 | ||||
| -rw-r--r-- | gnu/installer/newt/timezone.scm | 5 | ||||
| -rw-r--r-- | gnu/installer/services.scm | 51 | ||||
| -rw-r--r-- | gnu/installer/steps.scm | 26 | ||||
| -rw-r--r-- | gnu/installer/utils.scm | 14 |
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) |