87 lines
2.4 KiB
Fennel
87 lines
2.4 KiB
Fennel
(local { : Gdk } (require :lgi))
|
|
(local { : view } (require :fennel))
|
|
|
|
(local modifier-keyvals
|
|
{
|
|
;; These aren't canonical or official, this is just the
|
|
;; result of pressing keys on my keyboard. If Gtk/Gdk/GI
|
|
;; implemented KeyEvent.is_modifier we wouldn't have to
|
|
;; do this
|
|
65507 :control_l
|
|
65505 :shift_l
|
|
269025067 :fn
|
|
65515 :windows
|
|
65513 :alt_l
|
|
65027 :alt_gr
|
|
65508 :control_r
|
|
})
|
|
|
|
(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 (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 (string.byte (symbol:lower))
|
|
: 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 designates-command? [tbl]
|
|
;; a keymap entry has a string as key, a command
|
|
;; definition is a numerically-indexed array
|
|
(if (. tbl 1) true))
|
|
|
|
(fn compile-keymap [input]
|
|
(collect [k v (pairs input)]
|
|
(let [f (-> k keychord->spec spec->index)]
|
|
(if (designates-command? v)
|
|
(values f v)
|
|
(values f (compile-keymap v))))))
|
|
|
|
(fn recogniser [source-keymap]
|
|
(let [keymap (compile-keymap source-keymap)]
|
|
(var m keymap)
|
|
{
|
|
:accept-event
|
|
(fn [_ e]
|
|
(when (not (modifier? e.keyval))
|
|
(let [c (event->index e)
|
|
v (. m c)]
|
|
(if v
|
|
(if (designates-command? v)
|
|
(do
|
|
(set m keymap)
|
|
v)
|
|
(do
|
|
(set m v)
|
|
(values nil (.. c " "))))
|
|
(do
|
|
(set m keymap)
|
|
(values nil (.. "No binding for " (view e) " ")))))))
|
|
}))
|
|
|
|
|
|
{ : recogniser
|
|
:_ {
|
|
;; symbols in _ are exported only for testing
|
|
: keychord->spec
|
|
} }
|