add smalltalk-style browser

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

10 files changed, 553 insertions, 29 deletions

diff --git a/otherlibs/labltk/browser/Makefile b/otherlibs/labltk/browser/Makefile
index b518d8c271..9c5081f16a 100644
--- a/otherlibs/labltk/browser/Makefile
+++ b/otherlibs/labltk/browser/Makefile
@@ -7,6 +7,7 @@ INCLUDES=$(OTHERSLIB) $(LABLTKLIB) $(OCAMLTOPLIB)
 
 OBJ =	list2.cmo	useunix.cmo	setpath.cmo	lexical.cmo	\
 	fileselect.cmo	searchid.cmo	searchpos.cmo	shell.cmo	\
+	help.cmo	\
 	viewer.cmo	typecheck.cmo	editor.cmo	main.cmo
 
 JG =	jg_tk.cmo	jg_config.cmo	jg_bind.cmo	 jg_completion.cmo \
@@ -33,7 +34,12 @@ ocamlbrowser$(EXE): $(TOPDIR)/toplevel/toplevellib.cma jglib.cma $(OBJ) \
 		unix.cma str.cma labltk.cma jglib.cma $(OBJ)
 
 jglib.cma: $(JG)
-	$(LABLCOMP) -a -o jglib.cma $(JG) 
+	$(LABLCOMP) -a -o jglib.cma $(JG)
+
+#help.ml: help.txt
+#	printf 'let text = "' > $@
+#	cat help.txt >> $@
+#	printf '";;\n' >> $@
 
 install:
 	if test -f ocamlbrowser$(EXE); then : ; \
diff --git a/otherlibs/labltk/browser/Makefile.nt b/otherlibs/labltk/browser/Makefile.nt
index 7891e047fa..370da56de6 100644
--- a/otherlibs/labltk/browser/Makefile.nt
+++ b/otherlibs/labltk/browser/Makefile.nt
@@ -8,6 +8,7 @@ CCFLAGS=-I..\..\..\byterun /Zi $(TK_DEFS)
 
 OBJ =	list2.cmo	useunix.cmo	setpath.cmo	lexical.cmo	\
 	fileselect.cmo	searchid.cmo	searchpos.cmo	shell.cmo	\
+        help.cmo        \
 	viewer.cmo	typecheck.cmo	editor.cmo	main.cmo
 
 JG =	jg_tk.cmo	jg_config.cmo	jg_bind.cmo	 jg_completion.cmo \
