1 files changed, 34 insertions, 16 deletions

diff --git a/otherlibs/labltk/browser/editor.ml b/otherlibs/labltk/browser/editor.ml
index d754cec70..3fe8da159 100644
--- a/otherlibs/labltk/browser/editor.ml
+++ b/otherlibs/labltk/browser/editor.ml
@@ -24,9 +24,9 @@ open Mytypes
 let lex_on_load = ref true
 and type_on_load = ref false
 
-let compiler_preferences () =
+let compiler_preferences master =
   let tl = Jg_toplevel.titled "Compiler" in
-  Wm.transient_set tl ~master:Widget.default_toplevel;
+  Wm.transient_set tl ~master;
   let mk_chkbutton ~text ~ref ~invert =
     let variable = Textvariable.create ~on:tl () in
     if (if invert then not !ref else !ref) then
@@ -72,7 +72,7 @@ let rec exclude txt = function
 
 let goto_line tw =
   let tl = Jg_toplevel.titled "Go to" in
-  Wm.transient_set tl ~master:Widget.default_toplevel;
+  Wm.transient_set tl ~master:(Winfo.toplevel tw);
   Jg_bind.escape_destroy tl;
   let ef = Frame.create tl in
   let fl = Frame.create ef
@@ -297,6 +297,9 @@ class editor ~top ~menus = object (self)
   val vwindow = Textvariable.create ~on:top ()
   val mutable window_counter = 0
 
+  method has_window name =
+    List.exists windows ~f:(fun x -> x.name = name)
+
   method reset_window_menu =
     Menu.delete window_menu#menu ~first:(`Num 0) ~last:`End;
     List.iter
@@ -392,8 +395,15 @@ class editor ~top ~menus = object (self)
     error_messages <- Typecheck.f (List.hd windows)
 
   method lex () =
-    Text.tag_remove current_tw ~tag:"error" ~start:tstart ~stop:tend;
-    Lexical.tag current_tw
+    Toplevel.configure top ~cursor:(`Xcursor "watch");
+    Text.configure current_tw ~cursor:(`Xcursor "watch");
+    ignore (Timer.add ~ms:1 ~callback:
+      begin fun () ->
+        Text.tag_remove current_tw ~tag:"error" ~start:tstart ~stop:tend;
+        Lexical.tag current_tw;
+        Text.configure current_tw ~cursor:(`Xcursor "xterm");
+        Toplevel.configure top ~cursor:(`Xcursor "")
+      end)
 
   method save_text ?name:l txt =
     let l = match l with None -> [txt.name] | Some l -> l in
@@ -588,7 +598,7 @@ class editor ~top ~menus = object (self)
 
     (* Compiler menu *)
     compiler_menu#add_command "Preferences..."
-      ~command:compiler_preferences;
+      ~command:(fun () -> compiler_preferences top);
     compiler_menu#add_command "Lex" ~accelerator:"M-l"
       ~command:self#lex;
     compiler_menu#add_command "Typecheck" ~accelerator:"M-t"
@@ -628,19 +638,27 @@ end
 
 (* The main function starts here ! *)
 
-let already_open : editor option ref = ref None
-
-let editor ?file ?(pos=0) () =
-
-  if match !already_open with None -> false
-  | Some ed ->
-      try ed#reopen ~file ~pos; true
-      with Protocol.TkError _ -> already_open := None; false
+let already_open : editor list ref = ref []
+
+let editor ?file ?(pos=0) ?(reuse=false) () =
+
+  if !already_open <> [] &&
+    let ed = List.hd !already_open
+    (*  try
+        let name = match file with Some f -> f | None -> raise Not_found in
+        List.find !already_open ~f:(fun ed -> ed#has_window name)
+      with Not_found -> List.hd !already_open *)
+    in try
+      ed#reopen ~file ~pos;
+      true
+    with Protocol.TkError _ ->
+      already_open := [] (* List.filter !already_open ~f:((<>) ed) *);
+      false
   then () else
     let top = Jg_toplevel.titled "Editor" in
     let menus = Frame.create top ~name:"menubar" in
     let ed = new editor ~top ~menus in
-    already_open := Some ed;
+    already_open := !already_open @ [ed];
     if file <> None then ed#reopen ~file ~pos
 
 let f ?file ?pos ?(opendialog=false) () =
@@ -648,4 +666,4 @@ let f ?file ?pos ?(opendialog=false) () =
     Fileselect.f ~title:"Open File"
       ~action:(function [file] -> editor ~file () | _ -> ())
       ~filter:("*.{ml,mli}") ~sync:true ()
-  else editor ?file ?pos ()
+  else editor ?file ?pos ~reuse:(file <> None) ()