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'.
This commit is contained in:
Ludovic Courtès 2017-11-25 18:28:08 +01:00
parent 04c3573726
commit d344f5a528
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 134 additions and 73 deletions

View File

@ -11142,31 +11142,41 @@ The G-Expression denoting the default SLiM theme and its name.
@end defvr @end defvr
@deffn {Scheme Procedure} xorg-start-command [#:guile] @ @deffn {Scheme Procedure} xorg-start-command [#:guile] @
[#:configuration-file #f] [#:xorg-server @var{xorg-server}] [#:modules %default-xorg-modules] @
Return a derivation that builds a @var{guile} script to start the X server [#:fonts %default-xorg-fonts] @
from @var{xorg-server}. @var{configuration-file} is the server configuration [#:configuration-file (xorg-configuration-file @dots{})] @
file or a derivation that builds it; when omitted, the result of [#:xorg-server @var{xorg-server}]
@code{xorg-configuration-file} is used. 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
@code{xorg-wrapper} 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. Usually the X server is started by a login manager.
@end deffn @end deffn
@deffn {Scheme Procedure} xorg-configuration-file @ @deffn {Scheme Procedure} xorg-configuration-file @
[#:modules %default-xorg-modules] @
[#:fonts %default-xorg-fonts] @
[#:drivers '()] [#:resolutions '()] [#:extra-config '()] [#:drivers '()] [#:resolutions '()] [#:extra-config '()]
Return a configuration file for the Xorg server containing search paths for Return a configuration file for the Xorg server containing search paths for
all the common drivers. all the common drivers.
@var{modules} 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.
@var{fonts} must be a list of font directories to add to the server's
@dfn{font path}.
@var{drivers} must be either the empty list, in which case Xorg chooses a @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 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 Likewise, when @var{resolutions} is the empty list, Xorg chooses an
appropriate screen resolution; otherwise, it must be a list of appropriate screen resolution; otherwise, it must be a list of
resolutions---e.g., @code{((1024 768) (640 480))}. resolutions---e.g., @code{((1024 768) (640 480))}.
Last, @var{extra-config} is a list of strings or objects appended to the Last, @var{extra-config} is a list of strings or objects appended to the
@code{text-file*} argument list. It is used to pass extra text to be added configuration file. It is used to pass extra text to be
verbatim to the configuration file. added verbatim to the configuration file.
@end deffn @end deffn
@deffn {Scheme Procedure} screen-locker-service @var{package} [@var{name}] @deffn {Scheme Procedure} screen-locker-service @var{package} [@var{name}]

View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Andy Wingo <wingo@igalia.com> ;;; Copyright © 2017 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -45,6 +45,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (xorg-configuration-file #:export (xorg-configuration-file
%default-xorg-modules %default-xorg-modules
%default-xorg-fonts
xorg-wrapper xorg-wrapper
xorg-start-command xorg-start-command
xinitrc xinitrc
@ -70,11 +71,50 @@
;;; ;;;
;;; Code: ;;; 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 '())) (extra-config '()))
"Return a configuration file for the Xorg server containing search paths for "Return a configuration file for the Xorg server containing search paths for
all the common drivers. all the common drivers.
@var{modules} 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.
@var{fonts} must be a list of font directories to add to the server's
@dfn{font path}.
@var{drivers} must be either the empty list, in which case Xorg chooses a @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 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\")}.
@ -84,8 +124,23 @@ appropriate screen resolution; otherwise, it must be a list of
resolutions---e.g., @code{((1024 768) (640 480))}. resolutions---e.g., @code{((1024 768) (640 480))}.
Last, @var{extra-config} is a list of strings or objects appended to the Last, @var{extra-config} is a list of strings or objects appended to the
@code{mixed-text-file} 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." added verbatim to the configuration file."
(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) (define (device-section driver)
(string-append " (string-append "
Section \"Device\" Section \"Device\"
@ -108,65 +163,56 @@ Section \"Screen\"
EndSubSection EndSubSection
EndSection")) EndSection"))
(apply mixed-text-file "xserver.conf" " (define (expand modules)
Section \"Files\" ;; Append to MODULES the relevant /lib/xorg/modules
FontPath \"" font-alias "/share/fonts/X11/75dpi\" ;; sub-directories.
FontPath \"" font-alias "/share/fonts/X11/100dpi\" (append-map (lambda (module)
FontPath \"" font-alias "/share/fonts/X11/misc\" (filter-map (lambda (directory)
FontPath \"" font-alias "/share/fonts/X11/cyrillic\" (let ((full (string-append module
FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\" directory)))
ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" (and (file-exists? full)
ModulePath \"" xf86-video-fbdev "/lib/xorg/modules/drivers\" full)))
ModulePath \"" xf86-video-ati "/lib/xorg/modules/drivers\" '("/lib/xorg/modules/drivers"
ModulePath \"" xf86-video-cirrus "/lib/xorg/modules/drivers\" "/lib/xorg/modules/input"
ModulePath \"" xf86-video-intel "/lib/xorg/modules/drivers\" "/lib/xorg/modules/multimedia"
ModulePath \"" xf86-video-mach64 "/lib/xorg/modules/drivers\" "/lib/xorg/modules/extensions")))
ModulePath \"" xf86-video-nouveau "/lib/xorg/modules/drivers\" modules))
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 (display "Section \"Files\"\n" port)
# by those who know: (for-each (lambda (font)
# <http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>. (format port " FontPath \"~a\"~%" font))
ModulePath \"" xf86-input-libinput "/lib/xorg/modules/input\" '#$fonts)
(for-each (lambda (module)
ModulePath \"" xf86-input-evdev "/lib/xorg/modules/input\" (format port
ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\" " ModulePath \"~a\"~%"
ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\" module))
ModulePath \"" xf86-input-synaptics "/lib/xorg/modules/input\" (append (expand '#$all-modules)
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
;; For fbdevhw.so and so on.
(list #$(file-append xorg-server
"/lib/xorg/modules"))))
(display "EndSection\n" port)
(display "
Section \"ServerFlags\" Section \"ServerFlags\"
Option \"AllowMouseOpenFail\" \"on\" Option \"AllowMouseOpenFail\" \"on\"
EndSection EndSection\n" port)
"
(string-join (map device-section drivers) "\n") "\n" (display (string-join (map device-section drivers) "\n")
(string-join (map (cut screen-section <> resolutions) port)
(newline port)
(display (string-join
(map (cut screen-section <> '#$resolutions)
drivers) drivers)
"\n") "\n")
port)
(newline port)
"\n" (for-each (lambda (config)
extra-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) (define (xorg-configuration-directory modules)
"Return a directory that contains the @code{.conf} files for X.org that "Return a directory that contains the @code{.conf} files for X.org that
@ -196,8 +242,9 @@ in @var{modules}."
(define* (xorg-wrapper #:key (define* (xorg-wrapper #:key
(guile (canonical-package guile-2.0)) (guile (canonical-package guile-2.0))
(configuration-file (xorg-configuration-file))
(modules %default-xorg-modules) (modules %default-xorg-modules)
(configuration-file (xorg-configuration-file
#:modules modules))
(xorg-server xorg-server)) (xorg-server xorg-server))
"Return a derivation that builds a @var{guile} script to start the X 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 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 (define* (xorg-start-command #:key
(guile (canonical-package guile-2.0)) (guile (canonical-package guile-2.0))
(configuration-file (xorg-configuration-file))
(modules %default-xorg-modules) (modules %default-xorg-modules)
(fonts %default-xorg-fonts)
(configuration-file
(xorg-configuration-file #:modules modules
#:fonts fonts))
(xorg-server xorg-server)) (xorg-server xorg-server))
"Return a derivation that builds a @code{startx} script in which a number of "Return a @code{startx} script in which @var{modules}, a list of X module
X modules are available. See @code{xorg-wrapper} for more details on the packages, and @var{fonts}, a list of X font directories, are available. See
arguments. The result should be used in place of @code{startx}." @code{xorg-wrapper} for more details on the arguments. The result should be
used in place of @code{startx}."
(define X (define X
(xorg-wrapper #:guile guile (xorg-wrapper #:guile guile
#:configuration-file configuration-file #:configuration-file configuration-file