diff --git a/otherlibs/labltk/browser/help.ml b/otherlibs/labltk/browser/help.ml
new file mode 100644
index 0000000000..696e1d85b4
--- /dev/null
+++ b/otherlibs/labltk/browser/help.ml
@@ -0,0 +1,145 @@
+let text = "                          OCamlBrowser Help
+
+USE
+   OCamlBrowser is composed of three tools, the Editor, which allows
+   one to edit/typecheck/analyse .mli and .ml files, the Viewer, to
+   walk around compiled modules, and the Shell, to run an OCaml
+   subshell. You may only have one instance of Editor and Viewer, but
+   you may use several subshells.
+
+   As with the compiler, you may specify a different path for the
+   standard library by setting OCAMLDIR. You may also extend the
+   initial load path (only standard library by default) by using the
+   -I command line option.
+
+1) Viewer
+   It displays the list of modules in the load path. Click on one to
+   start your trip.
+
+   The entry line at the bottom allows one to search for an identifier
+   in all modules, either by its name (? and * patterns allowed) or by
+   its type (if there is an arrow in the input). When search by type
+   is used, it is done in inclusion mode (cf. Modules - search symbol)
+
+   The Close all button is there to dismiss the windows created
+   during your trip (every click creates one...) By double-clicking on
+   it you will quit the browser.
+
+   File - Open and File - Editor give access to the editor.
+
+   File - Shell opens an OCaml shell.
+
+   Modules - Path editor changes the load path.
+        Pressing [Add to path] or Insert key adds selected directories
+        to the load path.
+        Pressing [Remove from path] or Delete key removes selected
+        paths from the load path.
+   Modules - Reset cache rescans the load path and resets the module
+   cache. Do it if you recompile some interface, or change the load
+   path in a conflictual way.
+
+   Modules - Search symbol allows to search a symbol either by its
+   name, like the bottom line of the viewer, or, more interestingly,
+   by its type. Exact type searches for a type with exactly the same
+   information as the pattern (variables match only variables),
+   included type allows to give only partial information: the actual
+   type may take more arguments and return more results, and variables
+   in the pattern match anything. In both cases, argument and tuple
+   order is irrelevant (*), and unlabeled arguments in the pattern
+   match any label.
+
+   (*) To avoid combinatorial explosion of the search space, optional
+   arguments in the actual type are ignored if (1) there are to many
+   of them, and (2) they do not appear explicitly in the pattern.
+
+2) Module walking
+   Each module is displayed in its own window.
+
+   At the top, a scrollable list of the defined identifiers. If you
+   click on one, this will either create a new window (if this is a
+   sub-module) or display the signature for this identifier below.
+
+   Signatures are clickable. Double clicking with the left mouse
+   button on an identifier in a signature brings you to its signature,
+   inside its module box.
+   A single click on the right button pops up a menu displaying the
+   type declaration for the selected identifier. Its title, when
+   selectable, also brings you to its signature.
+
+   At the bottom, a series of buttons, depending on the context.
+   * Show all displays the signature of the whole module.
+   * Detach copies the currently displayed signature in a new window,
+     to keep it.
+   * Impl and Intf bring you to the implementation or interface of
+     the currently displayed signature, if it is available.
+
+   C-s opens a text search dialog for the displayed signature.
+
+3) File editor
+   You can edit files with it, but there is no auto-save nor undo at
+   the moment. Otherwise you can use it as a browser, making
+   occasional corrections.
+
+   The Edit menu contains commands for jump (C-g), search (C-s), and
+   sending the current selection to a sub-shell (M-x). For this last
+   option, you may choose the shell via a dialog.
+
+   Essential function are in the Compiler menu.
+
+   Preferences opens a dialog to set internals of the editor and
+   type checker.
+
+   Lex (M-l) adds colors according to lexical categories.
+
+   Typecheck (M-t) verifies typing, and memorizes it to let one see an
+   expression's type by double-clicking on it. This is also valid for
+   interfaces. If an error occurs, the part of the interface preceding
+   the error is computed.
+
+   After typechecking, pressing the right button pops up a menu giving
+   the type of the pointed expression, and eventually allowing to
+   follow some links.
+
+   Clear errors dismisses type checker error messages and warnings.
+
+   Signature shows the signature of the current file.
+
+4) Shell
+   When you create a shell, a dialog is presented to you, letting you
+   choose which command you want to run, and the title of the shell
+   (to choose it in the Editor).
+
+   You may change the default command by setting the OLABL environment
+   variable.
+
+   The executed subshell is given the current load path.
+   File: use a source file or load a bytecode file.
+     You may also import the browser's path into the subprocess.
+   History: M-p and M-n browse up and down.
+   Signal: C-c interrupts and you can kill the subprocess.
+
+BUGS
+
+* When you quit the editor and some file was modified, a dialogue is
+  displayed asking wether you want to really quit or not. But 1) if
+  you quit directly from the viewer, there is no dialogue at all, and
+  2) if you close from the window manager, the dialogue is displayed,
+  but you cannot cancel the destruction... Beware.
+
+* When you run it through xon, the shell hangs at the first error. But
+  its ok if you start ocamlbrowser from a remote shell...
+
+TODO
+
+* Complete cross-references.
+
+* Power up editor.
+
+* Add support for the debugger.
+
+* Make this a real programming environment, both for beginners an
+  experimented users.
+
+
+Bug reports and comments to <garrigue@kurims.kyoto-u.ac.jp>
+";;
diff --git a/otherlibs/labltk/browser/help.txt b/otherlibs/labltk/browser/help.txt
new file mode 100644
index 0000000000..941c81b046
--- /dev/null
+++ b/otherlibs/labltk/browser/help.txt
@@ -0,0 +1,144 @@
+                          OCamlBrowser Help
+
+USE
+   OCamlBrowser is composed of three tools, the Editor, which allows
+   one to edit/typecheck/analyse .mli and .ml files, the Viewer, to
+   walk around compiled modules, and the Shell, to run an OCaml
+   subshell. You may only have one instance of Editor and Viewer, but
+   you may use several subshells.
+
+   As with the compiler, you may specify a different path for the
+   standard library by setting OCAMLDIR. You may also extend the
+   initial load path (only standard library by default) by using the
+   -I command line option.
+
+1) Viewer
+   It displays the list of modules in the load path. Click on one to
+   start your trip.
+
+   The entry line at the bottom allows one to search for an identifier
+   in all modules, either by its name (? and * patterns allowed) or by
+   its type (if there is an arrow in the input). When search by type
+   is used, it is done in inclusion mode (cf. Modules - search symbol)
+
+   The Close all button is there to dismiss the windows created
+   during your trip (every click creates one...) By double-clicking on
+   it you will quit the browser.
+
+   File - Open and File - Editor give access to the editor.
+
+   File - Shell opens an OCaml shell.
+
+   Modules - Path editor changes the load path.
+        Pressing [Add to path] or Insert key adds selected directories
+        to the load path.
+        Pressing [Remove from path] or Delete key removes selected
+        paths from the load path.
+   Modules - Reset cache rescans the load path and resets the module
+   cache. Do it if you recompile some interface, or change the load
+   path in a conflictual way.
+
+   Modules - Search symbol allows to search a symbol either by its
+   name, like the bottom line of the viewer, or, more interestingly,
+   by its type. Exact type searches for a type with exactly the same
+   information as the pattern (variables match only variables),
+   included type allows to give only partial information: the actual
+   type may take more arguments and return more results, and variables
+   in the pattern match anything. In both cases, argument and tuple
+   order is irrelevant (*), and unlabeled arguments in the pattern
+   match any label.
+
+   (*) To avoid combinatorial explosion of the search space, optional
+   arguments in the actual type are ignored if (1) there are to many
+   of them, and (2) they do not appear explicitly in the pattern.
+
+2) Module walking
+   Each module is displayed in its own window.
+
+   At the top, a scrollable list of the defined identifiers. If you
+   click on one, this will either create a new window (if this is a
+   sub-module) or display the signature for this identifier below.
+
+   Signatures are clickable. Double clicking with the left mouse
+   button on an identifier in a signature brings you to its signature,
+   inside its module box.
+   A single click on the right button pops up a menu displaying the
+   type declaration for the selected identifier. Its title, when
+   selectable, also brings you to its signature.
+
+   At the bottom, a series of buttons, depending on the context.
+   * Show all displays the signature of the whole module.
+   * Detach copies the currently displayed signature in a new window,
+     to keep it.
+   * Impl and Intf bring you to the implementation or interface of
+     the currently displayed signature, if it is available.
+
+   C-s opens a text search dialog for the displayed signature.
+
+3) File editor
+   You can edit files with it, but there is no auto-save nor undo at
+   the moment. Otherwise you can use it as a browser, making
+   occasional corrections.
+
+   The Edit menu contains commands for jump (C-g), search (C-s), and
+   sending the current selection to a sub-shell (M-x). For this last
+   option, you may choose the shell via a dialog.
+
+   Essential function are in the Compiler menu.
+
+   Preferences opens a dialog to set internals of the editor and
+   type checker.
+
+   Lex (M-l) adds colors according to lexical categories.
+
+   Typecheck (M-t) verifies typing, and memorizes it to let one see an
+   expression's type by double-clicking on it. This is also valid for
+   interfaces. If an error occurs, the part of the interface preceding
+   the error is computed.
+
+   After typechecking, pressing the right button pops up a menu giving
+   the type of the pointed expression, and eventually allowing to
+   follow some links.
+
+   Clear errors dismisses type checker error messages and warnings.
+
+   Signature shows the signature of the current file.
+
+4) Shell
+   When you create a shell, a dialog is presented to you, letting you
+   choose which command you want to run, and the title of the shell
+   (to choose it in the Editor).
+
+   You may change the default command by setting the OLABL environment
+   variable.
+
+   The executed subshell is given the current load path.
+   File: use a source file or load a bytecode file.
+     You may also import the browser's path into the subprocess.
+   History: M-p and M-n browse up and down.
+   Signal: C-c interrupts and you can kill the subprocess.
+
+BUGS
+
+* When you quit the editor and some file was modified, a dialogue is
+  displayed asking wether you want to really quit or not. But 1) if
+  you quit directly from the viewer, there is no dialogue at all, and
+  2) if you close from the window manager, the dialogue is displayed,
+  but you cannot cancel the destruction... Beware.
+
+* When you run it through xon, the shell hangs at the first error. But
+  its ok if you start ocamlbrowser from a remote shell...
+
+TODO
+
+* Complete cross-references.
+
+* Power up editor.
+
+* Add support for the debugger.
+
+* Make this a real programming environment, both for beginners an
+  experimented users.
+
+
+Bug reports and comments to <garrigue@kurims.kyoto-u.ac.jp>
diff --git a/otherlibs/labltk/browser/jg_box.ml b/otherlibs/labltk/browser/jg_box.ml
index 1b9643ffa3..bbe2a286fe 100644
--- a/otherlibs/labltk/browser/jg_box.ml
+++ b/otherlibs/labltk/browser/jg_box.ml
@@ -43,7 +43,7 @@ class timed ?wait ?nocase get_texts = object
     super#reset
 end
 
