diff options
Diffstat (limited to 'gnu/installer/newt')
| -rw-r--r-- | gnu/installer/newt/final.scm | 28 | ||||
| -rw-r--r-- | gnu/installer/newt/keymap.scm | 45 | ||||
| -rw-r--r-- | gnu/installer/newt/locale.scm | 54 | ||||
| -rw-r--r-- | gnu/installer/newt/network.scm | 7 | ||||
| -rw-r--r-- | gnu/installer/newt/page.scm | 76 | ||||
| -rw-r--r-- | gnu/installer/newt/partition.scm | 36 | ||||
| -rw-r--r-- | gnu/installer/newt/services.scm | 80 | ||||
| -rw-r--r-- | gnu/installer/newt/timezone.scm | 5 | ||||
| -rw-r--r-- | gnu/installer/newt/user.scm | 99 | ||||
| -rw-r--r-- | gnu/installer/newt/welcome.scm | 8 | ||||
| -rw-r--r-- | gnu/installer/newt/wifi.scm | 3 |
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"))) |