me
/
guix
Archived
1
0
Fork 0

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>
master
r0man 2023-03-21 20:11:41 +01:00 committed by 宋文武
parent ff476daa57
commit a7f118d062
No known key found for this signature in database
GPG Key ID: D415BF253B515976
1 changed files with 20 additions and 3 deletions

View File

@ -358,6 +358,22 @@ in @var{modules}."
files) files)
#t)))) #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))) (define* (xorg-wrapper #:optional (config (xorg-configuration)))
"Return a derivation that builds a script to start the X server with the "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 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 (define exp
;; Write a small wrapper around the X server. ;; Write a small wrapper around the X server.
#~(begin #~(begin
(setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri")) (setenv "XORG_DRI_DRIVER_PATH"
(setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin")) #$(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"))) (let ((X (string-append #$(xorg-configuration-server config) "/bin/X")))
(apply execl X X (apply execl X X
"-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb") "-xkbdir" #$(xorg-configuration-xkb-dir config)
"-config" #$(xorg-configuration->file config) "-config" #$(xorg-configuration->file config)
"-configdir" #$(xorg-configuration-directory "-configdir" #$(xorg-configuration-directory
(xorg-configuration-modules config)) (xorg-configuration-modules config))