l4/pkg/ocaml/ocaml/contrib/otherlibs/labltk/browser/viewer.ml

   1 (*************************************************************************)
   2 (*                                                                       *)
   3 (*                Objective Caml LablTk library                          *)
   4 (*                                                                       *)
   5 (*            Jacques Garrigue, Kyoto University RIMS                    *)
   6 (*                                                                       *)
   7 (*   Copyright 1999 Institut National de Recherche en Informatique et    *)
   8 (*   en Automatique and Kyoto University.  All rights reserved.          *)
   9 (*   This file is distributed under the terms of the GNU Library         *)
  10 (*   General Public License, with the special exception on linking       *)
  11 (*   described in file ../../../LICENSE.                                 *)
  12 (*                                                                       *)
  13 (*************************************************************************)
  14
  15 (* $Id: viewer.ml 7307 2006-01-04 16:55:50Z doligez $ *)
  16
  17 open StdLabels
  18 open Tk
  19 open Jg_tk
  20 open Mytypes
  21 open Longident
  22 open Types
  23 open Typedtree
  24 open Env
  25 open Searchpos
  26 open Searchid
  27
  28 (* Managing the module list *)
  29
  30 let list_modules ~path =
  31   List.fold_left path ~init:[] ~f:
  32   begin fun modules dir ->
  33     let l =
  34       List.filter (Useunix.get_files_in_directory dir)
  35         ~f:(fun x -> Filename.check_suffix x ".cmi") in
  36     let l = List.map l ~f:
  37     begin fun x ->
  38       String.capitalize (Filename.chop_suffix x ".cmi")
  39     end in
  40     List.fold_left l ~init:modules
  41      ~f:(fun modules item ->
  42           if List.mem item modules then modules else item :: modules)
  43   end
  44
  45 let reset_modules box =
  46   Listbox.delete box ~first:(`Num 0) ~last:`End;
  47   module_list := Sort.list (Jg_completion.lt_string ~nocase:true)
  48       (list_modules ~path:!Config.load_path);
  49   Listbox.insert box ~index:`End ~texts:!module_list;
  50   Jg_box.recenter box ~index:(`Num 0)
  51
  52
  53 (* How to display a symbol *)
  54
  55 let view_symbol ~kind ~env ?path id =
  56   let name = match id with
  57       Lident x -> x
  58     | Ldot (_, x) -> x
  59     | _ -> match kind with Pvalue | Ptype | Plabel -> "z" | _ -> "Z"
  60   in
  61   match kind with
  62     Pvalue ->
  63       let path, vd = lookup_value id env in
  64       view_signature_item ~path ~env [Tsig_value (Ident.create name, vd)]
  65   | Ptype -> view_type_id id ~env
  66   | Plabel -> let ld = lookup_label id env in
  67       begin match ld.lbl_res.desc with
  68         Tconstr (path, _, _) -> view_type_decl path ~env
  69       | _ -> ()
  70       end
  71   | Pconstructor ->
  72       let cd = lookup_constructor id env in
  73       begin match cd.cstr_res.desc with
  74         Tconstr (cpath, _, _) ->
  75         if Path.same cpath Predef.path_exn then
  76           view_signature ~title:(string_of_longident id) ~env ?path
  77             [Tsig_exception (Ident.create name, cd.cstr_args)]
  78         else
  79           view_type_decl cpath ~env
  80       | _ -> ()
  81       end
  82   | Pmodule -> view_module_id id ~env
  83   | Pmodtype -> view_modtype_id id ~env
  84   | Pclass -> view_class_id id ~env
  85   | Pcltype -> view_cltype_id id ~env
  86
  87
  88 (* Create a list of symbols you can choose from *)
  89
  90 let choose_symbol ~title ~env ?signature ?path l =
  91   if match path with
  92     None -> false
  93   | Some path -> is_shown_module path
  94   then () else
  95   let tl = Jg_toplevel.titled title in
  96   Jg_bind.escape_destroy tl;
  97   top_widgets := coe tl :: !top_widgets;
  98   let buttons = Frame.create tl in
  99   let all = Button.create buttons ~text:"Show all" ~padx:20
 100   and ok = Jg_button.create_destroyer tl ~parent:buttons
 101   and detach = Button.create buttons ~text:"Detach"
 102   and edit = Button.create buttons ~text:"Impl"
 103   and intf = Button.create buttons ~text:"Intf" in
 104   let l = List.sort l ~cmp:(fun (li1, _) (li2,_) -> compare li1 li2) in
 105   let nl = List.map l ~f:
 106     begin fun (li, k) ->
 107       string_of_longident li ^ " (" ^ string_of_kind k ^ ")"
 108     end in
 109   let fb = Frame.create tl in
 110   let box =
 111     new Jg_multibox.c fb ~cols:3 ~texts:nl ~maxheight:3 ~width:21 in
 112   box#init;
 113   box#bind_kbd ~events:[`KeyPressDetail"Escape"]
 114     ~action:(fun _ ~index -> destroy tl; break ());
 115   if List.length nl > 9 then ignore (Jg_multibox.add_scrollbar box);
 116   Jg_multibox.add_completion box ~action:
 117     begin fun pos ->
 118       let li, k = List.nth l pos in
 119       let path =
 120         match path, li with
 121           None, Ldot (lip, _) ->
 122             begin try
 123               Some (fst (lookup_module lip env))
 124             with Not_found -> None
 125             end
 126         | _ -> path
 127       in view_symbol li ~kind:k ~env ?path
 128     end;
 129   pack [buttons] ~side:`Bottom ~fill:`X;
 130   pack [fb] ~side:`Top ~fill:`Both ~expand:true;
 131   begin match signature with
 132     None -> pack [ok] ~fill:`X ~expand:true
 133   | Some signature ->
 134       Button.configure all ~command:
 135         begin fun () ->
 136           view_signature signature ~title ~env ?path
 137         end;
 138       pack [ok; all] ~side:`Right ~fill:`X ~expand:true
 139   end;
 140   begin match path with None -> ()
 141   | Some path ->
 142       let frame = Frame.create tl in
 143       pack [frame] ~side:`Bottom ~fill:`X;
 144       add_shown_module path
 145         ~widgets:{ mw_frame = frame; mw_title = None; mw_detach = detach;
 146                    mw_edit = edit; mw_intf = intf }
 147   end
 148
 149 let choose_symbol_ref = ref choose_symbol
 150
 151
 152 (* Search, both by type and name *)
 153
 154 let guess_search_mode s : [`Type | `Long | `Pattern] =
 155   let is_type = ref false and is_long = ref false in
 156   for i = 0 to String.length s - 2 do
 157     if s.[i] = '-' && s.[i+1] = '>' then is_type := true;
 158     if s.[i] = '.' then is_long := true
 159   done;
 160   if !is_type then `Type else if !is_long then `Long else `Pattern
 161
 162
 163 let search_string ?(mode="symbol") ew =
 164   let text = Entry.get ew in
 165   try
 166     if text = "" then () else
 167     let l = match mode with
 168       "Name" ->
 169         begin match guess_search_mode text with
 170           `Long -> search_string_symbol text
 171         | `Pattern -> search_pattern_symbol text
 172         | `Type -> search_string_type text ~mode:`Included
 173         end
 174     | "Type" -> search_string_type text ~mode:`Included
 175     | "Exact" -> search_string_type text ~mode:`Exact
 176     | _ -> assert false
 177     in
 178     match l with [] -> ()
 179     | [lid,kind] -> view_symbol lid ~kind ~env:!start_env
 180     | l          -> choose_symbol ~title:"Choose symbol" ~env:!start_env l
 181   with Searchid.Error (s,e) ->
 182     Entry.icursor ew ~index:(`Num s)
 183
 184 let search_which = ref "Name"
 185
 186 let search_symbol () =
 187   if !module_list = [] then
 188   module_list := List.sort ~cmp:compare (list_modules ~path:!Config.load_path);
 189   let tl = Jg_toplevel.titled "Search symbol" in
 190   Jg_bind.escape_destroy tl;
 191   let ew = Entry.create tl ~width:30 in
 192   let choice = Frame.create tl
 193   and which = Textvariable.create ~on:tl () in
 194   let itself = Radiobutton.create choice ~text:"Itself"
 195         ~variable:which ~value:"Name"
 196   and extype = Radiobutton.create choice ~text:"Exact type"
 197         ~variable:which ~value:"Exact"
 198   and iotype = Radiobutton.create choice ~text:"Included type"
 199         ~variable:which ~value:"Type"
 200   and buttons = Frame.create tl in
 201   let search = Button.create buttons ~text:"Search" ~command:
 202     begin fun () ->
 203       search_which := Textvariable.get which;
 204       search_string ew ~mode:!search_which
 205     end
 206   and ok = Jg_button.create_destroyer tl ~parent:buttons ~text:"Cancel" in
 207
 208   Focus.set ew;
 209   Jg_bind.return_invoke ew ~button:search;
 210   Textvariable.set which !search_which;
 211   pack [itself; extype; iotype] ~side:`Left ~anchor:`W;
 212   pack [search; ok] ~side:`Left ~fill:`X ~expand:true;
 213   pack [coe ew; coe choice; coe buttons]
 214        ~side:`Top ~fill:`X ~expand:true
 215
 216
 217 (* Display the contents of a module *)
 218
 219 let ident_of_decl ~modlid = function
 220     Tsig_value (id, _) -> Lident (Ident.name id), Pvalue
 221   | Tsig_type (id, _, _) -> Lident (Ident.name id), Ptype
 222   | Tsig_exception (id, _) -> Ldot (modlid, Ident.name id), Pconstructor
 223   | Tsig_module (id, _, _) -> Lident (Ident.name id), Pmodule
 224   | Tsig_modtype (id, _) -> Lident (Ident.name id), Pmodtype
 225   | Tsig_class (id, _, _) -> Lident (Ident.name id), Pclass
 226   | Tsig_cltype (id, _, _) -> Lident (Ident.name id), Pcltype
 227
 228 let view_defined ~env ?(show_all=false) modlid =
 229   try match lookup_module modlid env with path, Tmty_signature sign ->
 230     let rec iter_sign sign idents =
 231       match sign with
 232         [] -> List.rev idents
 233       | decl :: rem ->
 234           let rem = match decl, rem with
 235             Tsig_class _, cty :: ty1 :: ty2 :: rem -> rem
 236           | Tsig_cltype _, ty1 :: ty2 :: rem -> rem
 237           | _, rem -> rem
 238           in iter_sign rem (ident_of_decl ~modlid decl :: idents)
 239     in
 240     let l = iter_sign sign [] in
 241     let title = string_of_path path in
 242     let env = open_signature path sign env in
 243     !choose_symbol_ref l ~title ~signature:sign ~env ~path;
 244     if show_all then view_signature sign ~title ~env ~path
 245   | _ -> ()
 246   with Not_found -> ()
 247   | Env.Error err ->
 248       let tl, tw, finish = Jg_message.formatted ~title:"Error!" () in
 249       Env.report_error Format.std_formatter err;
 250       finish ()
 251
 252
 253 (* Manage toplevel windows *)
 254
 255 let close_all_views () =
 256     List.iter !top_widgets
 257       ~f:(fun tl -> try destroy tl with Protocol.TkError _ -> ());
 258     top_widgets := []
 259
 260
 261 (* Launch a shell *)
 262
 263 let shell_counter = ref 1
 264 let default_shell = ref "ocaml"
 265
 266 let start_shell master =
 267   let tl = Jg_toplevel.titled "Start New Shell" in
 268   Wm.transient_set tl ~master;
 269   let input = Frame.create tl
 270   and buttons = Frame.create tl in
 271   let ok = Button.create buttons ~text:"Ok"
 272   and cancel = Jg_button.create_destroyer tl ~parent:buttons ~text:"Cancel"
 273   and labels = Frame.create input
 274   and entries = Frame.create input in
 275   let l1 = Label.create labels ~text:"Command:"
 276   and l2 = Label.create labels ~text:"Title:"
 277   and e1 =
 278     Jg_entry.create entries ~command:(fun _ -> Button.invoke ok)
 279   and e2 =
 280     Jg_entry.create entries ~command:(fun _ -> Button.invoke ok)
 281   and names = List.map ~f:fst (Shell.get_all ()) in
 282   Entry.insert e1 ~index:`End ~text:!default_shell;
 283   let shell_name () = "Shell #" ^ string_of_int !shell_counter in
 284   while List.mem (shell_name ()) names do
 285     incr shell_counter
 286   done;
 287   Entry.insert e2 ~index:`End ~text:(shell_name ());
 288   Button.configure ok ~command:(fun () ->
 289       if not (List.mem (Entry.get e2) names) then begin
 290         default_shell := Entry.get e1;
 291         Shell.f ~prog:!default_shell ~title:(Entry.get e2);
 292         destroy tl
 293       end);
 294   pack [l1;l2] ~side:`Top ~anchor:`W;
 295   pack [e1;e2] ~side:`Top ~fill:`X ~expand:true;
 296   pack [labels;entries] ~side:`Left ~fill:`X ~expand:true;
 297   pack [ok;cancel] ~side:`Left ~fill:`X ~expand:true;
 298   pack [input;buttons] ~side:`Top ~fill:`X ~expand:true
 299
 300
 301 (* Help window *)
 302
 303 let show_help () =
 304   let tl = Jg_toplevel.titled "OCamlBrowser Help" in
 305   Jg_bind.escape_destroy tl;
 306   let fw, tw, sb = Jg_text.create_with_scrollbar tl in
 307   let ok = Jg_button.create_destroyer ~parent:tl ~text:"Ok" tl in
 308   Text.insert tw ~index:tend ~text:Help.text;
 309   Text.configure tw ~state:`Disabled;
 310   Jg_bind.enter_focus tw;
 311   pack [tw] ~side:`Left ~fill:`Both ~expand:true;
 312   pack [sb] ~side:`Right ~fill:`Y;
 313   pack [fw] ~side:`Top ~expand:true ~fill:`Both;
 314   pack [ok] ~side:`Bottom ~fill:`X
 315
 316 (* Launch the classical viewer *)
 317
 318 let f ?(dir=Unix.getcwd()) ?on () =
 319   let (top, tl) = match on with
 320     None ->
 321       let tl = Jg_toplevel.titled "Module viewer" in
 322       ignore (Jg_bind.escape_destroy tl); (tl, coe tl)
 323   | Some top ->
 324       Wm.title_set top "OCamlBrowser";
 325       Wm.iconname_set top "OCamlBrowser";
 326       let tl = Frame.create top in
 327       bind tl ~events:[`Destroy] ~action:(fun _ -> exit 0);
 328       pack [tl] ~expand:true ~fill:`Both;
 329       (top, coe tl)
 330   in
 331   let menus = Jg_menu.menubar top in
 332   let filemenu = new Jg_menu.c "File" ~parent:menus
 333   and modmenu = new Jg_menu.c "Modules" ~parent:menus in
 334   let fmbox, mbox, msb = Jg_box.create_with_scrollbar tl in
 335
 336   Jg_box.add_completion mbox ~nocase:true ~action:
 337     begin fun index ->
 338       view_defined (Lident (Listbox.get mbox ~index)) ~env:!start_env
 339     end;
 340   Setpath.add_update_hook (fun () -> reset_modules mbox);
 341
 342   let ew = Entry.create tl in
 343   let buttons = Frame.create tl in
 344   let search = Button.create buttons ~text:"Search" ~pady:1
 345       ~command:(fun () -> search_string ew)
 346   and close =
 347     Button.create buttons ~text:"Close all" ~pady:1 ~command:close_all_views
 348   in
 349   (* bindings *)
 350   Jg_bind.enter_focus ew;
 351   Jg_bind.return_invoke ew ~button:search;
 352   bind close ~events:[`Modified([`Double], `ButtonPressDetail 1)]
 353     ~action:(fun _ -> destroy tl);
 354
 355   (* File menu *)
 356   filemenu#add_command "Open..."
 357     ~command:(fun () -> !editor_ref ~opendialog:true ());
 358   filemenu#add_command "Editor..." ~command:(fun () -> !editor_ref ());
 359   filemenu#add_command "Shell..." ~command:(fun () -> start_shell tl);
 360   filemenu#add_command "Quit" ~command:(fun () -> destroy tl);
 361
 362   (* modules menu *)
 363   modmenu#add_command "Path editor..."
 364     ~command:(fun () -> Setpath.set ~dir);
 365   modmenu#add_command "Reset cache"
 366     ~command:(fun () -> reset_modules mbox; Env.reset_cache ());
 367   modmenu#add_command "Search symbol..." ~command:search_symbol;
 368
 369   pack [close; search] ~fill:`X ~side:`Right ~expand:true;
 370   pack [coe buttons; coe ew] ~fill:`X ~side:`Bottom;
 371   pack [msb] ~side:`Right ~fill:`Y;
 372   pack [mbox] ~side:`Left ~fill:`Both ~expand:true;
 373   pack [fmbox] ~fill:`Both ~expand:true ~side:`Top;
 374   reset_modules mbox
 375
 376 (* Smalltalk-like version *)
 377
 378 class st_viewer ?(dir=Unix.getcwd()) ?on () =
 379   let (top, tl) = match on with
 380     None ->
 381       let tl = Jg_toplevel.titled "Module viewer" in
 382       ignore (Jg_bind.escape_destroy tl); (tl, coe tl)
 383   | Some top ->
 384       Wm.title_set top "OCamlBrowser";
 385       Wm.iconname_set top "OCamlBrowser";
 386       let tl = Frame.create top in
 387       bind tl ~events:[`Destroy] ~action:(fun _ -> exit 0);
 388       pack [tl] ~side:`Bottom ~expand:true ~fill:`Both;
 389       (top, coe tl)
 390   in
 391   let menus = Menu.create top ~name:"menubar" ~typ:`Menubar in
 392   let () = Toplevel.configure top ~menu:menus in
 393   let filemenu = new Jg_menu.c "File" ~parent:menus
 394   and modmenu = new Jg_menu.c "Modules" ~parent:menus
 395   and viewmenu = new Jg_menu.c "View" ~parent:menus
 396   and helpmenu = new Jg_menu.c "Help" ~parent:menus in
 397   let search_frame = Frame.create tl in
 398   let boxes_frame = Frame.create tl ~name:"boxes" in
 399   let label = Label.create tl ~anchor:`W ~padx:5 in
 400   let view = Frame.create tl in
 401   let buttons = Frame.create tl in
 402   let _all = Button.create buttons ~text:"Show all" ~padx:20
 403   and close = Button.create buttons ~text:"Close all" ~command:close_all_views
 404   and detach = Button.create buttons ~text:"Detach"
 405   and edit = Button.create buttons ~text:"Impl"
 406   and intf = Button.create buttons ~text:"Intf" in
 407 object (self)
 408   val mutable boxes = []
 409   val mutable show_all = fun () -> ()
 410
 411   method create_box =
 412     let fmbox, mbox, sb = Jg_box.create_with_scrollbar boxes_frame in
 413     bind mbox ~events:[`Modified([`Double], `ButtonPressDetail 1)]
 414       ~action:(fun _ -> show_all ());
 415     bind mbox ~events:[`Modified([`Double], `KeyPressDetail "Return")]
 416       ~action:(fun _ -> show_all ());
 417     boxes <- boxes @ [fmbox, mbox];
 418     pack [sb] ~side:`Right ~fill:`Y;
 419     pack [mbox] ~side:`Left ~fill:`Both ~expand:true;
 420     pack [fmbox] ~side:`Left ~fill:`Both ~expand:true;
 421     fmbox, mbox
 422
 423   initializer
 424     (* Search *)
 425     let ew = Entry.create search_frame
 426     and searchtype = Textvariable.create ~on:tl () in
 427     bind ew ~events:[`KeyPressDetail "Return"] ~action:
 428       (fun _ -> search_string ew ~mode:(Textvariable.get searchtype));
 429     Jg_bind.enter_focus ew;
 430     let search_button ?value text =
 431       Radiobutton.create search_frame
 432         ~text ~variable:searchtype ~value:text in
 433     let symbol = search_button "Name"
 434     and atype = search_button "Type" in
 435     Radiobutton.select symbol;
 436     pack [Label.create search_frame ~text:"Search"] ~side:`Left ~ipadx:5;
 437     pack [ew] ~fill:`X ~expand:true ~side:`Left;
 438     pack [Label.create search_frame ~text:"by"] ~side:`Left ~ipadx:5;
 439     pack [symbol; atype] ~side:`Left;
 440     pack [Label.create search_frame] ~side:`Right
 441
 442   initializer
 443     (* Boxes *)
 444     let fmbox, mbox = self#create_box in
 445     Jg_box.add_completion mbox ~nocase:true ~double:false ~action:
 446       begin fun index ->
 447         view_defined (Lident (Listbox.get mbox ~index)) ~env:!start_env
 448       end;
 449     Setpath.add_update_hook (fun () -> reset_modules mbox; self#hide_after 1);
 450     List.iter [1;2] ~f:(fun _ -> ignore self#create_box);
 451     Searchpos.default_frame := Some
 452         { mw_frame = view; mw_title = Some label;
 453           mw_detach = detach; mw_edit = edit; mw_intf = intf };
 454     Searchpos.set_path := self#set_path;
 455
 456     (* Buttons *)
 457     pack [close] ~side:`Right ~fill:`X ~expand:true;
 458     bind close ~events:[`Modified([`Double], `ButtonPressDetail 1)]
 459       ~action:(fun _ -> destroy tl);
 460
 461     (* File menu *)
 462     filemenu#add_command "Open..."
 463       ~command:(fun () -> !editor_ref ~opendialog:true ());
 464     filemenu#add_command "Editor..." ~command:(fun () -> !editor_ref ());
 465     filemenu#add_command "Shell..." ~command:(fun () -> start_shell tl);
 466     filemenu#add_command "Quit" ~command:(fun () -> destroy tl);
 467
 468     (* View menu *)
 469     viewmenu#add_command "Show all defs" ~command:(fun () -> show_all ());
 470     let show_search = Textvariable.create ~on:tl () in
 471     Textvariable.set show_search "1";
 472     Menu.add_checkbutton viewmenu#menu ~label:"Search Entry"
 473       ~variable:show_search ~indicatoron:true ~state:`Active
 474       ~command:
 475       begin fun () ->
 476         let v = Textvariable.get show_search in
 477         if v = "1" then begin
 478           pack [search_frame] ~after:menus ~fill:`X
 479         end else Pack.forget [search_frame]
 480       end;
 481
 482     (* modules menu *)
 483     modmenu#add_command "Path editor..."
 484       ~command:(fun () -> Setpath.set ~dir);
 485     modmenu#add_command "Reset cache"
 486       ~command:(fun () -> reset_modules mbox; Env.reset_cache ());
 487     modmenu#add_command "Search symbol..." ~command:search_symbol;
 488
 489     (* Help menu *)
 490     helpmenu#add_command "Manual..." ~command:show_help;
 491
 492     pack [search_frame] ~fill:`X;
 493     pack [boxes_frame] ~fill:`Both ~expand:true;
 494     pack [buttons] ~fill:`X ~side:`Bottom;
 495     pack [view] ~fill:`Both ~side:`Bottom ~expand:true;
 496     reset_modules mbox
 497
 498   val mutable shown_paths = []
 499
 500   method hide_after n =
 501     for i = n to List.length boxes - 1 do
 502       let fm, box = List.nth boxes i in
 503       if i < 3 then Listbox.delete box ~first:(`Num 0) ~last:`End
 504       else destroy fm
 505     done;
 506     let rec firsts n = function [] -> []
 507       | a :: l -> if n > 0 then a :: firsts (pred n) l else [] in
 508     shown_paths <- firsts (n-1) shown_paths;
 509     boxes <- firsts (max 3 n) boxes
 510
 511   method get_box ~path =
 512     let rec path_index p = function
 513         [] -> raise Not_found
 514       | a :: l -> if Path.same p a then 1 else path_index p l + 1 in
 515     try
 516       let n = path_index path shown_paths in
 517       self#hide_after (n+1);
 518       n
 519     with Not_found ->
 520       match path with
 521         Path.Pdot (path', _, _) ->
 522           let n = self#get_box ~path:path' in
 523           shown_paths <- shown_paths @ [path];
 524           if n + 1 >= List.length boxes then ignore self#create_box;
 525           n+1
 526       | _ ->
 527           self#hide_after 2;
 528           shown_paths <- [path];
 529           1
 530
 531   method set_path path ~sign =
 532     let rec path_elems l path =
 533       match path with
 534         Path.Pdot (path, _, _) -> path_elems (path::l) path
 535       | _ -> []
 536     in
 537     let path_elems path =
 538       match path with
 539       | Path.Pident _ -> [path]
 540       | _ -> path_elems [] path
 541     in
 542     let see_path ~box:n ?(sign=[]) path =
 543       let (_, box) = List.nth boxes n in
 544       let texts = Listbox.get_range box ~first:(`Num 0) ~last:`End in
 545       let rec index s = function
 546           [] -> raise Not_found
 547         | a :: l -> if a = s then 0 else 1 + index s l
 548       in
 549       try
 550         let modlid, s =
 551           match path with
 552             Path.Pdot (p, s, _) -> longident_of_path p, s
 553           | Path.Pident i -> Longident.Lident "M", Ident.name i
 554           | _ -> assert false
 555         in
 556         let li, k =
 557           if sign = [] then Longident.Lident s, Pmodule else
 558           ident_of_decl ~modlid (List.hd sign) in
 559         let s =
 560           if n = 0 then string_of_longident li else
 561           string_of_longident li ^ " (" ^ string_of_kind k ^ ")" in
 562         let n = index s texts in
 563         Listbox.see box (`Num n);
 564         Listbox.activate box (`Num n)
 565       with Not_found -> ()
 566     in
 567     let l = path_elems path in
 568     if l <> [] then begin
 569       List.iter l ~f:
 570         begin fun path ->
 571           if not (List.mem path shown_paths) then
 572             view_symbol (longident_of_path path) ~kind:Pmodule
 573               ~env:Env.initial ~path;
 574           let n = self#get_box path - 1 in
 575           see_path path ~box:n
 576         end;
 577       see_path path ~box:(self#get_box path) ~sign
 578     end
 579
 580   method choose_symbol ~title ~env ?signature ?path l =
 581     let n =
 582       match path with None -> 1
 583       | Some path -> self#get_box ~path
 584     in
 585     let l = List.sort l ~cmp:(fun (li1, _) (li2,_) -> compare li1 li2) in
 586     let nl = List.map l ~f:
 587         begin fun (li, k) ->
 588           string_of_longident li ^ " (" ^ string_of_kind k ^ ")"
 589         end in
 590     let _, box = List.nth boxes n in
 591     Listbox.delete box ~first:(`Num 0) ~last:`End;
 592     Listbox.insert box ~index:`End ~texts:nl;
 593
 594     let current = ref None in
 595     let display index =
 596       let `Num pos = Listbox.index box ~index in
 597       try
 598         let li, k = List.nth l pos in
 599         self#hide_after (n+1);
 600         if !current = Some (li,k) then () else
 601         let path =
 602           match path, li with
 603             None, Ldot (lip, _) ->
 604               begin try
 605                 Some (fst (lookup_module lip env))
 606               with Not_found -> None
 607               end
 608           | _ -> path
 609         in
 610         current := Some (li,k);
 611         view_symbol li ~kind:k ~env ?path
 612       with Failure "nth" -> ()
 613     in
 614     Jg_box.add_completion box ~double:false ~action:display;
 615     bind box ~events:[`KeyRelease] ~fields:[`Char]
 616       ~action:(fun ev -> display `Active);
 617
 618     begin match signature with
 619       None -> ()
 620     | Some signature ->
 621         show_all <-
 622           begin fun () ->
 623             current := None;
 624             view_signature signature ~title ~env ?path
 625           end
 626     end
 627 end
 628
 629 let st_viewer ?dir ?on () =
 630   let viewer = new st_viewer ?dir ?on () in
 631   choose_symbol_ref := viewer#choose_symbol