Created
October 23, 2023 14:14
-
-
Save linktohack/cdd3356d9a1ea422ee710c90f4d6b75a to your computer and use it in GitHub Desktop.
Naive implementation of home row mods in pure Hammerspoon
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| (local fennel (require :fennel)) | |
| (local pp fennel.view) | |
| ;; CAGS | |
| (local mod-map {:a :ctrl :s :alt :d :cmd :f :shift | |
| :j :rightshift :k :rightcmd :l :rightalt ";" :rightctrl}) | |
| (local flags-map {:deviceLeftAlternate :alt | |
| :deviceLeftCommand :cmd | |
| :deviceLeftControl :ctrl | |
| :deviceLeftShift :shift | |
| :deviceRightAlternate :rightalt | |
| :deviceRightCommand :rightcmd | |
| :deviceRightControl :rightctrl | |
| :deviceRightShift :rightshift}) | |
| (var state (collect [_k v (pairs mod-map) &into {:pending nil}] | |
| (values v false))) | |
| (fn waiting? [] | |
| "Has a mod or pending?" | |
| (accumulate [ret state.pending _k v (pairs mod-map)] | |
| (or ret (. state v)))) | |
| ;; (fn synthesize [evt] | |
| ;; "Synthesize down and up events with current state of mods" | |
| ;; (local flags (icollect [_k v (ipairs [(when (or state.rightcmd) :cmd)])] v)) | |
| ;; (print :Synthesize (pp {:state state :flags flags})) | |
| ;; (let [code (evt:getKeyCode) | |
| ;; new-evts (hs.eventtap.event.newKeyEventSequence flags code)] | |
| ;; (print :Synthesize (pp (icollect [k v (pairs new-evts)] | |
| ;; {:char (v:getCharacters) | |
| ;; :code (v:getKeyCode) | |
| ;; :flags (v:getFlags)}))) | |
| ;; new-evts)) | |
| (fn synthesize [evt] | |
| "Synthesize down and up events with current state of mods" | |
| ;; pairs is needed instead of ipairs because the array contains holes | |
| (local flags (icollect [_k v (pairs [(when (or state.rightcmd state.cmd) :cmd) | |
| (when (or state.rightalt state.alt) :alt) | |
| (when (or state.rightctrl state.ctrl) :ctrl) | |
| (when (or state.rightshift state.shift) :shift)])] | |
| v)) | |
| ;; (print :Synthesize (pp {:state state :flags flags})) | |
| (let [code (evt:getKeyCode) | |
| down-evt (hs.eventtap.event.newKeyEvent flags code true) | |
| up-evt (hs.eventtap.event.newKeyEvent flags code false) | |
| new-evts [down-evt up-evt]] | |
| (print :Synthesize (pp (icollect [k v (pairs new-evts)] | |
| {:char (v:getCharacters) | |
| :code (v:getKeyCode) | |
| :flags (v:getFlags)}))) | |
| new-evts)) | |
| (fn synthesis? [evt] | |
| "Is event synthetic?" | |
| ;; (print "Synthesis?") | |
| (let [id (evt:getProperty hs.eventtap.event.properties.eventSourceStateID)] | |
| (not (= id 1)))) | |
| (fn pp-evt [msg evt] | |
| "Pretty print an event" | |
| (let [props [:eventSourceGroupID | |
| :eventSourceStateID | |
| :eventSourceUnixProcessID | |
| :eventSourceUserData | |
| :eventSourceUserID | |
| :eventTargetProcessSerialNumber | |
| :eventTargetUnixProcessID]] | |
| (print msg | |
| (pp (collect [_k v (ipairs props)] | |
| (values v (evt:getProperty (. hs.eventtap.event.properties v)))))))) | |
| (local down (hs.eventtap.new [hs.eventtap.event.types.keyDown] | |
| (fn [evt] | |
| "Handle keyDown event" | |
| ;; (print "DOWN") | |
| (if (synthesis? evt) false | |
| (let [code (evt:getKeyCode) | |
| char (. hs.keycodes.map code)] | |
| ;; (print :Down (pp {:code code :char char :state state})) | |
| ;; (pp-evt :Down evt) | |
| (case (. mod-map char) ;; is char a mod? | |
| mod (do | |
| (if ;; is the mod active? Do nothing | |
| (. state mod) | |
| nil | |
| ;; is the mod pending? Promote it as the mod, un-pending it | |
| (= state.pending code) | |
| (do | |
| (tset state mod true) | |
| (set state.pending nil)) | |
| ;; another mod pending? Set it as the mod, pending current code | |
| state.pending | |
| (let [pending-mod (->> (. hs.keycodes.map | |
| state.pending) | |
| (. mod-map))] | |
| (tset state pending-mod true) | |
| (set state.pending code)) | |
| ;; nope. Set it as pending | |
| (set state.pending code)) | |
| true) | |
| ;; not a mod, send the event if not in waiting state | |
| _ (waiting?))))))) | |
| (local up | |
| (hs.eventtap.new [hs.eventtap.event.types.keyUp] | |
| (fn [evt] | |
| "Handle keyUp event" | |
| ;; (print "UP") | |
| (if (synthesis? evt) false | |
| (let [code (evt:getKeyCode) | |
| char (. hs.keycodes.map code)] | |
| ;; (print :Up (pp {:code code :char char :state state})) | |
| ;; (pp-evt :Up evt) | |
| (case (. mod-map char) ;; is char a mod? | |
| mod (do | |
| (tset state mod false) | |
| (if (= state.pending code) | |
| ;; is the mod pending? Synthesize it as a key | |
| (do | |
| (set state.pending nil) | |
| (values true (synthesize evt))) | |
| ;; nope. Skip the key | |
| true)) | |
| ;; not a mod, send the event if not in waiting state, otherwise | |
| _ (when (waiting?) | |
| (let [new-evts []] | |
| ;; two possibilities here | |
| ;; has a pending key? Synthesize it | |
| (when state.pending | |
| (icollect [_k v (ipairs (synthesize (hs.eventtap.event.newKeyEvent | |
| [] | |
| state.pending | |
| true))) &into new-evts] | |
| v) | |
| (set state.pending nil)) | |
| ;; has a pending key? Promote it as a mod, un pending it | |
| ;; (when state.pending | |
| ;; (let [pending-mod (->> state.pending | |
| ;; (. hs.keycodes.map) | |
| ;; (. mod-map))] | |
| ;; (tset state pending-mod true) | |
| ;; (set state.pending nil))) | |
| ;; synthesize the current key stroke | |
| (icollect [_k v (ipairs (synthesize evt)) &into new-evts] | |
| v) | |
| (values true new-evts))))))))) | |
| (local change | |
| (hs.eventtap.new [hs.eventtap.event.types.flagsChanged] | |
| (fn [evt] | |
| "Handle flagsChanged" | |
| (let [flags (evt:rawFlags)] | |
| (each [k v (pairs flags-map)] | |
| (let [mask (. hs.eventtap.event.rawFlagMasks k)] | |
| (tset state v (> (band flags mask) 0)))))))) | |
| (down:start) | |
| (up:start) | |
| (change:start) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Would you know of any version of this in lua?