installer: Desktop environment page now includes window managers.

* gnu/installer/services.scm (<system-service>)[snippet]: Change to be a
list of sexps and add default value.
[packages]: New field.
(%system-services): Adjust 'snippet' fields to be lists of sexps.
Add Openbox, awesome, i3, and ratpoison.
(system-services->configuration): Adjust 'snippet' handling.  Honor
'packages' field.
This commit is contained in:
Ludovic Courtès 2019-04-17 00:27:04 +02:00
parent a0e16bec37
commit 3ad3c55842
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 33 additions and 18 deletions

View File

@ -20,7 +20,6 @@
(define-module (gnu installer services) (define-module (gnu installer services)
#:use-module (guix records) #:use-module (guix records)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (system-service? #:export (system-service?
system-service-name system-service-name
system-service-type system-service-type
@ -37,7 +36,10 @@
system-service? system-service?
(name system-service-name) ;string (name system-service-name) ;string
(type system-service-type) ;'desktop | 'networking (type system-service-type) ;'desktop | 'networking
(snippet system-service-snippet)) ;sexp (snippet system-service-snippet ;list of sexps
(default '()))
(packages system-service-packages ;list of sexps
(default '())))
;; This is the list of desktop environments supported as services. ;; This is the list of desktop environments supported as services.
(define %system-services (define %system-services
@ -51,26 +53,38 @@
(list (list
(desktop-environment (desktop-environment
(name "GNOME") (name "GNOME")
(snippet '(service gnome-desktop-service-type))) (snippet '((service gnome-desktop-service-type))))
(desktop-environment (desktop-environment
(name "Xfce") (name "Xfce")
(snippet '(service xfce-desktop-service-type))) (snippet '((service xfce-desktop-service-type))))
(desktop-environment (desktop-environment
(name "MATE") (name "MATE")
(snippet '(service mate-desktop-service-type))) (snippet '((service mate-desktop-service-type))))
(desktop-environment (desktop-environment
(name "Enlightenment") (name "Enlightenment")
(snippet '(service enlightenment-desktop-service-type))) (snippet '((service enlightenment-desktop-service-type))))
(desktop-environment
(name "Openbox")
(packages '((specification->package "openbox"))))
(desktop-environment
(name "awesome")
(packages '((specification->package "awesome"))))
(desktop-environment
(name "i3")
(packages '((specification->package "i3-wm"))))
(desktop-environment
(name "ratpoison")
(packages '((specification->package "ratpoison"))))
;; Networking. ;; Networking.
(system-service (system-service
(name (G_ "OpenSSH secure shell daemon (sshd)")) (name (G_ "OpenSSH secure shell daemon (sshd)"))
(type 'networking) (type 'networking)
(snippet '(service openssh-service-type))) (snippet '((service openssh-service-type))))
(system-service (system-service
(name (G_ "Tor anonymous network router")) (name (G_ "Tor anonymous network router"))
(type 'networking) (type 'networking)
(snippet '(service tor-service-type))) (snippet '((service tor-service-type))))
;; Network connectivity management. ;; Network connectivity management.
(system-service (system-service
@ -86,7 +100,7 @@
(system-service (system-service
(name (G_ "DHCP client (dynamic IP address assignment)")) (name (G_ "DHCP client (dynamic IP address assignment)"))
(type 'network-management) (type 'network-management)
(snippet '(service dhcp-client-service-type)))))) (snippet '((service dhcp-client-service-type)))))))
(define (desktop-system-service? service) (define (desktop-system-service? service)
"Return true if SERVICE is a desktop environment service." "Return true if SERVICE is a desktop environment service."
@ -98,20 +112,21 @@
(define (system-services->configuration services) (define (system-services->configuration services)
"Return the configuration field for SERVICES." "Return the configuration field for SERVICES."
(let* ((snippets (append-map (lambda (service) (let* ((snippets (append-map system-service-snippet services))
(match (system-service-snippet service) (packages (append-map system-service-packages services))
((and lst (('service _ ...) ...))
lst)
(sexp
(list sexp))))
services))
(desktop? (find desktop-system-service? services)) (desktop? (find desktop-system-service? services))
(base (if desktop? (base (if desktop?
'%desktop-services '%desktop-services
'%base-services))) '%base-services)))
(if (null? snippets) (if (null? snippets)
`((services ,base)) `(,@(if (null? packages)
`((services (append (list ,@snippets '()
`((packages (list ,@packages))))
(services ,base))
`(,@(if (null? packages)
'()
`((packages (list ,@packages))))
(services (append (list ,@snippets
,@(if desktop? ,@(if desktop?
;; XXX: Assume 'keyboard-layout' is in ;; XXX: Assume 'keyboard-layout' is in