mirror of
https://codeberg.org/guix/guix.git
synced 2026-01-25 03:55:08 -06:00
a9462997d7
Configuration for xorg is embedded in the various display-manager configuration records, and extension support is factored out into the `handle-xorg-configuration' macro. However, the extension mechanism replaces the existing xorg-configuration with the supplied one, making it impossible to compose configuration from multiple sources. This patch adds a procedure to merge two xorg-configuration records, and calls it within handle-xorg-configuration, allowing the config to be built piecemeal. * gnu/services/xorg.scm (merge-xorg-configurations): New variable. (handle-xorg-configuration): Merge xorg configs. Change-Id: I20e9db911eef5d4efe98fdf382f3084e4defc1ba Signed-off-by: Liliana Marie Prikler <liliana.prikler@gmail.com>
232 lines
7.4 KiB
Scheme
232 lines
7.4 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
||
;;; Copyright © 2025 Ian Eure <ian@retrospec.tv>
|
||
;;;
|
||
;;; This file is part of GNU Guix.
|
||
;;;
|
||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||
;;; under the terms of the GNU General Public License as published by
|
||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||
;;; your option) any later version.
|
||
;;;
|
||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;;; GNU General Public License for more details.
|
||
;;;
|
||
;;; You should have received a copy of the GNU General Public License
|
||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
(define-module (tests services xorg)
|
||
#:use-module (guix diagnostics)
|
||
#:use-module (guix packages)
|
||
#:use-module (gnu packages xorg)
|
||
#:use-module (gnu bootloader)
|
||
#:use-module (gnu bootloader grub)
|
||
#:use-module (gnu services)
|
||
#:use-module (gnu services base)
|
||
#:use-module (gnu services xorg)
|
||
#:use-module (gnu system)
|
||
#:use-module (gnu system keyboard)
|
||
#:use-module (gnu system file-systems)
|
||
#:use-module ((srfi srfi-1) #:select (find))
|
||
#:use-module (srfi srfi-64))
|
||
|
||
;;; Tests for the (gnu services xorg) module.
|
||
|
||
(define %config-empty (xorg-configuration))
|
||
|
||
(define %default-server (xorg-configuration-server %config-empty))
|
||
|
||
|
||
|
||
(test-begin "merge-xorg-configurations")
|
||
|
||
(define merge-xorg-configurations
|
||
(@@ (gnu services xorg) merge-xorg-configurations))
|
||
|
||
(define gdm-configuration-xorg
|
||
(@@ (gnu services xorg) gdm-configuration-xorg))
|
||
|
||
;; keyboard-layout tests.
|
||
|
||
(define %config-xorg-keyboard-layout-1
|
||
(xorg-configuration
|
||
(keyboard-layout (keyboard-layout "us" #:options '("ctrl:nocaps")))))
|
||
|
||
(define %config-xorg-keyboard-layout-2
|
||
(xorg-configuration
|
||
(keyboard-layout (keyboard-layout "us" #:options '("ctrl:esc")))))
|
||
|
||
;; Later keyboard layouts replace earlier defaults
|
||
(test-equal
|
||
(keyboard-layout "us" #:options '("ctrl:nocaps"))
|
||
(xorg-configuration-keyboard-layout
|
||
(merge-xorg-configurations
|
||
(list %config-empty %config-xorg-keyboard-layout-1))))
|
||
|
||
;; Later keyboard layouts replace earlier customizations.
|
||
(test-equal
|
||
(keyboard-layout "us" #:options '("ctrl:esc"))
|
||
(xorg-configuration-keyboard-layout
|
||
(merge-xorg-configurations (list %config-empty
|
||
%config-xorg-keyboard-layout-1
|
||
%config-xorg-keyboard-layout-2))))
|
||
|
||
;; server, server-arguments tests.
|
||
|
||
(define %custom-server-1
|
||
(package
|
||
(inherit xorg-server)
|
||
(name "fake-xorg-server")))
|
||
|
||
(define %custom-server-2
|
||
(package
|
||
(inherit xorg-server)
|
||
(name "another-fake-xorg-server")))
|
||
|
||
(define %custom-server-1-arguments
|
||
(cons "-nosilk" %default-xorg-server-arguments))
|
||
|
||
(define %custom-server-2-arguments
|
||
(cons* "-logverbose" "9" %default-xorg-server-arguments))
|
||
|
||
(define %config-custom-server-1
|
||
(xorg-configuration
|
||
(server %custom-server-1)))
|
||
|
||
(define %config-custom-server-2
|
||
(xorg-configuration
|
||
(server %custom-server-2)))
|
||
|
||
(define %config-custom-server-1-and-arguments
|
||
(xorg-configuration
|
||
(inherit %config-custom-server-1)
|
||
(server-arguments %custom-server-1-arguments)))
|
||
|
||
(define %config-custom-server-2-and-arguments
|
||
(xorg-configuration
|
||
(inherit %config-custom-server-2)
|
||
(server-arguments %custom-server-2-arguments)))
|
||
|
||
;; Custom server is prioritized over earlier default.
|
||
(test-equal
|
||
%custom-server-1
|
||
(xorg-configuration-server
|
||
(merge-xorg-configurations (list %config-empty
|
||
%config-custom-server-1))))
|
||
|
||
;; Custom server preserves arguments.
|
||
(test-equal
|
||
(list %custom-server-1 %custom-server-1-arguments)
|
||
(let ((cfg (merge-xorg-configurations
|
||
(list
|
||
%config-empty
|
||
%config-custom-server-1-and-arguments))))
|
||
(list (xorg-configuration-server cfg)
|
||
(xorg-configuration-server-arguments cfg))))
|
||
|
||
;; Later custom arguments replace earlier.
|
||
(test-equal
|
||
(list %custom-server-2 %custom-server-2-arguments)
|
||
(let ((cfg (merge-xorg-configurations
|
||
(list
|
||
%config-empty
|
||
%config-custom-server-1-and-arguments
|
||
%config-custom-server-2-and-arguments))))
|
||
(list (xorg-configuration-server cfg)
|
||
(xorg-configuration-server-arguments cfg))))
|
||
|
||
;; Custom server is prioritized over later default.
|
||
(test-equal
|
||
%custom-server-1
|
||
(xorg-configuration-server
|
||
(merge-xorg-configurations (list %config-custom-server-1
|
||
%config-empty))))
|
||
|
||
;; Custom arguments are prioritized over earlier custom server.
|
||
(test-equal
|
||
%custom-server-2-arguments
|
||
(xorg-configuration-server-arguments
|
||
(merge-xorg-configurations
|
||
(list
|
||
(xorg-configuration (server %custom-server-1))
|
||
(xorg-configuration (server-arguments %custom-server-2-arguments))))))
|
||
|
||
;; Later custom servers are prioritized over earlier.
|
||
(test-equal
|
||
%custom-server-2
|
||
(xorg-configuration-server
|
||
(merge-xorg-configurations (list %config-custom-server-1
|
||
%config-empty
|
||
%config-custom-server-2))))
|
||
|
||
(test-equal
|
||
%custom-server-2
|
||
(xorg-configuration-server
|
||
(merge-xorg-configurations (list %config-empty
|
||
%config-custom-server-1
|
||
%config-custom-server-2))))
|
||
|
||
(test-equal
|
||
%custom-server-1
|
||
(xorg-configuration-server
|
||
(merge-xorg-configurations (list %config-empty
|
||
%config-custom-server-1))))
|
||
|
||
;; Make sure it works in the context of an operating-system.
|
||
(test-equal
|
||
%custom-server-2
|
||
(let ((os (operating-system
|
||
(host-name "test")
|
||
(bootloader
|
||
(bootloader-configuration
|
||
(bootloader grub-bootloader)
|
||
(targets '("/dev/sdX"))))
|
||
(file-systems
|
||
(cons
|
||
(file-system
|
||
(device (file-system-label "my-root"))
|
||
(mount-point "/")
|
||
(type "ext4"))
|
||
%base-file-systems))
|
||
(services
|
||
(cons*
|
||
(simple-service 'server-2 gdm-service-type
|
||
%config-custom-server-2)
|
||
(simple-service 'server-1 gdm-service-type
|
||
%config-custom-server-1)
|
||
(service gdm-service-type)
|
||
%base-services)))))
|
||
(xorg-configuration-server
|
||
(gdm-configuration-xorg
|
||
(service-value
|
||
(fold-services
|
||
(operating-system-services os)
|
||
#:target-type gdm-service-type))))))
|
||
|
||
;; extra-config tests.
|
||
|
||
;; Extra configurations append.
|
||
(let ((snippet-one "# First")
|
||
(snippet-two "# Second"))
|
||
(test-equal
|
||
(list snippet-one snippet-two)
|
||
(xorg-configuration-extra-config
|
||
(merge-xorg-configurations
|
||
(list (xorg-configuration (extra-config (list snippet-one)))
|
||
(xorg-configuration (extra-config (list snippet-two))))))))
|
||
|
||
;; drivers tests.
|
||
|
||
(define %drivers-custom-1 '("done"))
|
||
(define %drivers-custom-2 '("dtwo"))
|
||
|
||
(test-equal
|
||
(append %drivers-custom-1 %drivers-custom-2)
|
||
(xorg-configuration-drivers
|
||
(merge-xorg-configurations
|
||
(list
|
||
(xorg-configuration (drivers %drivers-custom-1))
|
||
(xorg-configuration (drivers %drivers-custom-2))))))
|
||
|
||
(test-end "merge-xorg-configurations")
|