07/10: services: xorg: Allow users to specify a list of modules.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit d344f5a528791cc8ee46b4506ff4ec49489108ee
Author: Ludovic Courtès <address@hidden>
Date:   Sat Nov 25 18:28:08 2017 +0100

    services: xorg: Allow users to specify a list of modules.
    
    * gnu/services/xorg.scm (%default-xorg-fonts): New variable.
    (xorg-configuration-file): Add #:modules and #:fonts.  Rewrite to return
    a 'computed-file' that honors MODULES and FONTS.
    (xorg-wrapper): Pass #:modules to 'xorg-configuration-file'.
    (xorg-start-command): Add #:fonts.  Pass #:fonts and #:modules to
    'xorg-configuration-file'.
    * doc/guix.texi (X Window): Adjust documentation of 'xorg-start-command'
    and 'xorg-configuration-file'.
---
 doc/guix.texi         |  26 ++++---
 gnu/services/xorg.scm | 185 ++++++++++++++++++++++++++++++++------------------
 2 files changed, 136 insertions(+), 75 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 17a8f4d..4a32cdf 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11142,31 +11142,41 @@ The G-Expression denoting the default SLiM theme and 
its name.
 @end defvr
 
 @deffn {Scheme Procedure} xorg-start-command [#:guile] @
-  [#:configuration-file #f] [#:xorg-server @var{xorg-server}]
-Return a derivation that builds a @var{guile} script to start the X server
-from @var{xorg-server}.  @var{configuration-file} is the server configuration
-file or a derivation that builds it; when omitted, the result of
address@hidden is used.
+  [#:modules %default-xorg-modules] @
+  [#:fonts %default-xorg-fonts] @
+  [#:configuration-file (xorg-configuration-file @dots{})] @
+  [#:xorg-server @var{xorg-server}]
+Return a @code{startx} script in which @var{modules}, a list of X module
+packages, and @var{fonts}, a list of X font directories, are available.  See
address@hidden for more details on the arguments.  The result should be
+used in place of @code{startx}.
 
 Usually the X server is started by a login manager.
 @end deffn
 
 @deffn {Scheme Procedure} xorg-configuration-file @
+  [#:modules %default-xorg-modules] @
+  [#:fonts %default-xorg-fonts] @
   [#:drivers '()] [#:resolutions '()] [#:extra-config '()]
 Return a configuration file for the Xorg server containing search paths for
 all the common drivers.
 
address@hidden must be a list of @dfn{module packages} loaded by the Xorg
+server---e.g., @code{xf86-video-vesa}, @code{xf86-input-keyboard}, and so on.
address@hidden must be a list of font directories to add to the server's
address@hidden path}.
+
 @var{drivers} must be either the empty list, in which case Xorg chooses a
 graphics driver automatically, or a list of driver names that will be tried in
-this order---e.g., @code{(\"modesetting\" \"vesa\")}.
+this order---e.g., @code{("modesetting" "vesa")}.
 
 Likewise, when @var{resolutions} is the empty list, Xorg chooses an
 appropriate screen resolution; otherwise, it must be a list of
 resolutions---e.g., @code{((1024 768) (640 480))}.
 
 Last, @var{extra-config} is a list of strings or objects appended to the
address@hidden argument list.  It is used to pass extra text to be added
-verbatim to the configuration file.
+configuration file.  It is used to pass extra text to be
+added verbatim to the configuration file.
 @end deffn
 
 @deffn {Scheme Procedure} screen-locker-service @var{package} address@hidden
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index c5a1a0d..c712793 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Andy Wingo <address@hidden>
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2015 Sou Bunnbu <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -45,6 +45,7 @@
   #:use-module (ice-9 match)
   #:export (xorg-configuration-file
             %default-xorg-modules
+            %default-xorg-fonts
             xorg-wrapper
             xorg-start-command
             xinitrc
@@ -70,11 +71,50 @@
 ;;;
 ;;; Code:
 
-(define* (xorg-configuration-file #:key (drivers '()) (resolutions '())
+(define %default-xorg-modules
+  ;; Default list of modules loaded by the server.  Note that the order
+  ;; matters since it determines which driver is going to be used when there's
+  ;; a choice.
+  (list xf86-video-vesa
+        xf86-video-fbdev
+        xf86-video-ati
+        xf86-video-cirrus
+        xf86-video-intel
+        xf86-video-mach64
+        xf86-video-nouveau
+        xf86-video-nv
+        xf86-video-sis
+
+        ;; Libinput is the new thing and is recommended over evdev/synaptics:
+        ;; 
<http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>.
+        xf86-input-libinput
+
+        xf86-input-evdev
+        xf86-input-keyboard
+        xf86-input-mouse
+        xf86-input-synaptics))
+
+(define %default-xorg-fonts
+  ;; Default list of fonts available to the X server.
+  (list (file-append font-alias "/share/fonts/X11/75dpi")
+        (file-append font-alias "/share/fonts/X11/100dpi")
+        (file-append font-alias "/share/fonts/X11/misc")
+        (file-append font-alias "/share/fonts/X11/cyrillic")
+        (file-append font-adobe75dpi "/share/fonts/X11/75dpi")))
+
+(define* (xorg-configuration-file #:key
+                                  (modules %default-xorg-modules)
+                                  (fonts %default-xorg-fonts)
+                                  (drivers '()) (resolutions '())
                                   (extra-config '()))
   "Return a configuration file for the Xorg server containing search paths for
 all the common drivers.
 
address@hidden must be a list of @dfn{module packages} loaded by the Xorg
+server---e.g., @code{xf86-video-vesa}, @code{xf86-input-keyboard}, and so on.
address@hidden must be a list of font directories to add to the server's
address@hidden path}.
+
 @var{drivers} must be either the empty list, in which case Xorg chooses a
 graphics driver automatically, or a list of driver names that will be tried in
 this order---e.g., @code{(\"modesetting\" \"vesa\")}.
@@ -84,17 +124,32 @@ appropriate screen resolution; otherwise, it must be a 
list of
 resolutions---e.g., @code{((1024 768) (640 480))}.
 
 Last, @var{extra-config} is a list of strings or objects appended to the
address@hidden argument list.  It is used to pass extra text to be
+configuration file.  It is used to pass extra text to be
 added verbatim to the configuration file."
-  (define (device-section driver)
-    (string-append "
+  (define all-modules
+    ;; 'xorg-server' provides 'fbdevhw.so' etc.
+    (append modules (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
+              '#$drivers)
+
+            (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 "\"
@@ -108,65 +163,56 @@ Section \"Screen\"
   EndSubSection
 EndSection"))
 
-  (apply mixed-text-file "xserver.conf" "
-Section \"Files\"
-  FontPath \"" font-alias "/share/fonts/X11/75dpi\"
-  FontPath \"" font-alias "/share/fonts/X11/100dpi\"
-  FontPath \"" font-alias "/share/fonts/X11/misc\"
-  FontPath \"" font-alias "/share/fonts/X11/cyrillic\"
-  FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\"
-  ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\"
-  ModulePath \"" xf86-video-fbdev "/lib/xorg/modules/drivers\"
-  ModulePath \"" xf86-video-ati "/lib/xorg/modules/drivers\"
-  ModulePath \"" xf86-video-cirrus "/lib/xorg/modules/drivers\"
-  ModulePath \"" xf86-video-intel "/lib/xorg/modules/drivers\"
-  ModulePath \"" xf86-video-mach64 "/lib/xorg/modules/drivers\"
-  ModulePath \"" xf86-video-nouveau "/lib/xorg/modules/drivers\"
-  ModulePath \"" xf86-video-nv "/lib/xorg/modules/drivers\"
-  ModulePath \"" xf86-video-sis "/lib/xorg/modules/drivers\"
-
-  # Libinput is the new thing and is recommended over evdev/synaptics
-  # by those who know:
-  # 
<http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>.
-  ModulePath \"" xf86-input-libinput "/lib/xorg/modules/input\"
-
-  ModulePath \"" xf86-input-evdev "/lib/xorg/modules/input\"
-  ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\"
-  ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\"
-  ModulePath \"" xf86-input-synaptics "/lib/xorg/modules/input\"
-  ModulePath \"" xorg-server "/lib/xorg/modules\"
-  ModulePath \"" xorg-server "/lib/xorg/modules/drivers\"
-  ModulePath \"" xorg-server "/lib/xorg/modules/extensions\"
-  ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\"
-EndSection
-
+            (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))
+                      '#$fonts)
+            (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
-"
-  (string-join (map device-section drivers) "\n") "\n"
-  (string-join (map (cut screen-section <> resolutions)
-                    drivers)
-               "\n")
+EndSection\n" port)
 
-  "\n"
-  extra-config))
+            (display (string-join (map device-section drivers) "\n")
+                     port)
+            (newline port)
+            (display (string-join
+                      (map (cut screen-section <> '#$resolutions)
+                           drivers)
+                      "\n")
+                     port)
+            (newline port)
+
+            (for-each (lambda (config)
+                        (display config port))
+                      '#$extra-config)))))
+
+  (computed-file "xserver.conf" build))
 
-(define %default-xorg-modules
-  (list xf86-video-vesa
-        xf86-video-fbdev
-        xf86-video-ati
-        xf86-video-cirrus
-        xf86-video-intel
-        xf86-video-mach64
-        xf86-video-nouveau
-        xf86-video-nv
-        xf86-video-sis
-        xf86-input-libinput
-        xf86-input-evdev
-        xf86-input-keyboard
-        xf86-input-mouse
-        xf86-input-synaptics))
 
 (define (xorg-configuration-directory modules)
   "Return a directory that contains the @code{.conf} files for X.org that
@@ -196,8 +242,9 @@ in @var{modules}."
 
 (define* (xorg-wrapper #:key
                        (guile (canonical-package guile-2.0))
-                       (configuration-file (xorg-configuration-file))
                        (modules %default-xorg-modules)
+                       (configuration-file (xorg-configuration-file
+                                            #:modules modules))
                        (xorg-server xorg-server))
   "Return a derivation that builds a @var{guile} script to start the X server
 from @var{xorg-server}.  @var{configuration-file} is the server configuration
@@ -221,12 +268,16 @@ in place of @code{/usr/bin/X}."
 
 (define* (xorg-start-command #:key
                              (guile (canonical-package guile-2.0))
-                             (configuration-file (xorg-configuration-file))
                              (modules %default-xorg-modules)
+                             (fonts %default-xorg-fonts)
+                             (configuration-file
+                              (xorg-configuration-file #:modules modules
+                                                       #:fonts fonts))
                              (xorg-server xorg-server))
-  "Return a derivation that builds a @code{startx} script in which a number of
-X modules are available.  See @code{xorg-wrapper} for more details on the
-arguments.  The result should be used in place of @code{startx}."
+  "Return a @code{startx} script in which @var{modules}, a list of X module
+packages, and @var{fonts}, a list of X font directories, are available.  See
address@hidden for more details on the arguments.  The result should be
+used in place of @code{startx}."
   (define X
     (xorg-wrapper #:guile guile
                   #:configuration-file configuration-file