dunlin/keymap.fnl

(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 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]
       (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
      } }