From d2e59637e37c00b9a9b6273693a68acf6dcc9493 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 6 Nov 2014 23:54:27 +0100
Subject: services: xorg: Allow users to specify a list of resolutions.

* gnu/services/xorg.scm (xorg-start-command): Add #:resolutions
  parameter and 'screen-section' procedure.  Use it.
* doc/guix.texi (X Window): Adjust accordingly.
---
 gnu/services/xorg.scm | 31 ++++++++++++++++++++++++++++---
 1 file changed, 28 insertions(+), 3 deletions(-)

(limited to 'gnu')

diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 41e05c9c17..b29f2e46c5 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -31,6 +31,9 @@
   #:use-module (guix gexp)
   #:use-module (guix monads)
   #:use-module (guix derivations)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
   #:export (xorg-start-command
             slim-service))
 
@@ -43,13 +46,17 @@
 (define* (xorg-start-command #:key
                              (guile (canonical-package guile-2.0))
                              (xorg-server xorg-server)
-                             (drivers '()))
+                             (drivers '()) (resolutions '()))
   "Return a derivation that builds a @var{guile} script to start the X server
 from @var{xorg-server}.  Usually the X server is started by a login manager.
 
 @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))}."
 
   (define (device-section driver)
     (string-append "
@@ -58,6 +65,21 @@ Section \"Device\"
   Driver \"" driver "\"
 EndSection"))
 
+  (define (screen-section driver resolutions)
+    (string-append "
+Section \"Screen\"
+  Identifier \"screen-" driver "\"
+  Device \"device-" driver "\"
+  SubSection \"Display\"
+    Modes "
+  (string-join (map (match-lambda
+                     ((x y)
+                      (string-append "\"" (number->string x)
+                                     "x" (number->string y) "\"")))
+                    resolutions)) "
+  EndSubSection
+EndSection"))
+
   (define (xserver.conf)
     (text-file* "xserver.conf" "
 Section \"Files\"
@@ -82,7 +104,10 @@ Section \"ServerFlags\"
   Option \"AllowMouseOpenFail\" \"on\"
 EndSection
 "
-  (string-join (map device-section drivers) "\n")))
+  (string-join (map device-section drivers) "\n")
+  (string-join (map (cut screen-section <> resolutions)
+                    drivers)
+               "\n")))
 
   (mlet %store-monad ((config (xserver.conf)))
     (define script
-- 
cgit v1.2.3