dunlin

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

keymap.fnl (4598B)

      1 (local { : Gdk } (require :lgi))
      2 (local { : view } (require :fennel))
      3 (local lume (require :lume))
      4 (import-macros {: trace : describe : expect : expect=} :macros)
      5 
      6 (local modifier-keyvals
      7        ;; we need to detect and discard modifier-only key events when
      8        ;; looking for the next key in a key sequence. Gtk/Gdk
      9        ;; allegedly has KeyEvent.is_modifier to do this but it's always
     10        ;; 0 because GI doesn't expose it.
     11        (let [names
     12              [
     13               :Control_L
     14               :Control_R
     15               :Control
     16               :Shift_L
     17               :Shift_R
     18               :WakeUp                   ; labelled "Fn"
     19               :Super_L                  ; labelled with Windows logo
     20               :Super_R                  ; menu key? not on my keyboard
     21               :Alt_L
     22               :Alt_R
     23               :Num_Lock
     24               :ISO_Level3_Shift         ; AltGr
     25               ]]
     26          (collect [_ n (ipairs names)]
     27            (values (Gdk.keyval_from_name n) n))))
     28 
     29 (fn modifier? [keyval]
     30   (. modifier-keyvals keyval))
     31 
     32 (fn ignored-modifier? [mod]
     33   (= mod :MOD2_MASK) ; numlock
     34   )
     35 
     36 (fn keychord->spec [keychord]
     37   (let [Mod Gdk.ModifierType
     38         symbol (keychord:match "(%w+)$")
     39 ;        upper? (and (symbol:match "%u") true)
     40         modmask (accumulate [m 0 ;(if upper? Mod.SHIFT_MASK 0)
     41                              v (keychord:gmatch "(%w+)-")]
     42                   (match (v:lower)
     43                     "m" (bor m Mod.MOD1_MASK)
     44                     "c" (bor m Mod.CONTROL_MASK)
     45                     "s" (bor m Mod.MOD4_MASK)))]
     46     {
     47      :keyval (bor (Gdk.keyval_from_name symbol) 0)
     48      : modmask
     49      }))
     50 
     51 (fn spec->index [spec]
     52   (string.format "%d:%d" spec.keyval spec.modmask))
     53 
     54 (fn event->index [event]
     55   (let [modmask
     56         (accumulate [m 0
     57                      k _ (pairs event.state)]
     58           (if (ignored-modifier? k)
     59               m
     60               (bor m (. Gdk.ModifierType (trace k)))))]
     61     (spec->index {:keyval event.keyval : modmask})))
     62 
     63 (fn compact [xs]
     64   (icollect [_ v (ipairs xs)] v))
     65 
     66 (fn index->string [index]
     67   (let [Mod Gdk.ModifierType
     68         [keyval modmask] (lume.map (lume.split index ":") tonumber)
     69         chars []]
     70     (if (> (band modmask Mod.CONTROL_MASK) 0) (table.insert chars "C"))
     71     (if (> (band modmask Mod.MOD1_MASK) 0) (table.insert chars "M"))
     72     (if (> (band modmask Mod.MOD4_MASK) 0) (table.insert chars "S"))
     73     (table.insert chars (Gdk.keyval_name keyval))
     74     (table.concat chars  "-")))
     75 
     76 (describe
     77  index->string
     78  (expect= (index->string "103:0") "g")
     79  (expect= (index->string "65:0") "A")
     80  (expect= (index->string "120:4") "C-x")
     81  (expect= (index->string "100:8") "M-d")
     82  (expect= (index->string "100:12") "C-M-d"))
     83 
     84 (fn command? [tbl]
     85   ;; a keymap entry has a string as key, a command
     86   ;; definition is a numerically-indexed array
     87   (if (. tbl 1) true))
     88 
     89 (fn keymap? [tbl]
     90   (not (. tbl 1)))
     91 
     92 (fn compile-keymap [input]
     93   (collect [k v (pairs input)]
     94     (let [f (-> k keychord->spec spec->index)]
     95       (if (keymap? v)
     96           (values f (compile-keymap v))
     97           (values f v)))))
     98 
     99 (fn ref [tbl keys]
    100   (when tbl
    101     (match keys
    102       [k1 & more] (ref (. tbl k1) more)
    103       [k1] (. tbl k1)
    104       x tbl)))
    105 
    106 (describe
    107  ref
    108  (let [v (ref {:a 1} [:a])] (expect= v 1))
    109  (let [v (ref {:a {:c 7}} [:a :c])] (expect= v 7))
    110  (let [v (ref {:a {:c 7}} [:a ])] (expect= v {:c 7}))
    111  (let [v (ref {:a {:c 7}} [:z :d])] (expect (not v))))
    112 
    113 
    114 (fn recogniser [source-keymap]
    115   (let [keymap (compile-keymap source-keymap)]
    116     (var key-sequence [])
    117     {
    118      :accept-event
    119      (fn [_ e]
    120        (when (not (modifier? e.keyval))
    121          (let [c (event->index e)]
    122            (table.insert key-sequence c)
    123            (match (ref keymap key-sequence)
    124              (where v (keymap? v))
    125              (values nil
    126                      (let [syms (lume.map key-sequence index->string)]
    127                        (table.concat syms " ")))
    128 
    129              (where v (command? v))
    130              (do
    131                (set key-sequence [])
    132                v)
    133 
    134              (where nil (= c "103:4"))
    135              (do
    136                (set key-sequence [])
    137                (values nil "cancelled"))
    138              _
    139              (let [syms (lume.map key-sequence index->string)]
    140                (set key-sequence [])
    141                (values nil (.. (table.concat syms " ") " is undefined")))))))
    142      }))
    143 
    144 
    145 { : recogniser
    146   :keyval (collect [_ name (ipairs [:Escape :Delete :BackSpace])]
    147             (values name (Gdk.keyval_from_name name)))
    148   :_ {
    149       ;; symbols in _ are exported only for testing
    150       : keychord->spec
    151       } }