xorg: honor xorg-configuration-server in xorg-configuration->file

Fixes <https://bugs.gnu.org/40806>.

Previously the xorg-server package specified in the configuration was ignored
entirely in xorg-configuration->file.  This had the effect that while the X
program of the configured package would be executed, the modules of the
configured package would be ignored in favor of the default xorg-server
package's modules.  This fixes that.

* gnu/services/xorg.scm (xorg-configuration->file): honor
  xorg-configuration-server.

1 files changed, 81 insertions, 80 deletions

diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 2505bde97b..ca39994516 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -180,31 +180,32 @@
 (define (xorg-configuration->file config)
   "Compute an Xorg configuration file corresponding to CONFIG, an
 <xorg-configuration> record."
-  (define all-modules
-    ;; 'xorg-server' provides 'fbdevhw.so' etc.
-    (append (xorg-configuration-modules config)
-            (list xorg-server)))
-
-  (define build
-    #~(begin
-        (use-modules (ice-9 match)
-                     (srfi srfi-1)
-                     (srfi srfi-26))
-
-        (call-with-output-file #$output
-          (lambda (port)
-            (define drivers
-              '#$(xorg-configuration-drivers config))
+  (let ((xorg-server (xorg-configuration-server config)))
+    (define all-modules
+      ;; 'xorg-server' provides 'fbdevhw.so' etc.
+      (append (xorg-configuration-modules config)
+              (list xorg-server)))
+
+    (define build
+      #~(begin
+          (use-modules (ice-9 match)
+                       (srfi srfi-1)
+                       (srfi srfi-26))
+
+          (call-with-output-file #$output
+            (lambda (port)
+              (define drivers
+                '#$(xorg-configuration-drivers config))
 
-            (define (device-section driver)
-              (string-append "
+              (define (device-section driver)
+                (string-append "
 Section \"Device\"
   Identifier \"device-" driver "\"
   Driver \"" driver "\"
 EndSection"))
 
-            (define (screen-section driver resolutions)
-              (string-append "
+              (define (screen-section driver resolutions)
+                (string-append "
 Section \"Screen\"
   Identifier \"screen-" driver "\"
   Device \"device-" driver "\"
@@ -218,8 +219,8 @@ Section \"Screen\"
   EndSubSection
 EndSection"))
 
-            (define (input-class-section layout variant model options)
-              (string-append "
+              (define (input-class-section layout variant model options)
+                (string-append "
 Section \"InputClass\"
   Identifier \"evdev keyboard catchall\"
   MatchIsKeyboard \"on\"
@@ -243,69 +244,69 @@ Section \"InputClass\"
   Driver \"evdev\"
 EndSection\n"))
 
-            (define (expand modules)
-              ;; Append to MODULES the relevant /lib/xorg/modules
-              ;; sub-directories.
-              (append-map (lambda (module)
-                            (filter-map (lambda (directory)
-                                          (let ((full (string-append module
-                                                                     directory)))
-                                            (and (file-exists? full)
-                                                 full)))
-                                        '("/lib/xorg/modules/drivers"
-                                          "/lib/xorg/modules/input"
-                                          "/lib/xorg/modules/multimedia"
-                                          "/lib/xorg/modules/extensions")))
-                          modules))
-
-            (display "Section \"Files\"\n" port)
-            (for-each (lambda (font)
-                        (format port "  FontPath \"~a\"~%" font))
-                      '#$(xorg-configuration-fonts config))
-            (for-each (lambda (module)
-                        (format port
-                                "  ModulePath \"~a\"~%"
-                                module))
-                      (append (expand '#$all-modules)
-
-                              ;; For fbdevhw.so and so on.
-                              (list #$(file-append xorg-server
-                                                   "/lib/xorg/modules"))))
-            (display "EndSection\n" port)
-            (display "
+              (define (expand modules)
+                ;; Append to MODULES the relevant /lib/xorg/modules
+                ;; sub-directories.
+                (append-map (lambda (module)
+                              (filter-map (lambda (directory)
+                                            (let ((full (string-append module
+                                                                       directory)))
+                                              (and (file-exists? full)
+                                                   full)))
+                                          '("/lib/xorg/modules/drivers"
+                                            "/lib/xorg/modules/input"
+                                            "/lib/xorg/modules/multimedia"
+                                            "/lib/xorg/modules/extensions")))
+                            modules))
+
+              (display "Section \"Files\"\n" port)
+              (for-each (lambda (font)
+                          (format port "  FontPath \"~a\"~%" font))
+                        '#$(xorg-configuration-fonts config))
+              (for-each (lambda (module)
+                          (format port
+                                  "  ModulePath \"~a\"~%"
+                                  module))
+                        (append (expand '#$all-modules)
+
+                                ;; For fbdevhw.so and so on.
+                                (list #$(file-append xorg-server
+                                                     "/lib/xorg/modules"))))
+              (display "EndSection\n" port)
+              (display "
 Section \"ServerFlags\"
   Option \"AllowMouseOpenFail\" \"on\"
 EndSection\n" port)
 
-            (display (string-join (map device-section drivers) "\n")
-                     port)
-            (newline port)
-            (display (string-join
-                      (map (cut screen-section <>
-                                '#$(xorg-configuration-resolutions config))
-                           drivers)
-                      "\n")
-                     port)
-            (newline port)
-
-            (let ((layout  #$(and=> (xorg-configuration-keyboard-layout config)
-                                    keyboard-layout-name))
-                  (variant #$(and=> (xorg-configuration-keyboard-layout config)
-                                    keyboard-layout-variant))
-                  (model   #$(and=> (xorg-configuration-keyboard-layout config)
-                                    keyboard-layout-model))
-                  (options '#$(and=> (xorg-configuration-keyboard-layout config)
-                                     keyboard-layout-options)))
-              (when layout
-                (display (input-class-section layout variant model options)
-                         port)
-                (newline port)))
-
-            (for-each (lambda (config)
-                        (display config port))
-                      '#$(xorg-configuration-extra-config config))))))
-
-  (computed-file "xserver.conf" build))
+              (display (string-join (map device-section drivers) "\n")
+                       port)
+              (newline port)
+              (display (string-join
+                        (map (cut screen-section <>
+                                  '#$(xorg-configuration-resolutions config))
+                             drivers)
+                        "\n")
+                       port)
+              (newline port)
+
+              (let ((layout  #$(and=> (xorg-configuration-keyboard-layout config)
+                                      keyboard-layout-name))
+                    (variant #$(and=> (xorg-configuration-keyboard-layout config)
+                                      keyboard-layout-variant))
+                    (model   #$(and=> (xorg-configuration-keyboard-layout config)
+                                      keyboard-layout-model))
+                    (options '#$(and=> (xorg-configuration-keyboard-layout config)
+                                       keyboard-layout-options)))
+                (when layout
+                  (display (input-class-section layout variant model options)
+                           port)
+                  (newline port)))
+
+              (for-each (lambda (config)
+                          (display config port))
+                        '#$(xorg-configuration-extra-config config))))))
+
+    (computed-file "xserver.conf" build)))
 
 (define (xorg-configuration-directory modules)
   "Return a directory that contains the @code{.conf} files for X.org that