Add keybindings of xbindkeys

oni/home/data/config.scm

@@ -244,7 +244,57 @@
                                  "class_g = 'trayer'"
                                  "bounding_shaped"))))))
 
-   (service home-xbindkeys-service-type)
+   (service home-xbindkeys-service-type
+            (home-xbindkeys-configuration
+             (keybindings
+              '(((mod4 shift q) . "herbstclient quit")
+                ((mod4 shift e) . "herbstclient reload")
+                ((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")
+                ((mod4 b) . "herbstclient spawn hlwm-run-or-raise \"\\(Conkeror\\|[Ff]irefox\\|Chromium\\|Next\\|qutebrowser\\)\" firefox")
+                ((mod4 e) . "herbstclient spawn hlwm-run-or-raise Emacs emacsclient --create-frame")
+                ((control mod1 l) . "herbstclient spawn i3lock")
+                ((mod4 x) . "herbstclient spawn hlwm-switch-tags")
+                ((mod4 shift b) . "herbstclient shift left")
+                ((mod4 shift n) . "herbstclient shift down")
+                ((mod4 shift p) . "herbstclient shift up")
+                ((mod4 shift f) . "herbstclient shift right")
+                ((mod4 control b) . "herbstclient resize left +0.05")
+                ((mod4 control n) . "herbstclient resize down +0.05")
+                ((mod4 control p) . "herbstclient resize up +0.05")
+                ((mod4 control f) . "herbstclient resize right +0.05")
+                ((mod4 shift underscore) . "herbstclient split bottom 0.5")
+                ((mod4 shift bar) . "herbstclient split right 0.5")
+                ((mod4 period) . "herbstclient use_index +1 --skip-visible")
+                ((mod4 comma) . "herbstclient use_index -1 --skip-visible")
+                ((mod4 shift control f) . "herbstclient floating toggle")
+                ((mod4 f) . "herbstclient cycle_layout 1 vertical max")
+                ((mod4 m) . "herbstclient fullscreen toggle")
+                ((mod4 p) . "herbstclient pseudotile toggle")
+                ((mod4 space) . "herbstclient or , and . compare tags.focus.curframe_wcount = 2 . cycle_layout +1 vertical horizontal max vertical grid , cycle_layout +1")
+                ((mod4 BackSpace) . "herbstclient cycle_monitor")
+                ((mod4 u) . "herbstclient jumpto urgent")
+                ((XF86AudioPlay) . "herbstclient spawn mpc toggle")
+                ((XF86AudioNext) . "herbstclient spawn mpc next")
+                ((XF86AudioPrev) . "herbstclient spawn mpc prev")
+                ((mod4 r) . "herbstclient spawn rofi -show run")
+                ((mod4 w) . "herbstclient spawn rofi -show window -window-command \"/home/chelys/usr/bin/hlwm-switch-to-window {window}\"")
+                ((mod4 c)
+                 ("1" . "herbstclient move_index 0")
+                 ("2" . "herbstclient move_index 1")
+                 ("3" . "herbstclient move_index 2")
+                 ("4" . "herbstclient move_index 3")
+                 ("5" . "herbstclient move_index 4")
+                 ("6" . "herbstclient move_index 5")
+                 ("7" . "herbstclient move_index 6")
+                 ("8" . "herbstclient move_index 7")
+                 ("9" . "herbstclient move_index 8")
+                 ("0" . "herbstclient move_index 9"))
+                ((mod4 s)
+                 ("f" . "flameshot full ~/pictures/screenshots/")
+                 ("c" . "flameshot gui"))))))
 
    (service home-herbstluftwm-service-type
             (home-herbstluftwm-configuration

oni/home/services/xbindkeys.scm

@@ -10,10 +10,67 @@
   #:export (home-xbindkeys-service-type
             home-xbindkeys-configuration))
 
-(define-configuration/no-serialization home-xbindkeys-configuration
+(define-configuration home-xbindkeys-configuration
   (package
    (package xbindkeys)
-   "Package to use for setting xbindkeys"))
+   "Package to use for setting xbindkeys")
+  (keybindings
+   (alist '())
+   "Keybindings")
+  (no-serialization))
+
+(define (serialize-keymap parent keymap)
+  (string-join
+   (let* ((prefixes (filter (lambda (pair) (list? (cdr pair))) keymap))
+          (others (filter (lambda (pair) (not (list? (cdr pair)))) keymap))
+          (names (map (lambda (_) (gensym)) prefixes)))
+     (append
+      (map (lambda (key-pair sym)
+             (format #f "  (define (~s)\n  (ungrab-all-keys)\n  (remove-all-keys)\n  ~a\n  (xbindkey-function '(control g) (reset-higher-level-binding ~a))\n  (xbindkey-function '(Return) (reset-higher-level-binding ~a))\n  (xbindkey-function '(Escape) (reset-higher-level-binding ~a))\n  (grab-all-keys))\n"
+                     sym
+                     (serialize-keymap sym (cdr key-pair))
+                     parent
+                     parent
+                     parent))
+           prefixes names)
+      (map (lambda (key-pair)
+             (let ((key (car key-pair)))
+               (format #f "  (xbindkey ~s ~s)\n  (xbindkey-function '(release ~s) (reset-higher-level-binding ~a))\n"
+                       (if (string? key) key `(quote ,key))
+                       (cdr key-pair)
+                       (car key-pair)
+                       parent)))
+           others)))
+   "\n"))
+
+(define (home-xbindkeys-configuration-file config)
+  (apply mixed-text-file
+         "xbindkeysrc.scm"
+         "(define (reset-higher-level-binding level) (lambda () (ungrab-all-keys) (remove-all-keys) (level) (grab-all-keys)))\n"
+         (let* ((prefixes (filter (lambda (pair) (list? (cdr pair)))
+                                  (home-xbindkeys-configuration-keybindings config)))
+                (others (filter (lambda (pair) (not (list? (cdr pair))))
+                                (home-xbindkeys-configuration-keybindings config)))
+                (names (map (lambda (_) (gensym)) prefixes)))
+           (append
+            (map (lambda (key-pair sym)
+                   (format #f "  (define (~s)\n  (ungrab-all-keys)\n  (remove-all-keys)\n  ~a\n  (xbindkey-function '(control g) (reset-higher-level-binding ~a))\n  (xbindkey-function '(Return) (reset-higher-level-binding ~a))\n  (xbindkey-function '(Escape) (reset-higher-level-binding ~a))\n  (grab-all-keys))\n"
+                     sym
+                     (serialize-keymap "first-binding" (cdr key-pair))
+                     'first-binding
+                     'first-binding
+                     'first-binding))
+                 prefixes names)
+            (list "(define (first-binding)\n"
+                  "  \"Top-level bindings\"\n")
+            (map (lambda (key-pair sym)
+                   (let ((key (car key-pair)))
+                     (format #f "(xbindkey-function ~s ~s)\n" (if (string? key) key `(quote ,key)) sym)))
+                 prefixes names)
+            (map (lambda (key-pair)
+                   (format #f "  (xbindkey (quote ~s) ~s) \n" (car key-pair) (cdr key-pair)))
+                 others)
+            (list "  )\n")))))
 
 (define (add-xbindkeys-packages config)
   (list (home-xbindkeys-configuration-package config)))
@@ -27,7 +84,8 @@
     (start
      #~(make-forkexec-constructor
         (list #$(file-append (home-xbindkeys-configuration-package config) "/bin/xbindkeys")
-              "--nodaemon")
+              "--nodaemon"
+              "--file-guile" #$(home-xbindkeys-configuration-file config))
         #:log-file (format #f "~a/.local/var/log/xbindkeys.log" (getenv "HOME"))))
     (stop #~(make-kill-destructor)))))