summaryrefslogtreecommitdiffstats
path: root/otherlibs/labltk/browser/shell.ml
diff options
context:
space:
mode:
authorJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2000-04-12 03:43:25 +0000
committerJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2000-04-12 03:43:25 +0000
commit780b65fca6ed06966864d76755dc1dad94c39ade (patch)
treea93efbe44a2b54752fbb4a0b2e994c0a4505b271 /otherlibs/labltk/browser/shell.ml
parent975d4dc752a717b2da0bb0f3307af6635572d3c5 (diff)
nouvelle syntaxe avec tilde
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3061 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'otherlibs/labltk/browser/shell.ml')
-rw-r--r--otherlibs/labltk/browser/shell.ml188
1 files changed, 94 insertions, 94 deletions
diff --git a/otherlibs/labltk/browser/shell.ml b/otherlibs/labltk/browser/shell.ml
index 7e8b479bd..5a82116d5 100644
--- a/otherlibs/labltk/browser/shell.ml
+++ b/otherlibs/labltk/browser/shell.ml
@@ -19,7 +19,7 @@ open Dummy
(* Here again, memoize regexps *)
-let (~) = Jg_memo.fast f:Str.regexp
+let (~!) = Jg_memo.fast ~f:Str.regexp
(* Nice history class. May reuse *)
@@ -38,7 +38,7 @@ class ['a] history () = object
List.nth history ((l + count - 1) mod l)
end
-let dump_mem ?(:pos = 0) ?:len obj =
+let dump_mem ?(pos = 0) ?len obj =
if not (Obj.is_block obj) then invalid_arg "Shell.dump_mem";
let len =
match len with
@@ -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 =
let (in2,out1) = Unix.pipe ()
and (in1,out2) = Unix.pipe ()
and (err1,err2) = Unix.pipe ()
@@ -68,8 +68,8 @@ object (self)
Array.append env [|sigdef|]
else env
in
- Unix.create_process_env :prog :args :env
- stdin:in2 stdout:out2 stderr:err2
+ 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 mutable alive = true
@@ -79,20 +79,20 @@ object (self)
val mutable ithreads = []
method alive = alive
method kill =
- if Winfo.exists textw then Text.configure textw state:`Disabled;
+ if Winfo.exists textw then Text.configure textw ~state:`Disabled;
if alive then begin
alive <- false;
protect close_out out;
try
if Sys.os_type = "Win32" then begin
- ignore (Unix.write sig1 buf:"T" pos:0 len:1);
- List.iter f:(protect Unix.close) [sig1; sig2]
+ ignore (Unix.write sig1 ~buf:"T" ~pos:0 ~len:1);
+ List.iter ~f:(protect Unix.close) [sig1; sig2]
end else begin
- List.iter f:(protect Unix.close) [in1; err1; sig1; sig2];
- Fileevent.remove_fileinput fd:in1;
- Fileevent.remove_fileinput fd:err1;
- Unix.kill :pid signal:Sys.sigkill;
- ignore (Unix.waitpid mode:[] pid)
+ List.iter ~f:(protect Unix.close) [in1; err1; sig1; sig2];
+ Fileevent.remove_fileinput ~fd:in1;
+ Fileevent.remove_fileinput ~fd:err1;
+ Unix.kill ~pid ~signal:Sys.sigkill;
+ ignore (Unix.waitpid ~mode:[] pid)
end
with _ -> ()
end
@@ -100,23 +100,23 @@ object (self)
if alive then try
reading <- false;
if Sys.os_type = "Win32" then begin
- ignore (Unix.write sig1 buf:"C" pos:0 len:1);
+ ignore (Unix.write sig1 ~buf:"C" ~pos:0 ~len:1);
self#send " "
end else
- Unix.kill :pid signal:Sys.sigint
+ Unix.kill ~pid ~signal:Sys.sigint
with Unix.Unix_error _ -> ()
method send s =
if alive then try
output_string out s;
flush out
with Sys_error _ -> ()
- method private read :fd :len =
+ method private read ~fd ~len =
begin try
let buf = String.create len in
- let len = Unix.read fd :buf pos:0 :len in
+ let len = Unix.read fd ~buf ~pos:0 ~len in
if len > 0 then begin
- self#insert (String.sub buf pos:0 :len);
- Text.mark_set textw mark:"input" index:(`Mark"insert",[`Char(-1)])
+ self#insert (String.sub buf ~pos:0 ~len);
+ Text.mark_set textw ~mark:"input" ~index:(`Mark"insert",[`Char(-1)])
end;
len
with Unix.Unix_error _ -> 0
@@ -124,50 +124,50 @@ object (self)
method history (dir : [`next|`previous]) =
if not h#empty then begin
if reading then begin
- Text.delete textw start:(`Mark"input",[`Char 1])
- end:(`Mark"insert",[])
+ Text.delete textw ~start:(`Mark"input",[`Char 1])
+ ~stop:(`Mark"insert",[])
end else begin
reading <- true;
- Text.mark_set textw mark:"input"
- index:(`Mark"insert",[`Char(-1)])
+ Text.mark_set textw ~mark:"input"
+ ~index:(`Mark"insert",[`Char(-1)])
end;
self#insert (if dir = `previous then h#previous else h#next)
end
- method private lex ?(:start = `Mark"insert",[`Linestart])
- ?(:end = `Mark"insert",[`Lineend]) () =
- Lexical.tag textw :start :end
+ method private lex ?(start = `Mark"insert",[`Linestart])
+ ?(stop = `Mark"insert",[`Lineend]) () =
+ Lexical.tag textw ~start ~stop
method insert text =
let idx = Text.index textw
- index:(`Mark"insert",[`Char(-1);`Linestart]) in
- Text.insert textw :text index:(`Mark"insert",[]);
- self#lex start:(idx,[`Linestart]) ();
- Text.see textw index:(`Mark"insert",[])
+ ~index:(`Mark"insert",[`Char(-1);`Linestart]) in
+ Text.insert textw ~text ~index:(`Mark"insert",[]);
+ self#lex ~start:(idx,[`Linestart]) ();
+ Text.see textw ~index:(`Mark"insert",[])
method private keypress c =
if not reading & c > " " then begin
reading <- true;
- Text.mark_set textw mark:"input" index:(`Mark"insert",[`Char(-1)])
+ Text.mark_set textw ~mark:"input" ~index:(`Mark"insert",[`Char(-1)])
end
method private keyrelease c = if c <> "" then self#lex ()
method private return =
if reading then reading <- false
- else Text.mark_set textw mark:"input"
- index:(`Mark"insert",[`Linestart;`Char 1]);
- Text.mark_set textw mark:"insert"index:(`Mark"insert",[`Line 1]);
- self#lex start:(`Mark"input",[`Linestart]) ();
+ else Text.mark_set textw ~mark:"input"
+ ~index:(`Mark"insert",[`Linestart;`Char 1]);
+ Text.mark_set textw ~mark:"insert"~index:(`Mark"insert",[`Line 1]);
+ self#lex ~start:(`Mark"input",[`Linestart]) ();
let s =
(* input is one character before real input *)
- Text.get textw start:(`Mark"input",[`Char 1])
- end:(`Mark"insert",[]) in
+ Text.get textw ~start:(`Mark"input",[`Char 1])
+ ~stop:(`Mark"insert",[]) in
h#add s;
- Text.insert textw index:(`Mark"insert",[]) text:"\n";
- Text.yview_index textw index:(`Mark"insert",[]);
+ Text.insert textw ~index:(`Mark"insert",[]) ~text:"\n";
+ Text.yview_index textw ~index:(`Mark"insert",[]);
self#send s;
self#send "\n"
method private paste ev =
if not reading then begin
reading <- true;
- Text.mark_set textw mark:"input"
- index:(`Atxy(ev.ev_MouseX, ev.ev_MouseY),[`Char(-1)])
+ Text.mark_set textw ~mark:"input"
+ ~index:(`Atxy(ev.ev_MouseX, ev.ev_MouseY),[`Char(-1)])
end
initializer
Lexical.init_tags textw;
@@ -183,42 +183,42 @@ object (self)
([`Control], `KeyPressDetail"c", [], fun _ -> self#interrupt);
([], `Destroy, [], fun _ -> self#kill) ]
in
- List.iter bindings f:
+ List.iter bindings ~f:
begin fun (modif,event,fields,action) ->
- bind textw events:[`Modified(modif,event)] :fields :action
+ bind textw ~events:[`Modified(modif,event)] ~fields ~action
end;
- bind textw events:[`KeyPressDetail"Return"] breakable:true
- action:(fun _ -> self#return; break());
- List.iter f:Unix.close [in2;out2;err2];
+ bind textw ~events:[`KeyPressDetail"Return"] ~breakable:true
+ ~action:(fun _ -> self#return; break());
+ List.iter ~f:Unix.close [in2;out2;err2];
if Sys.os_type = "Win32" then begin
let fileinput_thread fd =
let buf = String.create 1024 in
let len = ref 0 in
- try while len := ThreadUnix.read fd :buf pos:0 len:1024; !len > 0 do
+ try while len := ThreadUnix.read fd ~buf ~pos:0 ~len:1024; !len > 0 do
Mutex.lock imutex;
- Buffer.add_substring ibuffer buf pos:0 len:!len;
+ Buffer.add_substring ibuffer buf ~pos:0 ~len:!len;
Mutex.unlock imutex
done with Unix.Unix_error _ -> ()
in
- ithreads <- List.map [in1; err1] f:(Thread.create fileinput_thread);
+ ithreads <- List.map [in1; err1] ~f:(Thread.create fileinput_thread);
let rec read_buffer () =
Mutex.lock imutex;
if Buffer.length ibuffer > 0 then begin
- self#insert (Str.global_replace pat:~"\r\n" templ:"\n"
+ self#insert (Str.global_replace ~pat:~!"\r\n" ~templ:"\n"
(Buffer.contents ibuffer));
Buffer.reset ibuffer;
- Text.mark_set textw mark:"input" index:(`Mark"insert",[`Char(-1)])
+ Text.mark_set textw ~mark:"input" ~index:(`Mark"insert",[`Char(-1)])
end;
Mutex.unlock imutex;
- Timer.set ms:100 callback:read_buffer
+ Timer.set ~ms:100 ~callback:read_buffer
in
read_buffer ()
end else begin
try
- List.iter [in1;err1] f:
+ List.iter [in1;err1] ~f:
begin fun fd ->
- Fileevent.add_fileinput :fd
- callback:(fun () -> ignore (self#read :fd len:1024))
+ Fileevent.add_fileinput ~fd
+ ~callback:(fun () -> ignore (self#read ~fd ~len:1024))
end
with _ -> ()
end
@@ -230,20 +230,20 @@ let shells : (string * shell) list ref = ref []
(* Called before exiting *)
let kill_all () =
- List.iter !shells f:(fun (_,sh) -> if sh#alive then sh#kill);
+ List.iter !shells ~f:(fun (_,sh) -> if sh#alive then sh#kill);
shells := []
let get_all () =
- let all = List.filter !shells f:(fun (_,sh) -> sh#alive) in
+ let all = List.filter !shells ~f:(fun (_,sh) -> sh#alive) in
shells := all;
all
let may_exec_unix prog =
- try Unix.access file:prog perm:[Unix.X_OK]; true
+ try Unix.access ~file:prog ~perm:[Unix.X_OK]; true
with Unix.Unix_error _ -> false
let may_exec_win prog =
- List.exists f:may_exec_unix [prog; prog^".exe"; prog^".cmo"; prog^".bat"]
+ List.exists ~f:may_exec_unix [prog; prog^".exe"; prog^".cmo"; prog^".bat"]
let may_exec =
if Sys.os_type = "Win32" then may_exec_win else may_exec_unix
@@ -252,50 +252,50 @@ let path_sep = if Sys.os_type = "Win32" then ";" else ":"
let warnings = ref "A"
-let f :prog :title =
+let f ~prog ~title =
let progargs =
- List.filter f:((<>) "") (Str.split sep:~" " prog) in
+ List.filter ~f:((<>) "") (Str.split ~sep:~!" " prog) in
if progargs = [] then () else
let prog = List.hd progargs in
let path =
try Sys.getenv "PATH" with Not_found -> "/bin" ^ path_sep ^ "/usr/bin" in
- let exec_path = Str.split sep:~path_sep path in
+ let exec_path = Str.split ~sep:~!path_sep path in
let exists =
if not (Filename.is_implicit prog) then may_exec prog else
List.exists exec_path
- f:(fun dir -> may_exec (Filename.concat dir prog)) in
+ ~f:(fun dir -> may_exec (Filename.concat dir prog)) in
if not exists then () else
let tl = Jg_toplevel.titled title in
- let menus = Frame.create tl name:"menubar" in
- let file_menu = new Jg_menu.c "File" parent:menus
- and history_menu = new Jg_menu.c "History" parent:menus
- and signal_menu = new Jg_menu.c "Signal" parent:menus in
- pack [menus] side:`Top fill:`X;
+ let menus = Frame.create tl ~name:"menubar" in
+ let file_menu = new Jg_menu.c "File" ~parent:menus
+ and history_menu = new Jg_menu.c "History" ~parent:menus
+ and signal_menu = new Jg_menu.c "Signal" ~parent:menus in
+ pack [menus] ~side:`Top ~fill:`X;
pack [file_menu#button; history_menu#button; signal_menu#button]
- side:`Left ipadx:5 anchor:`W;
+ ~side:`Left ~ipadx:5 ~anchor:`W;
let frame, tw, sb = Jg_text.create_with_scrollbar tl in
- Text.configure tw background:`White;
- pack [sb] fill:`Y side:`Right;
- pack [tw] fill:`Both expand:true side:`Left;
- pack [frame] fill:`Both expand:true;
- let env = Array.map (Unix.environment ()) f:
+ Text.configure tw ~background:`White;
+ pack [sb] ~fill:`Y ~side:`Right;
+ pack [tw] ~fill:`Both ~expand:true ~side:`Left;
+ pack [frame] ~fill:`Both ~expand:true;
+ let env = Array.map (Unix.environment ()) ~f:
begin fun s ->
- if Str.string_match pat:~"TERM=" s pos:0 then "TERM=dumb" else s
+ if Str.string_match ~pat:~!"TERM=" s ~pos:0 then "TERM=dumb" else s
end in
let load_path =
- List2.flat_map !Config.load_path f:(fun dir -> ["-I"; dir]) in
+ List2.flat_map !Config.load_path ~f:(fun dir -> ["-I"; dir]) in
let modern = if !Clflags.classic then [] else ["-label"] in
let warnings =
if List.mem "-w" progargs || !warnings = "A" then []
else ["-w"; !warnings]
in
let args = Array.of_list (progargs @ modern @ warnings @ load_path) in
- let sh = new shell textw:tw :prog :env :args in
+ let sh = new shell ~textw:tw ~prog ~env ~args in
let current_dir = ref (Unix.getcwd ()) in
- file_menu#add_command "Use..." command:
+ file_menu#add_command "Use..." ~command:
begin fun () ->
- Fileselect.f title:"Use File" filter:"*.ml" sync:true dir:!current_dir ()
- action:(fun l ->
+ Fileselect.f ~title:"Use File" ~filter:"*.ml" ~sync:true ~dir:!current_dir ()
+ ~action:(fun l ->
if l = [] then () else
let name = List.hd l in
current_dir := Filename.dirname name;
@@ -304,11 +304,11 @@ let f :prog :title =
let cmd = "#use \"" ^ name ^ "\";;\n" in
sh#insert cmd; sh#send cmd)
end;
- file_menu#add_command "Load..." command:
+ file_menu#add_command "Load..." ~command:
begin fun () ->
- Fileselect.f title:"Load File" filter:"*.cm[oa]" sync:true ()
- dir:!current_dir
- action:(fun l ->
+ Fileselect.f ~title:"Load File" ~filter:"*.cm[oa]" ~sync:true ()
+ ~dir:!current_dir
+ ~action:(fun l ->
if l = [] then () else
let name = List.hd l in
current_dir := Filename.dirname name;
@@ -318,17 +318,17 @@ let f :prog :title =
let cmd = "#load \"" ^ name ^ "\";;\n" in
sh#insert cmd; sh#send cmd)
end;
- file_menu#add_command "Import path" command:
+ 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);
- history_menu#add_command "Next" accelerator:"M-n"
- 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);
+ file_menu#add_command "Close" ~command:(fun () -> destroy tl);
+ history_menu#add_command "Previous " ~accelerator:"M-p"
+ ~command:(fun () -> sh#history `previous);
+ history_menu#add_command "Next" ~accelerator:"M-n"
+ ~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
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-20 19:25:56 +0000