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/ethernet.scm | 80 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) create mode 100644 gnu/installer/newt/ethernet.scm (limited to 'gnu/installer/newt/ethernet.scm') diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm new file mode 100644 index 0000000000..2cbbfddacd --- /dev/null +++ b/gnu/installer/newt/ethernet.scm @@ -0,0 +1,80 @@ +;;; 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 ethernet) + #:use-module (gnu installer connman) + #:use-module (gnu installer steps) + #:use-module (gnu installer newt utils) + #:use-module (gnu installer newt page) + #:use-module (guix i18n) + #:use-module (ice-9 format) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (newt) + #:export (run-ethernet-page)) + +(define (ethernet-services) + "Return all the connman services of ethernet type." + (let ((services (connman-services))) + (filter (lambda (service) + (and (string=? (service-type service) "ethernet") + (not (string-null? (service-name service))))) + services))) + +(define (ethernet-service->text service) + "Return a string describing the given ethernet SERVICE." + (let* ((name (service-name service)) + (path (service-path service)) + (full-name (string-append name "-" path)) + (state (service-state service)) + (connected? (or (string=? state "online") + (string=? state "ready")))) + (format #f "~c ~a~%" + (if connected? #\* #\ ) + full-name))) + +(define (connect-ethernet-service service) + "Connect to the given ethernet SERVICE. Display a connecting page while the +connection is pending." + (let* ((service-name (service-name service)) + (form (draw-connecting-page service-name))) + (connman-connect service) + (destroy-form-and-pop form))) + +(define (run-ethernet-page) + (let ((services (ethernet-services))) + (if (null? services) + (begin + (run-error-page + (G_ "No ethernet service available, please try again.") + (G_ "No service")) + (raise + (condition + (&installer-step-abort)))) + (run-listbox-selection-page + #:info-text (G_ "Please select an ethernet network.") + #:title (G_ "Ethernet connection") + #:listbox-items services + #:listbox-item->text ethernet-service->text + #:button-text (G_ "Cancel") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort)))) + #:listbox-callback-procedure connect-ethernet-service)))) -- cgit v1.2.3 From fb1675cbca68a7ada710640294a26cf0f1b22168 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Wed, 5 Dec 2018 14:52:04 +0900 Subject: installer: Fix ethernet connection. * gnu/installer/newt/ethernet.scm (connect-ethernet-service): Return the service passed as parameter. --- gnu/installer/newt/ethernet.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gnu/installer/newt/ethernet.scm') diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm index 2cbbfddacd..2b02653777 100644 --- a/gnu/installer/newt/ethernet.scm +++ b/gnu/installer/newt/ethernet.scm @@ -54,7 +54,8 @@ (define (connect-ethernet-service service) (let* ((service-name (service-name service)) (form (draw-connecting-page service-name))) (connman-connect service) - (destroy-form-and-pop form))) + (destroy-form-and-pop form) + service)) (define (run-ethernet-page) (let ((services (ethernet-services))) -- cgit v1.2.3 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/ethernet.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 @@ (define (run-ethernet-page) #: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 @@ (define (run-config-display-page) #: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 @@ (define (run-layout-page layouts layout->text) #: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 @@ (define (run-language-page languages language->text) #: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 @@ (define (technology-items) #: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 @@ (define* (run-checkbox-tree-page #:key (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 @@ (define* (run-checkbox-tree-page #:key 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 @@ (define (fill-checkbox-tree checkbox-tree items) 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 @@ (define (fill-checkbox-tree checkbox-tree items) 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 @@ (define* (run-file-textbox-page #:key (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 @@ (define* (run-file-textbox-page #:key 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 @@ (define* (run-file-textbox-page #:key (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 @@ (define-module (gnu installer newt partition) #: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 @@ (define (run-scheme-page) #: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 @@ (define (device-items) #: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 @@ (define (run-label-page button-callback) #: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 @@ (define (run-type-page partition) #: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 @@ (define (run-fs-type-page) #: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 @@ (define (hotkey-action key listbox-item) path)) (result (choice-window (G_ "Delete disk") (G_ "Ok") - (G_ "Cancel") + (G_ "Exit") info-text))) (case result ((1) @@ -584,7 +584,7 @@ (define (hotkey-action key listbox-item) number-str)) (result (choice-window (G_ "Delete partition") (G_ "Ok") - (G_ "Cancel") + (G_ "Exit") info-text))) (case result ((1) @@ -616,8 +616,8 @@ (define (hotkey-action key listbox-item) #: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 @@ (define (run-page devices) #: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 @@ (define (run-page devices) (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 @@ (define (run-desktop-environments-cbt-page) #: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 @@ (define (loop path) #: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 @@ (define (run users) '() (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 @@ (define (run users) 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 @@ (define (run-wifi-page) (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 @@ (define (run-wifi-page) (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 @@ (define (run-wifi-page) ((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 v1.2.3