summaryrefslogtreecommitdiff
path: root/gnu/installer/newt
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer/newt')
-rw-r--r--gnu/installer/newt/final.scm28
-rw-r--r--gnu/installer/newt/keymap.scm45
-rw-r--r--gnu/installer/newt/locale.scm54
-rw-r--r--gnu/installer/newt/network.scm7
-rw-r--r--gnu/installer/newt/page.scm76
-rw-r--r--gnu/installer/newt/partition.scm36
-rw-r--r--gnu/installer/newt/services.scm80
-rw-r--r--gnu/installer/newt/timezone.scm5
-rw-r--r--gnu/installer/newt/user.scm99
-rw-r--r--gnu/installer/newt/welcome.scm8
-rw-r--r--gnu/installer/newt/wifi.scm3
11 files changed, 341 insertions, 100 deletions
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index 645c1e8689..e375282613 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/final.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.
;;;
@@ -29,15 +30,24 @@
#:use-module (newt)
#:export (run-final-page))
+(define* (strip-prefix file #:optional (prefix (%installer-target-dir)))
+ "Strip PREFIX from FILE, if PREFIX actually is a prefix of FILE."
+ (if (string-prefix? prefix file)
+ (string-drop file (string-length prefix))
+ file))
+
(define (run-config-display-page)
(let ((width (%configuration-file-width))
(height (nearest-exact-integer
(/ (screen-rows) 2))))
(run-file-textbox-page
- #:info-text (G_ "We're now ready to proceed with the installation! \
+ #:info-text (format #f (G_ "\
+We're now ready to proceed with the installation! \
A system configuration file has been generated, it is displayed below. \
+This file will be available as '~a' on the installed system. \
The new system will be created from this file once you've pressed OK. \
This will take a few minutes.")
+ (strip-prefix (%installer-configuration-file)))
#:title (G_ "Configuration file")
#:file (%installer-configuration-file)
#:info-textbox-width width
@@ -55,7 +65,10 @@ This will take a few minutes.")
(G_ "Reboot")
(G_ "Congratulations! Installation is now complete. \
You may remove the device containing the installation image and \
-press the button to reboot.")))
+press the button to reboot."))
+
+ ;; Return success so that the installer happily reboots.
+ 'success)
(define (run-install-failed-page)
(choice-window
@@ -65,22 +78,25 @@ 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
+ #:key (users '()))
(clear-screen)
(newt-suspend)
- (let ((install-ok? (install-system)))
+ (let ((install-ok? (install-system locale #:users users)))
(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))
+ (users (result-step result 'user))
(install-ok?
(with-mounted-partitions
user-partitions
(configuration->file configuration)
(run-config-display-page)
- (run-install-shell))))
+ (run-install-shell locale #:users users))))
(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 3e765bfdd4..2908ba7f0e 100644
--- a/gnu/installer/newt/keymap.scm
+++ b/gnu/installer/newt/keymap.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.
;;;
@@ -27,7 +28,10 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
- #:export (run-keymap-page))
+ #:use-module (ice-9 i18n)
+ #:use-module (ice-9 match)
+ #:export (run-keymap-page
+ keyboard-layout->configuration))
(define (run-layout-page layouts layout->text)
(let ((title (G_ "Layout")))
@@ -61,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."
@@ -94,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
@@ -108,15 +128,24 @@ 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)))
+
+(define (keyboard-layout->configuration keymap)
+ "Return the operating system configuration snippet to install KEYMAP."
+ (match keymap
+ ((name "")
+ `((keyboard-layout (keyboard-layout ,name))))
+ ((name variant)
+ `((keyboard-layout (keyboard-layout ,name ,variant))))))
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
index 4fa07df81e..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,17 +31,11 @@
#:export (run-locale-page))
(define (run-language-page languages language->text)
- (let ((title (G_ "Locale language")))
+ (define result
(run-listbox-selection-page
- #:title title
- #:info-text (G_ "Choose the locale's language to be used for the \
-installation process. A locale is a regional variant of your language \
-encompassing number, date and currency format, among other details.
-
-Based on the language you choose, you will possibly be asked to \
-select a locale's territory, codeset and modifier in the next \
-steps. The locale will also be used as the default one for the \
-installed system.")
+ #: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
#:listbox-items languages
#:listbox-item->text language->text
@@ -50,14 +45,19 @@ 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")))
(run-listbox-selection-page
#:title title
- #:info-text (G_ "Choose your locale's location. This is a shortlist of \
-locations based on the language you selected.")
+ #:info-text (G_ "Choose a territory for this language.")
#:listbox-items territories
#:listbox-item->text territory->text
#:button-text (G_ "Back")
@@ -71,8 +71,7 @@ locations based on the language you selected.")
(let ((title (G_ "Locale codeset")))
(run-listbox-selection-page
#:title title
- #:info-text (G_ "Choose your locale's codeset. If UTF-8 is available, \
- it should be preferred.")
+ #:info-text (G_ "Choose the locale encoding.")
#:listbox-items codesets
#:listbox-item->text identity
#:listbox-default-item "UTF-8"
@@ -163,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
@@ -177,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)
@@ -191,9 +197,11 @@ glibc locale string and return it."
;; narrow down the search of a locale.
(break-on-locale-found locales)
- ;; Otherwise, ask for a codeset.
- (run-codeset-page
- (delete-duplicates (map locale-codeset locales)))))))
+ ;; Otherwise, choose a codeset.
+ (let ((codesets (delete-duplicates (map locale-codeset locales))))
+ (if (member "UTF-8" codesets)
+ "UTF-8" ;don't even ask
+ (run-codeset-page codesets)))))))
(installer-step
(id 'modifier)
(compute
diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm
index f13176dc61..cf27a8cca2 100644
--- a/gnu/installer/newt/network.scm
+++ b/gnu/installer/newt/network.scm
@@ -59,7 +59,7 @@ Internet and return the selected technology. For now, only technologies with
(G_ "Internet access")
(G_ "Continue")
(G_ "Exit")
- (G_ "The install process requires an internet access, but no \
+ (G_ "The install process requires Internet access but no \
network device were found. Do you want to continue anyway?"))
((1) (raise
(condition
@@ -68,7 +68,7 @@ network device were found. Do you want to continue anyway?"))
(condition
(&installer-step-abort)))))
(run-listbox-selection-page
- #:info-text (G_ "The install process requires an internet access.\
+ #:info-text (G_ "The install process requires Internet access.\
Please select a network device.")
#:title (G_ "Internet access")
#:listbox-items items
@@ -93,7 +93,8 @@ network device were found. Do you want to continue anyway?"))
(full-value 5))
(run-scale-page
#:title (G_ "Powering technology")
- #:info-text (format #f "Waiting for technology ~a to be powered." name)
+ #:info-text (format #f (G_ "Waiting for technology ~a to be powered.")
+ name)
#:scale-full-value full-value
#:scale-update-proc
(lambda (value)
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 23fbfcce76..3173d54737 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.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.
;;;
@@ -20,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)
@@ -29,6 +31,7 @@
draw-connecting-page
run-input-page
run-error-page
+ run-confirmation-page
run-listbox-selection-page
run-scale-page
run-checkbox-tree-page
@@ -72,17 +75,20 @@ this page to TITLE."
#:key
(allow-empty-input? #f)
(default-text #f)
- (input-field-width 40))
+ (input-field-width 40)
+ (input-flags 0))
"Run a page to prompt user for an input. The given TEXT will be displayed
above the input field. The page title is set to TITLE. Unless
allow-empty-input? is set to #t, an error page will be displayed if the user
-enters an empty input."
+enters an empty input. INPUT-FLAGS is a bitwise-or'd set of flags for the
+input box, such as FLAG-PASSWORD."
(let* ((text-box
(make-reflowed-textbox -1 -1 text
input-field-width
#:flags FLAG-BORDER))
(grid (make-grid 1 3))
- (input-entry (make-entry -1 -1 20))
+ (input-entry (make-entry -1 -1 20
+ #:flags input-flags))
(ok-button (make-button -1 -1 (G_ "OK")))
(form (make-form)))
@@ -141,6 +147,42 @@ of the page is set to TITLE."
(newt-set-color COLORSET-ROOT "white" "blue")
(destroy-form-and-pop form)))
+(define* (run-confirmation-page text title
+ #:key (exit-button-procedure (const #f)))
+ "Run a page to inform the user of an error. The page contains the given TEXT
+to explain the error and an \"OK\" button to acknowledge the error. The title
+of the page is set to TITLE."
+ (let* ((text-box
+ (make-reflowed-textbox -1 -1 text 40
+ #:flags FLAG-BORDER))
+ (ok-button (make-button -1 -1 (G_ "Continue")))
+ (exit-button (make-button -1 -1 (G_ "Exit")))
+ (grid (vertically-stacked-grid
+ GRID-ELEMENT-COMPONENT text-box
+ GRID-ELEMENT-SUBGRID
+ (horizontal-stacked-grid
+ GRID-ELEMENT-COMPONENT ok-button
+ GRID-ELEMENT-COMPONENT exit-button)))
+ (form (make-form)))
+
+ (add-form-to-grid grid form #t)
+ (make-wrapped-grid-window grid title)
+
+ (receive (exit-reason argument)
+ (run-form form)
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (case exit-reason
+ ((exit-component)
+ (cond
+ ((components=? argument ok-button)
+ #t)
+ ((components=? argument exit-button)
+ (exit-button-procedure))))))
+ (lambda ()
+ (destroy-form-and-pop form))))))
+
(define* (run-listbox-selection-page #:key
info-text
title
@@ -185,7 +227,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.
@@ -211,7 +253,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)))
@@ -220,7 +262,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.
@@ -395,10 +437,14 @@ error is raised if the MAX-SCALE-UPDATE limit is reached."
(lambda ()
(destroy-form-and-pop form)))))
+(define %none-selected
+ (circular-list #f))
+
(define* (run-checkbox-tree-page #:key
info-text
title
items
+ (selection %none-selected)
item->text
(info-textbox-width 50)
(checkbox-tree-height 10)
@@ -411,7 +457,8 @@ a checkbox list. The page contains vertically stacked from the top to the
bottom, an informative text set to INFO-TEXT, the checkbox list and two
buttons, 'Ok' and 'Exit'. The page title's is set to TITLE. ITEMS are
converted to text using ITEM->TEXT before being displayed in the checkbox
-list.
+list. SELECTION is a list of Booleans of the same length as ITEMS that
+specifies which items are initially checked.
INFO-TEXTBOX-WIDTH is the width of the textbox where INFO-TEXT will be
displayed. CHECKBOX-TREE-HEIGHT is the height of the checkbox list.
@@ -423,12 +470,15 @@ pressed.
This procedure returns the list of checked items in the checkbox list among
ITEMS when 'Ok' is pressed."
(define (fill-checkbox-tree checkbox-tree items)
- (map
- (lambda (item)
- (let* ((item-text (item->text item))
- (key (add-entry-to-checkboxtree checkbox-tree item-text 0)))
- (cons key item)))
- items))
+ (map (lambda (item selected?)
+ (let* ((item-text (item->text item))
+ (key (add-entry-to-checkboxtree checkbox-tree item-text
+ (if selected?
+ FLAG-SELECTED
+ 0))))
+ (cons key item)))
+ items
+ selection))
(let* ((checkbox-tree
(make-checkboxtree -1 -1
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index d4c91edc66..2b22ac85b4 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.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.
;;;
@@ -41,8 +42,8 @@
(define (run-scheme-page)
"Run a page asking the user for a partitioning scheme."
(let* ((items
- '((root . "Everything is one partition")
- (root-home . "Separate /home partition")))
+ `((root . ,(G_ "Everything is one partition"))
+ (root-home . ,(G_ "Separate /home partition"))))
(result (run-listbox-selection-page
#:info-text (G_ "Please select a partitioning scheme.")
#:title (G_ "Partition scheme")
@@ -53,7 +54,12 @@
(car result)))
(define (draw-formatting-page)
- "Draw a page to indicate partitions are being formated."
+ "Draw a page asking for confirmation, and then indicating that partitions
+are being formatted."
+ (run-confirmation-page (G_ "We are about to format your hard disk. All \
+its data will be lost. Do you wish to continue?")
+ (G_ "Format disk?")
+ #:exit-button-procedure button-exit-action)
(draw-info-page
(format #f (G_ "Partition formatting is in progress, please wait."))
(G_ "Preparing partitions")))
@@ -146,6 +152,10 @@ USER-PARTITIONS list. Return this list with password fields filled-in."
(file-name (user-partition-file-name user-part))
(password-page
(lambda ()
+ ;; Note: Don't use FLAG-PASSWORD here because this is the
+ ;; first bit of text that the user types in, so it's
+ ;; probably safer if they can see that the keyboard layout
+ ;; they chose is in effect.
(run-input-page
(format #f (G_ "Please enter the password for the \
encryption of partition ~a (label: ~a).") file-name crypt-label)
@@ -155,7 +165,8 @@ encryption of partition ~a (label: ~a).") file-name crypt-label)
(run-input-page
(format #f (G_ "Please confirm the password for the \
encryption of partition ~a (label: ~a).") file-name crypt-label)
- (G_ "Password confirmation required")))))
+ (G_ "Password confirmation required")
+ #:input-flags FLAG-PASSWORD))))
(if crypt-label
(let loop ()
(let ((password (password-page))
@@ -418,10 +429,10 @@ partition. Leave this field empty if you don't want to set a mounting point.")
(run-listbox-selection-page
#:info-text
(if creation?
- (G_ (format #f "Creating ~a partition starting at ~a of ~a."
- type-str start file-name))
- (G_ (format #f "You are currently editing partition ~a."
- number-str)))
+ (format #f (G_ "Creating ~a partition starting at ~a of ~a.")
+ type-str start file-name)
+ (format #f (G_ "You are currently editing partition ~a.")
+ number-str))
#:title (if creation?
(G_ "Partition creation")
(G_ "Partition edit"))
@@ -662,7 +673,8 @@ by pressing the Exit button.~%~%")))
#:title (if guided?
(G_ "Guided partitioning")
(G_ "Manual partitioning"))
- #:info-textbox-width 70
+ #:info-textbox-width 76 ;we need a lot of room for INFO-TEXT
+ #:listbox-height 12
#:listbox-items (disk-items)
#:listbox-item->text cdr
#:sort-listbox-items? #f
@@ -713,9 +725,9 @@ by pressing the Exit button.~%~%")))
"Run a page asking the user for a partitioning method."
(define (run-page devices)
(let* ((items
- '((entire . "Guided - using the entire disk")
- (entire-encrypted . "Guided - using the entire disk with encryption")
- (manual . "Manual")))
+ `((entire . ,(G_ "Guided - using the entire disk"))
+ (entire-encrypted . ,(G_ "Guided - using the entire disk with encryption"))
+ (manual . ,(G_ "Manual"))))
(result (run-listbox-selection-page
#:info-text (G_ "Please select a partitioning method.")
#:title (G_ "Partitioning method")
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
index 6bcb6244ae..4f32d9077b 100644
--- a/gnu/installer/newt/services.scm
+++ b/gnu/installer/newt/services.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,19 +31,70 @@
(define (run-desktop-environments-cbt-page)
"Run a page allowing the user to choose between various desktop
environments."
- (run-checkbox-tree-page
- #:info-text (G_ "Please select the desktop(s) environment(s) you wish to \
-install. If you select multiple desktops environments, we will be able to \
-choose the one to use on the log-in screen with F1.")
- #:title (G_ "Desktop environment")
- #:items %desktop-environments
- #:item->text desktop-environment-name
- #:checkbox-tree-height 5
- #:exit-button-callback-procedure
- (lambda ()
- (raise
- (condition
- (&installer-step-abort))))))
+ (let ((items (filter desktop-system-service? %system-services)))
+ (run-checkbox-tree-page
+ #:info-text (G_ "Please select the desktop(s) environment(s) you wish to \
+install. If you select multiple desktops environments, you will be able to \
+choose the one to use on the log-in screen.")
+ #:title (G_ "Desktop environment")
+ #:items items
+ #:selection (map system-service-recommended? items)
+ #:item->text system-service-name ;no i18n for DE names
+ #:checkbox-tree-height 8
+ #:exit-button-callback-procedure
+ (lambda ()
+ (raise
+ (condition
+ (&installer-step-abort)))))))
+
+(define (run-networking-cbt-page)
+ "Run a page allowing the user to select networking services."
+ (let ((items (filter (lambda (service)
+ (eq? 'networking (system-service-type service)))
+ %system-services)))
+ (run-checkbox-tree-page
+ #:info-text (G_ "You can now select networking services to run on your \
+system.")
+ #:title (G_ "Network service")
+ #:items items
+ #:selection (map system-service-recommended? items)
+ #:item->text (compose G_ system-service-name)
+ #:checkbox-tree-height 5
+ #:exit-button-callback-procedure
+ (lambda ()
+ (raise
+ (condition
+ (&installer-step-abort)))))))
+
+(define (run-network-management-page)
+ "Run a page to select among several network management methods."
+ (let ((title (G_ "Network management")))
+ (run-listbox-selection-page
+ #:title title
+ #:info-text (G_ "Choose the method to manage network connections.
+
+We recommend NetworkManager or Connman for a WiFi-capable laptop; the DHCP \
+client may be enough for a server.")
+ #:info-textbox-width 70
+ #:listbox-items (filter (lambda (service)
+ (eq? 'network-management
+ (system-service-type service)))
+ %system-services)
+ #:listbox-item->text (compose G_ system-service-name)
+ #:sort-listbox-items? #f
+ #:button-text (G_ "Exit")
+ #:button-callback-procedure
+ (lambda _
+ (raise
+ (condition
+ (&installer-step-abort)))))))
(define (run-services-page)
- (run-desktop-environments-cbt-page))
+ (let ((desktop (run-desktop-environments-cbt-page)))
+ ;; When the user did not select any desktop services, and thus didn't get
+ ;; '%desktop-services', offer network management services.
+ (append desktop
+ (run-networking-cbt-page)
+ (if (null? desktop)
+ (list (run-network-management-page))
+ '()))))
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/newt/user.scm b/gnu/installer/newt/user.scm
index 59b1913cfc..deab056e0c 100644
--- a/gnu/installer/newt/user.scm
+++ b/gnu/installer/newt/user.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.
;;;
@@ -28,18 +29,31 @@
#:use-module (srfi srfi-26)
#:export (run-user-page))
-(define (run-user-add-page)
+(define* (run-user-add-page #:key (name "") (real-name "")
+ (home-directory ""))
+ "Run a form to enter the user name, home directory, and password. Use NAME,
+REAL-NAME, and HOME-DIRECTORY as the initial values in the form."
(define (pad-label label)
(string-pad-right label 20))
(let* ((label-name
(make-label -1 -1 (pad-label (G_ "Name"))))
+ (label-real-name
+ (make-label -1 -1 (pad-label (G_ "Real name"))))
(label-home-directory
(make-label -1 -1 (pad-label (G_ "Home directory"))))
+ (label-password
+ (make-label -1 -1 (pad-label (G_ "Password"))))
(entry-width 30)
- (entry-name (make-entry -1 -1 entry-width))
- (entry-home-directory (make-entry -1 -1 entry-width))
- (entry-grid (make-grid 2 2))
+ (entry-name (make-entry -1 -1 entry-width
+ #:initial-value name))
+ (entry-real-name (make-entry -1 -1 entry-width
+ #:initial-value real-name))
+ (entry-home-directory (make-entry -1 -1 entry-width
+ #:initial-value home-directory))
+ (entry-password (make-entry -1 -1 entry-width
+ #:flags FLAG-PASSWORD))
+ (entry-grid (make-grid 2 5))
(button-grid (make-grid 1 1))
(ok-button (make-button -1 -1 (G_ "OK")))
(grid (make-grid 1 2))
@@ -50,8 +64,12 @@
(set-entry-grid-field 0 0 label-name)
(set-entry-grid-field 1 0 entry-name)
- (set-entry-grid-field 0 1 label-home-directory)
- (set-entry-grid-field 1 1 entry-home-directory)
+ (set-entry-grid-field 0 1 label-real-name)
+ (set-entry-grid-field 1 1 entry-real-name)
+ (set-entry-grid-field 0 2 label-home-directory)
+ (set-entry-grid-field 1 2 entry-home-directory)
+ (set-entry-grid-field 0 3 label-password)
+ (set-entry-grid-field 1 3 entry-password)
(set-grid-field button-grid 0 0 GRID-ELEMENT-COMPONENT ok-button)
@@ -59,11 +77,17 @@
entry-name
(lambda (component)
(set-entry-text entry-home-directory
- (string-append "/home/" (entry-value entry-name)))))
+ (string-append "/home/" (entry-value entry-name)))
+
+ (when (string-null? (entry-value entry-real-name))
+ (set-entry-text entry-real-name
+ (string-titlecase (entry-value entry-name))))))
(add-components-to-form form
- label-name label-home-directory
- entry-name entry-home-directory
+ label-name label-real-name
+ label-home-directory label-password
+ entry-name entry-real-name
+ entry-home-directory entry-password
ok-button)
(make-wrapped-grid-window (vertically-stacked-grid
@@ -82,19 +106,57 @@
(when (eq? exit-reason 'exit-component)
(cond
((components=? argument ok-button)
- (let ((name (entry-value entry-name))
- (home-directory (entry-value entry-home-directory)))
+ (let ((name (entry-value entry-name))
+ (real-name (entry-value entry-real-name))
+ (home-directory (entry-value entry-home-directory))
+ (password (entry-value entry-password)))
(if (or (string=? name "")
(string=? home-directory ""))
(begin
(error-page)
(run-user-add-page))
- (user
- (name name)
- (home-directory home-directory))))))))
+ (let ((password (confirm-password password)))
+ (if password
+ (user
+ (name name)
+ (real-name real-name)
+ (home-directory home-directory)
+ (password password))
+ (run-user-add-page #:name name
+ #:real-name real-name
+ #:home-directory
+ home-directory)))))))))
(lambda ()
(destroy-form-and-pop form)))))))
+(define* (confirm-password password #:optional (try-again (const #f)))
+ "Ask the user to confirm PASSWORD, a possibly empty string. Call TRY-AGAIN,
+a thunk, if the confirmation doesn't match PASSWORD, and return its result."
+ (define confirmation
+ (run-input-page (G_ "Please confirm the password.")
+ (G_ "Password confirmation required")
+ #:allow-empty-input? #t
+ #:input-flags FLAG-PASSWORD))
+
+ (if (string=? password confirmation)
+ password
+ (begin
+ (run-error-page
+ (G_ "Password mismatch, please try again.")
+ (G_ "Password error"))
+ (try-again))))
+
+(define (run-root-password-page)
+ ;; TRANSLATORS: Leave "root" untranslated: it refers to the name of the
+ ;; system administrator account.
+ (define password
+ (run-input-page (G_ "Please choose a password for the system \
+administrator (\"root\").")
+ (G_ "System administrator password")
+ #:input-flags FLAG-PASSWORD))
+
+ (confirm-password password run-root-password-page))
+
(define (run-user-page)
(define (run users)
(let* ((listbox (make-listbox
@@ -169,7 +231,12 @@
(run-error-page (G_ "Please create at least one user.")
(G_ "No user"))
(run users))
- users))))
+ (reverse users)))))
(lambda ()
(destroy-form-and-pop form))))))
- (run '()))
+
+ ;; Add a "root" user simply to convey the root password.
+ (cons (user (name "root")
+ (home-directory "/root")
+ (password (run-root-password-page)))
+ (run '())))
diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm
index b0b5429c0f..aec3e7a612 100644
--- a/gnu/installer/newt/welcome.scm
+++ b/gnu/installer/newt/welcome.scm
@@ -95,9 +95,11 @@ installation and reboot."
(G_ "GNU Guix install")
(G_ "Welcome to GNU Guix system installer!
-Please note that the present graphical installer is still under heavy \
-development, so you might want to prefer using the shell based process. \
-The documentation is accessible at any time by pressing CTRL-ALT-F2.")
+You will be guided through a graphical installation program.
+
+If you are familiar with GNU/Linux and you want tight control over \
+the installation process, you can instead choose manual installation. \
+Documentation is accessible at any time by pressing Ctrl-Alt-F2.")
logo
#:listbox-items
`((,(G_ "Graphical install using a terminal based interface")
diff --git a/gnu/installer/newt/wifi.scm b/gnu/installer/newt/wifi.scm
index 4cf5c128e7..da2f0b56d0 100644
--- a/gnu/installer/newt/wifi.scm
+++ b/gnu/installer/newt/wifi.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Meiyo Peng <meiyo@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -80,7 +81,7 @@ nmc_wifi_strength_bars."
(message (G_ "Unable to find a wifi technology"))))))))
(define (draw-scanning-page)
- "Draw a page to indicate a wifi scan in in progress."
+ "Draw a page to indicate a wifi scan in progress."
(draw-info-page (G_ "Scanning wifi for available networks, please wait.")
(G_ "Scan in progress")))