diff options
| author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2000-06-07 07:12:46 +0000 |
|---|---|---|
| committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2000-06-07 07:12:46 +0000 |
| commit | 9e4ac3298c65fe71abfc3b80f82e071fd19c9fc0 (patch) | |
| tree | 61b0996f7fae7f2dd9418f9650643f055030b432 /otherlibs/labltk/browser | |
| parent | 874e4e62e15532a7e8d920b7e107db52579ed9a2 (diff) | |
add shell restart
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3192 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'otherlibs/labltk/browser')
| -rw-r--r-- | otherlibs/labltk/browser/shell.ml | 36 | ||||
| -rw-r--r-- | otherlibs/labltk/browser/shell.mli | 13 |
2 files changed, 37 insertions, 12 deletions
diff --git a/otherlibs/labltk/browser/shell.ml b/otherlibs/labltk/browser/shell.ml index 94c6419e5..b98a588d4 100644 --- a/otherlibs/labltk/browser/shell.ml +++ b/otherlibs/labltk/browser/shell.ml @@ -55,7 +55,7 @@ let dump_mem ?(pos = 0) ?len obj = let protect f x = try f x with _ -> () -class shell ~textw ~prog ~args ~env = +class shell ~textw ~prog ~args ~env ~history = let (in2,out1) = Unix.pipe () and (in1,out2) = Unix.pipe () and (err1,err2) = Unix.pipe () @@ -71,7 +71,7 @@ object (self) Unix.create_process_env ~prog ~args ~env ~stdin:in2 ~stdout:out2 ~stderr:err2 val out = Unix.out_channel_of_descr out1 - val h = new history () + val h : _ history = history val mutable alive = true val mutable reading = false val ibuffer = Buffer.create 1024 @@ -292,8 +292,23 @@ let f ~prog ~title = in let args = Array.of_list (progargs @ labels @ warnings @ rectypes @ load_path) in - let sh = new shell ~textw:tw ~prog ~env ~args in + let history = new history () in + let start_shell () = + let sh = new shell ~textw:tw ~prog ~env ~args ~history in + shells := (title, sh) :: !shells; + sh + in + let sh = ref (start_shell ()) in let current_dir = ref (Unix.getcwd ()) in + file_menu#add_command "Restart" ~command: + begin fun () -> + (!sh)#kill; + Text.configure tw ~state:`Normal; + Text.insert tw ~index:(`End,[]) ~text:"\n"; + Text.see tw ~index:(`End,[]); + Text.mark_set tw ~mark:"insert" ~index:(`End,[]); + sh := start_shell (); + end; file_menu#add_command "Use..." ~command: begin fun () -> Fileselect.f ~title:"Use File" ~filter:"*.ml" @@ -305,7 +320,7 @@ let f ~prog ~title = if Filename.check_suffix name ".ml" then let cmd = "#use \"" ^ name ^ "\";;\n" in - sh#insert cmd; sh#send cmd) + (!sh)#insert cmd; (!sh)#send cmd) end; file_menu#add_command "Load..." ~command: begin fun () -> @@ -319,19 +334,18 @@ let f ~prog ~title = Filename.check_suffix name ".cma" then let cmd = "#load \"" ^ name ^ "\";;\n" in - sh#insert cmd; sh#send cmd) + (!sh)#insert cmd; (!sh)#send cmd) end; file_menu#add_command "Import path" ~command: begin fun () -> List.iter (List.rev !Config.load_path) - ~f:(fun dir -> sh#send ("#directory \"" ^ dir ^ "\";;\n")) + ~f:(fun dir -> (!sh)#send ("#directory \"" ^ dir ^ "\";;\n")) end; file_menu#add_command "Close" ~command:(fun () -> destroy tl); history_menu#add_command "Previous " ~accelerator:"M-p" - ~command:(fun () -> sh#history `previous); + ~command:(fun () -> (!sh)#history `previous); history_menu#add_command "Next" ~accelerator:"M-n" - ~command:(fun () -> sh#history `next); + ~command:(fun () -> (!sh)#history `next); signal_menu#add_command "Interrupt " ~accelerator:"C-c" - ~command:(fun () -> sh#interrupt); - signal_menu#add_command "Kill" ~command:(fun () -> sh#kill); - shells := (title, sh) :: !shells + ~command:(fun () -> (!sh)#interrupt); + signal_menu#add_command "Kill" ~command:(fun () -> (!sh)#kill) diff --git a/otherlibs/labltk/browser/shell.mli b/otherlibs/labltk/browser/shell.mli index 856587319..4936cd6e2 100644 --- a/otherlibs/labltk/browser/shell.mli +++ b/otherlibs/labltk/browser/shell.mli @@ -13,11 +13,22 @@ (* $Id$ *) +class ['a] history : + unit -> + object + val mutable count : int + val mutable history : 'a list + method add : 'a -> unit + method empty : bool + method next : 'a + method previous : 'a + end + (* toplevel shell *) class shell : textw:Widget.text Widget.widget -> prog:string -> - args:string array -> env:string array -> + args:string array -> env:string array -> history:string history -> object method alive : bool method kill : unit |