From 607fcc75404e2b1fc74affcf372b4a6a789ac55e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 2 Apr 2019 22:50:38 +0200
Subject: services: Add 'localed' service type and have GDM extend it.

This fixes a bug whereby GDM would always switch to US English keyboard
layout regardless to the configured Xorg keyboard layout.

* gnu/services/xorg.scm (<localed-configuration>): New record type.
(localed-dbus-service): New procedure.
(localed-service-type): New variable.
(gdm-service-type): Extend LOCALED-SERVICE-TYPE.
---
 gnu/services/xorg.scm | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 88 insertions(+), 1 deletion(-)

diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 29c7f30013..7745f9a3cc 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,6 +93,10 @@
             screen-locker-service-type
             screen-locker-service
 
+            localed-configuration
+            localed-configuration?
+            localed-service-type
+
             gdm-configuration
             gdm-service-type
             gdm-service))
@@ -653,6 +659,82 @@ 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 ","))))))))
+      (localed-configuration-localed config)))
+
+(define localed-service-type
+  (let ((package (compose list localed-configuration-localed)))
+    (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 first)
+                  (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 +869,12 @@ 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))))
+
                 (default-value (gdm-configuration))
                 (description
                  "Run the GNOME Desktop Manager (GDM), a program that allows
-- 
cgit v1.2.3