diff options
Diffstat (limited to 'gnu/services/xorg.scm')
| -rw-r--r-- | gnu/services/xorg.scm | 46 |
1 files changed, 37 insertions, 9 deletions
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index d5d7ffbc4c3..7db30c996dc 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm | |||
| @@ -16,6 +16,7 @@ | |||
| 16 | ;;; Copyright © 2023 muradm <mail@muradm.net> | 16 | ;;; Copyright © 2023 muradm <mail@muradm.net> |
| 17 | ;;; Copyright © 2024 Zheng Junjie <873216071@qq.com> | 17 | ;;; Copyright © 2024 Zheng Junjie <873216071@qq.com> |
| 18 | ;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz> | 18 | ;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz> |
| 19 | ;;; Copyright © 2025 Ian Eure <ian@retrospec.tv> | ||
| 19 | ;;; | 20 | ;;; |
| 20 | ;;; This file is part of GNU Guix. | 21 | ;;; This file is part of GNU Guix. |
| 21 | ;;; | 22 | ;;; |
| @@ -43,6 +44,7 @@ | |||
| 43 | #:use-module (gnu system privilege) | 44 | #:use-module (gnu system privilege) |
| 44 | #:use-module (gnu services base) | 45 | #:use-module (gnu services base) |
| 45 | #:use-module (gnu services dbus) | 46 | #:use-module (gnu services dbus) |
| 47 | #:use-module (gnu services desktop) | ||
| 46 | #:use-module (gnu packages base) | 48 | #:use-module (gnu packages base) |
| 47 | #:use-module (gnu packages guile) | 49 | #:use-module (gnu packages guile) |
| 48 | #:use-module (gnu packages xorg) | 50 | #:use-module (gnu packages xorg) |
| @@ -209,6 +211,34 @@ | |||
| 209 | (server-arguments xorg-configuration-server-arguments ;list of strings | 211 | (server-arguments xorg-configuration-server-arguments ;list of strings |
| 210 | (default %default-xorg-server-arguments))) | 212 | (default %default-xorg-server-arguments))) |
| 211 | 213 | ||
| 214 | (define merge-xorg-configurations | ||
| 215 | (case-lambda* | ||
| 216 | (() (xorg-configuration)) | ||
| 217 | ((a) a) | ||
| 218 | ((#:rest configs) | ||
| 219 | (let ((configs (reverse configs))) ; Prefer later configurations. | ||
| 220 | (xorg-configuration | ||
| 221 | (modules (append-map xorg-configuration-modules configs)) | ||
| 222 | (fonts (append-map xorg-configuration-fonts configs)) | ||
| 223 | (drivers (append-map xorg-configuration-drivers configs)) | ||
| 224 | (resolutions (append-map xorg-configuration-resolutions configs)) | ||
| 225 | (extra-config (append-map xorg-configuration-extra-config configs)) | ||
| 226 | ;; Prefer the more recently set layout. | ||
| 227 | (keyboard-layout (find xorg-configuration-keyboard-layout configs)) | ||
| 228 | |||
| 229 | ;; Prefer the last non-default server. | ||
| 230 | (server | ||
| 231 | (or (find (lambda (server) (not (eq? xorg-server server))) | ||
| 232 | (map xorg-configuration-server configs)) | ||
| 233 | xorg-server)) | ||
| 234 | |||
| 235 | ;; Prefer the last non-default arguments. | ||
| 236 | (server-arguments | ||
| 237 | (or | ||
| 238 | (find (lambda (config) (not (eq? %default-xorg-server-arguments server))) | ||
| 239 | (map xorg-configuration-server-arguments configs)) | ||
| 240 | %default-xorg-server-arguments))))))) | ||
| 241 | |||
| 212 | (define (xorg-configuration->file config) | 242 | (define (xorg-configuration->file config) |
| 213 | "Compute an Xorg configuration file corresponding to CONFIG, an | 243 | "Compute an Xorg configuration file corresponding to CONFIG, an |
| 214 | <xorg-configuration> record." | 244 | <xorg-configuration> record." |
| @@ -227,7 +257,7 @@ | |||
| 227 | (call-with-output-file #$output | 257 | (call-with-output-file #$output |
| 228 | (lambda (port) | 258 | (lambda (port) |
| 229 | (define drivers | 259 | (define drivers |
| 230 | '#$(xorg-configuration-drivers config)) | 260 | (delete-duplicates '#$(xorg-configuration-drivers config))) |
| 231 | 261 | ||
| 232 | (define (device-section driver) | 262 | (define (device-section driver) |
| 233 | (string-append " | 263 | (string-append " |
| @@ -247,7 +277,7 @@ Section \"Screen\" | |||
| 247 | ((x y) | 277 | ((x y) |
| 248 | (string-append "\"" (number->string x) | 278 | (string-append "\"" (number->string x) |
| 249 | "x" (number->string y) "\""))) | 279 | "x" (number->string y) "\""))) |
| 250 | resolutions)) " | 280 | (delete-duplicates resolutions))) " |
| 251 | EndSubSection | 281 | EndSubSection |
| 252 | EndSection")) | 282 | EndSection")) |
| 253 | 283 | ||
| @@ -294,7 +324,7 @@ EndSection\n")) | |||
| 294 | (display "Section \"Files\"\n" port) | 324 | (display "Section \"Files\"\n" port) |
| 295 | (for-each (lambda (font) | 325 | (for-each (lambda (font) |
| 296 | (format port " FontPath \"~a\"~%" font)) | 326 | (format port " FontPath \"~a\"~%" font)) |
| 297 | '#$(xorg-configuration-fonts config)) | 327 | (delete-duplicates '#$(xorg-configuration-fonts config))) |
| 298 | (for-each (lambda (module) | 328 | (for-each (lambda (module) |
| 299 | (format port | 329 | (format port |
| 300 | " ModulePath \"~a\"~%" | 330 | " ModulePath \"~a\"~%" |
| @@ -315,7 +345,7 @@ EndSection\n" port) | |||
| 315 | (newline port) | 345 | (newline port) |
| 316 | (display (string-join | 346 | (display (string-join |
| 317 | (map (cut screen-section <> | 347 | (map (cut screen-section <> |
| 318 | '#$(xorg-configuration-resolutions config)) | 348 | (delete-duplicates '#$(xorg-configuration-resolutions config))) |
| 319 | drivers) | 349 | drivers) |
| 320 | "\n") | 350 | "\n") |
| 321 | port) | 351 | port) |
| @@ -335,7 +365,8 @@ EndSection\n" port) | |||
| 335 | (newline port))) | 365 | (newline port))) |
| 336 | 366 | ||
| 337 | (for-each (lambda (config) | 367 | (for-each (lambda (config) |
| 338 | (display config port)) | 368 | (display config port) |
| 369 | (newline port)) | ||
| 339 | '#$(xorg-configuration-extra-config config)))))) | 370 | '#$(xorg-configuration-extra-config config)))))) |
| 340 | 371 | ||
| 341 | (computed-file "xserver.conf" build))) | 372 | (computed-file "xserver.conf" build))) |
| @@ -632,10 +663,7 @@ a `service-extension', as used by `set-xorg-configuration'." | |||
| 632 | ((_ configuration-record service-type-definition) | 663 | ((_ configuration-record service-type-definition) |
| 633 | (service-type | 664 | (service-type |
| 634 | (inherit service-type-definition) | 665 | (inherit service-type-definition) |
| 635 | (compose (lambda (extensions) | 666 | (compose merge-xorg-configurations) |
| 636 | (match extensions | ||
| 637 | (() #f) | ||
| 638 | ((config . _) config)))) | ||
| 639 | (extend (lambda (config xorg-configuration) | 667 | (extend (lambda (config xorg-configuration) |
| 640 | (if xorg-configuration | 668 | (if xorg-configuration |
| 641 | (configuration-record | 669 | (configuration-record |
