branch master updated: services: xorg-wrapper: Support xorg server input rewriting.

[guix-commits]

This is an automated email from the git hooks/post-receive script.

iyzsong pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new a7f118d062 services: xorg-wrapper: Support xorg server input rewriting.
a7f118d062 is described below

commit a7f118d062db4408b23505750c44a1f996496c43
Author: r0man <roman@burningswell.com>
AuthorDate: Tue Mar 21 20:11:41 2023 +0100

    services: xorg-wrapper: Support xorg server input rewriting.
    
    This patch adds support for proper xorg server input rewriting. It uses the
    lookup-package-direct-input procedure to configure the X server paths
    dynamically, instead of always using the hard coded package. Something like
    this is now possible:
    
    (define other-mesa
      (package-input-rewriting/spec `(("mesa" . ,(const other-mesa)))))
    
    (xorg-configuration
     (xorg-configuration
      (server (other-mesa xorg-server))))
    
    Without this patch the X server would still be configured with mesa (causing
    version issues), and not with other-mesa (as per the input rewrite).
    
    * gnu/services/xorg.scm (xorg-configuration-server-package-path)
    (xorg-configuration-dri-driver-path, xorg-configuration-xkb-bin-dir)
    (xorg-configuration-xkb-dir): New procedures.
    (xorg-wrapper): Use them for dri and xkb paths.
    
    Signed-off-by: 宋文武 <iyzsong@member.fsf.org>
---
 gnu/services/xorg.scm | 23 ++++++++++++++++++++---
 1 file changed, 20 insertions(+), 3 deletions(-)

diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index c4745cecf5..7295a45b59 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -358,6 +358,22 @@ in @var{modules}."
                                  files)
                        #t))))
 
+(define (xorg-configuration-server-package-path config input path)
+  "Lookup the direct @var{input} in the xorg server package of @var{config}
+and append @var{path} to it."
+  (let* ((server (xorg-configuration-server config))
+         (package (lookup-package-direct-input server input)))
+    (when package (file-append package path))))
+
+(define (xorg-configuration-dri-driver-path config)
+  (xorg-configuration-server-package-path config "mesa" "/lib/dri"))
+
+(define (xorg-configuration-xkb-bin-dir config)
+  (xorg-configuration-server-package-path config "xkbcomp" "/bin"))
+
+(define (xorg-configuration-xkb-dir config)
+  (xorg-configuration-server-package-path config "xkeyboard-config" 
"/share/X11/xkb"))
+
 (define* (xorg-wrapper #:optional (config (xorg-configuration)))
   "Return a derivation that builds a script to start the X server with the
 given @var{config}.  The resulting script should be used in place of
@@ -365,12 +381,13 @@ given @var{config}.  The resulting script should be used 
in place of
   (define exp
     ;; Write a small wrapper around the X server.
     #~(begin
-        (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri"))
-        (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin"))
+        (setenv "XORG_DRI_DRIVER_PATH"
+                #$(xorg-configuration-dri-driver-path config))
+        (setenv "XKB_BINDIR" #$(xorg-configuration-xkb-bin-dir config))
 
         (let ((X (string-append #$(xorg-configuration-server config) 
"/bin/X")))
           (apply execl X X
-                 "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb")
+                 "-xkbdir" #$(xorg-configuration-xkb-dir config)
                  "-config" #$(xorg-configuration->file config)
                  "-configdir" #$(xorg-configuration-directory
                                  (xorg-configuration-modules config))