conses wrote 2 years ago
(address . guix-patches@gnu.org)
---
gnu/home/services/desktop.scm | 109 ++++++++++++++++++++++++++++++++++
1 file changed, 109 insertions(+)
Toggle diff (136 lines)
diff --git a/gnu/home/services/desktop.scm b/gnu/home/services/desktop.scm
index cb25b03b64..b3c60b017e 100644
--- a/gnu/home/services/desktop.scm
+++ b/gnu/home/services/desktop.scm
@@ -22,10 +22,13 @@ (define-module (gnu home services desktop)
#:use-module (gnu home services shepherd)
#:use-module (gnu services configuration)
#:autoload (gnu packages glib) (dbus)
+ #:autoload (gnu packages xorg) (xmodmap)
#:autoload (gnu packages xdisorg) (redshift)
+ #:use-module (guix packages)
#:use-module (guix records)
#:use-module (guix gexp)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-43)
#:use-module (ice-9 match)
#:export (home-redshift-configuration
home-redshift-configuration?
@@ -226,3 +229,109 @@ (define home-dbus-service-type
(default-value (home-dbus-configuration))
(description
"Run the session-specific D-Bus inter-process message bus.")))
+
+
+;;;
+;;; xmodmap
+;;;
+
+(define-configuration/no-serialization home-xmodmap-configuration
+ (xmodmap
+ (package xmodmap)
+ "The @code{xmodmap} package to use.")
+ (config
+ (alist '())
+ "Association list of key and value pairs for the
+ @code{xmodmap} configuration file. Its syntax can take something like
+the following:
+
+@example
+'((#(add mod4) . Print)
+ (clear lock)
+ (clear control)
+ (#(keycode 66) . Control_L)
+ (#(add control) . #(Control_L Control_R)))
+@end example"))
+
+(define (home-xmodmap-shepherd-service config)
+ (list
+ (shepherd-service
+ (provision '(xmodmap))
+ (start #~(make-system-constructor
+ (string-join
+ (list #$(file-append
+ (home-xmodmap-configuration-xmodmap config)
+ "/bin/xmodmap")
+ #$(home-xmodmap-file config)))))
+ (one-shot? #t))))
+
+(define (get-xmodmap-configuration field-name val)
+ (define serialize-term
+ (match-lambda
+ ((? vector? e)
+ (string-join
+ (vector-fold
+ (lambda (i acc e)
+ (append
+ acc
+ (list (serialize-term e))))
+ '() e) " "))
+ ((? symbol? e) (symbol->string e))
+ ((? number? e) (number->string e))
+ (e e)))
+
+ (define serialize-field
+ (match-lambda
+ ((? list? e)
+ (string-join
+ (map
+ (lambda (x)
+ (serialize-term x))
+ e)
+ " "))
+ ((key . value)
+ (format #f "~a = ~a"
+ (serialize-term key)
+ (serialize-term value)))
+ (key (string-append (serialize-term key)))))
+
+ #~(string-append
+ #$@(interpose
+ (map serialize-field val)
+ "\n" 'suffix)))
+
+(define (home-xmodmap-files-service config)
+ `(("xmodmap/config"
+ ,(home-xmodmap-file config))))
+
+(define (home-xmodmap-file config)
+ (mixed-text-file
+ "config"
+ (get-xmodmap-configuration
+ #f (home-xmodmap-configuration-config config))))
+
+(define (home-xmodmap-profile-service config)
+ (list (home-xmodmap-configuration-xmodmap config)))
+
+(define home-xmodmap-service-type
+ (service-type
+ (name 'home-xmodmap)
+ (extensions
+ (list
+ (service-extension
+ home-profile-service-type
+ home-xmodmap-profile-service)
+ (service-extension
+ home-xdg-configuration-files-service-type
+ home-xmodmap-files-service)
+ (service-extension
+ home-shepherd-service-type
+ home-xmodmap-shepherd-service)))
+ (description "Configure @code{xmodmap} bindings and rules.")
+ (default-value (home-xmodmap-configuration))))
+
+(define (generate-home-xmodmap-documentation)
+ (generate-documentation
+ `((home-xmodmap-configuration
+ ,home-xmodmap-configuration-fields))
+ 'home-xmodmap-configuration))
--
2.39.1
--
Best regards,
conses