From 511ae8325db0dfc7803d7b98d7e4d8f76774e8c5 Mon Sep 17 00:00:00 2001
From: conses <contact@conses.eu>
Date: Fri, 17 Mar 2023 13:06:35 +0100
Subject: home: services: Add home-xmodmap-service-type.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* gnu/home/services/desktop.scm (home-xmodmap-service-type)
(home-xmodmap-configuration): New variables;
(serialize-xmodmap-configuration)
(xmodmap-shepherd-service): New procedures;
* doc/guix.texi (Desktop Services): Document it.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 gnu/home/services/desktop.scm | 57 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 57 insertions(+)

(limited to 'gnu/home/services')

diff --git a/gnu/home/services/desktop.scm b/gnu/home/services/desktop.scm
index ab2b871539..fb1cd44060 100644
--- a/gnu/home/services/desktop.scm
+++ b/gnu/home/services/desktop.scm
@@ -24,6 +24,7 @@
   #:use-module (gnu services configuration)
   #:autoload   (gnu packages glib)    (dbus)
   #:autoload   (gnu packages xdisorg) (redshift unclutter)
+  #:autoload   (gnu packages xorg) (setxkbmap xmodmap)
   #:use-module (guix records)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
@@ -275,3 +276,59 @@ according to time of day.")))
    (description "Run the @code{unclutter} daemon, which, on systems using the
 Xorg graphical display server, automatically hides the cursor after a
 user-defined timeout has expired.")))
+
+
+;;;
+;;; Xmodmap.
+;;;
+
+(define-configuration/no-serialization home-xmodmap-configuration
+  (xmodmap
+   (file-like xmodmap)
+   "The @code{xmodmap} package to use.")
+  (key-map
+   (list '())
+   "List of expressions to be read by @code{xmodmap} on service startup."))
+
+(define (serialize-xmodmap-configuration field-name val)
+  (define serialize-field
+    (match-lambda
+      ((key . value)
+       (format #f "~a = ~a" key value))
+      (e e)))
+
+  #~(string-append
+     #$@(interpose (map serialize-field val) "\n" 'suffix)))
+
+(define (xmodmap-shepherd-service config)
+  (define config-file
+    (mixed-text-file
+     "config"
+     (serialize-xmodmap-configuration
+      #f (home-xmodmap-configuration-key-map config))))
+
+  (list
+   (shepherd-service
+    (provision '(xmodmap))
+    (start #~(make-system-constructor
+              (string-join
+               (list #$(file-append
+                        (home-xmodmap-configuration-xmodmap config)
+                        "/bin/xmodmap")
+                     #$config-file))))
+    (stop #~(make-system-constructor
+             #$(file-append setxkbmap "/bin/setxkbmap")))
+    (documentation "On startup, run @code{xmodmap} and read the expressions in
+the configuration file.  On stop, reset all the mappings back to the
+defaults."))))
+
+(define home-xmodmap-service-type
+  (service-type
+   (name 'home-xmodmap)
+   (extensions
+    (list
+     (service-extension home-shepherd-service-type
+                        xmodmap-shepherd-service)))
+   (default-value (home-xmodmap-configuration))
+   (description "Run the @code{xmodmap} utility to modify keymaps and pointer
+buttons under the Xorg display server via user-defined expressions.")))
-- 
cgit 1.4.1