installer: Generalize desktop environments to system services.
* gnu/installer/services.scm (<desktop-environment>): Rename to... (<system-service>): ... this. Add a 'type' field. (%desktop-environments): Rename to... (%system-services): ... this. (desktop-system-service?): New procedure. (desktop-environments->configuration): Rename to... (system-services->configuration): ... this. Determine the base list of services based on whether SERVICES contains at least one "desktop" service. * gnu/installer/newt/services.scm (run-desktop-environments-cbt-page): Adjust accordingly. * gnu/installer.scm (installer-steps): Likewise.
This commit is contained in:
parent
e8aa4e9511
commit
75988317b2
|
@ -256,8 +256,7 @@ selected keymap."
|
||||||
(description (G_ "Services"))
|
(description (G_ "Services"))
|
||||||
(compute (lambda _
|
(compute (lambda _
|
||||||
((installer-services-page current-installer))))
|
((installer-services-page current-installer))))
|
||||||
(configuration-formatter
|
(configuration-formatter system-services->configuration))
|
||||||
desktop-environments->configuration))
|
|
||||||
|
|
||||||
(installer-step
|
(installer-step
|
||||||
(id 'final)
|
(id 'final)
|
||||||
|
|
|
@ -32,11 +32,11 @@
|
||||||
environments."
|
environments."
|
||||||
(run-checkbox-tree-page
|
(run-checkbox-tree-page
|
||||||
#:info-text (G_ "Please select the desktop(s) environment(s) you wish to \
|
#: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.")
|
choose the one to use on the log-in screen.")
|
||||||
#:title (G_ "Desktop environment")
|
#:title (G_ "Desktop environment")
|
||||||
#:items %desktop-environments
|
#:items (filter desktop-system-service? %system-services)
|
||||||
#:item->text desktop-environment-name
|
#:item->text system-service-name
|
||||||
#:checkbox-tree-height 5
|
#:checkbox-tree-height 5
|
||||||
#:exit-button-callback-procedure
|
#:exit-button-callback-procedure
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
|
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||||
|
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -18,44 +19,58 @@
|
||||||
|
|
||||||
(define-module (gnu installer services)
|
(define-module (gnu installer services)
|
||||||
#:use-module (guix records)
|
#:use-module (guix records)
|
||||||
#:export (<desktop-environment>
|
#:use-module (srfi srfi-1)
|
||||||
desktop-environment
|
#:export (system-service?
|
||||||
make-desktop-environment
|
system-service-name
|
||||||
desktop-environment-name
|
system-service-type
|
||||||
desktop-environment-snippet
|
system-service-snippet
|
||||||
|
|
||||||
%desktop-environments
|
desktop-system-service?
|
||||||
desktop-environments->configuration))
|
|
||||||
|
|
||||||
(define-record-type* <desktop-environment>
|
%system-services
|
||||||
desktop-environment make-desktop-environment
|
system-services->configuration))
|
||||||
desktop-environment?
|
|
||||||
(name desktop-environment-name) ;string
|
(define-record-type* <system-service>
|
||||||
(snippet desktop-environment-snippet)) ;symbol
|
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.
|
;; This is the list of desktop environments supported as services.
|
||||||
(define %desktop-environments
|
(define %system-services
|
||||||
(list
|
(let-syntax ((desktop-environment (syntax-rules ()
|
||||||
(desktop-environment
|
((_ fields ...)
|
||||||
(name "GNOME")
|
(system-service
|
||||||
(snippet '(service gnome-desktop-service-type)))
|
(type 'desktop)
|
||||||
(desktop-environment
|
fields ...)))))
|
||||||
(name "Xfce")
|
(list
|
||||||
;; TODO: Use 'xfce-desktop-service-type' when the 'guix' package provides
|
(desktop-environment
|
||||||
;; it with a default value.
|
(name "GNOME")
|
||||||
(snippet '(xfce-desktop-service)))
|
(snippet '(service gnome-desktop-service-type)))
|
||||||
(desktop-environment
|
(desktop-environment
|
||||||
(name "MATE")
|
(name "Xfce")
|
||||||
(snippet '(service mate-desktop-service-type)))
|
;; TODO: Use 'xfce-desktop-service-type' when the 'guix' package provides
|
||||||
(desktop-environment
|
;; it with a default value.
|
||||||
(name "Enlightenment")
|
(snippet '(xfce-desktop-service)))
|
||||||
(snippet '(service enlightenment-desktop-service-type)))))
|
(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)
|
(define (desktop-system-service? service)
|
||||||
"Return the configuration field for DESKTOP-ENVIRONMENTS."
|
"Return true if SERVICE is a desktop environment service."
|
||||||
(let ((snippets
|
(eq? 'desktop (system-service-type service)))
|
||||||
(map desktop-environment-snippet desktop-environments)))
|
|
||||||
`(,@(if (null? snippets)
|
(define (system-services->configuration services)
|
||||||
'()
|
"Return the configuration field for SERVICES."
|
||||||
`((services (cons* ,@snippets
|
(let* ((snippets (map system-service-snippet services))
|
||||||
%desktop-services)))))))
|
(desktop? (find desktop-system-service? services))
|
||||||
|
(base (if desktop?
|
||||||
|
'%desktop-services
|
||||||
|
'%base-services)))
|
||||||
|
(if (null? snippets)
|
||||||
|
`((services ,base))
|
||||||
|
`((services (cons* ,@snippets ,base))))))
|
||||||
|
|
Loading…
Reference in New Issue