diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/xorg.scm | 161 |
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 |