diff options
Diffstat (limited to 'gnu/installer')
| -rw-r--r-- | gnu/installer/locale.scm | 21 | ||||
| -rw-r--r-- | gnu/installer/newt/locale.scm | 24 | ||||
| -rw-r--r-- | gnu/installer/newt/network.scm | 4 | ||||
| -rw-r--r-- | gnu/installer/newt/services.scm | 37 | ||||
| -rw-r--r-- | gnu/installer/newt/welcome.scm | 8 | ||||
| -rw-r--r-- | gnu/installer/services.scm | 120 | ||||
| -rw-r--r-- | gnu/installer/steps.scm | 2 |
7 files changed, 152 insertions, 64 deletions
diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm index 2b45b2200a..284062a6e7 100644 --- a/gnu/installer/locale.scm +++ b/gnu/installer/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. ;;; @@ -69,6 +70,24 @@ (codeset . ,(match:substring matches 5)) (modifier . ,(match:substring matches 7))))) +(define (normalize-codeset codeset) + "Compute the \"normalized\" variant of CODESET." + ;; info "(libc) Using gettextized software", for the algorithm used to + ;; compute the normalized codeset. + (letrec-syntax ((-> (syntax-rules () + ((_ proc value) + (proc value)) + ((_ proc rest ...) + (proc (-> rest ...)))))) + (-> (lambda (str) + (if (string-every char-set:digit str) + (string-append "iso" str) + str)) + string-downcase + (lambda (str) + (string-filter char-set:letter+digit str)) + codeset))) + (define (locale->locale-string locale) "Reverse operation of locale-string->locale." (let ((language (locale-language locale)) @@ -81,7 +100,7 @@ `("_" ,territory) '()) ,@(if codeset - `("." ,codeset) + `("." ,(normalize-codeset codeset)) '()) ,@(if modifier `("@" ,modifier) diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm index 4fa07df81e..b819d06691 100644 --- a/gnu/installer/newt/locale.scm +++ b/gnu/installer/newt/locale.scm @@ -33,14 +33,8 @@ (let ((title (G_ "Locale language"))) (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.") + #: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 @@ -56,8 +50,7 @@ installed system.") (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 +64,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" @@ -191,9 +183,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..37a2a45411 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 diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm index 6bcb6244ae..10c19115ca 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. ;;; @@ -32,11 +33,33 @@ 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.") +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 %desktop-environments - #:item->text desktop-environment-name + #:items (filter desktop-system-service? %system-services) + #:item->text system-service-name ;no i18n for DE names + #:checkbox-tree-height 5 + #:exit-button-callback-procedure + (lambda () + (raise + (condition + (&installer-step-abort)))))) + +(define (run-networking-cbt-page network-management?) + "Run a page allowing the user to select networking services. When +NETWORK-MANAGEMENT? is true, include network management services like +NetworkManager." + (run-checkbox-tree-page + #:info-text (G_ "You can now select networking services to run on your \ +system.") + #:title (G_ "Network service") + #:items (filter (let ((types (if network-management? + '(network-management networking) + '(networking)))) + (lambda (service) + (memq (system-service-type service) types))) + %system-services) + #:item->text (compose G_ system-service-name) #:checkbox-tree-height 5 #:exit-button-callback-procedure (lambda () @@ -45,4 +68,8 @@ choose the one to use on the log-in screen with F1.") (&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 (null? desktop))))) 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/services.scm b/gnu/installer/services.scm index 2b6625f6af..46ade0f8fa 100644 --- a/gnu/installer/services.scm +++ b/gnu/installer/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. ;;; @@ -18,44 +19,89 @@ (define-module (gnu installer services) #:use-module (guix records) - #:export (<desktop-environment> - desktop-environment - make-desktop-environment - desktop-environment-name - desktop-environment-snippet + #:use-module (srfi srfi-1) + #:export (system-service? + system-service-name + system-service-type + system-service-snippet - %desktop-environments - desktop-environments->configuration)) + desktop-system-service? + networking-system-service? -(define-record-type* <desktop-environment> - desktop-environment make-desktop-environment - desktop-environment? - (name desktop-environment-name) ;string - (snippet desktop-environment-snippet)) ;symbol + %system-services + system-services->configuration)) + +(define-record-type* <system-service> + system-service make-system-service + system-service? + (name system-service-name) ;string + (type system-service-type) ;'desktop | 'networking + (snippet system-service-snippet)) ;sexp ;; This is the list of desktop environments supported as services. -(define %desktop-environments - (list - (desktop-environment - (name "GNOME") - (snippet '(service gnome-desktop-service-type))) - (desktop-environment - (name "Xfce") - ;; TODO: Use 'xfce-desktop-service-type' when the 'guix' package provides - ;; it with a default value. - (snippet '(xfce-desktop-service))) - (desktop-environment - (name "MATE") - (snippet '(service mate-desktop-service-type))) - (desktop-environment - (name "Enlightenment") - (snippet '(service enlightenment-desktop-service-type))))) - -(define (desktop-environments->configuration desktop-environments) - "Return the configuration field for DESKTOP-ENVIRONMENTS." - (let ((snippets - (map desktop-environment-snippet desktop-environments))) - `(,@(if (null? snippets) - '() - `((services (cons* ,@snippets - %desktop-services))))))) +(define %system-services + (let-syntax ((desktop-environment (syntax-rules () + ((_ fields ...) + (system-service + (type 'desktop) + fields ...)))) + (G_ (syntax-rules () ;for xgettext + ((_ str) str)))) + (list + (desktop-environment + (name "GNOME") + (snippet '(service gnome-desktop-service-type))) + (desktop-environment + (name "Xfce") + ;; TODO: Use 'xfce-desktop-service-type' when the 'guix' package provides + ;; it with a default value. + (snippet '(xfce-desktop-service))) + (desktop-environment + (name "MATE") + (snippet '(service mate-desktop-service-type))) + (desktop-environment + (name "Enlightenment") + (snippet '(service enlightenment-desktop-service-type))) + + ;; Networking. + (system-service + (name (G_ "OpenSSH secure shell daemon (sshd)")) + (type 'networking) + (snippet '(service openssh-service-type))) + (system-service + (name (G_ "Tor anonymous network router")) + (type 'networking) + (snippet '(service tor-service-type))) + + ;; Network connectivity management. + (system-service + (name (G_ "NetworkManager network connection manager")) + (type 'network-management) + (snippet '(service network-manager-service-type))) + (system-service + (name (G_ "Connman network connection manager")) + (type 'network-management) + (snippet '(service connman-service-type))) + (system-service + (name (G_ "DHCP client (dynamic IP address assignment)")) + (type 'network-management) + (snippet '(service dhcp-client-service)))))) + +(define (desktop-system-service? service) + "Return true if SERVICE is a desktop environment service." + (eq? 'desktop (system-service-type service))) + +(define (networking-system-service? service) + "Return true if SERVICE is a desktop environment service." + (eq? 'networking (system-service-type service))) + +(define (system-services->configuration services) + "Return the configuration field for SERVICES." + (let* ((snippets (map system-service-snippet services)) + (desktop? (find desktop-system-service? services)) + (base (if desktop? + '%desktop-services + '%base-services))) + (if (null? snippets) + `((services ,base)) + `((services (cons* ,@snippets ,base)))))) diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index 3f0bdad4f7..96cfdd03d1 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm @@ -215,7 +215,7 @@ found in RESULTS." '()))) steps)) (modules '((use-modules (gnu)) - (use-service-modules desktop)))) + (use-service-modules desktop networking ssh)))) `(,@modules () (operating-system ,@configuration)))) |