Keymap

Keymap.fs

module Keymap = 

    type Modifier = Ctrl = 1 | Alt = 2 | Win = 4 | Shift = 8 | None = 0

    type KeyStroke = Key of Modifier * string

    type Keyseq = KeyStroke list

    type CommandFn = Keyseq -> Unit

    type KeymapItem = Command of CommandFn | Keymap of TKeymap
    and  TKeymap = Map<KeyStroke, KeymapItem>

    // Sicuramente c'e' un modo migliore di fare questo :V
    let rec to_mods ss = 
        let f (s2:string) = 
            match s2 with
            | "C" -> Modifier.Ctrl
            | "A" -> Modifier.Alt
            | "W" -> Modifier.Win
            | "S" -> Modifier.Shift
            | x -> failwith (sprintf "%A invalid modifier" x)
        match ss with 
        | x :: xs -> (f x) ||| (to_mods xs)
        | [] -> Modifier.None

    let to_keystroke (s2:string) = 
        let modsAndKey = Array.toList (s2.Split '-')

        let mods, k = match modsAndKey  with
            | x :: y :: xs ->  
                let len = List.length modsAndKey
                let mods = List.take (len - 1) modsAndKey
                let key = List.last modsAndKey
                ((to_mods mods), key)
            | [x] -> (Modifier.None, x)

        Key(mods, k)

    // takes a string like "C-x C-c" and transforms it to a Keyseq
    let string_to_keyseq (s:string) : Keyseq = 
        (s.Split ' ')
        |> Array.toList
        |> List.map to_keystroke 

    type InterpretResult = Fail | PartialMatch | Match of CommandFn

     

    let rec interpret (keyseq:Keyseq) (keymap:TKeymap) = 
        match keyseq with
        | x :: xs -> 
            match Map.tryFind x keymap with
            | Some(Keymap km)  -> 
                match xs with 
                | y :: ys -> interpret xs km
                | [] -> PartialMatch
            | Some(Command f) -> Match f
            | None -> Fail

        | [] -> PartialMatch
        
    let rec interpret_string (keyseq:string) (keymap:TKeymap) = 
        interpret (string_to_keyseq keyseq) keymap

    
    let rec define_key2 (keyseq:Keyseq) (a:CommandFn) (keymap:TKeymap) = 
        match keyseq with
        | [k] -> Map.add k (Command a) keymap
        | k :: ks -> 
            match Map.tryFind k keymap with
            | Some (Keymap km) -> Map.add k (Keymap (define_key2 ks a km)) keymap
            | _ -> define_key2 keyseq a (Map.add k (Keymap Map.empty) keymap)

    let define_key (keyseq:string) (a:CommandFn) (keymap:TKeymap) = 
        define_key2 (string_to_keyseq keyseq) a keymap

    let eval_keyseq (keyseq:Keyseq) (keymap:TKeymap) = 
        match interpret keyseq keymap with
        | PartialMatch -> printfn "More"
        | Fail -> printfn "Fail"
        | Match f -> f keyseq

    let eval (keyseq:string) (keymap:TKeymap) = 
        eval_keyseq (string_to_keyseq keyseq)  keymap

        
let m1 = Keymap.define_key "C-f" (fun x -> printfn "foobar") Map.empty
let m2 = 
    Map.empty
    |> Keymap.define_key "C-f" (fun x -> printfn "forward-key")
    |> Keymap.define_key "C-b" (fun x -> printfn "backward-key")
    |> Keymap.define_key "C-x C-c" (fun x -> printfn "exit")

let exitseq = Keymap.string_to_keyseq "C-x C-c"

Keymap.eval_keyseq exitseq m2

Keymap.eval "C-f" m2
Keymap.eval "C-b" m2
Keymap.eval "C-x C-c" m2