diff options
| -rw-r--r-- | gnu/installer.scm | 3 | ||||
| -rw-r--r-- | gnu/installer/newt/services.scm | 6 | ||||
| -rw-r--r-- | gnu/installer/services.scm | 87 |
3 files changed, 55 insertions, 41 deletions
diff --git a/gnu/installer.scm b/gnu/installer.scm index 5694cef66f..50e2e7d85e 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -256,8 +256,7 @@ selected keymap." (description (G_ "Services")) (compute (lambda _ ((installer-services-page current-installer)))) - (configuration-formatter - desktop-environments->configuration)) + (configuration-formatter system-services->configuration)) (installer-step (id 'final) diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm index adeb1d784a..2cbfc5ca36 100644 --- a/gnu/installer/newt/services.scm +++ b/gnu/installer/newt/services.scm @@ -32,11 +32,11 @@ 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 \ +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 #:checkbox-tree-height 5 #:exit-button-callback-procedure (lambda () diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm index 2b6625f6af..8e482b7246 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,58 @@ (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? -(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) ;symbol + (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 %system-services + (let-syntax ((desktop-environment (syntax-rules () + ((_ fields ...) + (system-service + (type 'desktop) + fields ...))))) + (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-system-service? service) + "Return true if SERVICE is a desktop environment service." + (eq? 'desktop (system-service-type service))) -(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->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)))))) |