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