aboutsummaryrefslogtreecommitdiff
path: root/odf/odf.ml
diff options
context:
space:
mode:
Diffstat (limited to 'odf/odf.ml')
-rwxr-xr-xodf/odf.ml113
1 files changed, 69 insertions, 44 deletions
diff --git a/odf/odf.ml b/odf/odf.ml
index df98adb..da33ba9 100755
--- a/odf/odf.ml
+++ b/odf/odf.ml
@@ -6,25 +6,27 @@ let u = UTF8.from_utf8string
type t
-let load_attrs attrs =
-
- let _load t = function
- | (("urn:oasis:names:tc:opendocument:xmlns:table:1.0", "formula"), x) ->
- T.Tuple3.replace1 (Some x) t
- | (("urn:oasis:names:tc:opendocument:xmlns:office:1.0", "value"), x) ->
- T.Tuple3.replace2 (Some x) t
- | (("urn:oasis:names:tc:opendocument:xmlns:office:1.0", "date-value"), x) ->
- T.Tuple3.replace2 (Some x) t
- | (("urn:oasis:names:tc:opendocument:xmlns:table:1.0", "number-columns-repeated"), x) ->
- T.Tuple3.replace3 (Some x) t
- | _ -> t
- in List.fold_left _load (None, None, None) attrs
+(** Map for storing all the attributes *)
+module AttributesMap = Map.Make (struct
+ type t = string * string
+ let compare = Pervasives.compare
+end)
+
+let get_attr map key = begin
+ try Some (AttributesMap.find key map) with
+ Not_found -> None
+end
let load_formula formula =
let lineBuffer = Lexing.from_string formula in
- Expression.Formula (
- Expression.Expression (
- Odf_ExpressionParser.value Odf_ExpressionLexer.read lineBuffer))
+ try
+ Expression.Formula (
+ Expression.Expression (
+ Odf_ExpressionParser.value Odf_ExpressionLexer.read lineBuffer))
+ with e ->
+ print_endline formula;
+ raise e
+
let load_content content = begin function
| "float" -> Expression.Basic (
@@ -38,38 +40,52 @@ let load_content content = begin function
UTF8.from_utf8string content))
end
+(** Load the content from a cell *)
let load_cell sheet cell_num row_num changed (attrs, cell) = begin
- let attributes = load_attrs attrs in
- let repetition = match T.Tuple3.thd attributes with
+ (* Load all the attributes from the xml element *)
+ let add_attr map (key, value) = AttributesMap.add key value map in
+ let attributes = List.fold_left add_attr AttributesMap.empty attrs in
+
+ (* Check if the content is repeated *)
+ let repetition = match get_attr attributes NS.number_columns_repeat_attr with
+ | None -> 1
+ | Some x -> int_of_string x
+
+ (* cell width *)
+ and cell_width = match get_attr attributes NS.number_columns_spanned_attr with
| None -> 1
| Some x -> int_of_string x in
let vtype =
try List.assoc NS.ovalue_type_attr attrs
with Not_found -> "" in
- let expression, new_change = begin match attributes with
- | Some x, _, _ -> load_formula x, true
- | _, Some x, _ ->
+
+ let formula = get_attr attributes NS.formula_attr
+ and value = get_attr attributes NS.value_attr in
+
+ let expression, update = begin match formula, value with
+ | Some x, _ -> load_formula x, true
+ | _, Some x ->
(load_content x vtype) , true
| _ ->
begin try
Xml.member "p" cell
|> Xml.data_to_string
|> fun x -> (load_content x vtype, true)
- with Xml.Tag_not_found _ -> Expression.Basic ScTypes.Undefined, false
+ with Xml.Tag_not_found _ -> Expression.Undefined, false
end
end in
- if new_change then (
+ if update then (
for i = 1 to repetition do
- incr cell_num;
+ cell_num := !cell_num + cell_width;
sheet := snd @@ Sheet.Raw.add (!cell_num, !row_num) (Expression.load_expr expression) !sheet
done
) else (
- cell_num := !cell_num + repetition
+ cell_num := !cell_num + (repetition * cell_width )
);
- changed || new_change
+ changed || update
end
let load_row sheet row_num (attrs, row) = begin
@@ -119,13 +135,13 @@ let load file =
Zip.copy_entry_to_file zip content tmp_file;
let input = open_in_bin tmp_file in
- Tools.try_finally (fun () ->
- load_xml input
- )( fun () ->
- close_in input;
- Unix.unlink tmp_file;
- Zip.close_in zip
- )
+ Tools.try_finally
+ (fun () -> load_xml input)
+ (fun () ->
+ close_in input;
+ Unix.unlink tmp_file;
+ Zip.close_in zip
+ )
let write_type ovalue_type cvalue_type attrs output value = begin
@@ -157,7 +173,6 @@ let write_basic attrs output = begin function
| ScTypes.Date d ->
let value = Tools.Date.to_string d in
write_date ((NS.date_value_attr, value)::attrs) output value
- | _ -> ()
end
let write_formula output attrs f = begin function
@@ -180,11 +195,13 @@ let rec print_expr buffer = begin function
| ScTypes.Value (ScTypes.Num (n, _)) ->
UTF8.Buffer.add_string buffer @@ u(string_of_float @@ Num.float_of_num n)
| ScTypes.Value (ScTypes.Str s) ->
- UTF8.Buffer.add_string buffer @@ u"\"";
- UTF8.Buffer.add_string buffer s;
- UTF8.Buffer.add_string buffer @@ u"\""
- | ScTypes.Value (ScTypes.Bool b) -> UTF8.Buffer.add_string buffer @@ u(string_of_bool b)
- | ScTypes.Value x -> ()
+ UTF8.Printf.bprintf buffer "\"%s\"" (UTF8.to_utf8string s)
+ | ScTypes.Value (ScTypes.Bool b) ->
+ u(string_of_bool b)
+ |> UTF8.Buffer.add_string buffer
+ | ScTypes.Value (ScTypes.Date d) ->
+ u(Tools.Date.to_string d)
+ |> UTF8.Buffer.add_string buffer
| ScTypes.Ref r -> print_ref buffer r
| ScTypes.Expression x ->
UTF8.Buffer.add_char buffer '(';
@@ -194,6 +211,10 @@ let rec print_expr buffer = begin function
begin match (UTF8.to_utf8string ident) with
| "+" | "*" | "-" | "/" | "^" | "="
| "<>" | "<=" | ">=" | "<" | ">" -> begin match params with
+ | v1::[] ->
+ UTF8.Printf.bprintf buffer "%s%a"
+ (UTF8.to_utf8string ident)
+ print_expr v1
| v1::v2::[] ->
UTF8.Printf.bprintf buffer "%a%s%a"
print_expr v1
@@ -210,6 +231,7 @@ let rec print_expr buffer = begin function
end
let write_cell output value = begin function
+ | Expression.Undefined -> ()
| Expression.Basic b -> write_basic [] output b
| Expression.Formula (Expression.Expression f) ->
let buffer = UTF8.Buffer.create 10 in
@@ -222,8 +244,9 @@ let write_cell output value = begin function
end
(** Jump to the wanted position *)
-let goto output (from_x, from_y) (to_x, to_y) = begin
+let goto output (from_x, from_y) (to_x, to_y) :unit = begin
+ (** Insert as many rows than required *)
let insert_rows count = begin
(* Close the previous openend rows *)
Xmlm.output output `El_end;
@@ -240,6 +263,7 @@ let goto output (from_x, from_y) (to_x, to_y) = begin
1
end
+ (** Insert as many cells as required *)
and insert_cells count = begin
Xmlm.output output (
`El_start (
@@ -255,11 +279,11 @@ let goto output (from_x, from_y) (to_x, to_y) = begin
else
from_x in
let jump_cell = to_x - from_x' in
- if jump_cell > 0 then insert_cells jump_cell;
-
-
+ if jump_cell > 0 then
+ insert_cells jump_cell
end
+(** Write the cell content and return the updated position *)
let f output cursor position (expr, value) = begin
goto output cursor position;
@@ -271,7 +295,7 @@ let f output cursor position (expr, value) = begin
Tools.Tuple2.map1 ((+) 1) position
end
-let save sheet file =
+let save sheet file = begin
let tmp_file = Filename.temp_file "content" ".xml" in
Unix.unlink tmp_file;
let out_channel = open_out_bin tmp_file in
@@ -308,3 +332,4 @@ let save sheet file =
Zip.close_out zip;
Unix.unlink tmp_file
)
+end