amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu: Merge xorg configurations when extending.

Browse source 
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
This commit is contained in:
Ian Eure 2025-03-25 15:17:03 -07:00
parent 6766ac184c
commit 986456b994
No known key found for this signature in database
GPG key ID: 8499AC88F1A71CF2
1 changed files with 37 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

46
gnu/services/xorg.scm
View file

@ -16,6 +16,7 @@
;;; Copyright © 2023 muradm <mail@muradm.net> ;;; Copyright © 2023 muradm <mail@muradm.net>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com> ;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz> ;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
;;; Copyright © 2025 Ian Eure <ian@retrospec.tv>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -43,6 +44,7 @@
#:use-module (gnu system privilege) #:use-module (gnu system privilege)
#:use-module (gnu services base) #:use-module (gnu services base)
#:use-module (gnu services dbus) #:use-module (gnu services dbus)
#:use-module (gnu services desktop)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages guile) #:use-module (gnu packages guile)
#:use-module (gnu packages xorg) #:use-module (gnu packages xorg)
@ -209,6 +211,34 @@
(server-arguments xorg-configuration-server-arguments ;list of strings (server-arguments xorg-configuration-server-arguments ;list of strings
(default %default-xorg-server-arguments))) (default %default-xorg-server-arguments)))
(define merge-xorg-configurations
(case-lambda*
(() (xorg-configuration))
((a) a)
((#:rest configs)
(let ((configs (reverse configs))) ; Prefer later configurations.
(xorg-configuration
(modules (append-map xorg-configuration-modules configs))
(fonts (append-map xorg-configuration-fonts configs))
(drivers (append-map xorg-configuration-drivers configs))
(resolutions (append-map xorg-configuration-resolutions configs))
(extra-config (append-map xorg-configuration-extra-config configs))
;; Prefer the more recently set layout.
(keyboard-layout (find xorg-configuration-keyboard-layout configs))
;; Prefer the last non-default server.
(server
(or (find (lambda (server) (not (eq? xorg-server server)))
(map xorg-configuration-server configs))
xorg-server))
;; Prefer the last non-default arguments.
(server-arguments
(or
(find (lambda (config) (not (eq? %default-xorg-server-arguments server)))
(map xorg-configuration-server-arguments configs))
%default-xorg-server-arguments)))))))
(define (xorg-configuration->file config) (define (xorg-configuration->file config)
"Compute an Xorg configuration file corresponding to CONFIG, an "Compute an Xorg configuration file corresponding to CONFIG, an
<xorg-configuration> record." <xorg-configuration> record."
@ -227,7 +257,7 @@
(call-with-output-file #$output (call-with-output-file #$output
(lambda (port) (lambda (port)
(define drivers (define drivers
'#$(xorg-configuration-drivers config)) (delete-duplicates '#$(xorg-configuration-drivers config)))
(define (device-section driver) (define (device-section driver)
(string-append " (string-append "
@ -247,7 +277,7 @@ Section \"Screen\"
((x y) ((x y)
(string-append "\"" (number->string x) (string-append "\"" (number->string x)
"x" (number->string y) "\""))) "x" (number->string y) "\"")))
resolutions)) " (delete-duplicates resolutions))) "
EndSubSection EndSubSection
EndSection")) EndSection"))
@ -294,7 +324,7 @@ EndSection\n"))
(display "Section \"Files\"\n" port) (display "Section \"Files\"\n" port)
(for-each (lambda (font) (for-each (lambda (font)
(format port " FontPath \"~a\"~%" font)) (format port " FontPath \"~a\"~%" font))
'#$(xorg-configuration-fonts config)) (delete-duplicates '#$(xorg-configuration-fonts config)))
(for-each (lambda (module) (for-each (lambda (module)
(format port (format port
" ModulePath \"~a\"~%" " ModulePath \"~a\"~%"
@ -315,7 +345,7 @@ EndSection\n" port)
(newline port) (newline port)
(display (string-join (display (string-join
(map (cut screen-section <> (map (cut screen-section <>
'#$(xorg-configuration-resolutions config)) (delete-duplicates '#$(xorg-configuration-resolutions config)))
drivers) drivers)
"\n") "\n")
port) port)
@ -335,7 +365,8 @@ EndSection\n" port)
(newline port))) (newline port)))
(for-each (lambda (config) (for-each (lambda (config)
(display config port)) (display config port)
(newline port))
'#$(xorg-configuration-extra-config config)))))) '#$(xorg-configuration-extra-config config))))))
(computed-file "xserver.conf" build))) (computed-file "xserver.conf" build)))
@ -632,10 +663,7 @@ a `service-extension', as used by `set-xorg-configuration'."
((_ configuration-record service-type-definition) ((_ configuration-record service-type-definition)
(service-type (service-type
(inherit service-type-definition) (inherit service-type-definition)
(compose (lambda (extensions) (compose merge-xorg-configurations)
(match extensions
(() #f)
((config . _) config))))
(extend (lambda (config xorg-configuration) (extend (lambda (config xorg-configuration)
(if xorg-configuration (if xorg-configuration
(configuration-record (configuration-record