~ruther/guix-local

8b158e8b2cd0293eeebe73f5a71f0c513a89d606 — Caleb Ristvedt 6 years ago 0266094
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(-)

M gnu/services/xorg.scm
M gnu/services/xorg.scm => gnu/services/xorg.scm +81 -80
@@ 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