aboutsummaryrefslogtreecommitdiff
path: root/gnu/installer
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer')
-rw-r--r--gnu/installer/newt/services.scm6
-rw-r--r--gnu/installer/services.scm87
2 files changed, 54 insertions, 39 deletions
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))))))