better handling of crossrefs

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4989 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

3 files changed, 66 insertions, 12 deletions

diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml
index 5e45718fe..1f414686d 100644
--- a/otherlibs/labltk/browser/searchpos.ml
+++ b/otherlibs/labltk/browser/searchpos.ml
@@ -248,6 +248,7 @@ type module_widgets =
 
 let shown_modules = Hashtbl.create 17
 let default_frame = ref None
+let set_path = ref (fun _ ~sign -> assert false)
 let filter_modules () =
   Hashtbl.iter
     (fun key data ->
@@ -335,6 +336,7 @@ let rec view_signature ?title ?path ?(env = !start_env) ?(detach=false) sign =
             view_module path ~env;
             find_shown_module path
         in
+        !set_path path ~sign;
         begin match mw.mw_title with None -> ()
         | Some label ->
             Label.configure label ~text:title;
diff --git a/otherlibs/labltk/browser/searchpos.mli b/otherlibs/labltk/browser/searchpos.mli
index f0bebb6c4..ac5456eb0 100644
--- a/otherlibs/labltk/browser/searchpos.mli
+++ b/otherlibs/labltk/browser/searchpos.mli
@@ -29,6 +29,7 @@ val add_shown_module : Path.t -> widgets:module_widgets -> unit
 val find_shown_module : Path.t -> module_widgets
 val is_shown_module : Path.t -> bool
 val default_frame : module_widgets option ref
+val set_path : (Path.t -> sign:Types.signature -> unit) ref
 
 val view_defined_ref : (Longident.t -> env:Env.t -> unit) ref
 val editor_ref :
diff --git a/otherlibs/labltk/browser/viewer.ml b/otherlibs/labltk/browser/viewer.ml
index 5bdd068bc..617d40bb8 100644
--- a/otherlibs/labltk/browser/viewer.ml
+++ b/otherlibs/labltk/browser/viewer.ml
@@ -216,18 +216,17 @@ let search_symbol () =
 
 (* Display the contents of a module *)
 
+let ident_of_decl ~modlid = function
+    Tsig_value (id, _) -> Lident (Ident.name id), Pvalue
+  | Tsig_type (id, _) -> Lident (Ident.name id), Ptype
+  | Tsig_exception (id, _) -> Ldot (modlid, Ident.name id), Pconstructor
+  | Tsig_module (id, _) -> Lident (Ident.name id), Pmodule
+  | Tsig_modtype (id, _) -> Lident (Ident.name id), Pmodtype
+  | Tsig_class (id, _) -> Lident (Ident.name id), Pclass
+  | Tsig_cltype (id, _) -> Lident (Ident.name id), Pcltype
+
 let view_defined modlid ~env =
-  try match lookup_module modlid env with
-    path, Tmty_signature sign ->
-    let ident_of_decl = function
-        Tsig_value (id, _) -> Lident (Ident.name id), Pvalue
-      | Tsig_type (id, _) -> Lident (Ident.name id), Ptype
-      | Tsig_exception (id, _) -> Ldot (modlid, Ident.name id), Pconstructor
-      | Tsig_module (id, _) -> Lident (Ident.name id), Pmodule
-      | Tsig_modtype (id, _) -> Lident (Ident.name id), Pmodtype
-      | Tsig_class (id, _) -> Lident (Ident.name id), Pclass
-      | Tsig_cltype (id, _) -> Lident (Ident.name id), Pcltype
-    in
+  try match lookup_module modlid env with path, Tmty_signature sign ->
     let rec iter_sign sign idents =
       match sign with
         [] -> List.rev idents
@@ -236,7 +235,7 @@ let view_defined modlid ~env =
             Tsig_class _, cty :: ty1 :: ty2 :: rem -> rem
           | Tsig_cltype _, ty1 :: ty2 :: rem -> rem
           | _, rem -> rem
-          in iter_sign rem (ident_of_decl decl :: idents)
+          in iter_sign rem (ident_of_decl ~modlid decl :: idents)
     in
     let l = iter_sign sign [] in
     !choose_symbol_ref l ~title:(string_of_path path) ~signature:sign
@@ -451,6 +450,7 @@ object (self)
     Searchpos.default_frame := Some
         { mw_frame = view; mw_title = Some label;
           mw_detach = detach; mw_edit = edit; mw_intf = intf };
+    Searchpos.set_path := self#set_path;
 
     (* Buttons *)
     pack [close] ~side:`Right ~fill:`X ~expand:true;
@@ -530,6 +530,57 @@ object (self)
           self#hide_after 2;
           shown_paths <- [path];
           1
+
+  method set_path path ~sign =
+    prerr_endline ("* " ^ string_of_path path);
+    let rec path_elems l path =
+      match path with
+        Path.Pdot (path, _, _) -> path_elems (path::l) path
+      | _ -> []
+    in
+    let path_elems path =
+      match path with
+      | Path.Pident _ -> [path]
+      | _ -> path_elems [] path
+    in
+    let see_path ~box:n ?(sign=[]) path =
+      let (_, box) = List.nth boxes n in
+      let texts = Listbox.get_range box ~first:(`Num 0) ~last:`End in
+      let rec index s = function
+          [] -> raise Not_found
+        | a :: l -> if a = s then 0 else 1 + index s l
+      in
+      try
+        let modlid, s =
+          match path with
+            Path.Pdot (p, s, _) -> longident_of_path p, s
+          | Path.Pident i -> Longident.Lident "M", Ident.name i
+          | _ -> assert false
+        in
+        let li, k =
+          if sign = [] then Longident.Lident s, Pmodule else
+          ident_of_decl ~modlid (List.hd sign) in
+        let s =
+          if n = 0 then string_of_longident li else
+          string_of_longident li ^ " (" ^ string_of_kind k ^ ")" in
+        prerr_endline s;
+        let n = index s texts in
+        Listbox.see box (`Num n);
+        Listbox.activate box (`Num n)
+      with Not_found -> ()
+    in
+    let l = path_elems path in
+    if l <> [] then begin
+      List.iter l ~f:
+        begin fun path ->
+          if not (List.mem path shown_paths) then
+            view_symbol (longident_of_path path) ~kind:Pmodule
+              ~env:Env.initial ~path;
+          let n = self#get_box path - 1 in
+          see_path path ~box:n
+        end;
+      see_path path ~box:(self#get_box path) ~sign
+    end
         
   method choose_symbol ~title ~env ?signature ?path l =
     let n =