140 lines
4.3 KiB
Fennel
140 lines
4.3 KiB
Fennel
(local { : Gdk } (require :lgi))
|
|
(local { : view } (require :fennel))
|
|
(local lume (require :lume))
|
|
|
|
(local modifier-keyvals
|
|
;; we need to detect and discard modifier-only key events when
|
|
;; looking for the next key in a key sequence. Gtk/Gdk
|
|
;; allegedly has KeyEvent.is_modifier to do this but it's always
|
|
;; 0 because GI doesn't expose it.
|
|
(let [names
|
|
[
|
|
:Control_L
|
|
:Control_R
|
|
:Control
|
|
:Shift_L
|
|
:Shift_R
|
|
:WakeUp ; labelled "Fn"
|
|
:Super_L ; labelled with Windows logo
|
|
:Super_R ; menu key? not on my keyboard
|
|
:Alt_L
|
|
:Alt_R
|
|
:ISO_Level3_Shift ; AltGr
|
|
]]
|
|
(collect [_ n (ipairs names)]
|
|
(values (Gdk.keyval_from_name n) n))))
|
|
|
|
(fn modifier? [keyval]
|
|
(. modifier-keyvals keyval))
|
|
|
|
(fn keychord->spec [keychord]
|
|
(let [Mod Gdk.ModifierType
|
|
symbol (keychord:match "(%w+)$")
|
|
; upper? (and (symbol:match "%u") true)
|
|
modmask (accumulate [m 0 ;(if upper? Mod.SHIFT_MASK 0)
|
|
v (keychord:gmatch "(%w+)-")]
|
|
(match (v:lower)
|
|
"m" (bor m Mod.MOD1_MASK)
|
|
"c" (bor m Mod.CONTROL_MASK)
|
|
"s" (bor m Mod.MOD4_MASK)))]
|
|
{
|
|
:keyval (Gdk.keyval_from_name symbol)
|
|
: modmask
|
|
}))
|
|
|
|
(fn spec->index [spec]
|
|
(string.format "%d:%d" spec.keyval spec.modmask))
|
|
|
|
(fn event->index [event]
|
|
(let [modmask
|
|
(accumulate [m 0
|
|
k _ (pairs event.state)]
|
|
(bor m (. Gdk.ModifierType k)))]
|
|
(spec->index {:keyval event.keyval : modmask})))
|
|
|
|
(fn compact [xs]
|
|
(icollect [_ v (ipairs xs)] v))
|
|
|
|
(fn index->string [index]
|
|
(let [Mod Gdk.ModifierType
|
|
[keyval modmask] (lume.map (lume.split index ":") tonumber)
|
|
chars []]
|
|
(if (> (band modmask Mod.CONTROL_MASK) 0) (table.insert chars "C"))
|
|
(if (> (band modmask Mod.MOD1_MASK) 0) (table.insert chars "M"))
|
|
(if (> (band modmask Mod.MOD4_MASK) 0) (table.insert chars "S"))
|
|
(table.insert chars (Gdk.keyval_name keyval))
|
|
(table.concat chars "-")))
|
|
|
|
(let [v (index->string "103:0")] (assert (= v "g") v))
|
|
(let [v (index->string "65:0")] (assert (= v "A") v))
|
|
(let [v (index->string "120:4")] (assert (= v "C-x") v))
|
|
(let [v (index->string "100:8")] (assert (= v "M-d") v))
|
|
(let [v (index->string "100:12")] (assert (= v "C-M-d") v))
|
|
|
|
(fn command? [tbl]
|
|
;; a keymap entry has a string as key, a command
|
|
;; definition is a numerically-indexed array
|
|
(if (. tbl 1) true))
|
|
|
|
(fn keymap? [tbl]
|
|
(not (. tbl 1)))
|
|
|
|
(fn compile-keymap [input]
|
|
(collect [k v (pairs input)]
|
|
(let [f (-> k keychord->spec spec->index)]
|
|
(if (keymap? v)
|
|
(values f (compile-keymap v))
|
|
(values f v)))))
|
|
|
|
(fn ref [tbl keys]
|
|
(when tbl
|
|
(match keys
|
|
[k1 & more] (ref (. tbl k1) more)
|
|
[k1] (. tbl k1)
|
|
x tbl)))
|
|
|
|
(let [v (ref {:a 1} [:a])] (assert (= v 1) v))
|
|
(let [v (ref {:a {:c 7}} [:a :c])] (assert (= v 7) v))
|
|
(let [v (ref {:a {:c 7}} [:a ])] (assert (match v {:c 7} true) (view v)))
|
|
(let [v (ref {:a {:c 7}} [:z :d])] (assert (not v) v))
|
|
|
|
|
|
(fn recogniser [source-keymap]
|
|
(let [keymap (compile-keymap source-keymap)]
|
|
(var key-sequence [])
|
|
{
|
|
:accept-event
|
|
(fn [_ e]
|
|
(when (not (modifier? e.keyval))
|
|
(let [c (event->index e)]
|
|
(table.insert key-sequence c)
|
|
(match (ref keymap key-sequence)
|
|
(where v (keymap? v))
|
|
(values nil
|
|
(let [syms (lume.map key-sequence index->string)]
|
|
(table.concat syms " ")))
|
|
|
|
(where v (command? v))
|
|
(do
|
|
(set key-sequence [])
|
|
v)
|
|
|
|
(where nil (= c "103:4"))
|
|
(do
|
|
(set key-sequence [])
|
|
(values nil "cancelled"))
|
|
_
|
|
(let [syms (lume.map key-sequence index->string)]
|
|
(set key-sequence [])
|
|
(values nil (.. (table.concat syms " ") " is undefined")))))))
|
|
}))
|
|
|
|
|
|
{ : recogniser
|
|
:keyval (collect [_ name (ipairs [:Escape :Delete :BackSpace])]
|
|
(values name (Gdk.keyval_from_name name)))
|
|
:_ {
|
|
;; symbols in _ are exported only for testing
|
|
: keychord->spec
|
|
} }
|