-let add_completion ?action ?wait ?nocase lb =
+let add_completion ?action ?wait ?nocase ?(double=true) lb =
   let comp =
     new timed ?wait ?nocase
       (fun () -> Listbox.get_range lb ~first:(`Num 0) ~last:`End) in
@@ -62,10 +62,19 @@ let add_completion ?action ?wait ?nocase lb =
     Some action ->
       bind lb ~events:[`KeyPressDetail "Return"]
         ~action:(fun _ -> action `Active);
-      bind lb ~events:[`Modified([`Double], `ButtonPressDetail 1)]
+      let bmod = if double then [`Double] else [] in
+      bind lb ~events:[`Modified(bmod, `ButtonPressDetail 1)]
         ~breakable:true ~fields:[`MouseY]
-        ~action:(fun ev ->
-          action (Listbox.nearest lb ~y:ev.ev_MouseY); break ())
+        ~action:
+        begin fun ev ->
+          let index = Listbox.nearest lb ~y:ev.ev_MouseY in
+          if not double then begin
+            Listbox.selection_clear lb ~first:(`Num 0) ~last:`End;
+            Listbox.selection_set lb ~first:index ~last:index;
+          end;
+          action index;
+          break ()
+        end
   | None -> ()
   end;
 
diff --git a/otherlibs/labltk/browser/main.ml b/otherlibs/labltk/browser/main.ml
index 6e0b4618bc..ef1e18ba34 100644
--- a/otherlibs/labltk/browser/main.ml
+++ b/otherlibs/labltk/browser/main.ml
@@ -17,6 +17,7 @@ open Tk
 
 let _ =
   let path = ref [] in
+  let st = ref false in
   Arg.parse
     ~keywords:["-I", Arg.String (fun s -> path := s :: !path),
                "<dir>  Add <dir> to the list of include directories";
@@ -24,6 +25,7 @@ let _ =
                " Use commuting label syntax";
                "-rectypes", Arg.Set Clflags.recursive_types,
                " Allow arbitrary recursive types";
+               "-st", Arg.Set st, " Smalltalk-like one-box browsing";
                "-w", Arg.String (fun s -> Shell.warnings := s),
                "<flags>  Enable or disable warnings according to <flags>:\n\
                 \032    A/a enable/disable all warnings\n\
@@ -49,16 +51,17 @@ let _ =
   end;
   
   Searchpos.view_defined_ref := Viewer.view_defined;
-  Searchpos.editor_ref.contents <- Editor.f;
+  Searchpos.editor_ref := Editor.f;
 
   let top = openTk ~clas:"OCamlBrowser" () in
   Jg_config.init ();
 
-  bind top ~events:[`Destroy] ~action:(fun _ -> exit 0);
+  (* bind top ~events:[`Destroy] ~action:(fun _ -> exit 0); *)
   at_exit Shell.kill_all;
   
 
-  Viewer.f ~on:top ();
+  if !st then Viewer.st_viewer ~on:top ()
+  else Viewer.f ~on:top ();
 
   while true do
     try
diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml
index e887c3c103..72dbf701dd 100644
--- a/otherlibs/labltk/browser/searchpos.ml
+++ b/otherlibs/labltk/browser/searchpos.ml
@@ -226,6 +226,7 @@ type module_widgets =
       mw_intf: Widget.button Widget.widget }
 
 let shown_modules = Hashtbl.create 17
+let default_frame = ref None
 let filter_modules () =
   Hashtbl.iter shown_modules ~f:
     begin fun ~key ~data ->
@@ -234,13 +235,18 @@ let filter_modules () =
     end
 let add_shown_module path ~widgets =
   Hashtbl.add shown_modules ~key:path ~data:widgets
-and find_shown_module path =
-  filter_modules ();
-  Hashtbl.find shown_modules path
+let find_shown_module path =
+  try
+    filter_modules ();
+    Hashtbl.find shown_modules path
+  with Not_found ->
+    match !default_frame with
+      None -> raise Not_found
+    | Some mw -> mw
 
 let is_shown_module path =
-  filter_modules ();
-  Hashtbl.mem shown_modules path
+  !default_frame <> None ||
+  (filter_modules (); Hashtbl.mem shown_modules path)
 
 (* Viewing a signature *)
 
@@ -280,7 +286,7 @@ let edit_source ~file ~path ~sign =
 (* List of windows to destroy by Close All *)
 let top_widgets = ref []
 
-let rec view_signature ?title ?path ?(env = !start_env) sign =
+let rec view_signature ?title ?path ?(env = !start_env) ?(detach=false) sign =
   let env =
     match path with None -> env
     | Some path -> Env.open_signature path sign env in
@@ -290,20 +296,27 @@ let rec view_signature ?title ?path ?(env = !start_env) sign =
     | None, None -> "Signature"
   in
   let tl, tw, finish =
-    try match path with
-      None -> raise Not_found
-    | Some path ->
-        let widgets =
+    try match path, !default_frame with
+      None, Some mw when not detach ->
+        Button.configure mw.mw_detach
+          ~command:(fun () -> view_signature sign ~title ~env);
+        pack [mw.mw_detach] ~side:`Left;
+        Pack.forget [mw.mw_edit; mw.mw_intf];
+        List.iter ~f:destroy (Winfo.children mw.mw_frame);
+        Jg_message.formatted ~title ~on:mw.mw_frame ~maxheight:15 ()
+    | None, _ -> raise Not_found
+    | Some path, _ ->
+        let mw =
           try find_shown_module path
           with Not_found ->
             view_module path ~env;
             find_shown_module path
         in
-        Button.configure widgets.mw_detach
-          ~command:(fun () -> view_signature sign ~title ~env);
-        pack [widgets.mw_detach] ~side:`Left;
-        Pack.forget [widgets.mw_edit; widgets.mw_intf];
-        List.iter2 [widgets.mw_edit; widgets.mw_intf] [".ml"; ".mli"] ~f:
+        Button.configure mw.mw_detach
+          ~command:(fun () -> view_signature sign ~title ~env ~detach:true);
+        pack [mw.mw_detach] ~side:`Left;
+        Pack.forget [mw.mw_edit; mw.mw_intf];
+        List.iter2 [mw.mw_edit; mw.mw_intf] [".ml"; ".mli"] ~f:
           begin fun button ext ->
             try
               let id = head_id path in
@@ -315,11 +328,11 @@ let rec view_signature ?title ?path ?(env = !start_env) sign =
               pack [button] ~side:`Left
             with Not_found -> ()
           end;
-        let top = Winfo.toplevel widgets.mw_frame in
+        let top = Winfo.toplevel mw.mw_frame in
         if not (Winfo.ismapped top) then Wm.deiconify top;
         Focus.set top;
-        List.iter ~f:destroy (Winfo.children widgets.mw_frame);
-        Jg_message.formatted ~title ~on:widgets.mw_frame ~maxheight:15 ()
+        List.iter ~f:destroy (Winfo.children mw.mw_frame);
+        Jg_message.formatted ~title ~on:mw.mw_frame ~maxheight:15 ()
     with Not_found ->
       let tl, tw, finish = Jg_message.formatted ~title ~maxheight:15 () in
       top_widgets := tl :: !top_widgets;
diff --git a/otherlibs/labltk/browser/searchpos.mli b/otherlibs/labltk/browser/searchpos.mli
index 15fe48d347..962a45d67c 100644
--- a/otherlibs/labltk/browser/searchpos.mli
+++ b/otherlibs/labltk/browser/searchpos.mli
@@ -26,13 +26,15 @@ type module_widgets =
 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 view_defined_ref : (Longident.t -> env:Env.t -> unit) ref
 val editor_ref :
     (?file:string -> ?pos:int -> ?opendialog:bool -> unit -> unit) ref
 
 val view_signature :
-  ?title:string -> ?path:Path.t -> ?env:Env.t -> Types.signature -> unit
+  ?title:string ->
+  ?path:Path.t -> ?env:Env.t -> ?detach:bool -> Types.signature -> unit
 val view_signature_item :
   Types.signature -> path:Path.t -> env:Env.t -> unit
 val view_module_id : Longident.t -> env:Env.t -> unit
diff --git a/otherlibs/labltk/browser/viewer.ml b/otherlibs/labltk/browser/viewer.ml
index c793c0bdfc..e7d068805e 100644
--- a/otherlibs/labltk/browser/viewer.ml
+++ b/otherlibs/labltk/browser/viewer.ml
@@ -23,6 +23,8 @@ open Env
 open Searchpos
 open Searchid
 
+(* Managing the module list *)
+
 let list_modules ~path =
   List.fold_left path ~init:[] ~f:
   begin fun modules dir ->
@@ -45,6 +47,9 @@ let reset_modules box =
   Listbox.insert box ~index:`End ~texts:!module_list;
   Jg_box.recenter box ~index:(`Num 0)
 
+
+(* How to display a symbol *)
+
 let view_symbol ~kind ~env ?path id =
   let name = match id with
       Lident x -> x
@@ -77,6 +82,9 @@ let view_symbol ~kind ~env ?path id =
   | Pclass -> view_class_id id ~env
   | Pcltype -> view_cltype_id id ~env
 
+
+(* Create a list of symbols you can choose from *)
+
 let choose_symbol ~title ~env ?signature ?path l =
   if match path with
     None -> false
@@ -136,9 +144,14 @@ let choose_symbol ~title ~env ?signature ?path l =
       pack [frame] ~side:`Bottom ~fill:`X;
       add_shown_module path
         ~widgets:{ mw_frame = frame; mw_detach = detach;
-                  mw_edit = edit; mw_intf = intf }
+                   mw_edit = edit; mw_intf = intf }
   end
 
+let choose_symbol_ref = ref choose_symbol
+
+
+(* Search, both by type and name *)
+
 let search_which = ref "itself"
 
 let search_symbol () =
@@ -185,6 +198,9 @@ let search_symbol () =
   pack [coe ew; coe choice; coe buttons]
        ~side:`Top ~fill:`X ~expand:true
 
+
+(* Display the contents of a module *)
+
 let view_defined modlid ~env =
   try match lookup_module modlid env with
     path, Tmty_signature sign ->
@@ -208,7 +224,7 @@ let view_defined modlid ~env =
           in iter_sign rem (ident_of_decl decl :: idents)
     in
     let l = iter_sign sign [] in
-    choose_symbol l ~title:(string_of_path path) ~signature:sign
+    !choose_symbol_ref l ~title:(string_of_path path) ~signature:sign
        ~env:(open_signature path sign env) ~path
   | _ -> ()
   with Not_found -> ()
@@ -217,12 +233,17 @@ let view_defined modlid ~env =
       Env.report_error Format.std_formatter err;
       finish ()
 
+
+(* Manage toplevel windows *)
+
 let close_all_views () =
     List.iter !top_widgets
       ~f:(fun tl -> try destroy tl with Protocol.TkError _ -> ());
     top_widgets := []
 
 
+(* Launch a shell *)
+
 let shell_counter = ref 1
 let default_shell = ref "ocaml"
 
@@ -260,6 +281,22 @@ let start_shell () =
   pack [ok;cancel] ~side:`Left ~fill:`X ~expand:true;
   pack [input;buttons] ~side:`Top ~fill:`X ~expand:true
 
+
+(* Help window *)
+
+let show_help () =
+  let tl = Jg_toplevel.titled "OCamlBrowser Help" in
+  Jg_bind.escape_destroy tl;
+  let fw, tw, sb = Jg_text.create_with_scrollbar tl in
+  let ok = Jg_button.create_destroyer ~parent:tl ~text:"Ok" tl in
+  Text.insert tw ~index:tend ~text:Help.text;
+  pack [tw] ~side:`Left ~fill:`Both ~expand:true;
+  pack [sb] ~side:`Right ~fill:`Y;
+  pack [fw] ~side:`Top ~expand:true ~fill:`Both;
+  pack [ok] ~side:`Bottom ~fill:`X
+
+(* Launch the classical viewer *)
+
 let f ?(dir=Unix.getcwd()) ?on () =
   let tl = match on with
     None ->
@@ -269,6 +306,7 @@ let f ?(dir=Unix.getcwd()) ?on () =
       Wm.title_set top "OCamlBrowser";
       Wm.iconname_set top "OCamlBrowser";
       let tl = Frame.create top in
+      bind tl ~events:[`Destroy] ~action:(fun _ -> exit 0);
       pack [tl] ~expand:true ~fill:`Both;
       coe tl
   in
@@ -337,3 +375,164 @@ let f ?(dir=Unix.getcwd()) ?on () =
   pack [mbox] ~side:`Left ~fill:`Both ~expand:true;
   pack [fmbox] ~fill:`Both ~expand:true ~side:`Top;
   reset_modules mbox
+
+(* Smalltalk-like version *)
+
+class st_viewer ?(dir=Unix.getcwd()) ?on () =
+  let tl = match on with
+    None ->
+      let tl = Jg_toplevel.titled "Module viewer" in
+      ignore (Jg_bind.escape_destroy tl); coe tl
+  | Some top ->
+      Wm.title_set top "OCamlBrowser";
+      Wm.iconname_set top "OCamlBrowser";
+      let tl = Frame.create top in
+      bind tl ~events:[`Destroy] ~action:(fun _ -> exit 0);
+      pack [tl] ~expand:true ~fill:`Both;
+      coe tl
+  in
+  let menus = Frame.create tl ~name:"menubar" in
+  let filemenu = new Jg_menu.c "File" ~parent:menus
+  and modmenu = new Jg_menu.c "Modules" ~parent:menus
+  and helpmenu = new Jg_menu.c "Help" ~parent:menus in
+  let boxes_frame = Frame.create tl ~name:"boxes" in
+  let view = Frame.create tl in
+  let buttons = Frame.create tl in
+  let all = Button.create buttons ~text:"Show all" ~padx:20
+  and close = Button.create buttons ~text:"Close all" ~command:close_all_views
+  and detach = Button.create buttons ~text:"Detach"
+  and edit = Button.create buttons ~text:"Impl"
+  and intf = Button.create buttons ~text:"Intf" in
+object (self)
+  val mutable boxes = []
+
+  method create_box =
+    let fmbox, mbox, sb = Jg_box.create_with_scrollbar boxes_frame in
+    boxes <- boxes @ [fmbox, mbox];
+    pack [sb] ~side:`Right ~fill:`Y;
+    pack [mbox] ~side:`Left ~fill:`Both ~expand:true;
+    pack [fmbox] ~side:`Left ~fill:`Both ~expand:true;
+    fmbox, mbox
+
+  initializer
+    (* Boxes *)
+    let fmbox, mbox = self#create_box in
+    Jg_box.add_completion mbox ~nocase:true ~double:false ~action:
+      begin fun index ->
+        view_defined (Lident (Listbox.get mbox ~index)) ~env:!start_env
+      end;
+    Setpath.add_update_hook (fun () -> reset_modules mbox; self#hide_after 1);
+    List.iter [1;2] ~f:(fun _ -> ignore self#create_box);
+    Searchpos.default_frame := Some
+      { mw_frame = view; mw_detach = detach; mw_edit = edit; mw_intf = intf };
+
+    (* Buttons *)
+    pack [close] ~side:`Right ~fill:`X ~expand:true;
+    bind close ~events:[`Modified([`Double], `ButtonPressDetail 1)]
+      ~action:(fun _ -> destroy tl);
+
+    (* File menu *)
+    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 "Quit" ~command:(fun () -> destroy tl);
+
+    (* modules menu *)
+    modmenu#add_command "Path editor..."
+      ~command:(fun () -> Setpath.set ~dir);
+    modmenu#add_command "Reset cache"
+      ~command:(fun () -> reset_modules mbox; Env.reset_cache ());
+    modmenu#add_command "Search symbol..." ~command:search_symbol;
+
+    (* Help menu *)
+    helpmenu#add_command "Manual..." ~command:show_help;
+
+    pack [filemenu#button; modmenu#button] ~side:`Left ~ipadx:5 ~anchor:`W;
+    pack [helpmenu#button] ~side:`Right ~anchor:`E ~ipadx:5;
+    pack [menus] ~side:`Top ~fill:`X;      
+    (* pack [close; search] ~fill:`X ~side:`Right ~expand:true; *)
+    pack [boxes_frame] ~fill:`Both ~expand:true;
+    pack [view] ~fill:`X ~expand:false;
+    pack [buttons] ~fill:`X ~side:`Bottom ~expand:false;
+    reset_modules mbox
+
+  val mutable shown_paths = []
+
+  method hide_after n =
+    for i = n to List.length boxes - 1 do
+      let fm, box = List.nth boxes i in
+      if i < 3 then Listbox.delete box ~first:(`Num 0) ~last:`End
+      else destroy fm
+    done;
+    let rec firsts n = function [] -> []
+      | a :: l -> if n > 0 then a :: firsts (pred n) l else [] in
+    shown_paths <- firsts (n-1) shown_paths;
+    boxes <- firsts (max 3 n) boxes
+
+  method get_box ~path =
+    let rec path_index p = function
+        [] -> raise Not_found
+      | a :: l -> if Path.same p a then 1 else path_index p l + 1 in
+    try
+      let n = path_index path shown_paths in
+      self#hide_after (n+1);
+      n
+    with Not_found ->
+      match path with
+        Path.Pdot (path', _, _) ->
+          let n = self#get_box ~path:path' in
+          shown_paths <- shown_paths @ [path];
+          if n + 1 >= List.length boxes then ignore self#create_box;
+          n+1
+      | _ ->
+          self#hide_after 2;
+          shown_paths <- [path];
+          1
+        
+  method choose_symbol ~title ~env ?signature ?path l =
+    let n =
+      match path with None -> 1
+      | Some path -> self#get_box ~path
+    in
+
+    let l = Sort.list l ~order:
+        (fun (li1, _) (li2,_) ->
+          string_of_longident li1 < string_of_longident li2)
+    in
+    let nl = List.map l ~f:
+        begin fun (li, k) ->
+          string_of_longident li ^ " (" ^ string_of_kind k ^ ")"
+        end in
+    let _, box = List.nth boxes n in
+    Listbox.delete box ~first:(`Num 0) ~last:`End;
+    Listbox.insert box ~index:`End ~texts:nl;
+    Jg_box.add_completion box ~double:false ~action:
+      begin fun index ->
+        let `Num pos = Listbox.index box ~index in
+        let li, k = List.nth l pos in
+        let path =
+          match path, li with
+            None, Ldot (lip, _) ->
+              begin try
+                Some (fst (lookup_module lip env))
+              with Not_found -> None
+              end
+          | _ -> path
+        in
+        view_symbol li ~kind:k ~env ?path;
+      end;
+    begin match signature with
+      None -> ()
+    | Some signature ->
+        Button.configure all ~command:
+          begin fun () ->
+            view_signature signature ~title ~env ?path
+          end;
+        pack [all] ~side:`Right ~fill:`X ~expand:true
+    end
+end
+
+let st_viewer ?dir ?on () =
+  let viewer = new st_viewer ?dir ?on () in
+  choose_symbol_ref := viewer#choose_symbol
diff --git a/otherlibs/labltk/browser/viewer.mli b/otherlibs/labltk/browser/viewer.mli
index 75503f2f20..05b28657f6 100644
--- a/otherlibs/labltk/browser/viewer.mli
+++ b/otherlibs/labltk/browser/viewer.mli
@@ -21,6 +21,8 @@ val search_symbol : unit -> unit
 
 val f : ?dir:string -> ?on:toplevel widget -> unit -> unit
         (* open then module viewer *)
+val st_viewer : ?dir:string -> ?on:toplevel widget -> unit -> unit
+        (* one-box viewer *)
 
 val view_defined : Longident.t -> env:Env.t -> unit
         (* displays a signature, found in environment *)