blob: 67baad6d36cae965202fcedb0fc3a98e7e265895 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
(define-module (oni home services xbindkeys)
#:use-module (gnu services configuration)
#:use-module (gnu packages xdisorg)
#:use-module (gnu home services)
#:use-module (gnu home services shepherd)
#:use-module (gnu home services utils)
#:use-module (guix packages)
#:use-module (guix gexp)
#:export (home-xbindkeys-service-type
home-xbindkeys-configuration
home-xbindkeys-extension))
(define-configuration home-xbindkeys-configuration
(package
(package xbindkeys)
"Package to use for setting xbindkeys")
(keybindings
(alist '())
"Keybindings")
(no-serialization))
(define-configuration home-xbindkeys-extension
(keybindings
(alist '())
"Keybindings")
(no-serialization))
(define (serialize-keymap parent keymap)
(string-join
(let* ((prefixes (filter (λ (pair) (list? (cdr pair))) keymap))
(others (filter (λ (pair) (not (list? (cdr pair)))) keymap))
(names (map (λ (_) (gensym)) prefixes)))
(append
(map (λ (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 (λ (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 (λ (pair) (list? (cdr pair)))
(home-xbindkeys-configuration-keybindings config)))
(others (filter (λ (pair) (not (list? (cdr pair))))
(home-xbindkeys-configuration-keybindings config)))
(names (map (λ (_) (gensym)) prefixes)))
(append
(map (λ (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 (λ (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 (λ (key-pair)
(format #f " (xbindkey (quote ~s) ~s) \n" (car key-pair) (cdr key-pair)))
others)
(list " )\n"
"(first-binding)\n")))))
(define (add-xbindkeys-packages config)
(list (home-xbindkeys-configuration-package config)))
(define (home-xbindkeys-extensions original-config extension-configs)
(home-xbindkeys-configuration
(inherit original-config)
(keybindings
(apply append (home-xbindkeys-configuration-keybindings original-config)
(map home-xbindkeys-extension-keybindings extension-configs)))))
(define (home-xbindkeys-shepherd-service config)
(list
(shepherd-service
(documentation "Start xbindkeys")
(provision '(xbindkeys))
(auto-start? #t)
(start
#~(make-forkexec-constructor
(list #$(file-append (home-xbindkeys-configuration-package config) "/bin/xbindkeys")
"--nodaemon"
"-fg" #$(home-xbindkeys-configuration-file config))
#:log-file (format #f "~a/.local/var/log/xbindkeys.log" (getenv "HOME"))))
(stop #~(make-kill-destructor)))))
(define home-xbindkeys-service-type
(service-type
(name 'home-xbindkeys)
(extensions
(list (service-extension
home-profile-service-type
add-xbindkeys-packages)
(service-extension
home-shepherd-service-type
home-xbindkeys-shepherd-service)))
(compose identity)
(extend home-xbindkeys-extensions)
(default-value (home-xbindkeys-configuration))
(description "Install and configure xbindkeys.")))
|
