diff options
-rwxr-xr-x | src/actionParser.mly | 4 | ||||
-rwxr-xr-x | src/actions.mli | 2 | ||||
-rwxr-xr-x | src/main.ml | 201 | ||||
-rwxr-xr-x | src/odf/odf.ml | 2 | ||||
-rwxr-xr-x | src/odf/odfLoader.ml | 10 | ||||
-rwxr-xr-x | src/screen.ml | 64 | ||||
-rwxr-xr-x | src/screen.mli | 11 | ||||
-rwxr-xr-x | src/selection.ml | 14 | ||||
-rwxr-xr-x | src/selection.mli | 2 | ||||
-rwxr-xr-x | src/sheet.ml | 167 | ||||
-rwxr-xr-x | src/sheet.mli | 81 | ||||
-rwxr-xr-x | tests/sheet_test.ml | 150 |
12 files changed, 310 insertions, 398 deletions
diff --git a/src/actionParser.mly b/src/actionParser.mly index 6318ca6..296467a 100755 --- a/src/actionParser.mly +++ b/src/actionParser.mly @@ -7,7 +7,6 @@ %token EOF %token LEFT RIGHT UP DOWN %token NPAGE PPAGE HOME END -%token RESIZE %token DELETE %token SEARCH %token E U V Y P @@ -16,6 +15,7 @@ %token <int*int>BUTTON1_CLICKED %token <int*int>BUTTON1_RELEASED %token COMMAND +%token RESIZE %start <Actions.actions> normal %% @@ -27,7 +27,6 @@ normal: | RIGHT { Move (Right 1) } | UP { Move (Up 1) } | DOWN { Move (Down 1) } - | RESIZE { Resize } | DELETE { Delete } | E { Edit } | U { Undo } @@ -43,3 +42,4 @@ normal: | BUTTON1_CLICKED { Button1_clicked $1} | BUTTON1_RELEASED{ Button1_released $1} | COMMAND { Command } + | RESIZE { Resize } diff --git a/src/actions.mli b/src/actions.mli index f955538..9a59aa1 100755 --- a/src/actions.mli +++ b/src/actions.mli @@ -13,7 +13,6 @@ type modes = type actions =
| Move of direction
-| Resize (* Resize event *)
| Escape
| Delete
| Yank
@@ -26,3 +25,4 @@ type actions = | Button1_clicked of (int * int)
| Button1_released of (int * int)
| Command
+| Resize
diff --git a/src/main.ml b/src/main.ml index 8e557ce..4e49aa3 100755 --- a/src/main.ml +++ b/src/main.ml @@ -2,17 +2,15 @@ module E:Sym_expr.SYM_EXPR = Evaluate 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' +let redraw t screen selection = + Screen.draw t selection screen; + Screen.draw_input t selection screen + +let action f msg (t, screen, selection) = begin + let count = f t in + redraw t screen selection; + Screen.status screen @@ UTF8.from_utf8string (Printf.sprintf msg count); + t, screen, selection end let catalog = Functions.C.compile @@ Functions.built_in Functions.C.empty @@ -67,187 +65,188 @@ let parser screen = begin menhirParser get_value end -let rec normal_mode (t, screen) = begin +let rec normal_mode (t, screen, selection) = begin match (parser screen) with - | exception x -> normal_mode (t, screen) + | exception x -> normal_mode (t, screen, selection) | Actions.Visual -> Screen.status screen @@ u"-- Selection --"; - selection_mode (t, screen) + selection_mode (t, screen, selection) | Actions.Move direction -> - begin match Sheet.move direction t with - | Some t' -> normal_mode @@ redraw t' screen - | None -> normal_mode (t, screen) + begin match Selection.move direction selection with + | Some selection -> + redraw t screen selection; + normal_mode (t, screen, selection) + | None -> normal_mode (t, screen, selection) end - | Actions.Resize -> normal_mode (t, Screen.resize t screen) + | Actions.Resize -> normal_mode (t, Screen.resize t selection screen, selection) | 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) + let yank_before_delete = fun x -> + ignore @@ Sheet.yank selection x; + Sheet.delete selection x in + normal_mode @@ action yank_before_delete "Deleted %d cells" (t, screen, selection) | Actions.Yank -> - normal_mode @@ action Sheet.yank "Yanked %d cells" (t, screen) + normal_mode @@ action (Sheet.yank selection) "Yanked %d cells" (t, screen, selection) | Actions.Paste -> - normal_mode @@ action Sheet.paste "Pasted %d cells" (t, screen) + let paste = Sheet.paste @@ Selection.extract selection in + normal_mode @@ action paste "Pasted %d cells" (t, screen, selection) | Actions.Undo -> begin match Sheet.undo t with - | Some t' -> normal_mode @@ redraw t' screen - | None -> normal_mode (t, screen) + | true -> + redraw t screen selection; + normal_mode (t, screen, selection) + | false -> normal_mode (t, screen, selection) 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 + let position = Selection.extract selection in + let expr, _, _ = Sheet.get_cell position t in + let expr_repr = Expression.show expr in + begin match Screen.editor ~position ~prefix:(u"-> ") ~init:expr_repr screen with | None -> (* Restore the previous value *) - Screen.status screen expr; - normal_mode (t, screen) + Screen.status screen expr_repr; + normal_mode (t, screen, selection) | Some content -> let expr' = Expression.load content in - let _, t' = Sheet.add expr' t in - normal_mode @@ redraw t' screen + ignore @@ Sheet.add ~history:true expr' position t; + redraw t screen selection; + normal_mode (t, screen, selection) end (* Insert a new formula, the actual value will be erased *) | Actions.InsertFormula -> - let position = Selection.extract t.Sheet.selected in + let position = Selection.extract selection 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) + let expr, _, _ = Sheet.get_cell position t in + Screen.status screen (Expression.show expr); + normal_mode (t, screen, selection) | Some content -> let expr = Expression.load content in - let _, t' = Sheet.add expr t in - normal_mode @@ redraw t' screen + ignore @@ Sheet.add ~history:true expr position t; + redraw t screen selection; + normal_mode (t, screen, selection) end -(* - | Actions.Search -> - let expr = Screen.search screen - |> Expression.load in - (*let pattern = Expression.eval expr (fun _ -> ScTypes.Refs.Single None) in*) - let pattern = Expression.eval' expr catalog 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) + | None -> normal_mode (t, screen, selection) + | Some (x,y) -> begin match Selection.move (Actions.Absolute (x,y)) selection with + | Some selection' -> + redraw t screen selection'; + normal_mode (t, screen, selection') + | None -> normal_mode (t, screen, selection) 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) -> + | Some (x,y) when (x,y) <> (Selection.extract selection) -> 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) + let selection = Selection.extends (Actions.Absolute (x,y)) selection in + Screen.draw t selection screen; + selection_mode (t, screen, selection) + | _ -> normal_mode (t, screen, selection) end | Actions.Command -> begin match Screen.editor ~prefix:(u":") screen with | None -> - normal_mode (t, screen) + normal_mode (t, screen, selection) | 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 + command (t, screen, selection) args end - | _ -> normal_mode (t, screen) + | _ -> normal_mode (t, screen, selection) end -and selection_mode (t, screen) = begin +and selection_mode (t, screen, selection) = begin match (parser screen) with - | exception x -> selection_mode (t, screen) + | exception x -> selection_mode (t, screen, selection) - | Actions.Resize -> selection_mode (t, Screen.resize t screen) + | Actions.Resize -> selection_mode (t, Screen.resize t selection screen, selection) | 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) + let yank_before_delete = fun x -> + ignore @@ Sheet.yank selection x; + Sheet.delete selection x in + normal_mode @@ action yank_before_delete "Deleted %d cells" (t, screen, selection) | Actions.Yank -> - normal_mode @@ action Sheet.yank "Yanked %d cells" (t, screen) + normal_mode @@ action (Sheet.yank selection) "Yanked %d cells" (t, screen, selection) | 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') + let selection = Selection.create (Selection.extract selection) in + Screen.draw t selection screen; + Screen.draw_input t selection screen; + Screen.status screen UTF8.empty; + normal_mode (t, screen, selection) | 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') + let selection = Selection.extends m selection in + Screen.draw t selection screen; + selection_mode (t, screen, selection) | 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' -> + | None -> normal_mode (t, screen, selection) + | Some (x,y) -> begin match Selection.move (Actions.Absolute (x,y)) selection with + | Some selection -> Screen.status screen UTF8.empty; - normal_mode @@ redraw t' screen - | None -> normal_mode (t, screen) + redraw t screen selection; + normal_mode (t, screen, selection) + | None -> normal_mode (t, screen, selection) end end - | _ -> selection_mode (t, screen) + | _ -> selection_mode (t, screen, selection) end -and command (t, screen) action = begin +and command (t, screen, selection) 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 -*) + Odf.save t file; + redraw t screen selection; + normal_mode (t, screen, selection) | ("enew", _) -> (* Start a new spreadsheet *) - normal_mode @@ redraw (Sheet.create catalog Sheet.Raw.empty) screen + let selection = Selection.create (1, 1) + and sheet = Sheet.create catalog in + redraw sheet screen selection; + normal_mode (sheet, screen, selection) | ("q", _) -> (* Quit *) t - | _ -> normal_mode @@ redraw t screen + | _ -> + redraw t screen selection; + normal_mode (t, screen, selection) end let () = begin let sheet = if Array.length Sys.argv = 1 then - Sheet.Raw.empty + Sheet.create catalog else - Odf.load catalog Sys.argv.(1) in + Odf.load catalog Sys.argv.(1) + + and selection = Selection.create (1, 1) in Screen.run (fun window -> - ignore @@ normal_mode @@ redraw (Sheet.create catalog sheet) window) + redraw sheet window selection; + ignore @@ normal_mode (sheet, window, selection) + ) end diff --git a/src/odf/odf.ml b/src/odf/odf.ml index 176e70a..1db9d4b 100755 --- a/src/odf/odf.ml +++ b/src/odf/odf.ml @@ -210,7 +210,7 @@ let save sheet file = begin Xmlm.output output (`El_start (NS.table_node, []));
Xmlm.output output (`El_start (NS.table_row_node, []));
- ignore (Sheet.Raw.fold (f output) (1,1) sheet);
+ ignore (Sheet.fold (f output) (1,1) sheet);
Xmlm.output output `El_end;
Xmlm.output output `El_end;
diff --git a/src/odf/odfLoader.ml b/src/odf/odfLoader.ml index 93a6c62..280e6bd 100755 --- a/src/odf/odfLoader.ml +++ b/src/odf/odfLoader.ml @@ -83,7 +83,7 @@ let build_p (attributes:Xmlm.attribute list) = begin function end
-let build_row (sheet:Sheet.Raw.t ref) (row_num:int ref) catalog (attributes:Xmlm.attribute list) (childs:tree list) = begin
+let build_row (sheet:Sheet.t) (row_num:int ref) (attributes:Xmlm.attribute list) (childs:tree list) = begin
let repetition =
try int_of_string @@ List.assoc (NS.table, "number-rows-repeated") attributes
@@ -94,7 +94,7 @@ let build_row (sheet:Sheet.Raw.t ref) (row_num:int ref) catalog (attributes:Xmlm List.iter (function
| Cell cell ->
for i = 1 to cell.repetition do
- sheet := snd @@ Sheet.Raw.add (!cell_num, !row_num) cell.expression catalog !sheet;
+ ignore @@ Sheet.add ~history:false cell.expression (!cell_num, !row_num) sheet;
cell_num := !cell_num + cell.cell_width
done;
| _ -> ()
@@ -109,13 +109,13 @@ let data str = Data str let load catalog source = begin
(* Mutable datas *)
- let sheet = ref Sheet.Raw.empty in
+ let sheet = Sheet.create catalog in
let cache = Hashtbl.create 10 in
let table = Base.String_dict.of_alist_exn [
((NS.text ^ "p"), build_p);
((NS.table ^ "table-cell"), build_cell cache);
- ((NS.table ^ "table-row"), build_row sheet (ref 1) catalog)
+ ((NS.table ^ "table-row"), build_row sheet (ref 1))
] in
let el (((ns, name), attributes):Xmlm.tag) childs = begin
@@ -125,6 +125,6 @@ let load catalog source = begin end in
match Xmlm.input_doc_tree ~el ~data source with
- | _, Unit -> !sheet
+ | _, Unit -> sheet
| _ -> raise Not_found
end
diff --git a/src/screen.ml b/src/screen.ml index c61efea..7888ba5 100755 --- a/src/screen.ml +++ b/src/screen.ml @@ -32,16 +32,14 @@ let get_cell screen (x, y) = begin Some (x', y') end -let center data screen height width = begin +let center data position screen height width = begin let height' = height - 3 and width' = (width - screen.left_margin) / cell_size in let end_x = (fst screen.start) + width' -1 in let end_y = (snd screen.start) + height' -2 in - let selected = Selection.extract data.Sheet.selected in - let center_axis f replace max_limit shift screen = begin - let selected_axis = f selected in + let selected_axis = f position in match (selected_axis >= f screen.start), (selected_axis > max_limit) with | true, false -> screen | _ -> { screen with start = replace (max 1 (selected_axis - shift)) screen.start } @@ -65,23 +63,20 @@ let status screen msg = begin end (** Draw the spreadsheet *) -let draw data screen = begin - - let selected = Selection.extract data.Sheet.selected in +let draw data selected screen = begin - let referenced = - Sheet.Raw.get_expr selected data.Sheet.data - |> Expression.collect_sources + let position = Selection.extract selected in - and sink = Sheet.Raw.get_sink selected data.Sheet.data in + let expr, _, sink = Sheet.get_cell position data in + let referenced = Expression.collect_sources expr in let height, width = screen.size in - let screen = center data screen height width in + let screen = center data position screen height width in for y = 1 to (height-2) do let pos_y = (y + (snd screen.start) - 1) in if (Curses.has_colors ()) then begin - if Selection.is_selected (Selection.Vertical pos_y) data.Sheet.selected then + if Selection.is_selected (Selection.Vertical pos_y) selected then Curses.wattrset screen.sheet (Attrs.color_pair 2 ) else Curses.wattrset screen.sheet (Attrs.color_pair 1 ) @@ -95,7 +90,7 @@ let draw data screen = begin for x = 0 to ((width - cell_size - screen.left_margin) / cell_size) do let pos_x = x + (fst screen.start) in if (Curses.has_colors ()) then begin - if Selection.is_selected (Selection.Horizontal pos_x) data.Sheet.selected then + if Selection.is_selected (Selection.Horizontal pos_x) selected then Curses.wattrset screen.sheet (Attrs.color_pair 2 ) else Curses.wattrset screen.sheet (Attrs.color_pair 1 ) @@ -112,7 +107,7 @@ let draw data screen = begin let pos_y = y + (snd screen.start) - 1 in if (Curses.has_colors ()) then begin - if Selection.is_selected (Selection.Cell (pos_x, pos_y)) data.Sheet.selected then + if Selection.is_selected (Selection.Cell (pos_x, pos_y)) selected then Curses.wattrset screen.sheet (Attrs.color_pair 3 ) else if Cell.Set.mem (pos_x, pos_y) referenced then Curses.wattrset screen.sheet (Attrs.color_pair 4 ) @@ -124,8 +119,9 @@ let draw data screen = begin (* Get the content from the cell *) - let content = Sheet.Raw.get_value (pos_x, pos_y) data.Sheet.data - |> Option.map (fun x -> UTF8.split ~sep:(u"\n") (ScTypes.Result.show x)) + + let _, value, _ = Sheet.get_cell (pos_x, pos_y) data in + let content = Option.map (fun x -> UTF8.split ~sep:(u"\n") (ScTypes.Result.show x)) value |> Option.default UTF8.empty in (* If the content is defined, try to encode it and print it*) @@ -143,8 +139,7 @@ let draw data screen = begin ) done done; - ignore @@ Curses.wrefresh screen.sheet; - screen + ignore @@ Curses.wrefresh screen.sheet end @@ -190,15 +185,13 @@ let close {window} = begin Curses.endwin() end -let draw_input t screen = begin +let draw_input t selected screen = begin let height, width = screen.size in - let expr = Sheet.Raw.get_expr (Selection.extract t.Sheet.selected) t.Sheet.data - |> Expression.show in + let expr, value, _ = Sheet.get_cell (Selection.extract selected) t in - let result = Sheet.Raw.get_value (Selection.extract t.Sheet.selected) t.Sheet.data - |> Option.map ScTypes.Result.show + let result = Option.map ScTypes.Result.show value |> Option.default UTF8.empty in UTF8.encode result |> Option.iter (fun encoded_result -> @@ -214,11 +207,14 @@ let draw_input t screen = begin && Curses.wrefresh screen.input) ); - status screen expr; - screen + status screen (Expression.show expr); + () end -(** Wait for an event and return the key pressed +(** Wait for an event and return the key pressed. + + Non blocking for other running Lwt thread. + If the key code contains more than one char, they are both returned *) let read_key {window} = begin @@ -238,7 +234,7 @@ let read_key {window} = begin Buffer.contents buff end -let resize data t = begin +let resize data selection t = begin let size = Curses.getmaxyx t.window in if (size <> t.size) then ( let height, width = size in @@ -253,7 +249,8 @@ let resize data t = begin && Curses.mvwin t.status (height - 1) 0); Curses.wclear t.status; ignore @@ Curses.wrefresh t.status; - draw data t + draw data selection t; + t ) else t end @@ -441,15 +438,6 @@ let editor ?position ?(prefix=UTF8.empty) ?(init=UTF8.empty) t = begin try _edit (UTF8.rev_explode init) [] @@ read_key t with _ -> None) (fun () -> ignore @@ Curses.curs_set 0) - -end - -let search screen = begin - let result = editor ~prefix:(u"/") screen in - begin match result with - | Some content -> content - | None -> UTF8.empty - end end let run f = diff --git a/src/screen.mli b/src/screen.mli index b5f74b2..0d9dc69 100755 --- a/src/screen.mli +++ b/src/screen.mli @@ -7,11 +7,11 @@ val run: (t -> 'a) -> 'a (** {2 Screen updates} *)
-val draw: Sheet.t -> t -> t
+val draw: Sheet.t -> Selection.t -> t -> unit
-val draw_input: Sheet.t -> t -> t
+val draw_input: Sheet.t -> Selection.t -> t -> unit
-val resize: Sheet.t -> t -> t
+val resize: Sheet.t -> Selection.t -> t -> t
(** Display a message in the status bar. *)
val status: t -> UTF8.t -> unit
@@ -22,8 +22,7 @@ val status: t -> UTF8.t -> unit val read_key : t -> string
(** The keycode is always NULL terminated *)
-val search: t -> UTF8.t
-
-val get_cell: t -> int * int -> (int * int) option
+(** Get the cell matching the terminal coordinates *)
+val get_cell: t -> int * int -> Sheet.cell option
val editor: ?position: int * int -> ?prefix:UTF8.t -> ?init:UTF8.t -> t -> UTF8.t option
diff --git a/src/selection.ml b/src/selection.ml index 2bf41ce..28e11fa 100755 --- a/src/selection.ml +++ b/src/selection.ml @@ -71,3 +71,17 @@ end let shift = function | Single (start_x, start_y) -> fun (x, y) -> (x - start_x, y - start_y) | Multiple ((start_x, start_y), _) -> fun (x, y) -> (x - start_x, y - start_y) + +let move direction t = + let position = extract t in + let position' = begin match direction with + | Actions.Left quant -> Tools.Tuple2.replace1 (max 1 ((fst position) - quant)) position + | Actions.Right quant -> Tools.Tuple2.replace1 ((fst position) + quant) position + | Actions.Up quant -> Tools.Tuple2.replace2 (max 1 ((snd position) - quant)) position + | Actions.Down quant -> Tools.Tuple2.replace2 ((snd position) + quant) position + | Actions.Absolute (x, y)-> (x, y) + end in + if position = position' then + None + else + Some (create position') diff --git a/src/selection.mli b/src/selection.mli index fb207e4..aa14e38 100755 --- a/src/selection.mli +++ b/src/selection.mli @@ -18,3 +18,5 @@ val shift: t -> (int * int) -> (int * int) val fold: ('a -> int * int -> 'a) -> 'a -> t -> 'a val extends: Actions.direction -> t -> t + +val move: Actions.direction -> t -> t option diff --git a/src/sheet.ml b/src/sheet.ml index 6d3c34a..881bf58 100755 --- a/src/sheet.ml +++ b/src/sheet.ml @@ -1,11 +1,5 @@ type cell = int * int
-type search = [
- | `Pattern of ScTypes.Result.t option
- | `Next
- | `Previous
-]
-
module Raw = struct
type content = {
@@ -25,14 +19,10 @@ module Raw = struct of 8×8 cells, and each array is stored in a tree. *)
module Map = PageMap.SplayMap(struct type t = content let default = empty_cell end)
- type t = Map.t
-
(** The sheet is a map which always contains evaluated values. When a cell is
updated, all the cell which references this value are also updated.
*)
- let empty = Map.empty
-
- let get_value id t = (Map.find id t).value
+ type t = Map.t
let get_expr id t = (Map.find id t).expr
@@ -41,7 +31,7 @@ module Raw = struct @return Some map if the map has been updated
*)
let update catalog cell content t = begin
- let new_val = Expression.eval content.expr catalog (fun id -> get_value id t) in
+ let new_val = Expression.eval content.expr catalog (fun id -> (Map.find id t).value) in
match content.value with
| None ->
(* If the previous value wasn't defined, update the map *)
@@ -188,7 +178,7 @@ module Raw = struct let f cell t = begin
{ cell with
expr = expression ;
- value = Some (Expression.eval expression catalog (fun id -> get_value id t)) }
+ value = Some (Expression.eval expression catalog (fun id -> (Map.find id t).value)) }
end in
add_element catalog id f t
end
@@ -198,147 +188,120 @@ module Raw = struct let f cell t =
{ cell with
expr = expr ;
- value = Some (Expression.eval expr catalog (fun id -> get_value id t))
+ value = Some (Expression.eval expr catalog (fun id -> (Map.find id t).value))
} in
add_element catalog id f t
end
- let search pattern t = begin
- let exception Found of (int * int) in
-
- let _search key content () =
- if content.value = pattern then raise (Found key) in
-
- try
- (* Iteration*)
- Map.fold _search t ();
- None
- with Found key -> Some key
- end
-
let get_sink id t =
try (Map.find id t).sink
with Not_found -> Cell.Set.empty
- (** Fold over each defined value *)
- let fold f a t = begin
- Map.fold (fun key content a ->
- match content.value with
- | None -> a
- | Some x ->
- f a key (content.expr, x)
- ) t a
- end
-
end
-type yank = cell * Raw.content
-type history = ((cell * Expression.t) list) list
-
-type t = {
- selected: Selection.t; (* The selected cell *)
+type sheet = {
data: Raw.t;
- history: history; (* Unlimited history *)
- yank: yank list;
+ history: ((cell * Expression.t) list) list; (* Unlimited history *)
+ yank: (cell * Raw.content) list;
catalog: Functions.C.t;
}
+type t = sheet ref
+
let undo t = begin
- match t.history with
- | [] -> None
+ let catalog = (!t).catalog in
+ match (!t).history with
+ | [] -> false
| hd::tl ->
let data = List.fold_left (
fun data (id, expression) ->
if Expression.is_defined expression then
- snd @@ Raw.add id expression t.catalog data
+ snd @@ Raw.add id expression catalog data
else
- snd @@ Raw.remove id t.catalog data
- ) t.data hd in
- Some { t with data = data; history = tl}
+ snd @@ Raw.remove id catalog data
+ ) (!t).data hd in
+ t:= { (!t) with data = data; history = tl};
+ true
end
-let move direction t =
- let position = Selection.extract t.selected in
- let position' = begin match direction with
- | Actions.Left quant -> Tools.Tuple2.replace1 (max 1 ((fst position) - quant)) position
- | Actions.Right quant -> Tools.Tuple2.replace1 ((fst position) + quant) position
- | Actions.Up quant -> Tools.Tuple2.replace2 (max 1 ((snd position) - quant)) position
- | Actions.Down quant -> Tools.Tuple2.replace2 ((snd position) + quant) position
- | Actions.Absolute (x, y) -> (x, y)
- end in
- if position = position' then
- None
- else
- Some {t with selected = Selection.create position'}
-
-let delete t = begin
- let catalog = t.catalog in
- let history = Selection.fold (fun acc id -> (id, Raw.get_expr id t.data)::acc) [] t.selected in
- let count, data' = Selection.fold (fun (count, c) t ->
- (count + 1, snd @@ Raw.remove t catalog c)) (0, t.data) t.selected in
- let t' = { t with
+let delete selected t = begin
+ let catalog = (!t).catalog in
+ let history = Selection.fold (fun acc id -> (id, Raw.get_expr id (!t).data)::acc) [] selected in
+ let count, data' = Selection.fold (fun (count, data) c ->
+ (count + 1, snd @@ Raw.remove c catalog (!t).data)) (0, (!t).data) selected in
+ t := { !t with
data = data';
- history = history::t.history
- } in
- t', count
+ history = history::(!t).history
+ };
+ count
end
-let yank t = begin
+let yank selected t = begin
- let shift = Selection.shift t.selected in
+ let shift = Selection.shift selected in
let origin = shift (0, 0) in
let _yank (count, extracted) cell = begin
let content =
- try let content = (Raw.Map.find cell t.data) in
+ try let content = (Raw.Map.find cell (!t).data) in
{ content with Raw.expr = Expression.shift origin content.Raw.expr }
with Not_found -> Raw.empty_cell in
count + 1, (shift cell,content)::extracted
end in
- let count, yanked = Selection.fold _yank (0, []) t.selected in
- let t' = { t with yank = List.rev yanked; } in
- t', count
+ let count, yanked = Selection.fold _yank (0, []) selected in
+ t := { !t with yank = List.rev yanked; };
+ count
end
-let paste t = begin
- let catalog = t.catalog in
+let paste shift t = begin
+ let catalog = (!t).catalog in
(* Origin of first cell *)
- let (shift_x, shift_y) as shift = Selection.extract t.selected in
+ let (shift_x, shift_y) as shift = shift in
let history' = List.map (fun ((x, y), content) ->
let id = shift_x + x, shift_y + y in
- id, Raw.get_expr id t.data) t.yank in
+ id, Raw.get_expr id (!t).data) (!t).yank in
let _paste (count, t) ((x, y), content) = begin
count + 1, snd @@ Raw.paste catalog (shift_x + x, shift_y + y) shift content t
end in
- let count, data' = List.fold_left _paste (0, t.data) t.yank in
- let t' = { t with data = data'; history = history'::t.history } in
- t', count
+ let count, data' = List.fold_left _paste (0, (!t).data) (!t).yank in
+ t := { !t with data = data'; history = history'::(!t).history };
+ count
end
-let add expression t = begin
- let id = Selection.extract t.selected in
- let prev_expression = Raw.get_expr id t.data in
- let cells, data' = Raw.add id expression t.catalog t.data in
- cells, { t with data = data'; history = [id, prev_expression]::t.history }
-end
+let add ~history expression id t = begin
+ let prev_expression = Raw.get_expr id (!t).data in
+ let cells, data' = Raw.add id expression (!t).catalog (!t).data in
-let search action t = begin match action with
- | `Pattern pattern ->
- begin match Raw.search pattern t.data with
- | None -> None
- | Some x -> Some {t with selected = Selection.create x}
- end
- | _ -> None
+ let () = if history then
+ t:= { !t with data = data'; history = [id, prev_expression]::(!t).history }
+ else
+ t:= { !t with data = data' } in
+
+ cells
end
-let create catalog data = {
- data = data;
- selected = Selection.create (1, 1);
+let create catalog = ref {
+ data = Raw.Map.empty;
history = [];
yank = [];
catalog = catalog
}
+
+(** Fold over each defined value *)
+let fold f a t = begin
+ Raw.Map.fold (fun key content a ->
+ match content.Raw.value with
+ | None -> a
+ | Some x ->
+ f a key (content.Raw.expr, x)
+ ) (!t).data a
+end
+
+let get_cell id t = begin
+ let cell = Raw.Map.find id (!t).data in
+ cell.expr, cell.value, cell.sink
+end
diff --git a/src/sheet.mli b/src/sheet.mli index 14856d4..169932e 100755 --- a/src/sheet.mli +++ b/src/sheet.mli @@ -1,80 +1,37 @@ (** This module represent a sheet *) type cell = int * int - -module Raw: sig - type t - - (** An empty sheet *) - val empty: t - - (** Add a new value in the sheet. The previous value is replaced - @return All the successors to update and the new sheet. - *) - val add: cell -> Expression.t -> Functions.C.t -> t -> Cell.Set.t * t - - val remove: cell -> Functions.C.t -> t -> Cell.Set.t * t +type t - (** Get the value content. - @return None if the cell is not defined - *) - val get_value: cell -> t -> ScTypes.Result.t option - - val get_expr: cell -> t -> Expression.t +(** Crate an empty sheet. *) +val create: Functions.C.t -> t - val get_sink: cell -> t -> Cell.Set.t - - (** Fold over all the defined values *) - val fold: ('a -> cell -> (Expression.t * ScTypes.Result.t ) -> 'a) -> 'a -> t -> 'a - -end - -type yank -type history - -type t = { - selected: Selection.t; (* The selected cell *) - data: Raw.t; - history: history; (* Unlimited history *) - yank: yank list; (* All the selected cells *) - catalog: Functions.C.t -} - -type search = [ - | `Pattern of ScTypes.Result.t option - | `Next - | `Previous -] - -(** Undo the last action and return the previous state, if any *) -val undo: t -> t option +(** Add or update the sheet. + The expression is added at given position. + @return A set containing all updated cells. *) +val add: history:bool -> Expression.t -> cell -> t -> Cell.Set.t -(** Move the cursor in one direction, return the state updated if the move is - allowed *) -val move: Actions.direction -> t -> t option +(** Undo the last action and return true if something has been undone *) +val undo: t -> bool (** Delete the content of selected cells. @return The sheet and the number of cells deleted *) -val delete: t -> t * int +val delete: Selection.t -> t -> int (** Copy the selected cells @return The sheet and the number of cells deleted *) -val yank: t -> t * int - -(** Search for a pattern on the sheet - @return The state updated if the pattern has been found. *) -val search: search -> t -> t option +val yank: Selection.t -> t -> int -val paste: t -> t * int +(** Paste all the selection at the given position. *) +val paste: cell -> t -> int -(** Add or update the sheet. - The expression is added at current selection. - @return A set containing all updated cells, and the tree updated. *) -val add: Expression.t -> t -> Cell.Set.t * t - -(** Create an empty sheet *) -val create: Functions.C.t -> Raw.t -> t +(** Fold over all the defined values *) +val fold: ('a -> cell -> (Expression.t * ScTypes.Result.t) -> 'a) -> 'a -> t -> 'a +(** Get the content from a cell. + Also return all the other cell pointing to it. +*) +val get_cell: cell -> t -> Expression.t * ScTypes.Result.t option * Cell.Set.t diff --git a/tests/sheet_test.ml b/tests/sheet_test.ml index dfa8da4..197cf88 100755 --- a/tests/sheet_test.ml +++ b/tests/sheet_test.ml @@ -23,11 +23,11 @@ let build_num value = ScTypes.Type.number @@ DataType.Num.of_int value (** Test a simple references between two cells *) let test_create_ref_1 ctx = begin - let s = Sheet.Raw.empty - |> Sheet.Raw.add (3,3) (Expression.load @@ u"=-1") catalog - |> snd |> Sheet.Raw.add (0,0) (Expression.load @@ u"=C3") catalog - |> snd in - let result = (Sheet.Raw.get_value (0, 0) s) in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=-1") (3,3) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=C3") (0,0) s; + + let _, result, _ = Sheet.get_cell (0, 0) s in let expected = Some (ScTypes.Result.Ok (build_num (-1))) in assert_equal @@ -38,14 +38,12 @@ end let test_create_ref_2 ctx = begin - let s = Sheet.Raw.empty - |> Sheet.Raw.add (2,2) (Expression.load @@ u"=C3") catalog - |> snd |> Sheet.Raw.add (3,3) (Expression.load @@ u"=A1") catalog - |> snd |> Sheet.Raw.add (1,1) (Expression.load @@ u"123") catalog - |> snd in - + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=C3") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1") (3,3) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"123") (1,1) s; - let result = (Sheet.Raw.get_value (2, 2) s) in + let _, result, _ = Sheet.get_cell (2, 2) s in let expected = Some (ScTypes.Result.Ok (build_num 123)) in assert_equal @@ -56,10 +54,10 @@ end let test_create_direct_cycle ctx = begin - let s = Sheet.Raw.empty - |> Sheet.Raw.add (2,2) (Expression.load @@ u"=B2 + 1") catalog - |> snd in - let result = (Sheet.Raw.get_value (2, 2) s) in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=B2 + 1") (2,2) s; + + let _, result, _ = Sheet.get_cell (2, 2) s in let expected = Some (ScTypes.Result.Error Errors.TypeError) in assert_equal @@ -71,11 +69,11 @@ end (** Overide the value after a cycle. *) let test_recover_from_cycle ctx = begin - let s = Sheet.Raw.empty - |> Sheet.Raw.add (2,2) (Expression.load @@ u"=B2 + 1") catalog - |> snd |> Sheet.Raw.add (2,2) (Expression.load @@ u"=6") catalog - |> snd in - let result = (Sheet.Raw.get_value (2, 2) s) in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=B2 + 1") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=6") (2,2) s; + + let _, result, _ = Sheet.get_cell (2, 2) s in let expected = Some (ScTypes.Result.Ok (build_num (6))) in assert_equal @@ -86,13 +84,13 @@ end let test_create_indirect_cycle ctx = begin - let s = Sheet.Raw.empty - |> Sheet.Raw.add (2,2) (Expression.load @@ u"=A1") catalog - |> snd |> Sheet.Raw.add (1,1) (Expression.load @@ u"=2") catalog - |> snd |> Sheet.Raw.add (1,1) (Expression.load @@ u"=B2+1") catalog - |> snd |> Sheet.Raw.add (0,0) (Expression.load @@ u"=A1") catalog - |> snd in - let result = (Sheet.Raw.get_value (0, 0) s) in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=2") (1,1) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=B2+1") (1,1) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1") (0,0) s; + + let _, result, _ = Sheet.get_cell (0, 0) s in let expected = Some (ScTypes.Result.Error Errors.Cycle) in assert_equal @@ -103,18 +101,18 @@ end let test_check_cycle3 ctx = begin - let s = Sheet.Raw.empty - (* First set A1 to 3 *) - |> Sheet.Raw.add (1,1) (Expression.load @@ u"=3") catalog - |> snd |> Sheet.Raw.add (1,2) (Expression.load @@ u"=A1") catalog - |> snd |> Sheet.Raw.add (2,2) (Expression.load @@ u"=A1") catalog - |> snd |> Sheet.Raw.add (5,5) (Expression.load @@ u"=B2") catalog - (* A3 = A1 + A1 = 6 *) - |> snd |> Sheet.Raw.add (1,3) (Expression.load @@ u"=A2 + E5") catalog - (* Then set A1 to 2 *) - |> snd |> Sheet.Raw.add (1,1) (Expression.load @@ u"=2") catalog - |> snd in - let result = (Sheet.Raw.get_value (1, 3) s) in + let s = Sheet.create catalog in + (* First set A1 to 3 *) + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=3") (1,1) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1") (1,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=B2") (5,5) s; + (* A3 = A1 + A1 = 6 *) + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A2 + E5") (1,3) s; + (* Then set A1 to 2 *) + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=2") (1,1) s; + + let _, result, _ = Sheet.get_cell (1, 3) s in (* A3 = A1 + A1 = 4 *) let expected = Some (ScTypes.Result.Ok (build_num 4)) in @@ -126,13 +124,12 @@ end let test_delete ctx = begin - let s = Sheet.Raw.empty - |> Sheet.Raw.add (2,2) (Expression.load @@ u"=C3") catalog - |> snd |> Sheet.Raw.add (3,3) (Expression.load @@ u"=A1") catalog - |> snd |> Sheet.Raw.remove (2,2) catalog - |> snd |> Sheet.Raw.remove (3,3) catalog - |> snd in - let result = (Sheet.Raw.get_value (3, 3) s) in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=C3") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1") (3,3) s; + ignore @@ Sheet.delete (Selection.create (2,2)) s; + ignore @@ Sheet.delete (Selection.create (3,3)) s; + let _, result, _ = Sheet.get_cell (3, 3) s in let expected = None in assert_equal @@ -143,12 +140,12 @@ end let test_update_succs1 ctx = begin - let result = Sheet.Raw.empty - |> Sheet.Raw.add (1,1) (Expression.load @@ u" =1") catalog - |> snd |> Sheet.Raw.add (2,2) (Expression.load @@ u"=A2") catalog - |> snd |> Sheet.Raw.add (1,2) (Expression.load @@ u"=A1/1") catalog - |> snd |> Sheet.Raw.add (1,1) (Expression.load @@ u"=2") catalog - |> fst in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u" =1") (1,1) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A2") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1/1") (1,2) s; + + let result = Sheet.add ~history:false (Expression.load @@ u"=2") (1,1) s in (* All the cells are updated by the change *) let expected = Cell.Set.of_list [(1,1); (1, 2); (2,2)] in @@ -164,12 +161,13 @@ end let test_update_succs2 ctx = begin - let result = Sheet.Raw.empty - |> Sheet.Raw.add (1,1) (Expression.load @@ u"=1") catalog - |> snd |> Sheet.Raw.add (2,2) (Expression.load @@ u"=A2") catalog - |> snd |> Sheet.Raw.add (1,2) (Expression.load @@ u"=A1/0") catalog - |> snd |> Sheet.Raw.add (1,1) (Expression.load @@ u"=2") catalog - |> fst in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=1") (1,1) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A2") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1/0") (1,2) s; + + let result = Sheet.add ~history:false (Expression.load @@ u"=2") (1,1) s in + (* Only (1, 1) is updated ; (2, 2) does not change, neither (2, 2) *) let expected = Cell.Set.of_list [(1,1)] in @@ -180,19 +178,14 @@ end let test_paste_undo ctx = begin - let empty = Sheet.create catalog Sheet.Raw.empty in - (* The expected result for the whole test *) let expected = Some (ScTypes.Result.Ok (ScTypes.Type.number (DataType.Num.of_int 6))) in - let sheet = empty - |> Tools.Option.test @@ Sheet.move (Actions.Absolute (2, 1)) - |> Sheet.add (Expression.load @@ u"=6") - |> snd - |> Tools.Option.test @@ Sheet.move (Actions.Absolute (1, 1)) - |> Sheet.add (Expression.load @@ u"=B1") - |> snd in - let result = Sheet.Raw.get_value (1, 1) sheet.Sheet.data in + let sheet = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=6") (2, 1) sheet; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=B1") (1, 1) sheet; + + let _, result, _ = Sheet.get_cell (1, 1) sheet in (* Ensure the value is correctly evaluated *) assert_equal @@ -200,17 +193,14 @@ let test_paste_undo ctx = begin expected result; - let sheet2 = - (* Copy the cell *) - fst @@ Sheet.yank sheet - |> Tools.Option.test @@ Sheet.move (Actions.Absolute (2, 1)) - (* Paste it on another value *) - |> Sheet.paste - |> fst - (* Undo the paste *) - |> Tools.Option.test @@ Sheet.undo in - - let result = Sheet.Raw.get_value (1, 1) sheet2.Sheet.data in + (* Copy the cell *) + ignore @@ Sheet.yank (Selection.create (1, 1)) sheet; + (* Paste it on another value *) + ignore @@ Sheet.paste (2, 1) sheet; + (* Undo the paste *) + assert_equal true (Sheet.undo sheet); + + let _, result, _ = Sheet.get_cell (1, 1) sheet in (* The value should be the same as the first evaluation *) assert_equal |