6 files changed, 56 insertions, 31 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) ()
diff --git a/otherlibs/labltk/browser/fileselect.ml b/otherlibs/labltk/browser/fileselect.ml
index 51d782b71..6ca08f5ac 100644
--- a/otherlibs/labltk/browser/fileselect.ml
+++ b/otherlibs/labltk/browser/fileselect.ml
@@ -17,12 +17,12 @@
 (* file selection box *)
 
 open StdLabels
-open Useunix
 open Str
 open Filename
-
 open Tk
 
+open Useunix
+
 (**** Memoized rexgexp *)
 
 let (~!) = Jg_memo.fast ~f:Str.regexp
@@ -56,12 +56,6 @@ let parse_filter s =
       dirs, ptrn
   else "", s
 
-let concat dir name =
-  let len = String.length dir in
-  if len = 0 then name else
-  if dir.[len-1] = '/' then dir ^ name
-  else dir ^ "/" ^ name
-
 let rec fixpoint ~f v =
   let v' = f v in
   if v = v' then v else fixpoint ~f v'
diff --git a/otherlibs/labltk/browser/jg_text.ml b/otherlibs/labltk/browser/jg_text.ml
index 5a7023f63..067b9dac5 100644
--- a/otherlibs/labltk/browser/jg_text.ml
+++ b/otherlibs/labltk/browser/jg_text.ml
@@ -48,7 +48,7 @@ let goto_tag tw ~tag =
 
 let search_string tw =
   let tl = Jg_toplevel.titled "Search" in
-  Wm.transient_set tl ~master:Widget.default_toplevel;
+  Wm.transient_set tl ~master:(Winfo.toplevel tw);
   let fi = Frame.create tl
   and fd = Frame.create tl
   and fm = Frame.create tl
diff --git a/otherlibs/labltk/browser/useunix.ml b/otherlibs/labltk/browser/useunix.ml
index a12d56c35..4998bbd66 100644
--- a/otherlibs/labltk/browser/useunix.ml
+++ b/otherlibs/labltk/browser/useunix.ml
@@ -18,7 +18,13 @@ open StdLabels
 open UnixLabels
 
 let get_files_in_directory dir =
-  match
+  let len = String.length dir in
+  let dir =
+    if len > 0 && Sys.os_type = "Win32" &&
+     (dir.[len-1] = '/' || dir.[len-1] = '\\')
+    then String.sub dir ~pos:0 ~len:(len-1)
+    else dir
+  in match
     try Some(opendir dir) with Unix_error _ -> None
   with
     None -> []
@@ -39,8 +45,14 @@ let is_directory name =
     (stat name).st_kind = S_DIR
   with _ -> false
 
+let concat dir name =
+  let len = String.length dir in
+  if len = 0 then name else
+  if dir.[len-1] = '/' then dir ^ name
+  else dir ^ "/" ^ name
+
 let get_directories_in_files ~path =
-  List.filter ~f:(fun x -> is_directory  (path ^ "/" ^ x))
+  List.filter ~f:(fun x -> is_directory  (concat path x))
 
 (************************************************** Subshell call *)
 let subshell ~cmd =
diff --git a/otherlibs/labltk/browser/useunix.mli b/otherlibs/labltk/browser/useunix.mli
index 52ac7c770..2850c0d2d 100644
--- a/otherlibs/labltk/browser/useunix.mli
+++ b/otherlibs/labltk/browser/useunix.mli
@@ -18,5 +18,6 @@
 
 val get_files_in_directory : string -> string list
 val is_directory : string -> bool
+val concat : string -> string -> string
 val get_directories_in_files : path:string -> string list -> string list
 val subshell : cmd:string -> string list
diff --git a/otherlibs/labltk/browser/viewer.ml b/otherlibs/labltk/browser/viewer.ml
index 4f5d62ce8..2d21f42f0 100644
--- a/otherlibs/labltk/browser/viewer.ml
+++ b/otherlibs/labltk/browser/viewer.ml
@@ -263,9 +263,9 @@ let close_all_views () =
 let shell_counter = ref 1
 let default_shell = ref "ocaml"
 
-let start_shell () =
+let start_shell master =
   let tl = Jg_toplevel.titled "Start New Shell" in
-  Wm.transient_set tl ~master:Widget.default_toplevel;
+  Wm.transient_set tl ~master;
   let input = Frame.create tl
   and buttons = Frame.create tl in
   let ok = Button.create buttons ~text:"Ok"
@@ -356,7 +356,7 @@ let f ?(dir=Unix.getcwd()) ?on () =
   filemenu#add_command "Open..."
     ~command:(fun () -> !editor_ref ~opendialog:true ());
   filemenu#add_command "Editor..." ~command:(fun () -> !editor_ref ());
-  filemenu#add_command "Shell..." ~command:start_shell;
+  filemenu#add_command "Shell..." ~command:(fun () -> start_shell tl);
   filemenu#add_command "Quit" ~command:(fun () -> destroy tl);
 
   (* modules menu *)
@@ -463,7 +463,7 @@ object (self)
     filemenu#add_command "Open..."
       ~command:(fun () -> !editor_ref ~opendialog:true ());
     filemenu#add_command "Editor..." ~command:(fun () -> !editor_ref ());
-    filemenu#add_command "Shell..." ~command:start_shell;
+    filemenu#add_command "Shell..." ~command:(fun () -> start_shell tl);
     filemenu#add_command "Quit" ~command:(fun () -> destroy tl);
 
     (* View menu *)