allow modifiers in keymaps
This commit is contained in:
parent
ddef8af528
commit
15c0ce3417
|
@ -13,7 +13,7 @@
|
||||||
"g" #(Command.invoke-interactively
|
"g" #(Command.invoke-interactively
|
||||||
"visit-location"
|
"visit-location"
|
||||||
{:buffer "main"})
|
{:buffer "main"})
|
||||||
"q" #(Command.invoke-interactively
|
"M-q" #(Command.invoke-interactively
|
||||||
"quit-browser"
|
"quit-browser"
|
||||||
{})
|
{})
|
||||||
"c" {
|
"c" {
|
||||||
|
@ -54,7 +54,7 @@
|
||||||
(tset window :on_key_release_event
|
(tset window :on_key_release_event
|
||||||
(fn [window event]
|
(fn [window event]
|
||||||
(when (not (Command.active?))
|
(when (not (Command.active?))
|
||||||
(match (recogniser:accept (string.char event.keyval))
|
(match (recogniser:accept-event event)
|
||||||
c (c)
|
c (c)
|
||||||
(nil prompt) (print "prompted" prompt)))
|
(nil prompt) (print "prompted" prompt)))
|
||||||
(when (and event.state.MOD1_MASK
|
(when (and event.state.MOD1_MASK
|
||||||
|
|
75
keymap.fnl
75
keymap.fnl
|
@ -1,19 +1,64 @@
|
||||||
|
(local { : Gdk } (require :lgi))
|
||||||
|
(local { : view } (require :fennel))
|
||||||
|
|
||||||
|
(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 recogniser [keymap]
|
(fn compile-keymap [input]
|
||||||
(var m keymap)
|
(collect [k v (pairs input)]
|
||||||
{
|
(let [f (-> k keychord->spec spec->index)]
|
||||||
:accept
|
(match (type v)
|
||||||
(fn [_ c]
|
"function" (values f v)
|
||||||
(let [v (. m c)]
|
"table" (values f (compile-keymap v))))))
|
||||||
(match (type v)
|
|
||||||
"table" (do
|
(fn recogniser [source-keymap]
|
||||||
(set m v)
|
(let [keymap (compile-keymap source-keymap)]
|
||||||
(values nil (.. c " ")))
|
(var m keymap)
|
||||||
"function" (do
|
{
|
||||||
(set m keymap)
|
:accept-event
|
||||||
v))))
|
(fn [_ e]
|
||||||
})
|
(let [c (event->index e)
|
||||||
|
v (. m c)]
|
||||||
|
(match (type v)
|
||||||
|
"table" (do
|
||||||
|
(set m v)
|
||||||
|
(values nil (.. c " ")))
|
||||||
|
"function" (do
|
||||||
|
(set m keymap)
|
||||||
|
v)
|
||||||
|
"nil" (do
|
||||||
|
(set m keymap)
|
||||||
|
(values nil (.. "No binding for " (view e) " ")))
|
||||||
|
|
||||||
|
)))
|
||||||
|
}))
|
||||||
|
|
||||||
|
|
||||||
{ : recogniser }
|
{ : recogniser
|
||||||
|
:_ {
|
||||||
|
;; symbols in _ are exported only for testing
|
||||||
|
: keychord->spec
|
||||||
|
} }
|
||||||
|
|
|
@ -1,7 +1,11 @@
|
||||||
(local { : view } (require :fennel))
|
(local { : view } (require :fennel))
|
||||||
|
(local { : Gdk } (require :lgi))
|
||||||
|
|
||||||
(local keymap (require :keymap))
|
(local keymap (require :keymap))
|
||||||
|
|
||||||
|
|
||||||
|
(local Mod Gdk.ModifierType)
|
||||||
|
|
||||||
(local km
|
(local km
|
||||||
{"a"
|
{"a"
|
||||||
{"a" #1
|
{"a" #1
|
||||||
|
@ -11,10 +15,33 @@
|
||||||
"c" #4
|
"c" #4
|
||||||
})
|
})
|
||||||
|
|
||||||
|
(fn fake-key-event [c]
|
||||||
|
{:keyval (string.byte c)
|
||||||
|
:state {}
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
(let [s (keymap._.keychord->spec "q")]
|
||||||
|
(match s
|
||||||
|
{:keyval 113 :modmask 0} true
|
||||||
|
_ (assert false (view s))))
|
||||||
|
|
||||||
|
(let [s (keymap._.keychord->spec "C-a")]
|
||||||
|
(match s
|
||||||
|
{:keyval 97 :modmask 4} true
|
||||||
|
_ (assert false (view s))))
|
||||||
|
|
||||||
|
(let [s (keymap._.keychord->spec "C-M-Z")]
|
||||||
|
(match s
|
||||||
|
{:keyval 122 :modmask 13} true
|
||||||
|
_ (assert false (view s))))
|
||||||
|
|
||||||
|
|
||||||
(let [r (keymap.recogniser km)
|
(let [r (keymap.recogniser km)
|
||||||
(ok err)
|
(ok err)
|
||||||
(match (r:accept "c")
|
(match (r:accept-event (fake-key-event "c"))
|
||||||
(where f (= (f) 4)) true
|
(where f (= (f) 4)) true
|
||||||
x (values false (x)))]
|
x (values false (view x))
|
||||||
|
nil (values false "???"))]
|
||||||
|
|
||||||
(assert ok err))
|
(assert ok err))
|
||||||
|
|
Loading…
Reference in New Issue