Merge pull request #412 from AltGr/fix-utf8

Fix the display of utf8 characters in the code editor

Author: erikmd

src/ace-lib/ace.ml

@@ -47,14 +47,6 @@ let read_range range =
   ((range##.start##.row, range##.start##.column),
    (range##.end_##.row, range##.end_##.column))
 
-let get_contents ?range {editor} =
-  let document = (editor##getSession)##getDocument in
-  match range with
-  | None ->
-      Js.to_string @@ document##getValue
-  | Some r ->
-      Js.to_string @@ document##(getTextRange r)
-
 let set_contents ?(reset_undo=false) {editor} code =
   let session = editor##getSession in
   session##getDocument##setValue (Js.string code);
@@ -71,6 +63,20 @@ let get_line {editor} line =
   let document = (editor##getSession)##getDocument in
   Js.to_string @@ document##(getLine line)
 
+let get_contents ?range e =
+  let document = (e.editor##getSession)##getDocument in
+  match range with
+  | None ->
+      Js.to_string @@ document##getValue
+  | Some r ->
+      (* Bytes range to utf8 string range conversion *)
+      let (r1,c1), (r2, c2) = read_range r in
+      let l1, l2 = get_line e r1, get_line e r2 in
+      let c1 = Js_utils.pos8_to_pos16 l1 c1 in
+      let c2 = Js_utils.pos8_to_pos16 l2 c2 in
+      let r = create_range (create_position r1 c1) (create_position r2 c2) in
+      Js.to_string @@ document##(getTextRange r)
+
 let create_editor editor_div =
   let editor = edit editor_div in
   Js.Unsafe.set editor "$blockScrolling" (Js.Unsafe.variable "Infinity");
@@ -122,7 +128,14 @@ let set_mark editor ?loc ?(type_ = Message) msg =
     | Some { loc_start = (sr, sc) ; loc_end = (er, ec) } ->
         let sr = sr - 1 in
         let er = er - 1 in
+        (* Corrects column positions for unicode strings *)
+        let sline = get_line editor sr in
+        let eline = get_line editor er in
+        let sc = Js_utils.pos8_to_pos16 sline sc in
+        let ec = Js_utils.pos8_to_pos16 ~stop_before:false eline ec in
+        (* end position corrections *)
       sr, sc, Some (range sr sc er ec) in
+
   let annot : annotation Js.t = Js.Unsafe.obj [||] in
   annot##.row := sr;
   annot##.column := sc;
@@ -203,8 +216,10 @@ type token = Ace_types.token Js.t
 let token ~type_ value =
   let obj : Ace_types.token Js.t = Js.Unsafe.obj [||] in
   obj##.value := Js.string value;
+  obj##._val := value;
   obj##._type := Js.string type_;
   obj
+let get_token_val token = token##._val
 
 type doc = Ace_types.document Js.t
 

src/ace-lib/ace.mli

@@ -80,6 +80,7 @@ val set_custom_data: 'a editor -> 'a -> unit
 
 type token
 val token: type_:string -> string -> token
+val get_token_val: token -> string
 
 type 'state helpers = {
   initial_state: unit -> 'state;

src/ace-lib/ace_types.mli

@@ -10,6 +10,7 @@ open Js_of_ocaml
 
 class type token = object
   method value : Js.js_string Js.t Js.prop
+  method _val : string Js.prop
   method _type : Js.js_string Js.t Js.prop
 end
 

src/ace-lib/ocaml_mode.ml

@@ -298,11 +298,18 @@ let get_line_tokens line st row doc =
         if !debug_indent > 1 && tok.token <> EOL && tok.token <> ESCAPED_EOL then
           IndentBlock.dump block;
         let st = { block; lex_ctxt; } in
-        match tok.token with
-        | EOL | ESCAPED_EOL ->
+        let type_ = token_type tok.token in
+        match tok.token, tokens with
+        | ILLEGAL_CHAR c, t::toks ->
+          let t = Ace.token ~type_ ((Ace.get_token_val t)^(String.make 1 c)) in
+          iter st offset stream (t :: toks)
+        | STRING_CONTENT, t::toks ->
+          let t = Ace.token ~type_ ((Ace.get_token_val t)^tok.between^tok.substr) in
+          iter st offset stream (t :: toks)
+        | EOL, _ | ESCAPED_EOL, _ ->
             (* FIXME some spaces ??? *)
             (st, List.rev tokens)
-        | COMMENT_OPEN_EOL ->
+        | COMMENT_OPEN_EOL, _ ->
             (st, List.rev (comment_open tok.between :: tokens))
         | _ ->
             iter st offset stream (wrap_token st tok :: tokens)

src/utils/js_utils.ml

@@ -31,6 +31,20 @@ let js_debug obj = Firebug.console##(debug obj)
 let js_warn obj = Firebug.console##(warn obj)
 let js_error obj = Firebug.console##(error obj)
 
+let rec pos8_to_pos16 line c8 i8 i16 stop_before = 
+    if i8 >= c8 || i8 >= String.length line then i16 else
+    let di8, di16 = match line.[i8] with
+      | '\x00' .. '\x7F' -> 1, 1
+      | '\xC2' .. '\xDF' -> 2, 1
+      | '\xE0' .. '\xEF' -> 3, 1
+      | '\xF0' .. '\xF4' -> 4, 2 
+      | _                -> 1, 1 in
+    if stop_before && i8 <= c8 && c8 < i8 + di8 then i16
+    else pos8_to_pos16 line c8 (i8+di8) (i16+di16) stop_before
+
+let pos8_to_pos16 ?(stop_before = true) line c8 =
+	pos8_to_pos16 line c8 0 0 stop_before
+
 let log fmt =
   Format.kfprintf
     (fun _ -> Firebug.console##(log (Js.string (Format.flush_str_formatter ()))))

src/utils/js_utils.mli

@@ -32,6 +32,8 @@ val js_debug: 'a -> unit
 val js_warn: 'a -> unit
 val js_error: 'a -> unit
 
+val pos8_to_pos16: ?stop_before:bool -> string -> int -> int
+
 val reload: unit -> unit
 
 (** Gets the language configured in the browser *)