diff options
author | Tom Willemse | 2022-04-20 01:23:26 -0700 |
---|---|---|
committer | Tom Willemse | 2022-04-20 01:23:26 -0700 |
commit | 2489c0fc26728f505cc95f9518b5f1ff17bae6e7 (patch) | |
tree | 189834d82e0ad3d5b311cc9c88d3ca7098eb801b /oni/home/services | |
parent | edba4af64db8808fae99e8327251af1283a35a91 (diff) | |
download | new-dotfiles-2489c0fc26728f505cc95f9518b5f1ff17bae6e7.tar.gz new-dotfiles-2489c0fc26728f505cc95f9518b5f1ff17bae6e7.zip |
Add keybindings of xbindkeys
Diffstat (limited to 'oni/home/services')
-rw-r--r-- | oni/home/services/xbindkeys.scm | 64 |
1 files changed, 61 insertions, 3 deletions
diff --git a/oni/home/services/xbindkeys.scm b/oni/home/services/xbindkeys.scm index b8e7cc9..984a163 100644 --- a/oni/home/services/xbindkeys.scm +++ b/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))))) |