From e8cdf76fbfaa6bd6c79b7a44a22e277c62781c9e Mon Sep 17 00:00:00 2001
From: Tom Willemse
Date: Fri, 22 Jul 2022 21:12:45 -0700
Subject: Move a couple of keybindings to herbstluftwm

---
 GNUmakefile                        |  3 +++
 oni/home/data/config.scm           | 13 +++++++------
 oni/home/services/herbstluftwm.scm | 20 +++++++++++++++++---
 oni/kbd.scm                        | 29 +++++++++++++++++++++++++++++
 test/kbd.scm                       | 28 ++++++++++++++++++++++++++++
 5 files changed, 84 insertions(+), 9 deletions(-)
 create mode 100644 oni/kbd.scm
 create mode 100644 test/kbd.scm

diff --git a/GNUmakefile b/GNUmakefile
index 2f5d0e8..f368adb 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -143,6 +143,9 @@ nyxt: nyxt/.config/nyxt/init.lisp
 %.zwc: %
 	zsh -c "zcompile $@ $^"
 
+check:
+	$(SCHEME_IMPLEMENTATION) --no-auto-compile test.scm
+
 # Local Variables:
 # outline-regexp: "##+"
 # End:
diff --git a/oni/home/data/config.scm b/oni/home/data/config.scm
index f54221f..a81bd1e 100644
--- a/oni/home/data/config.scm
+++ b/oni/home/data/config.scm
@@ -255,9 +255,7 @@
    (service home-xbindkeys-service-type
             (home-xbindkeys-configuration
              (keybindings
-              '(((mod4 shift q) . "herbstclient quit")
-                ((mod4 shift e) . "herbstclient reload")
-                ((mod4 k) . "hersbtclient close")
+              '(((mod4 k) . "hersbtclient close")
                 ((mod4 mod1 k) . "herbstclient remove")
                 ((mod4 Return) . "herbstclient spawn kitty")
                 ((mod4 t) . "herbstclient spawn hlwm-run-or-raise \"\\(URxct\\|Hyper\\|kitty\\)\" kitty")
@@ -305,10 +303,13 @@
    (service home-herbstluftwm-service-type
             (home-herbstluftwm-configuration
              (tags '(dev web game))
+             (key-bindings
+              '(("s-S-q" . "quit")
+                ("s-S-e" . "reload")))
              (mouse-bindings
-              '(("Mod4-Button1" . "move")
-                ("Mod4-Button2" . "zoom")
-                ("Mod4-Button3" . "resize")))
+              '(("s-Button1" . "move")
+                ("s-Button2" . "zoom")
+                ("s-Button3" . "resize")))
              (settings
               '((default_frame_layout . 2)
                 (frame_border_active_color . "#3d3d3d")
diff --git a/oni/home/services/herbstluftwm.scm b/oni/home/services/herbstluftwm.scm
index caa78df..70aa916 100644
--- a/oni/home/services/herbstluftwm.scm
+++ b/oni/home/services/herbstluftwm.scm
@@ -8,6 +8,7 @@
   #:use-module (guix gexp)
   #:use-module (oni home services xinit)
   #:use-module (oni gexp)
+  #:use-module (oni kbd)
   #:use-module (srfi srfi-1)
 
   #:export (home-herbstluftwm-service-type
@@ -17,6 +18,9 @@
   (package
    (package herbstluftwm)
    "Package use for setting herbstluftwm")
+  (key-bindings
+   (alist '())
+   "Key bindings")
   (mouse-bindings
    (alist '())
    "Mouse bindings")
@@ -48,17 +52,27 @@
 (define (add-herbstluftwm-packages config)
   (list (home-herbstluftwm-configuration-package config) zsh))
 
+(define (build-keybindings bindings)
+  (append
+   (list "herbstclient keyunbind --all\n")
+   (map (lambda (binding)
+          (format #f "herbstclient keybind ~a ~a\n"
+                  (kbd (car binding)) (cdr binding)))
+        bindings)))
+
 (define (home-herbstluftwm-autostart-file config)
   (apply mixed-executable-file
          "autostart"
          "#!" zsh "/bin/zsh\n"
          "herbstclient emit_hook reload\n"
-         "herbstclient keyunbind --all\n"
          (let ((tags (home-herbstluftwm-configuration-tags config)))
-           (append (list "herbstclient mouseunbind --all\n")
+           (append (build-keybindings
+                    (home-herbstluftwm-configuration-key-bindings config))
+
+                   (list "herbstclient mouseunbind --all\n")
                    (map (lambda (binding)
                           (format #f "herbstclient mousebind ~a ~a\n"
-                                  (car binding) (cdr binding)))
+                                  (kbd (car binding)) (cdr binding)))
                         (home-herbstluftwm-configuration-mouse-bindings config))
                    (map (lambda (setting)
                           (format #f "herbstclient set ~s ~s\n"
diff --git a/oni/kbd.scm b/oni/kbd.scm
new file mode 100644
index 0000000..eb7f8d7
--- /dev/null
+++ b/oni/kbd.scm
@@ -0,0 +1,29 @@
+(define-module (oni kbd)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+
+  #:export (kbd))
+
+(define (convert-modifier mod)
+  (match mod
+    ("C" "Ctrl")
+    ("M" "Mod1")
+    ("S" "Shift")
+    ("s" "Mod4")))
+
+(define (convert-key key)
+  (match key
+    ("RET" "Return")
+    ("SPC" "space")
+    ("<backspace>" "BackSpace")
+    (_ key)))
+
+(define (kbd str)
+  (let ((parts (string-split str #\-)))
+    (string-join
+     (fold-right (lambda (key previous)
+                   (if (null? previous)
+                       (list (convert-key key))
+                       (cons (convert-modifier key) previous)))
+                 '() parts)
+     "-")))
diff --git a/test/kbd.scm b/test/kbd.scm
new file mode 100644
index 0000000..52eb3d3
--- /dev/null
+++ b/test/kbd.scm
@@ -0,0 +1,28 @@
+(define-module (test kbd)
+  #:use-module (srfi srfi-64)
+  #:use-module (oni kbd))
+
+(test-begin "kbd-test")
+
+(test-equal "Any letter alone is untouched"
+  "s" (kbd "s"))
+(test-equal "The `s' modifier is converted to `Mod4'"
+  "Mod4-s" (kbd "s-s"))
+(test-equal "The `S' modifier is converted to `Shift'"
+  "Shift-s" (kbd "S-s"))
+(test-equal "The `M' modifier is converted to `Mod1'"
+  "Mod1-x" (kbd "M-x"))
+(test-equal "The `C' modifier is converted to `Ctrl'"
+  "Ctrl-f" (kbd "C-f"))
+(test-equal "Two modifiers can be combined"
+  "Mod4-Shift-q" (kbd "s-S-q"))
+(test-equal "Three modifiers can be combined"
+  "Mod4-Shift-Ctrl-f" (kbd "s-S-C-f"))
+(test-equal "The `RET' key is converted to `Return'"
+  "Mod4-Return" (kbd "s-RET"))
+(test-equal "The `SPC' key is converted to `space'"
+  "Ctrl-space" (kbd "C-SPC"))
+(test-equal "The `<backspace>' key is converted to `BackSpace'"
+  "Mod1-BackSpace" (kbd "M-<backspace>"))
+
+(test-end "kbd-test")
-- 
cgit v1.2.3-54-g00ecf