let u = UTF8.from_utf8string let redraw t screen = let screen' = Screen.draw t screen |> Screen.draw_input t in t, screen' let action f msg (t, screen) = begin let t', count = f t in let t', screen' = redraw t' screen in Screen.status screen' @@ UTF8.from_utf8string (Printf.sprintf msg count); t', screen' end let f screen = ActionParser.( begin match Screen.read_key screen with | "\027" -> ESC | "\001\002" -> DOWN | "\001\003" -> UP | "\001\004" -> LEFT | "\001\005" -> RIGHT | "\001\006" -> HOME | "\001\104" -> END | "\001R" -> NPAGE | "\001S" -> PPAGE (* See http://www.ibb.net/~anne/keyboard.html for thoses keycode. *) | "\001\074"|"\127" -> DELETE | "e" -> E | "u" -> U | "v" -> V | "y" -> Y | "p" -> P | "=" -> EQUAL | "/" -> SEARCH | ":" -> COMMAND | "\001\154" -> RESIZE | "\001\153" -> begin match Tools.NCurses.get_mouse_event () with | None -> raise Not_found | Some (id, ev, (x, y, z)) -> if Tools.NCurses.is_event_of_type Tools.NCurses.BUTTON1_CLICKED ev then BUTTON1_CLICKED(x, y) else if Tools.NCurses.is_event_of_type Tools.NCurses.BUTTON1_PRESSED ev then BUTTON1_CLICKED(x, y) else if Tools.NCurses.is_event_of_type Tools.NCurses.BUTTON1_RELEASED ev then BUTTON1_RELEASED(x, y) else raise Not_found end | _ -> raise Not_found end) let menhirParser = MenhirLib.Convert.Simplified.traditional2revised ActionParser.normal let parser screen = begin let get_value () = f screen, Lexing.dummy_pos, Lexing.dummy_pos in menhirParser get_value end let rec normal_mode (t, screen) = begin match (parser screen) with | exception x -> normal_mode (t, screen) | Actions.Visual -> Screen.status screen @@ u"-- Selection --"; selection_mode (t, screen) | Actions.Move direction -> begin match Sheet.move direction t with | Some t' -> normal_mode @@ redraw t' screen | None -> normal_mode (t, screen) end | Actions.Resize -> normal_mode (t, Screen.resize t screen) | Actions.Delete -> let yank_before_delete = fun x -> Sheet.delete (fst (Sheet.yank x)) in normal_mode @@ action yank_before_delete "Deleted %d cells" (t, screen) | Actions.Yank -> normal_mode @@ action Sheet.yank "Yanked %d cells" (t, screen) | Actions.Paste -> normal_mode @@ action Sheet.paste "Pasted %d cells" (t, screen) | Actions.Undo -> begin match Sheet.undo t with | Some t' -> normal_mode @@ redraw t' screen | None -> normal_mode (t, screen) end (* Edit a content *) | Actions.Edit -> let position = Selection.extract t.Sheet.selected in let expr = Sheet.Raw.get_expr position t.Sheet.data |> Expression.show in begin match Screen.editor ~position ~prefix:(u"-> ") ~init:expr screen with | None -> (* Restore the previous value *) Screen.status screen expr; normal_mode (t, screen) | Some content -> let expr' = Expression.load content in let _, t' = Sheet.add expr' t in normal_mode @@ redraw t' screen end (* Insert a new formula, the actual value will be erased *) | Actions.InsertFormula -> let position = Selection.extract t.Sheet.selected in begin match Screen.editor ~position ~init:(u"=") screen with | None -> (* Restore the previous value *) let expr = Sheet.Raw.get_expr position t.Sheet.data |> Expression.show in Screen.status screen expr; normal_mode (t, screen) | Some content -> let expr = Expression.load content in let _, t' = Sheet.add expr t in normal_mode @@ redraw t' screen end | Actions.Search -> let expr = Screen.search screen |> Expression.load in let pattern = Expression.eval expr (fun _ -> ScTypes.Refs.Single None) in begin match Sheet.search (`Pattern (Some pattern)) t with | Some t' -> normal_mode @@ redraw t' screen | None -> normal_mode (t, screen) end | Actions.Button1_clicked coord -> begin match Screen.get_cell screen coord with | None -> normal_mode (t, screen) | Some (x,y) -> begin match Sheet.move (Actions.Absolute (x,y)) t with | Some t' -> normal_mode @@ redraw t' screen | None -> normal_mode (t, screen) end end | Actions.Button1_released coord -> begin match Screen.get_cell screen coord with | Some (x,y) when (x,y) <> (Selection.extract t.Sheet.selected) -> Screen.status screen @@ u"-- Selection -- "; let t' = { t with Sheet.selected = Selection.extends (Actions.Absolute (x,y)) t.Sheet.selected } in let screen' = Screen.draw t' screen in selection_mode (t', screen') | _ -> normal_mode (t, screen) end | Actions.Command -> begin match Screen.editor ~prefix:(u":") screen with | None -> normal_mode (t, screen) | Some content -> let args = try UTF8.to_utf8string content |> Tools.String.split ~by:' ' with Not_found -> (UTF8.to_utf8string content, "") in command (t, screen) args end | _ -> normal_mode (t, screen) end and selection_mode (t, screen) = begin match (parser screen) with | exception x -> selection_mode (t, screen) | Actions.Resize -> selection_mode (t, Screen.resize t screen) | Actions.Delete -> let yank_before_delete = fun x -> Sheet.delete (fst (Sheet.yank x)) in normal_mode @@ action yank_before_delete "Deleted %d cells" (t, screen) | Actions.Yank -> normal_mode @@ action Sheet.yank "Yanked %d cells" (t, screen) | Actions.Escape -> let t' = { t with Sheet.selected = Selection.create (Selection.extract t.Sheet.selected) } in let screen' = Screen.draw t' screen |> Screen.draw_input t' in Screen.status screen UTF8.empty; normal_mode (t', screen') | Actions.Move m -> let t' = { t with Sheet.selected = Selection.extends m t.Sheet.selected } in let screen' = Screen.draw t' screen in selection_mode (t', screen') | Actions.Button1_clicked coord -> begin match Screen.get_cell screen coord with | None -> normal_mode (t, screen) | Some (x,y) -> begin match Sheet.move (Actions.Absolute (x,y)) t with | Some t' -> Screen.status screen UTF8.empty; normal_mode @@ redraw t' screen | None -> normal_mode (t, screen) end end | _ -> selection_mode (t, screen) end and command (t, screen) action = begin match action with | ("w", file) -> (* Save the file *) Odf.save t.Sheet.data file; normal_mode @@ redraw t screen (* | ("repr", file) -> (* Save the file *) let out_gv = open_out_bin file in let form = Format.formatter_of_out_channel out_gv in Evaluator.repr form (Evaluator.get_catalog ()); close_out out_gv; normal_mode @@ redraw t screen *) | ("enew", _) -> (* Start a new spreadsheet *) normal_mode @@ redraw (Sheet.create Sheet.Raw.empty) screen | ("q", _) -> (* Quit *) t | _ -> normal_mode @@ redraw t screen end let () = begin let catalog = Functions.built_in Functions.C.empty in ignore @@ Evaluator.set_catalog (Functions.C.compile catalog); let sheet = if Array.length Sys.argv = 1 then Sheet.Raw.empty else Odf.load Sys.argv.(1) in Screen.run (fun window -> ignore @@ normal_mode @@ redraw (Sheet.create sheet) window) end