Package: guix-patches;
Reported by: Ian Eure <ian <at> retrospec.tv>
Date: Wed, 26 Mar 2025 04:25:02 UTC
Severity: normal
Tags: patch
Done: Ian Eure <ian <at> retrospec.tv>
Bug is archived. No further changes may be made.
Message #86 received at 77266 <at> debbugs.gnu.org (full text, mbox):
From: Ian Eure <ian <at> retrospec.tv> To: 77266 <at> debbugs.gnu.org Cc: Ian Eure <ian <at> retrospec.tv> Subject: [PATCH v5 1/2] gnu: Merge xorg configurations when extending. Date: Sun, 18 May 2025 17:07:10 -0700
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.
* doc/guix.texi (X Window): Document xorg-configuration composition.
Change-Id: I20e9db911eef5d4efe98fdf382f3084e4defc1ba
---
doc/guix.texi | 48 +++++++++++++++++++++++++++++++++++--
gnu/services/xorg.scm | 55 +++++++++++++++++++++++++++++++++----------
2 files changed, 88 insertions(+), 15 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 4f9cd56aa5b..dd184b27e78 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -140,6 +140,7 @@ Copyright @copyright{} 2025 Rostislav Svoboda@*
Copyright @copyright{} 2025 Zacchaeus@*
Copyright @copyright{} 2025 Sergio Pastor Pérez@*
Copyright @copyright{} 2024 Evgeny Pisemsky@*
+Copyright @copyright{} 2025 Ian Eure@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -25039,8 +25040,51 @@ Tell the log-in manager (of type @var{login-manager-service-type}) to use
@var{config}, an @code{<xorg-configuration>} record.
Since the Xorg configuration is embedded in the log-in manager's
-configuration---e.g., @code{gdm-configuration}---this procedure provides a
-shorthand to set the Xorg configuration.
+configuration---e.g., @code{gdm-configuration}---this procedure provides
+a shorthand to set the Xorg configuration.
+
+In addition to @code{set-xorg-configuration}, you may extend your log-in
+manager’s service-type to provide reusable, partial configurations,
+which are concatenated to create the final Xorg configuration:
+
+@lisp
+;; A service which configures Intel video drivers.
+(define %xorg-intel-service
+ (simple-service
+ 'xorg-intel
+ gdm-service-type
+ (xorg-configuration
+ (modules (list xf86-video-intel))
+ (drivers '("intel"))
+ (extra-config "
+ Section \"Device\"
+ Identifier \"Intel GPU\"
+ Driver \"intel\"
+ Option \"TearFree\" \"true\"
+ EndSection"))))
+
+;; A service which configures the keyboard.
+(define %xorg-keyboard-service
+ (simple-service
+ 'xorg-keyboard
+ gdm-service-type
+ (xorg-configuration
+ (keyboard-layout
+ (keyboard-layout "us" #:options '("ctrl:nocaps"))))))
+
+(operating-system
+ (services
+ (append
+ (list (service gdm-service-type)
+ %xorg-intel-service
+ %xorg-keyboard-service)
+ %base-services))
+ @dots{})
+@end lisp
+
+Service extension and @code{set-xorg-configuration} can each be used
+seperately, or in conjunction.
+
@end deffn
@deffn {Procedure} xorg-start-command [config]
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index bef05b9bb9b..c2ee68b1ab2 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -209,14 +209,43 @@ (define-record-type* <xorg-configuration>
(server-arguments xorg-configuration-server-arguments ;list of strings
(default %default-xorg-server-arguments)))
+(define (merge-xorg-configurations a b)
+ (let ((configs (list b a))) ; 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 (or (xorg-configuration-keyboard-layout b)
+ (xorg-configuration-keyboard-layout a)
+ #f))
+ (server
+ ;; Prefer the non-default server.
+ (if (eq? xorg-server (xorg-configuration-server a))
+ (xorg-configuration-server b)
+ (xorg-configuration-server a)))
+ (server-arguments
+ ;; Prefer the non-default arguments.
+ (if (eq? %default-xorg-server-arguments
+ (xorg-configuration-server-arguments a))
+ (xorg-configuration-server-arguments b)
+ (xorg-configuration-server-arguments a))))))
+
(define (xorg-configuration->file config)
"Compute an Xorg configuration file corresponding to CONFIG, an
<xorg-configuration> record."
(let ((xorg-server (xorg-configuration-server config)))
(define all-modules
;; 'xorg-server' provides 'fbdevhw.so' etc.
- (append (xorg-configuration-modules config)
- (list xorg-server)))
+ (delete-duplicates
+ (append (xorg-configuration-modules config)
+ (list xorg-server))))
(define build
#~(begin
@@ -227,7 +256,7 @@ (define build
(call-with-output-file #$output
(lambda (port)
(define drivers
- '#$(xorg-configuration-drivers config))
+ (delete-duplicates '#$(xorg-configuration-drivers config)))
(define (device-section driver)
(string-append "
@@ -247,7 +276,7 @@ (define (screen-section driver resolutions)
((x y)
(string-append "\"" (number->string x)
"x" (number->string y) "\"")))
- resolutions)) "
+ (delete-duplicates resolutions))) "
EndSubSection
EndSection"))
@@ -294,7 +323,7 @@ (define (expand modules)
(display "Section \"Files\"\n" port)
(for-each (lambda (font)
(format port " FontPath \"~a\"~%" font))
- '#$(xorg-configuration-fonts config))
+ (delete-duplicates '#$(xorg-configuration-fonts config)))
(for-each (lambda (module)
(format port
" ModulePath \"~a\"~%"
@@ -315,7 +344,7 @@ (define (expand modules)
(newline port)
(display (string-join
(map (cut screen-section <>
- '#$(xorg-configuration-resolutions config))
+ (delete-duplicates '#$(xorg-configuration-resolutions config)))
drivers)
"\n")
port)
@@ -334,9 +363,12 @@ (define (expand modules)
port)
(newline port)))
- (for-each (lambda (config)
- (display config port))
- '#$(xorg-configuration-extra-config config))))))
+ (for-each
+ (lambda (config)
+ (display config port)
+ (newline port))
+ (delete-duplicates
+ '#$(xorg-configuration-extra-config config)))))))
(computed-file "xserver.conf" build)))
@@ -628,10 +660,7 @@ (define-syntax handle-xorg-configuration
((_ configuration-record service-type-definition)
(service-type
(inherit service-type-definition)
- (compose (lambda (extensions)
- (match extensions
- (() #f)
- ((config . _) config))))
+ (compose (cut reduce merge-xorg-configurations #f <>))
(extend (lambda (config xorg-configuration)
(if xorg-configuration
(configuration-record
--
2.49.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.