summary refs log tree commit diff
path: root/gnu/services/xorg.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services/xorg.scm')
-rw-r--r--gnu/services/xorg.scm122
1 files changed, 120 insertions, 2 deletions
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 29c7f30013..d4e73c13b4 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -27,6 +27,7 @@
   #:use-module (gnu services shepherd)
   #:use-module (gnu system pam)
   #:use-module (gnu system keyboard)
+  #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module ((gnu packages base) #:select (canonical-package))
   #:use-module (gnu packages guile)
@@ -35,6 +36,7 @@
   #:use-module (gnu packages gl)
   #:use-module (gnu packages glib)
   #:use-module (gnu packages display-managers)
+  #:use-module (gnu packages freedesktop)
   #:use-module (gnu packages gnustep)
   #:use-module (gnu packages gnome)
   #:use-module (gnu packages admin)
@@ -91,9 +93,14 @@
             screen-locker-service-type
             screen-locker-service
 
+            localed-configuration
+            localed-configuration?
+            localed-service-type
+
             gdm-configuration
             gdm-service-type
-            gdm-service))
+            gdm-service
+            set-xorg-configuration))
 
 ;;; Commentary:
 ;;;
@@ -653,6 +660,88 @@ makes the good ol' XlockMore usable."
                           (file-append package "/bin/" program)
                           allow-empty-passwords?)))
 
+
+;;;
+;;; Locale service.
+;;;
+
+(define-record-type* <localed-configuration>
+  localed-configuration make-localed-configuration
+  localed-configuration?
+  (localed         localed-configuration-localed
+                   (default localed))
+  (keyboard-layout localed-configuration-keyboard-layout
+                   (default #f)))
+
+(define (localed-dbus-service config)
+  "Return the 'localed' D-Bus service for @var{config}, a
+@code{<localed-configuration>} record."
+  (define keyboard-layout
+    (localed-configuration-keyboard-layout config))
+
+  ;; The primary purpose of 'localed' is to tell GDM what the "current" Xorg
+  ;; keyboard layout is.  If 'localed' is missing, or if it's unable to
+  ;; determine the current XKB layout, then GDM forcefully installs its
+  ;; default XKB config (US English).  Here we communicate the configured
+  ;; layout through environment variables.
+
+  (if keyboard-layout
+      (let* ((layout  (keyboard-layout-name keyboard-layout))
+             (variant (keyboard-layout-variant keyboard-layout))
+             (model   (keyboard-layout-model keyboard-layout))
+             (options (keyboard-layout-options keyboard-layout)))
+        (list (wrapped-dbus-service
+               (localed-configuration-localed config)
+               "libexec/localed/localed"
+               `(("GUIX_XKB_LAYOUT" ,layout)
+                 ,@(if variant
+                       `(("GUIX_XKB_VARIANT" ,variant))
+                       '())
+                 ,@(if model
+                       `(("GUIX_XKB_MODEL" ,model))
+                       '())
+                 ,@(if (null? options)
+                       '()
+                       `(("GUIX_XKB_OPTIONS"
+                          ,(string-join options ","))))))))
+      '()))
+
+(define localed-service-type
+  (let ((package (lambda (config)
+                   ;; Don't bother if the user didn't specify any keyboard
+                   ;; layout.
+                   (if (localed-configuration-keyboard-layout config)
+                       (list (localed-configuration-localed config))
+                       '()))))
+    (service-type (name 'localed)
+                  (extensions
+                   (list (service-extension dbus-root-service-type
+                                            localed-dbus-service)
+                         (service-extension udev-service-type package)
+                         (service-extension polkit-service-type package)
+
+                         ;; Add 'localectl' to the profile.
+                         (service-extension profile-service-type package)))
+
+                  ;; This service can be extended, typically by the X login
+                  ;; manager, to communicate the chosen Xorg keyboard layout.
+                  (compose (lambda (extensions)
+                             (find keyboard-layout? extensions)))
+                  (extend (lambda (config keyboard-layout)
+                            (localed-configuration
+                             (inherit config)
+                             (keyboard-layout keyboard-layout))))
+                  (description
+                   "Run the locale daemon, @command{localed}, which can be used
+to control the system locale and keyboard mapping from user programs such as
+the GNOME desktop environment.")
+                  (default-value (localed-configuration)))))
+
+
+;;;
+;;; GNOME Desktop Manager.
+;;;
+
 (define %gdm-accounts
   (list (user-group (name "gdm") (system? #t))
         (user-account
@@ -787,7 +876,26 @@ makes the good ol' XlockMore usable."
                                           gdm-configuration-gnome-shell-assets)
                        (service-extension dbus-root-service-type
                                           (compose list
-                                                   gdm-configuration-gdm))))
+                                                   gdm-configuration-gdm))
+                       (service-extension localed-service-type
+                                          (compose
+                                           xorg-configuration-keyboard-layout
+                                           gdm-configuration-xorg))))
+
+                ;; For convenience, this service can be extended with an
+                ;; <xorg-configuration> record.  Take the first one that
+                ;; comes.
+                (compose (lambda (extensions)
+                           (match extensions
+                             (() #f)
+                             ((config . _) config))))
+                (extend (lambda (config xorg-configuration)
+                          (if xorg-configuration
+                              (gdm-configuration
+                               (inherit config)
+                               (xorg-configuration xorg-configuration))
+                              config)))
+
                 (default-value (gdm-configuration))
                 (description
                  "Run the GNOME Desktop Manager (GDM), a program that allows
@@ -821,4 +929,14 @@ password."
             (gdm gdm)
             (allow-empty-passwords? allow-empty-passwords?))))
 
+(define* (set-xorg-configuration config
+                                 #:optional
+                                 (login-manager-service-type
+                                  gdm-service-type))
+  "Tell the log-in manager (of type @var{login-manager-service-type}) to use
+@var{config}, an <xorg-configuration> record."
+  (simple-service 'set-xorg-configuration
+                  login-manager-service-type
+                  config))
+
 ;;; xorg.scm ends here