-
Notifications
You must be signed in to change notification settings - Fork 0
/
keyboard.cljs
281 lines (229 loc) · 7.87 KB
/
keyboard.cljs
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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
(ns reagent-keybindings.keyboard
(:require [reagent.core :as r]
[goog.events :as events]
[clojure.string :as s])
(:import [goog.events EventType]))
(def modifiers
(reduce (fn [m [k v]]
(assoc m k v))
{ "shift" 16
"alt" 18
"option" 18
"ctrl" 17
"control" 17
"cmd" 91
"command" 91}
(for [k (range 1 20)] [(str "f" k) (+ 111 k)])))
;; We include the mouse buttons, but will most likely never be used.
;; (Contrary to a keybinding, we often click directly on the item on
;; which we want to apply an action.)
(def mouse-buttons
{"mouse0" :m0
"mouseleft" :m0
"mouse2" :m2
"mouseright" :m2
"mouse1" :m1
"mousemiddle" :m1})
(def special-ks
{ "backspace" 8
"tab" 9
"clear" 12
"enter" 13
"return" 13
"esc" 27
"escape" 27
"space" 32
"left" 37
"up" 38
"right" 39
"down" 40
"del" 46
"delete" 46
"home" 36
"end" 35
"pageup" 33
"pagedown" 34
"," 188
"." 190
"/" 191
"`" 192
"-" 189
"=" 187,
";" 186
"'" 222
"[" 219
"]" 221
"\\" 220})
(defn- get-keycode
"Return the keycode (number) of the key given as a string."
[key]
(or (get special-ks key)
(get modifiers key)
(get mouse-buttons key)
(.charCodeAt (.toUpperCase key) 0)))
;; keyCode will give us the code the for the uppercase letter
(defn- string-to-keys*
"Convert string representation of shortcuts to their map equilavent.
Modifiers are separated from the main key by a space or a dash.
For example :
\"ctrl-a\" or \"ctrl a\""
[kb-string]
(let [keys (-> (s/lower-case kb-string)
(s/replace #"--| -" "-dash")
(s/split #" |-")
((fn [string]
(map #(s/replace % "dash" "-") string))))]
(->> (for [k (map get-keycode keys)]
(cond
(= 16 k) [:shift true]
(= 17 k) [:ctrl true]
(= 18 k) [:alt true]
:else [:keycode k]))
(into {}))))
(def string-to-keys (memoize string-to-keys*))
;;;;
(def preventing-default-keys
"Prevent the default action for these keys."
(atom [{:keycode 82 :ctrl true} ;; ctrl r ---> we never want our user to
;; reload by accident
{:keycode 83 :ctrl true} ;; ctrl s ---> don't save the HTML page
]))
(defonce keyboard-state
(r/atom {:keycode nil
:shift nil
:ctrl nil
:alt nil}))
(defonce deactivate-shortcuts-comps (atom []))
(defn shortcuts-active?
"Return true if keyboard and mouse shortcuts are active."
[]
(not (seq @deactivate-shortcuts-comps)))
(defonce registered-keys (atom {}))
(defn register-keys!
"Register a shortcut. If multiple shortcuts have the same keys,
only the most recently added will be active. Re-registering the same
keys and ID combination will update the action function without
changing the order."
[shortcut-string id action-fn]
(let [keys-map (string-to-keys shortcut-string)]
(swap! registered-keys update-in [keys-map]
(fn [action-coll]
(if (some #(= (:id %) id) action-coll)
;; ID already registered
(vec (for [entry action-coll]
(if (= id (:id entry))
(assoc entry :action-fn action-fn)
entry)))
;; New ID
(conj (or action-coll [])
{:id id
:action-fn action-fn}))))))
(defn deregister-keys! [shortcut-string id]
(let [keys-map (string-to-keys shortcut-string)]
(swap! registered-keys update-in [keys-map]
(fn [action-coll]
(vec (remove #(= (:id %) id) action-coll))))))
(defn get-keys-action
"Return the keys action, if any."
[keys-map]
(when (shortcuts-active?)
(-> (get-in @registered-keys [keys-map])
(peek)
:action-fn)))
(defn evt-modifiers
"Return the keyboard modifiers associated with this event."
[evt]
{:shift (.-shiftKey evt)
:ctrl (.-ctrlKey evt)
:alt (.-altKey evt)})
(defn key-up! [evt]
(let [keycode (.-keyCode evt)
mods (evt-modifiers evt)]
(swap! keyboard-state merge mods
(when (= keycode (:keycode @keyboard-state))
{:keycode nil}))))
(defn key-down! [evt]
(let [keycode (.-keyCode evt)
mods (evt-modifiers evt)
new-state (assoc mods :keycode keycode)
pressed-keys (into {} (filter second new-state))]
(reset! keyboard-state new-state)
(when-let [action (get-keys-action pressed-keys)]
(action evt)
(.preventDefault evt))
;; maybe prevent default action
(when (some #{pressed-keys} @preventing-default-keys)
(.preventDefault evt))))
(defn mouse-up! [evt]
(let [button (.-button evt)
keycode (condp = button
0 :m0
1 :m1
2 :m2
:else nil)
mods (evt-modifiers evt)]
(swap! keyboard-state merge mods
(when (= keycode (:keycode @keyboard-state))
{:keycode nil}))))
(defn mouse-down! [evt]
(let [button (.-button evt)
keycode (condp = button
0 :m0
1 :m1
2 :m2
:else nil)
mods (evt-modifiers evt)
new-state (assoc mods :keycode keycode)
pressed-keys (into {} (filter second new-state))]
(reset! keyboard-state new-state)
(when-let [action (get-keys-action pressed-keys)]
(action evt)
(.preventDefault evt)
(.stopPropagation evt))))
;;; API
(defn keyboard-listener
"Component that will add the necessary events listeners to the
window."
[]
(r/with-let [_ (.addEventListener js/window EventType.KEYUP key-up!)
_ (.addEventListener js/window EventType.KEYDOWN key-down!)
_ (.addEventListener js/window EventType.MOUSEUP mouse-up!)
_ (.addEventListener js/window EventType.MOUSEDOWN mouse-down!)]
[:span]
(finally (.removeEventListener js/window EventType.KEYUP key-up!)
(.removeEventListener js/window EventType.KEYDOWN key-down!)
(.removeEventListener js/window EventType.MOUSEUP mouse-up!)
(.removeEventListener js/window EventType.MOUSEDOWN mouse-down!))))
(defn kb-action
"Component to register a shortcut. If multiple shortcuts have the same keys,
only the most recently added will be active. Re-registering the same
keys and ID combination will update the action function without
changing the order.
Modifiers in `shortcut-string` are separated from the main key by a space or a dash.
For example :
\"ctrl-a\" or \"ctrl a\"
The `keyboard-listener` component must be mounted somewhere in order
for the shortcuts to be activated."
([shortcut-string kb-fn]
(let [id (gensym "kb-")]
(r/create-class
{:component-did-mount (fn [_]
(register-keys! shortcut-string id kb-fn))
:component-did-update (fn [_ [_ _ new-kb-fn]]
(when-not (= kb-fn new-kb-fn)
(register-keys! shortcut-string id kb-fn)))
:component-will-unmount (fn [_]
(deregister-keys! shortcut-string id))
:reagent-render (fn [_] [:span])}))))
(defn deactivate-kb-shortcuts
"While mounted, kb shortcuts are completely deactivated.
Useful when showing a form in a modal. (We wouldn't want the user to
activate shortcuts while typing in some text field.)"
([]
(let [id (gensym "deactivate-shortcuts-")]
(r/create-class
{:component-did-mount (fn [_]
(swap! deactivate-shortcuts-comps conj id))
:component-will-unmount (fn [_]
(swap! deactivate-shortcuts-comps #(remove #{id} %)))
:reagent-render (fn [_] [:span])}))))