From d0f3a672dcbdfefd3556b6a21985ff0e35eed3be Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Fri, 16 Nov 2018 20:43:55 +0900 Subject: gnu: Add graphical installer support. * configure.ac: Require that guile-newt is available. * gnu/installer.scm: New file. * gnu/installer/aux-files/logo.txt: New file. * gnu/installer/build-installer.scm: New file. * gnu/installer/connman.scm: New file. * gnu/installer/keymap.scm: New file. * gnu/installer/locale.scm: New file. * gnu/installer/newt.scm: New file. * gnu/installer/newt/ethernet.scm: New file. * gnu/installer/newt/hostname.scm: New file. * gnu/installer/newt/keymap.scm: New file. * gnu/installer/newt/locale.scm: New file. * gnu/installer/newt/menu.scm: New file. * gnu/installer/newt/network.scm: New file. * gnu/installer/newt/page.scm: New file. * gnu/installer/newt/timezone.scm: New file. * gnu/installer/newt/user.scm: New file. * gnu/installer/newt/utils.scm: New file. * gnu/installer/newt/welcome.scm: New file. * gnu/installer/newt/wifi.scm: New file. * gnu/installer/steps.scm: New file. * gnu/installer/timezone.scm: New file. * gnu/installer/utils.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add previous files. * gnu/system.scm: Export %root-account. * gnu/system/install.scm (%installation-services): Use kmscon instead of linux VT for all tty. (installation-os)[users]: Add the graphical installer as shell of the root account. [packages]: Add font related packages. * po/guix/POTFILES.in: Add installer files. --- gnu/installer/newt/keymap.scm | 132 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 132 insertions(+) create mode 100644 gnu/installer/newt/keymap.scm (limited to 'gnu/installer/newt/keymap.scm') diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm new file mode 100644 index 0000000000..219ac3f8e2 --- /dev/null +++ b/gnu/installer/newt/keymap.scm @@ -0,0 +1,132 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu installer newt keymap) + #:use-module (gnu installer keymap) + #:use-module (gnu installer steps) + #:use-module (gnu installer newt page) + #:use-module (guix i18n) + #:use-module (guix records) + #:use-module (newt) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:export (run-keymap-page)) + +(define (run-layout-page layouts layout->text) + (let ((title (G_ "Layout selection"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Please choose your keyboard layout.") + #:listbox-items layouts + #:listbox-item->text layout->text + #:button-text (G_ "Cancel") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort))))))) + +(define (run-variant-page variants variant->text) + (let ((title (G_ "Variant selection"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Please choose a variant for your keyboard layout.") + #:listbox-items variants + #:listbox-item->text variant->text + #:button-text (G_ "Back") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort))))))) + +(define (run-model-page models model->text) + (let ((title (G_ "Keyboard model selection"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Please choose your keyboard model.") + #:listbox-items models + #:listbox-item->text model->text + #:listbox-default-item (find (lambda (model) + (string=? (x11-keymap-model-name model) + "pc105")) + models) + #:sort-listbox-items? #f + #:button-text (G_ "Back") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort))))))) + +(define* (run-keymap-page #:key models layouts) + "Run a page asking the user to select a keyboard model, layout and +variant. MODELS and LAYOUTS are lists of supported X11-KEYMAP-MODEL and +X11-KEYMAP-LAYOUT. Return a list of three elements, the names of the selected +keyboard model, layout and variant." + (define keymap-steps + (list + (installer-step + (id 'model) + (compute + (lambda _ + ;; TODO: Understand why (run-model-page models x11-keymap-model-name) + ;; fails with: warning: possibly unbound variable + ;; `%x11-keymap-model-description-procedure. + (run-model-page models (lambda (model) + (x11-keymap-model-description + model)))))) + (installer-step + (id 'layout) + (compute + (lambda _ + (let* ((layout (run-layout-page + layouts + (lambda (layout) + (x11-keymap-layout-description layout))))) + (if (null? (x11-keymap-layout-variants layout)) + ;; Break if this layout does not have any variant. + (raise + (condition + (&installer-step-break))) + layout))))) + ;; Propose the user to select a variant among those supported by the + ;; previously selected layout. + (installer-step + (id 'variant) + (compute + (lambda (result) + (let ((variants (x11-keymap-layout-variants + (result-step result 'layout)))) + (run-variant-page variants + (lambda (variant) + (x11-keymap-variant-description + variant))))))))) + + (define (format-result result) + (let ((model (x11-keymap-model-name + (result-step result 'model))) + (layout (x11-keymap-layout-name + (result-step result 'layout))) + (variant (and=> (result-step result 'variant) + (lambda (variant) + (x11-keymap-variant-name variant))))) + (list model layout (or variant "")))) + (format-result + (run-installer-steps #:steps keymap-steps))) -- cgit 1.4.1 From 5cdb6bd2db0b465fa616a9fd36760b14844d5c48 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Wed, 5 Dec 2018 14:19:28 +0900 Subject: installer: Remove "selection" from all titles. * gnu/installer/newt/hostname.scm (run-hostname-page): Remove selection from page title, (run-variant-page): ditto. * gnu/installer/newt/keymap.scm (run-layout-page): Ditto. * gnu/installer/newt/locale.scm (run-layout-page): Ditto, (run-territory-page): ditto, (run-codeset-page): ditto, (run-modifier-page): ditto * gnu/installer/newt/network.scm (run-territory-page): Ditto. * gnu/installer/newt/timezone.scm (run-timezone-page): Ditto. * gnu/installer/newt/wifi.scm (run-wifi-page): Ditto. --- gnu/installer/newt/hostname.scm | 2 +- gnu/installer/newt/keymap.scm | 4 ++-- gnu/installer/newt/locale.scm | 8 ++++---- gnu/installer/newt/network.scm | 2 +- gnu/installer/newt/timezone.scm | 2 +- gnu/installer/newt/wifi.scm | 2 +- 6 files changed, 10 insertions(+), 10 deletions(-) (limited to 'gnu/installer/newt/keymap.scm') diff --git a/gnu/installer/newt/hostname.scm b/gnu/installer/newt/hostname.scm index acbee64a6a..a8209bc2de 100644 --- a/gnu/installer/newt/hostname.scm +++ b/gnu/installer/newt/hostname.scm @@ -23,4 +23,4 @@ (define (run-hostname-page) (run-input-page (G_ "Please enter the system hostname") - (G_ "Hostname selection"))) + (G_ "Hostname"))) diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm index 219ac3f8e2..0c9432bba2 100644 --- a/gnu/installer/newt/keymap.scm +++ b/gnu/installer/newt/keymap.scm @@ -29,7 +29,7 @@ #:export (run-keymap-page)) (define (run-layout-page layouts layout->text) - (let ((title (G_ "Layout selection"))) + (let ((title (G_ "Layout"))) (run-listbox-selection-page #:title title #:info-text (G_ "Please choose your keyboard layout.") @@ -43,7 +43,7 @@ (&installer-step-abort))))))) (define (run-variant-page variants variant->text) - (let ((title (G_ "Variant selection"))) + (let ((title (G_ "Variant"))) (run-listbox-selection-page #:title title #:info-text (G_ "Please choose a variant for your keyboard layout.") diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm index 5444a07598..599a6b0ecf 100644 --- a/gnu/installer/newt/locale.scm +++ b/gnu/installer/newt/locale.scm @@ -30,7 +30,7 @@ #:export (run-locale-page)) (define (run-language-page languages language->text) - (let ((title (G_ "Language selection"))) + (let ((title (G_ "Language"))) (run-listbox-selection-page #:title title #:info-text (G_ "Choose the language to be used for the installation \ @@ -46,7 +46,7 @@ language for the installed system.") (&installer-step-abort))))))) (define (run-territory-page territories territory->text) - (let ((title (G_ "Location selection"))) + (let ((title (G_ "Location"))) (run-listbox-selection-page #:title title #:info-text (G_ "Choose your location. This is a shortlist of locations \ @@ -61,7 +61,7 @@ based on the language you selected.") (&installer-step-abort))))))) (define (run-codeset-page codesets) - (let ((title (G_ "Codeset selection"))) + (let ((title (G_ "Codeset"))) (run-listbox-selection-page #:title title #:info-text (G_ "Choose your codeset. If UTF-8 is available, it should be \ @@ -77,7 +77,7 @@ preferred.") (&installer-step-abort))))))) (define (run-modifier-page modifiers modifier->text) - (let ((title (G_ "Modifier selection"))) + (let ((title (G_ "Modifier"))) (run-listbox-selection-page #:title title #:info-text (G_ "Choose your modifier.") diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm index c6ba69d4e8..45989ac2ac 100644 --- a/gnu/installer/newt/network.scm +++ b/gnu/installer/newt/network.scm @@ -56,7 +56,7 @@ Internet and return the selected technology. For now, only technologies with (run-listbox-selection-page #:info-text (G_ "The install process requires an internet access.\ Please select a network technology.") - #:title (G_ "Technology selection") + #:title (G_ "Internet access") #:listbox-items (technology-items) #:listbox-item->text technology->text #:button-text (G_ "Cancel") diff --git a/gnu/installer/newt/timezone.scm b/gnu/installer/newt/timezone.scm index a2c9b458f5..874f4a0734 100644 --- a/gnu/installer/newt/timezone.scm +++ b/gnu/installer/newt/timezone.scm @@ -55,7 +55,7 @@ returned." (define (loop path) (let ((timezones (locate-childrens timezone-tree path))) (run-listbox-selection-page - #:title (G_ "Timezone selection") + #:title (G_ "Timezone") #:info-text (G_ "Please select a timezone.") #:listbox-items timezones #:listbox-item->text identity diff --git a/gnu/installer/newt/wifi.scm b/gnu/installer/newt/wifi.scm index 6cac54399a..de443345f6 100644 --- a/gnu/installer/newt/wifi.scm +++ b/gnu/installer/newt/wifi.scm @@ -219,7 +219,7 @@ force a wifi scan." cancel-button) (make-wrapped-grid-window (basic-window-grid info-textbox middle-grid buttons-grid) - (G_ "Wifi selection")) + (G_ "Wifi")) (receive (exit-reason argument) (run-form form) -- cgit 1.4.1 From c088b2e47f6675199f1ef545df7d04d4532e64e3 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Wed, 5 Dec 2018 14:36:22 +0900 Subject: installer: Do not ask for keyboard model. Suppose that the keyboard model is "pc105". * gnu/installer.scm (apply-keymap): Remove model ... * gnu/installer/newt/keymap.scm (run-keymap-page): passed here. (run-model-page): remove procedure * gnu/installer/record.scm (installer): Edit keymap-page prototype in comment. * gnu/installer/keymap.scm (default-keyboard-model): New exported parameter. --- gnu/installer.scm | 10 +++++----- gnu/installer/keymap.scm | 4 ++++ gnu/installer/newt.scm | 5 ++--- gnu/installer/newt/keymap.scm | 44 ++++++------------------------------------- gnu/installer/newt/locale.scm | 6 +++--- gnu/installer/record.scm | 2 +- 6 files changed, 21 insertions(+), 50 deletions(-) (limited to 'gnu/installer/newt/keymap.scm') diff --git a/gnu/installer.scm b/gnu/installer.scm index e53acb12f4..4a587eb35b 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -133,10 +133,11 @@ been performed at build time." result)))) (define apply-keymap - ;; Apply the specified keymap. + ;; Apply the specified keymap. Use the default keyboard model. #~(match-lambda - ((model layout variant) - (kmscon-update-keymap model layout variant)))) + ((layout variant) + (kmscon-update-keymap (default-keyboard-model) + layout variant)))) (define* (compute-keymap-step) "Return a gexp that runs the keymap-page of INSTALLER and install the @@ -150,8 +151,7 @@ selected keymap." "/share/X11/xkb/rules/base.xml"))) (lambda (models layouts) ((installer-keymap-page current-installer) - #:models models - #:layouts layouts))))) + layouts))))) (#$apply-keymap result)))) (define (installer-steps) diff --git a/gnu/installer/keymap.scm b/gnu/installer/keymap.scm index 78065aa6c6..d9f8656855 100644 --- a/gnu/installer/keymap.scm +++ b/gnu/installer/keymap.scm @@ -46,6 +46,7 @@ x11-keymap-variant-name x11-keymap-variant-description + default-keyboard-model xkb-rules->models+layouts kmscon-update-keymap)) @@ -68,6 +69,9 @@ (name x11-keymap-variant-name) ;string (description x11-keymap-variant-description)) ;string +;; Assume all modern keyboards have this model. +(define default-keyboard-model (make-parameter "pc105")) + (define (xkb-rules->models+layouts file) "Parse FILE and return two values, the list of supported X11-KEYMAP-MODEL and X11-KEYMAP-LAYOUT records. FILE is an XML file from the X Keyboard diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm index 77a7e6dca2..1f51b111a8 100644 --- a/gnu/installer/newt.scm +++ b/gnu/installer/newt.scm @@ -68,9 +68,8 @@ (define (menu-page steps) (run-menu-page steps)) -(define* (keymap-page #:key models layouts) - (run-keymap-page #:models models - #:layouts layouts)) +(define* (keymap-page layouts) + (run-keymap-page layouts)) (define (network-page) (run-network-page)) diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm index 0c9432bba2..0c38a79e19 100644 --- a/gnu/installer/newt/keymap.scm +++ b/gnu/installer/newt/keymap.scm @@ -56,42 +56,12 @@ (condition (&installer-step-abort))))))) -(define (run-model-page models model->text) - (let ((title (G_ "Keyboard model selection"))) - (run-listbox-selection-page - #:title title - #:info-text (G_ "Please choose your keyboard model.") - #:listbox-items models - #:listbox-item->text model->text - #:listbox-default-item (find (lambda (model) - (string=? (x11-keymap-model-name model) - "pc105")) - models) - #:sort-listbox-items? #f - #:button-text (G_ "Back") - #:button-callback-procedure - (lambda _ - (raise - (condition - (&installer-step-abort))))))) - -(define* (run-keymap-page #:key models layouts) - "Run a page asking the user to select a keyboard model, layout and -variant. MODELS and LAYOUTS are lists of supported X11-KEYMAP-MODEL and -X11-KEYMAP-LAYOUT. Return a list of three elements, the names of the selected -keyboard model, layout and variant." +(define* (run-keymap-page layouts) + "Run a page asking the user to select a keyboard layout and variant. LAYOUTS +is a list of supported X11-KEYMAP-LAYOUT. Return a list of two elements, the +names of the selected keyboard layout and variant." (define keymap-steps (list - (installer-step - (id 'model) - (compute - (lambda _ - ;; TODO: Understand why (run-model-page models x11-keymap-model-name) - ;; fails with: warning: possibly unbound variable - ;; `%x11-keymap-model-description-procedure. - (run-model-page models (lambda (model) - (x11-keymap-model-description - model)))))) (installer-step (id 'layout) (compute @@ -120,13 +90,11 @@ keyboard model, layout and variant." variant))))))))) (define (format-result result) - (let ((model (x11-keymap-model-name - (result-step result 'model))) - (layout (x11-keymap-layout-name + (let ((layout (x11-keymap-layout-name (result-step result 'layout))) (variant (and=> (result-step result 'variant) (lambda (variant) (x11-keymap-variant-name variant))))) - (list model layout (or variant "")))) + (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 599a6b0ecf..028372c194 100644 --- a/gnu/installer/newt/locale.scm +++ b/gnu/installer/newt/locale.scm @@ -143,7 +143,7 @@ glibc locale string and return it." (installer-step (id 'territory) (compute - (lambda (result) + (lambda (result _) (let ((locales (filter-locales supported-locales result))) ;; Stop the process if the language returned by the previous step ;; is matching one and only one supported locale. @@ -161,7 +161,7 @@ glibc locale string and return it." (installer-step (id 'codeset) (compute - (lambda (result) + (lambda (result _) (let ((locales (filter-locales supported-locales result))) ;; Same as above but we now have a language and a territory to ;; narrow down the search of a locale. @@ -173,7 +173,7 @@ glibc locale string and return it." (installer-step (id 'modifier) (compute - (lambda (result) + (lambda (result _) (let ((locales (filter-locales supported-locales result))) ;; Same thing with a language, a territory and a codeset this time. (break-on-locale-found locales) diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm index bf74040699..ba7625e65a 100644 --- a/gnu/installer/record.scm +++ b/gnu/installer/record.scm @@ -57,9 +57,9 @@ (exit installer-exit) ;; procedure (key arguments) -> void (exit-error installer-exit-error) - ;; procedure (#:key models layouts) -> (list model layout variant) ;; procedure void -> void (final-page installer-final-page) + ;; procedure (layouts) -> (list layout variant) (keymap-page installer-keymap-page) ;; procedure: (#:key supported-locales iso639-languages iso3166-territories) ;; -> glibc-locale -- cgit 1.4.1 From 54754efc91e4862f5a904d53a82fcc59e19646a2 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Wed, 5 Dec 2018 17:48:36 +0900 Subject: installer: Fix compute calls. * gnu/installer/newt/keymap.scm (run-keymap-page): Add missing argument to compute procedure. * gnu/installer/newt/network.scm (run-network-page): Ditto. --- gnu/installer/newt/keymap.scm | 2 +- gnu/installer/newt/network.scm | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'gnu/installer/newt/keymap.scm') diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm index 0c38a79e19..4bdae51340 100644 --- a/gnu/installer/newt/keymap.scm +++ b/gnu/installer/newt/keymap.scm @@ -81,7 +81,7 @@ names of the selected keyboard layout and variant." (installer-step (id 'variant) (compute - (lambda (result) + (lambda (result _) (let ((variants (x11-keymap-layout-variants (result-step result 'layout)))) (run-variant-page variants diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm index 45989ac2ac..4912959147 100644 --- a/gnu/installer/newt/network.scm +++ b/gnu/installer/newt/network.scm @@ -131,7 +131,7 @@ Internet." (installer-step (id 'power-technology) (compute - (lambda (result) + (lambda (result _) (let ((technology (result-step result 'select-technology))) (connman-enable-technology technology) (wait-technology-powered technology))))) @@ -140,7 +140,7 @@ Internet." (installer-step (id 'connect-service) (compute - (lambda (result) + (lambda (result _) (let* ((technology (result-step result 'select-technology)) (type (technology-type technology))) (cond -- cgit 1.4.1 From 7d812901daf0259d5d381199168d6d2994ce00ac Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Wed, 5 Dec 2018 19:50:17 +0900 Subject: installer: Turn "Cancel" buttons into "Exit" buttons. This change and previous ones were, Suggested-by: Thorsten Wilms here: https://lists.gnu.org/archive/html/guix-devel/2018-11/msg00330.html gnu/installer/newt/ethernet.scm: Turn cancel into exit. gnu/installer/newt/final.scm: Ditto. gnu/installer/newt/keymap.scm: Ditto. gnu/installer/newt/locale.scm: Ditto. gnu/installer/newt/network.scm: Ditto. gnu/installer/newt/page.scm: Ditto. gnu/installer/newt/partition.scm: Ditto. gnu/installer/newt/services.scm: Ditto. gnu/installer/newt/timezone.scm: Ditto. gnu/installer/newt/user.scm: Ditto. gnu/installer/newt/wifi.scm: Ditto. --- gnu/installer/newt/ethernet.scm | 2 +- gnu/installer/newt/final.scm | 2 +- gnu/installer/newt/keymap.scm | 2 +- gnu/installer/newt/locale.scm | 2 +- gnu/installer/newt/network.scm | 2 +- gnu/installer/newt/page.scm | 24 ++++++++++++------------ gnu/installer/newt/partition.scm | 34 +++++++++++++++++----------------- gnu/installer/newt/services.scm | 2 +- gnu/installer/newt/timezone.scm | 2 +- gnu/installer/newt/user.scm | 4 ++-- gnu/installer/newt/wifi.scm | 8 ++++---- 11 files changed, 42 insertions(+), 42 deletions(-) (limited to 'gnu/installer/newt/keymap.scm') diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm index 2b02653777..d1f357243b 100644 --- a/gnu/installer/newt/ethernet.scm +++ b/gnu/installer/newt/ethernet.scm @@ -72,7 +72,7 @@ connection is pending." #:title (G_ "Ethernet connection") #:listbox-items services #:listbox-item->text ethernet-service->text - #:button-text (G_ "Cancel") + #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ (raise diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm index 023777cc0a..81af949de1 100644 --- a/gnu/installer/newt/final.scm +++ b/gnu/installer/newt/final.scm @@ -42,7 +42,7 @@ new system will be created from this file when pression the Ok button.") #:info-textbox-width width #:file-textbox-width width #:file-textbox-height height - #:cancel-button-callback-procedure + #:exit-button-callback-procedure (lambda () (raise (condition diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm index 4bdae51340..9178a4341a 100644 --- a/gnu/installer/newt/keymap.scm +++ b/gnu/installer/newt/keymap.scm @@ -35,7 +35,7 @@ #:info-text (G_ "Please choose your keyboard layout.") #:listbox-items layouts #:listbox-item->text layout->text - #:button-text (G_ "Cancel") + #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ (raise diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm index 4de78f3330..4fa07df81e 100644 --- a/gnu/installer/newt/locale.scm +++ b/gnu/installer/newt/locale.scm @@ -45,7 +45,7 @@ installed system.") #:listbox-items languages #:listbox-item->text language->text #:sort-listbox-items? #f - #:button-text (G_ "Cancel") + #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ (raise diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm index 4912959147..ee6af0674e 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 #:title (G_ "Internet access") #:listbox-items (technology-items) #:listbox-item->text technology->text - #:button-text (G_ "Cancel") + #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ (raise diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm index 10849b81eb..98cbbb9c05 100644 --- a/gnu/installer/newt/page.scm +++ b/gnu/installer/newt/page.scm @@ -404,12 +404,12 @@ error is raised if the MAX-SCALE-UPDATE limit is reached." (checkbox-tree-height 10) (ok-button-callback-procedure (const #t)) - (cancel-button-callback-procedure + (exit-button-callback-procedure (const #t))) "Run a page allowing the user to select one or multiple items among ITEMS in 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 'Cancel'. The page title's is set to TITLE. ITEMS are +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. @@ -417,7 +417,7 @@ 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. OK-BUTTON-CALLBACK-PROCEDURE is called when the 'Ok' button is pressed. -CANCEL-BUTTON-CALLBACK-PROCEDURE is called when the 'Cancel' button is +EXIT-BUTTON-CALLBACK-PROCEDURE is called when the 'Exit' button is pressed. This procedure returns the list of checked items in the checkbox list among @@ -439,14 +439,14 @@ ITEMS when 'Ok' is pressed." info-textbox-width #:flags FLAG-BORDER)) (ok-button (make-button -1 -1 (G_ "Ok"))) - (cancel-button (make-button -1 -1 (G_ "Cancel"))) + (exit-button (make-button -1 -1 (G_ "Exit"))) (grid (vertically-stacked-grid GRID-ELEMENT-COMPONENT info-textbox GRID-ELEMENT-COMPONENT checkbox-tree GRID-ELEMENT-SUBGRID (horizontal-stacked-grid GRID-ELEMENT-COMPONENT ok-button - GRID-ELEMENT-COMPONENT cancel-button))) + GRID-ELEMENT-COMPONENT exit-button))) (keys (fill-checkbox-tree checkbox-tree items)) (form (make-form))) @@ -468,8 +468,8 @@ ITEMS when 'Ok' is pressed." entries))) (ok-button-callback-procedure) current-items)) - ((components=? argument cancel-button) - (cancel-button-callback-procedure)))))) + ((components=? argument exit-button) + (exit-button-callback-procedure)))))) (lambda () (destroy-form-and-pop form)))))) @@ -482,7 +482,7 @@ ITEMS when 'Ok' is pressed." (file-textbox-height 30) (ok-button-callback-procedure (const #t)) - (cancel-button-callback-procedure + (exit-button-callback-procedure (const #t))) (let* ((info-textbox (make-reflowed-textbox -1 -1 info-text @@ -495,14 +495,14 @@ ITEMS when 'Ok' is pressed." file-textbox-height (logior FLAG-SCROLL FLAG-BORDER))) (ok-button (make-button -1 -1 (G_ "Ok"))) - (cancel-button (make-button -1 -1 (G_ "Cancel"))) + (exit-button (make-button -1 -1 (G_ "Exit"))) (grid (vertically-stacked-grid GRID-ELEMENT-COMPONENT info-textbox GRID-ELEMENT-COMPONENT file-textbox GRID-ELEMENT-SUBGRID (horizontal-stacked-grid GRID-ELEMENT-COMPONENT ok-button - GRID-ELEMENT-COMPONENT cancel-button))) + GRID-ELEMENT-COMPONENT exit-button))) (form (make-form))) (set-textbox-text file-textbox file-text) @@ -519,7 +519,7 @@ ITEMS when 'Ok' is pressed." (cond ((components=? argument ok-button) (ok-button-callback-procedure)) - ((components=? argument cancel-button) - (cancel-button-callback-procedure)))))) + ((components=? argument exit-button) + (exit-button-callback-procedure)))))) (lambda () (destroy-form-and-pop form)))))) diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index 806337a9cb..1d5e4538e4 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm @@ -32,7 +32,7 @@ #:use-module (parted) #:export (run-partioning-page)) -(define (button-cancel-action) +(define (button-exit-action) "Raise the &installer-step-abort condition." (raise (condition @@ -48,8 +48,8 @@ #:title (G_ "Partition scheme") #:listbox-items items #:listbox-item->text cdr - #:button-text (G_ "Cancel") - #:button-callback-procedure button-cancel-action))) + #:button-text (G_ "Exit") + #:button-callback-procedure button-exit-action))) (car result))) (define (draw-formating-page) @@ -71,8 +71,8 @@ DEVICES list." #:title (G_ "Disk") #:listbox-items (device-items) #:listbox-item->text cdr - #:button-text (G_ "Cancel") - #:button-callback-procedure button-cancel-action)) + #:button-text (G_ "Exit") + #:button-callback-procedure button-exit-action)) (device (car result))) device)) @@ -84,7 +84,7 @@ Be careful, all data on the disk will be lost.") #:title (G_ "Partition table") #:listbox-items '("msdos" "gpt") #:listbox-item->text identity - #:button-text (G_ "Cancel") + #:button-text (G_ "Exit") #:button-callback-procedure button-callback)) (define (run-type-page partition) @@ -103,8 +103,8 @@ Be careful, all data on the disk will be lost.") #:listbox-items items #:listbox-item->text symbol->string #:sort-listbox-items? #f - #:button-text (G_ "Cancel") - #:button-callback-procedure button-cancel-action))) + #:button-text (G_ "Exit") + #:button-callback-procedure button-exit-action))) (define (run-fs-type-page) "Run a page asking the user to select a file-system type." @@ -114,8 +114,8 @@ Be careful, all data on the disk will be lost.") #:listbox-items '(ext4 btrfs fat32 swap) #:listbox-item->text user-fs-type-name #:sort-listbox-items? #f - #:button-text (G_ "Cancel") - #:button-callback-procedure button-cancel-action)) + #:button-text (G_ "Exit") + #:button-callback-procedure button-exit-action)) (define (inform-can-create-partition? user-partition) "Return #t if it is possible to create USER-PARTITION. This is determined by @@ -563,7 +563,7 @@ edit it." path)) (result (choice-window (G_ "Delete disk") (G_ "Ok") - (G_ "Cancel") + (G_ "Exit") info-text))) (case result ((1) @@ -584,7 +584,7 @@ edit it." number-str)) (result (choice-window (G_ "Delete partition") (G_ "Ok") - (G_ "Cancel") + (G_ "Exit") info-text))) (case result ((1) @@ -616,8 +616,8 @@ At least one partition must have its mounting point set to '/'.") #:allow-delete? #t #:button-text (G_ "Ok") #:button-callback-procedure button-ok-action - #:button2-text (G_ "Cancel") - #:button2-callback-procedure button-cancel-action + #:button2-text (G_ "Exit") + #:button2-callback-procedure button-exit-action #:listbox-callback-procedure listbox-action #:hotkey-callback-procedure hotkey-action))) (if (eq? result #t) @@ -664,8 +664,8 @@ At least one partition must have its mounting point set to '/'.") #:title (G_ "Partitioning method") #:listbox-items items #:listbox-item->text cdr - #:button-text (G_ "Cancel") - #:button-callback-procedure button-cancel-action)) + #:button-text (G_ "Exit") + #:button-callback-procedure button-exit-action)) (method (car result))) (case method ((entire) @@ -674,7 +674,7 @@ At least one partition must have its mounting point set to '/'.") (disk (if disk-type (disk-new device) (let* ((label (run-label-page - button-cancel-action)) + button-exit-action)) (disk (mklabel device label))) (disk-commit disk) disk))) diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm index 80fac43dc8..6bcb6244ae 100644 --- a/gnu/installer/newt/services.scm +++ b/gnu/installer/newt/services.scm @@ -38,7 +38,7 @@ choose the one to use on the log-in screen with F1.") #:items %desktop-environments #:item->text desktop-environment-name #:checkbox-tree-height 5 - #:cancel-button-callback-procedure + #:exit-button-callback-procedure (lambda () (raise (condition diff --git a/gnu/installer/newt/timezone.scm b/gnu/installer/newt/timezone.scm index 874f4a0734..6c96ee55b1 100644 --- a/gnu/installer/newt/timezone.scm +++ b/gnu/installer/newt/timezone.scm @@ -60,7 +60,7 @@ returned." #:listbox-items timezones #:listbox-item->text identity #:button-text (if (null? path) - (G_ "Cancel") + (G_ "Exit") (G_ "Back")) #:button-callback-procedure (if (null? path) diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm index 8337d628ae..c043f53def 100644 --- a/gnu/installer/newt/user.scm +++ b/gnu/installer/newt/user.scm @@ -116,7 +116,7 @@ '() (list GRID-ELEMENT-COMPONENT del-button))))) (ok-button (make-button -1 -1 (G_ "Ok"))) - (cancel-button (make-button -1 -1 (G_ "Cancel"))) + (exit-button (make-button -1 -1 (G_ "Exit"))) (title "User creation") (grid (vertically-stacked-grid @@ -126,7 +126,7 @@ GRID-ELEMENT-SUBGRID listbox-button-grid) GRID-ELEMENT-SUBGRID (horizontal-stacked-grid GRID-ELEMENT-COMPONENT ok-button - GRID-ELEMENT-COMPONENT cancel-button))) + GRID-ELEMENT-COMPONENT exit-button))) (sorted-users (sort users (lambda (a b) (string<= (user-name a) (user-name b))))) diff --git a/gnu/installer/newt/wifi.scm b/gnu/installer/newt/wifi.scm index de443345f6..c744e826a9 100644 --- a/gnu/installer/newt/wifi.scm +++ b/gnu/installer/newt/wifi.scm @@ -198,7 +198,7 @@ force a wifi scan." (make-reflowed-textbox -1 -1 info-text (info-textbox-width) #:flags FLAG-BORDER)) - (cancel-button (make-button -1 -1 (G_ "Cancel"))) + (exit-button (make-button -1 -1 (G_ "Exit"))) (scan-button (make-button -1 -1 (G_ "Scan"))) (services (wifi-services)) (service-items '())) @@ -211,12 +211,12 @@ force a wifi scan." (set-grid-field middle-grid 1 0 GRID-ELEMENT-COMPONENT scan-button #:anchor ANCHOR-TOP #:pad-left 2) - (set-grid-field buttons-grid 0 0 GRID-ELEMENT-COMPONENT cancel-button) + (set-grid-field buttons-grid 0 0 GRID-ELEMENT-COMPONENT exit-button) (add-components-to-form form info-textbox listbox scan-button - cancel-button) + exit-button) (make-wrapped-grid-window (basic-window-grid info-textbox middle-grid buttons-grid) (G_ "Wifi")) @@ -231,7 +231,7 @@ force a wifi scan." ((components=? argument scan-button) (run-wifi-scan-page) (run-wifi-page)) - ((components=? argument cancel-button) + ((components=? argument exit-button) (raise (condition (&installer-step-abort)))) -- cgit 1.4.1 From 9e58d4e90e77db150fbc57a559eaa01d85ce03f6 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Wed, 5 Dec 2018 21:55:51 +0900 Subject: installer: keymap: Fix keymap selection of layouts with not variant. * gnu/installer/newt/keymap.scm (run-keymap-page): Test if the layout has no variant at 'variant step, instead of raising a condition at 'layout step. --- gnu/installer/newt/keymap.scm | 28 ++++++++++++---------------- 1 file changed, 12 insertions(+), 16 deletions(-) (limited to 'gnu/installer/newt/keymap.scm') diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm index 9178a4341a..55a0aa6bf9 100644 --- a/gnu/installer/newt/keymap.scm +++ b/gnu/installer/newt/keymap.scm @@ -66,28 +66,24 @@ names of the selected keyboard layout and variant." (id 'layout) (compute (lambda _ - (let* ((layout (run-layout-page - layouts - (lambda (layout) - (x11-keymap-layout-description layout))))) - (if (null? (x11-keymap-layout-variants layout)) - ;; Break if this layout does not have any variant. - (raise - (condition - (&installer-step-break))) - layout))))) + (run-layout-page + layouts + (lambda (layout) + (x11-keymap-layout-description layout)))))) ;; Propose the user to select a variant among those supported by the ;; previously selected layout. (installer-step (id 'variant) (compute (lambda (result _) - (let ((variants (x11-keymap-layout-variants - (result-step result 'layout)))) - (run-variant-page variants - (lambda (variant) - (x11-keymap-variant-description - variant))))))))) + (let* ((layout (result-step result 'layout)) + (variants (x11-keymap-layout-variants layout))) + ;; Return #f if the layout does not have any variant. + (and (not (null? variants)) + (run-variant-page variants + (lambda (variant) + (x11-keymap-variant-description + variant)))))))))) (define (format-result result) (let ((layout (x11-keymap-layout-name -- cgit 1.4.1 From cb614af01146d9d4be40e705f71db4efcbe684e7 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sat, 12 Jan 2019 18:26:11 +0100 Subject: installer: keymap: Put English layout and international variant ahead. * gnu/installer/newt/keymap.scm (sort-layouts): New procedure, (sort-variants): new procedure, (run-keymap-page): use the two procedures above to sort layouts and variants. --- gnu/installer/newt/keymap.scm | 36 +++++++++++++++++++++++++++++++----- 1 file changed, 31 insertions(+), 5 deletions(-) (limited to 'gnu/installer/newt/keymap.scm') diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm index 55a0aa6bf9..6211af2bc5 100644 --- a/gnu/installer/newt/keymap.scm +++ b/gnu/installer/newt/keymap.scm @@ -24,6 +24,7 @@ #:use-module (guix records) #:use-module (newt) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:export (run-keymap-page)) @@ -35,6 +36,7 @@ #:info-text (G_ "Please choose your keyboard layout.") #:listbox-items layouts #:listbox-item->text layout->text + #:sort-listbox-items? #f #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ @@ -49,6 +51,7 @@ #:info-text (G_ "Please choose a variant for your keyboard layout.") #:listbox-items variants #:listbox-item->text variant->text + #:sort-listbox-items? #f #:button-text (G_ "Back") #:button-callback-procedure (lambda _ @@ -56,6 +59,28 @@ (condition (&installer-step-abort))))))) +(define (sort-layouts layouts) + "Sort LAYOUTS list by putting the US layout ahead and return it." + (call-with-values + (lambda () + (partition + (lambda (layout) + (let ((name (x11-keymap-layout-name layout))) + (string=? name "us"))) + layouts)) + (cut append <> <>))) + +(define (sort-variants variants) + "Sort VARIANTS list by putting the internation variant ahead and return it." + (call-with-values + (lambda () + (partition + (lambda (variant) + (let ((name (x11-keymap-variant-name variant))) + (string=? name "altgr-intl"))) + variants)) + (cut append <> <>))) + (define* (run-keymap-page layouts) "Run a page asking the user to select a keyboard layout and variant. LAYOUTS is a list of supported X11-KEYMAP-LAYOUT. Return a list of two elements, the @@ -67,7 +92,7 @@ names of the selected keyboard layout and variant." (compute (lambda _ (run-layout-page - layouts + (sort-layouts layouts) (lambda (layout) (x11-keymap-layout-description layout)))))) ;; Propose the user to select a variant among those supported by the @@ -80,10 +105,11 @@ names of the selected keyboard layout and variant." (variants (x11-keymap-layout-variants layout))) ;; Return #f if the layout does not have any variant. (and (not (null? variants)) - (run-variant-page variants - (lambda (variant) - (x11-keymap-variant-description - variant)))))))))) + (run-variant-page + (sort-variants variants) + (lambda (variant) + (x11-keymap-variant-description + variant)))))))))) (define (format-result result) (let ((layout (x11-keymap-layout-name -- cgit 1.4.1