diff options
Diffstat (limited to 'otherlibs/labltk/browser/editor.ml')
| -rw-r--r-- | otherlibs/labltk/browser/editor.ml | 404 |
1 files changed, 202 insertions, 202 deletions
diff --git a/otherlibs/labltk/browser/editor.ml b/otherlibs/labltk/browser/editor.ml index 6725f5dab..acc514d77 100644 --- a/otherlibs/labltk/browser/editor.ml +++ b/otherlibs/labltk/browser/editor.ml @@ -24,18 +24,18 @@ and type_on_load = ref false let compiler_preferences () = let tl = Jg_toplevel.titled "Compiler" in - Wm.transient_set tl master:Widget.default_toplevel; - let mk_chkbutton :text :ref :invert = - let variable = Textvariable.create on:tl () in + Wm.transient_set tl ~master:Widget.default_toplevel; + let mk_chkbutton ~text ~ref ~invert = + let variable = Textvariable.create ~on:tl () in if (if invert then not !ref else !ref) then Textvariable.set variable "1"; - Checkbutton.create tl :text :variable, + Checkbutton.create tl ~text ~variable, (fun () -> ref := Textvariable.get variable = (if invert then "0" else "1")) in let chkbuttons, setflags = List.split (List.map - f:(fun (text, ref, invert) -> mk_chkbutton :text :ref :invert) + ~f:(fun (text, ref, invert) -> mk_chkbutton ~text ~ref ~invert) [ "No pervasives", Clflags.nopervasives, false; "No warnings", Typecheck.nowarnings, false; "Modern", Clflags.classic, true; @@ -43,16 +43,16 @@ let compiler_preferences () = "Type on load", type_on_load, false ]) in let buttons = Frame.create tl in - let ok = Button.create buttons text:"Ok" padx:20 command: + let ok = Button.create buttons ~text:"Ok" ~padx:20 ~command: begin fun () -> - List.iter f:(fun f -> f ()) setflags; + List.iter ~f:(fun f -> f ()) setflags; destroy tl end - and cancel = Jg_button.create_destroyer tl parent:buttons text:"Cancel" + and cancel = Jg_button.create_destroyer tl ~parent:buttons ~text:"Cancel" in - pack chkbuttons side:`Top anchor:`W; - pack [ok;cancel] side:`Left fill:`X expand:true; - pack [buttons] side:`Bottom fill:`X + pack chkbuttons ~side:`Top ~anchor:`W; + pack [ok;cancel] ~side:`Left ~fill:`X ~expand:true; + pack [buttons] ~side:`Bottom ~fill:`X let rec exclude txt = function [] -> [] @@ -60,75 +60,75 @@ let rec exclude txt = function let goto_line tw = let tl = Jg_toplevel.titled "Go to" in - Wm.transient_set tl master:Widget.default_toplevel; + Wm.transient_set tl ~master:Widget.default_toplevel; Jg_bind.escape_destroy tl; let ef = Frame.create tl in let fl = Frame.create ef and fi = Frame.create ef in - let ll = Label.create fl text:"Line number:" - and il = Entry.create fi width:10 - and lc = Label.create fl text:"Col number:" - and ic = Entry.create fi width:10 + let ll = Label.create fl ~text:"Line ~number:" + and il = Entry.create fi ~width:10 + and lc = Label.create fl ~text:"Col ~number:" + and ic = Entry.create fi ~width:10 and get_int ew = try int_of_string (Entry.get ew) with Failure "int_of_string" -> 0 in let buttons = Frame.create tl in - let ok = Button.create buttons text:"Ok" command: + let ok = Button.create buttons ~text:"Ok" ~command: begin fun () -> let l = get_int il and c = get_int ic in - Text.mark_set tw mark:"insert" index:(`Linechar (l,0), [`Char c]); - Text.see tw index:(`Mark "insert", []); + Text.mark_set tw ~mark:"insert" ~index:(`Linechar (l,0), [`Char c]); + Text.see tw ~index:(`Mark "insert", []); destroy tl end - and cancel = Jg_button.create_destroyer tl parent:buttons text:"Cancel" in + and cancel = Jg_button.create_destroyer tl ~parent:buttons ~text:"Cancel" in Focus.set il; - List.iter [il; ic] f: + List.iter [il; ic] ~f: begin fun w -> Jg_bind.enter_focus w; - Jg_bind.return_invoke w button:ok + Jg_bind.return_invoke w ~button:ok end; - pack [ll; lc] side:`Top anchor:`W; - pack [il; ic] side:`Top fill:`X expand:true; - pack [fl; fi] side:`Left fill:`X expand:true; - pack [ok; cancel] side:`Left fill:`X expand:true; - pack [ef; buttons] side:`Top fill:`X expand:true + pack [ll; lc] ~side:`Top ~anchor:`W; + pack [il; ic] ~side:`Top ~fill:`X ~expand:true; + pack [fl; fi] ~side:`Left ~fill:`X ~expand:true; + pack [ok; cancel] ~side:`Left ~fill:`X ~expand:true; + pack [ef; buttons] ~side:`Top ~fill:`X ~expand:true let select_shell txt = let shells = Shell.get_all () in - let shells = Sort.list shells order:(fun (x,_) (y,_) -> x <= y) in + let shells = Sort.list shells ~order:(fun (x,_) (y,_) -> x <= y) in let tl = Jg_toplevel.titled "Select Shell" in Jg_bind.escape_destroy tl; - Wm.transient_set tl master:(Winfo.toplevel txt.tw); - let label = Label.create tl text:"Send to:" + Wm.transient_set tl ~master:(Winfo.toplevel txt.tw); + let label = Label.create tl ~text:"Send ~to:" and box = Listbox.create tl and frame = Frame.create tl in Jg_bind.enter_focus box; - let cancel = Jg_button.create_destroyer tl parent:frame text:"Cancel" - and ok = Button.create frame text:"Ok" command: + let cancel = Jg_button.create_destroyer tl ~parent:frame ~text:"Cancel" + and ok = Button.create frame ~text:"Ok" ~command: begin fun () -> try - let name = Listbox.get box index:`Active in + let name = Listbox.get box ~index:`Active in txt.shell <- Some (name, List.assoc name shells); destroy tl with Not_found -> txt.shell <- None; destroy tl end in - Listbox.insert box index:`End texts:(List.map f:fst shells); - Listbox.configure box height:(List.length shells); - bind box events:[`KeyPressDetail"Return"] breakable:true - action:(fun _ -> Button.invoke ok; break ()); - bind box events:[`Modified([`Double],`ButtonPressDetail 1)] breakable:true - fields:[`MouseX;`MouseY] - action:(fun ev -> - Listbox.activate box index:(`Atxy (ev.ev_MouseX, ev.ev_MouseY)); + Listbox.insert box ~index:`End ~texts:(List.map ~f:fst shells); + Listbox.configure box ~height:(List.length shells); + bind box ~events:[`KeyPressDetail"Return"] ~breakable:true + ~action:(fun _ -> Button.invoke ok; break ()); + bind box ~events:[`Modified([`Double],`ButtonPressDetail 1)] ~breakable:true + ~fields:[`MouseX;`MouseY] + ~action:(fun ev -> + Listbox.activate box ~index:(`Atxy (ev.ev_MouseX, ev.ev_MouseY)); Button.invoke ok; break ()); - pack [label] side:`Top anchor:`W; - pack [box] side:`Top fill:`Both; - pack [frame] side:`Bottom fill:`X expand:true; - pack [ok;cancel] side:`Left fill:`X expand:true + pack [label] ~side:`Top ~anchor:`W; + pack [box] ~side:`Top ~fill:`Both; + pack [frame] ~side:`Bottom ~fill:`X ~expand:true; + pack [ok;cancel] ~side:`Left ~fill:`X ~expand:true open Parser @@ -141,13 +141,13 @@ let send_phrase txt = match txt.shell with None -> () | Some (_,sh) -> try - let i1,i2 = Text.tag_nextrange txt.tw tag:"sel" start:tstart in - let phrase = Text.get txt.tw start:(i1,[]) end:(i2,[]) in + let i1,i2 = Text.tag_nextrange txt.tw ~tag:"sel" ~start:tstart in + let phrase = Text.get txt.tw ~start:(i1,[]) ~stop:(i2,[]) in sh#send phrase; - if Str.string_match phrase pat:(Str.regexp ";;") pos:0 + if Str.string_match phrase ~pat:(Str.regexp ";;") ~pos:0 then sh#send "\n" else sh#send ";;\n" with Not_found | Protocol.TkError _ -> - let text = Text.get txt.tw start:tstart end:tend in + let text = Text.get txt.tw ~start:tstart ~stop:tend in let buffer = Lexing.from_string text in let start = ref 0 and block_start = ref [] @@ -161,12 +161,12 @@ let send_phrase txt = in let bol = (pos = 0) || text.[pos-1] = '\n' in if not !after && - Text.compare txt.tw index:(tpos pos) op:(if bol then `Gt else `Ge) - index:(`Mark"insert",[]) + Text.compare txt.tw ~index:(tpos pos) ~op:(if bol then `Gt else `Ge) + ~index:(`Mark"insert",[]) then begin after := true; let anon, real = - List.partition !block_start f:(fun x -> x = -1) in + List.partition !block_start ~f:(fun x -> x = -1) in block_start := anon; if real <> [] then start := List.hd real; end; @@ -194,46 +194,46 @@ let send_phrase txt = | _ -> () done; - let phrase = String.sub text pos:!start len:(!pend - !start) in + let phrase = String.sub text ~pos:!start ~len:(!pend - !start) in sh#send phrase; sh#send ";;\n" -let search_pos_window txt :x :y = +let search_pos_window txt ~x ~y = if txt.structure = [] & txt.psignature = [] then () else - let `Linechar (l, c) = Text.index txt.tw index:(`Atxy(x,y), []) in + let `Linechar (l, c) = Text.index txt.tw ~index:(`Atxy(x,y), []) in let text = Jg_text.get_all txt.tw in - let pos = Searchpos.lines_to_chars l in:text + c in + let pos = Searchpos.lines_to_chars l ~text + c in try if txt.structure <> [] then - try Searchpos.search_pos_structure txt.structure :pos + try Searchpos.search_pos_structure txt.structure ~pos with Searchpos.Found_str (kind, env) -> - Searchpos.view_type kind :env + Searchpos.view_type kind ~env else try Searchpos.search_pos_signature - txt.psignature :pos env:!Searchid.start_env; + txt.psignature ~pos ~env:!Searchid.start_env; () with Searchpos.Found_sig (kind, lid, env) -> - Searchpos.view_decl lid :kind :env + Searchpos.view_decl lid ~kind ~env with Not_found -> () -let search_pos_menu txt :x :y = +let search_pos_menu txt ~x ~y = if txt.structure = [] & txt.psignature = [] then () else - let `Linechar (l, c) = Text.index txt.tw index:(`Atxy(x,y), []) in + let `Linechar (l, c) = Text.index txt.tw ~index:(`Atxy(x,y), []) in let text = Jg_text.get_all txt.tw in - let pos = Searchpos.lines_to_chars l in:text + c in + let pos = Searchpos.lines_to_chars l ~text + c in try if txt.structure <> [] then - try Searchpos.search_pos_structure txt.structure :pos + try Searchpos.search_pos_structure txt.structure ~pos with Searchpos.Found_str (kind, env) -> - let menu = Searchpos.view_type_menu kind :env parent:txt.tw in + let menu = Searchpos.view_type_menu kind ~env ~parent:txt.tw in let x = x + Winfo.rootx txt.tw and y = y + Winfo.rooty txt.tw - 10 in - Menu.popup menu :x :y + Menu.popup menu ~x ~y else try Searchpos.search_pos_signature - txt.psignature :pos env:!Searchid.start_env; + txt.psignature ~pos ~env:!Searchid.start_env; () with Searchpos.Found_sig (kind, lid, env) -> - let menu = Searchpos.view_decl_menu lid :kind :env parent:txt.tw in + let menu = Searchpos.view_decl_menu lid ~kind ~env ~parent:txt.tw in let x = x + Winfo.rootx txt.tw and y = y + Winfo.rooty txt.tw - 10 in - Menu.popup menu :x :y + Menu.popup menu ~x ~y with Not_found -> () let string_width s = @@ -247,54 +247,54 @@ let string_width s = let indent_line = let ins = `Mark"insert" and reg = Str.regexp "[ \t]*" in fun tw -> - let `Linechar(l,c) = Text.index tw index:(ins,[]) - and line = Text.get tw start:(ins,[`Linestart]) end:(ins,[`Lineend]) in - ignore (Str.string_match pat:reg line pos:0); + let `Linechar(l,c) = Text.index tw ~index:(ins,[]) + and line = Text.get tw ~start:(ins,[`Linestart]) ~stop:(ins,[`Lineend]) in + ignore (Str.string_match ~pat:reg line ~pos:0); let len = Str.match_end () in - if len < c then Text.insert tw index:(ins,[]) text:"\t" else + if len < c then Text.insert tw ~index:(ins,[]) ~text:"\t" else let width = string_width (Str.matched_string line) in - Text.mark_set tw mark:"insert" index:(ins,[`Linestart;`Char len]); + Text.mark_set tw ~mark:"insert" ~index:(ins,[`Linestart;`Char len]); let indent = if l <= 1 then 2 else let previous = - Text.get tw start:(ins,[`Line(-1);`Linestart]) - end:(ins,[`Line(-1);`Lineend]) in - ignore (Str.string_match pat:reg previous pos:0); + Text.get tw ~start:(ins,[`Line(-1);`Linestart]) + ~stop:(ins,[`Line(-1);`Lineend]) in + ignore (Str.string_match ~pat:reg previous ~pos:0); let previous = Str.matched_string previous in let width_previous = string_width previous in if width_previous <= width then 2 else width_previous - width in - Text.insert tw index:(ins,[]) text:(String.make indent ' ') + Text.insert tw ~index:(ins,[]) ~text:(String.make indent ' ') (* The editor class *) -class editor :top :menus = object (self) - val file_menu = new Jg_menu.c "File" parent:menus - val edit_menu = new Jg_menu.c "Edit" parent:menus - val compiler_menu = new Jg_menu.c "Compiler" parent:menus - val module_menu = new Jg_menu.c "Modules" parent:menus - val window_menu = new Jg_menu.c "Windows" parent:menus +class editor ~top ~menus = object (self) + val file_menu = new Jg_menu.c "File" ~parent:menus + val edit_menu = new Jg_menu.c "Edit" ~parent:menus + val compiler_menu = new Jg_menu.c "Compiler" ~parent:menus + val module_menu = new Jg_menu.c "Modules" ~parent:menus + val window_menu = new Jg_menu.c "Windows" ~parent:menus val label = - Checkbutton.create menus state:`Disabled - onvalue:"modified" offvalue:"unchanged" + Checkbutton.create menus ~state:`Disabled + ~onvalue:"modified" ~offvalue:"unchanged" val mutable current_dir = Unix.getcwd () val mutable error_messages = [] val mutable windows = [] val mutable current_tw = Text.create top - val vwindow = Textvariable.create on:top () + val vwindow = Textvariable.create ~on:top () val mutable window_counter = 0 method reset_window_menu = - Menu.delete window_menu#menu first:(`Num 0) last:`End; + Menu.delete window_menu#menu ~first:(`Num 0) ~last:`End; List.iter - (Sort.list windows order: + (Sort.list windows ~order: (fun w1 w2 -> Filename.basename w1.name < Filename.basename w2.name)) - f: + ~f: begin fun txt -> Menu.add_radiobutton window_menu#menu - label:(Filename.basename txt.name) - variable:vwindow value:txt.number - command:(fun () -> self#set_edit txt) + ~label:(Filename.basename txt.name) + ~variable:vwindow ~value:txt.number + ~command:(fun () -> self#set_edit txt) end method set_edit txt = @@ -303,74 +303,74 @@ class editor :top :menus = object (self) windows <- txt :: exclude txt windows; self#reset_window_menu; current_tw <- txt.tw; - Checkbutton.configure label text:(Filename.basename txt.name) - variable:txt.modified; + Checkbutton.configure label ~text:(Filename.basename txt.name) + ~variable:txt.modified; Textvariable.set vwindow txt.number; - Text.yview txt.tw scroll:(`Page 0); - pack [txt.frame] fill:`Both expand:true side:`Bottom + Text.yview txt.tw ~scroll:(`Page 0); + pack [txt.frame] ~fill:`Both ~expand:true ~side:`Bottom method new_window name = let tl, tw, sb = Jg_text.create_with_scrollbar top in - Text.configure tw background:`White; + Text.configure tw ~background:`White; Jg_bind.enter_focus tw; window_counter <- window_counter + 1; let txt = { name = name; tw = tw; frame = tl; number = string_of_int window_counter; - modified = Textvariable.create on:tw (); + modified = Textvariable.create ~on:tw (); shell = None; structure = []; signature = []; psignature = [] } in let control c = Char.chr (Char.code c - 96) in - bind tw events:[`Modified([`Alt], `KeyPress)] action:ignore; - bind tw events:[`KeyPress] fields:[`Char] - action:(fun ev -> + bind tw ~events:[`Modified([`Alt], `KeyPress)] ~action:ignore; + bind tw ~events:[`KeyPress] ~fields:[`Char] + ~action:(fun ev -> if ev.ev_Char <> "" & (ev.ev_Char.[0] >= ' ' or List.mem ev.ev_Char.[0] - (List.map f:control ['d'; 'h'; 'i'; 'k'; 'o'; 't'; 'w'; 'y'])) + (List.map ~f:control ['d'; 'h'; 'i'; 'k'; 'o'; 't'; 'w'; 'y'])) then Textvariable.set txt.modified "modified"); - bind tw events:[`KeyPressDetail"Tab"] breakable:true - action:(fun _ -> + bind tw ~events:[`KeyPressDetail"Tab"] ~breakable:true + ~action:(fun _ -> indent_line tw; Textvariable.set txt.modified "modified"; break ()); - bind tw events:[`Modified([`Control],`KeyPressDetail"k")] - action:(fun _ -> + bind tw ~events:[`Modified([`Control],`KeyPressDetail"k")] + ~action:(fun _ -> let text = - Text.get tw start:(`Mark"insert",[]) end:(`Mark"insert",[`Lineend]) - in ignore (Str.string_match pat:(Str.regexp "[ \t]*") text pos:0); + Text.get tw ~start:(`Mark"insert",[]) ~stop:(`Mark"insert",[`Lineend]) + in ignore (Str.string_match ~pat:(Str.regexp "[ \t]*") text ~pos:0); if Str.match_end () <> String.length text then begin Clipboard.clear (); - Clipboard.append data:text () + Clipboard.append ~data:text () end); - bind tw events:[`KeyRelease] fields:[`Char] - action:(fun ev -> + bind tw ~events:[`KeyRelease] ~fields:[`Char] + ~action:(fun ev -> if ev.ev_Char <> "" then - Lexical.tag tw start:(`Mark"insert", [`Linestart]) - end:(`Mark"insert", [`Lineend])); - bind tw events:[`Motion] action:(fun _ -> Focus.set tw); - bind tw events:[`ButtonPressDetail 2] - action:(fun _ -> + Lexical.tag tw ~start:(`Mark"insert", [`Linestart]) + ~stop:(`Mark"insert", [`Lineend])); + bind tw ~events:[`Motion] ~action:(fun _ -> Focus.set tw); + bind tw ~events:[`ButtonPressDetail 2] + ~action:(fun _ -> Textvariable.set txt.modified "modified"; - Lexical.tag txt.tw start:(`Mark"insert", [`Linestart]) - end:(`Mark"insert", [`Lineend])); - bind tw events:[`Modified([`Double], `ButtonPressDetail 1)] - fields:[`MouseX;`MouseY] - action:(fun ev -> search_pos_window txt x:ev.ev_MouseX y:ev.ev_MouseY); - bind tw events:[`ButtonPressDetail 3] fields:[`MouseX;`MouseY] - action:(fun ev -> search_pos_menu txt x:ev.ev_MouseX y:ev.ev_MouseY); - - pack [sb] fill:`Y side:`Right; - pack [tw] fill:`Both expand:true side:`Left; + Lexical.tag txt.tw ~start:(`Mark"insert", [`Linestart]) + ~stop:(`Mark"insert", [`Lineend])); + bind tw ~events:[`Modified([`Double], `ButtonPressDetail 1)] + ~fields:[`MouseX;`MouseY] + ~action:(fun ev -> search_pos_window txt ~x:ev.ev_MouseX ~y:ev.ev_MouseY); + bind tw ~events:[`ButtonPressDetail 3] ~fields:[`MouseX;`MouseY] + ~action:(fun ev -> search_pos_menu txt ~x:ev.ev_MouseX ~y:ev.ev_MouseY); + + pack [sb] ~fill:`Y ~side:`Right; + pack [tw] ~fill:`Both ~expand:true ~side:`Left; self#set_edit txt; Checkbutton.deselect label; Lexical.init_tags txt.tw method clear_errors () = - Text.tag_remove current_tw tag:"error" start:tstart end:tend; + Text.tag_remove current_tw ~tag:"error" ~start:tstart ~stop:tend; List.iter error_messages - f:(fun tl -> try destroy tl with Protocol.TkError _ -> ()); + ~f:(fun tl -> try destroy tl with Protocol.TkError _ -> ()); error_messages <- [] method typecheck () = @@ -378,7 +378,7 @@ class editor :top :menus = object (self) error_messages <- Typecheck.f (List.hd windows) method lex () = - Text.tag_remove current_tw tag:"error" start:tstart end:tend; + Text.tag_remove current_tw ~tag:"error" ~start:tstart ~stop:tend; Lexical.tag current_tw method save_text ?name:l txt = @@ -389,17 +389,17 @@ class editor :top :menus = object (self) try if Sys.file_exists name then if txt.name = name then - Sys.rename old:name new:(name ^ "~") + Sys.rename ~src:name ~dst:(name ^ "~") else begin match - Jg_message.ask master:top title:"Save" + Jg_message.ask ~master:top ~title:"Save" ("File `" ^ name ^ "' exists. Overwrite it?") with `yes -> () | `no | `cancel -> raise Exit end; let file = open_out name in - let text = Text.get txt.tw start:tstart end:(tposend 1) in + let text = Text.get txt.tw ~start:tstart ~stop:(tposend 1) in output_string file text; close_out file; - Checkbutton.configure label text:(Filename.basename name); + Checkbutton.configure label ~text:(Filename.basename name); Checkbutton.deselect label; txt.name <- name with @@ -411,17 +411,17 @@ class editor :top :menus = object (self) try let index = try - self#set_edit (List.find windows f:(fun x -> x.name = name)); + self#set_edit (List.find windows ~f:(fun x -> x.name = name)); let txt = List.hd windows in if Textvariable.get txt.modified = "modified" then - begin match Jg_message.ask master:top title:"Open" + begin match Jg_message.ask ~master:top ~title:"Open" ("`" ^ Filename.basename txt.name ^ "' modified. Save it?") with `yes -> self#save_text txt | `no -> () | `cancel -> raise Exit end; Checkbutton.deselect label; - (Text.index current_tw index:(`Mark"insert", []), []) + (Text.index current_tw ~index:(`Mark"insert", []), []) with Not_found -> self#new_window name; tstart in current_dir <- Filename.dirname name; @@ -429,16 +429,16 @@ class editor :top :menus = object (self) and tw = current_tw and len = ref 0 and buf = String.create 4096 in - Text.delete tw start:tstart end:tend; + Text.delete tw ~start:tstart ~stop:tend; while - len := input file :buf pos:0 len:4096; + len := input file ~buf ~pos:0 ~len:4096; !len > 0 do - Jg_text.output tw :buf pos:0 len:!len + Jg_text.output tw ~buf ~pos:0 ~len:!len done; close_in file; - Text.mark_set tw mark:"insert" :index; - Text.see tw :index; + Text.mark_set tw ~mark:"insert" ~index; + Text.see tw ~index; if Filename.check_suffix name ".ml" or Filename.check_suffix name ".mli" then begin @@ -451,7 +451,7 @@ class editor :top :menus = object (self) method close_window txt = try if Textvariable.get txt.modified = "modified" then - begin match Jg_message.ask master:top title:"Close" + begin match Jg_message.ask ~master:top ~title:"Close" ("`" ^ Filename.basename txt.name ^ "' modified. Save it?") with `yes -> self#save_text txt | `no -> () @@ -465,8 +465,8 @@ class editor :top :menus = object (self) with Exit -> () method open_file () = - Fileselect.f title:"Open File" action:self#load_text - dir:current_dir filter:("*.{ml,mli}") sync:true () + Fileselect.f ~title:"Open File" ~action:self#load_text + ~dir:current_dir ~filter:("*.{ml,mli}") ~sync:true () method save_file () = self#save_text (List.hd windows) @@ -474,27 +474,27 @@ class editor :top :menus = object (self) method quit () = try - List.iter windows f: + List.iter windows ~f: begin fun txt -> if Textvariable.get txt.modified = "modified" then - match Jg_message.ask master:top title:"Quit" + match Jg_message.ask ~master:top ~title:"Quit" ("`" ^ Filename.basename txt.name ^ "' modified. Save it?") with `yes -> self#save_text txt | `no -> () | `cancel -> raise Exit end; - bind top events:[`Destroy]; + bind top ~events:[`Destroy]; destroy top; break () with Exit -> break () - method reopen :file :pos = + method reopen ~file ~pos = if not (Winfo.ismapped top) then Wm.deiconify top; match file with None -> () | Some file -> self#load_text [file]; - Text.mark_set current_tw mark:"insert" index:(tpos pos); + Text.mark_set current_tw ~mark:"insert" ~index:(tpos pos); Text.yview_index current_tw - index:(`Linechar(1,0),[`Char pos; `Line (-2)]) + ~index:(`Linechar(1,0),[`Char pos; `Line (-2)]) initializer (* Create a first window *) @@ -508,60 +508,60 @@ class editor :top :menus = object (self) [`Alt], "x", (fun () -> send_phrase (List.hd windows)); [`Alt], "l", self#lex; [`Alt], "t", self#typecheck ] - f:begin fun (modi,key,act) -> - bind top events:[`Modified(modi, `KeyPressDetail key)] breakable:true - action:(fun _ -> act (); break ()) + ~f:begin fun (modi,key,act) -> + bind top ~events:[`Modified(modi, `KeyPressDetail key)] ~breakable:true + ~action:(fun _ -> act (); break ()) end; - bind top events:[`Destroy] breakable:true fields:[`Widget] action: + bind top ~events:[`Destroy] ~breakable:true ~fields:[`Widget] ~action: begin fun ev -> if Widget.name ev.ev_Widget = Widget.name top then self#quit () end; (* File menu *) - file_menu#add_command "Open File..." command:self#open_file; + file_menu#add_command "Open File..." ~command:self#open_file; file_menu#add_command "Reopen" - command:(fun () -> self#load_text [(List.hd windows).name]); - file_menu#add_command "Save File" command:self#save_file accelerator:"M-s"; - file_menu#add_command "Save As..." underline:5 command: + ~command:(fun () -> self#load_text [(List.hd windows).name]); + file_menu#add_command "Save File" ~command:self#save_file ~accelerator:"M-s"; + file_menu#add_command "Save As..." ~underline:5 ~command: begin fun () -> let txt = List.hd windows in - Fileselect.f title:"Save as File" - action:(fun name -> self#save_text txt :name) - dir:(Filename.dirname txt.name) - filter:"*.{ml,mli}" - file:(Filename.basename txt.name) - sync:true usepath:false () + Fileselect.f ~title:"Save as File" + ~action:(fun name -> self#save_text txt ~name) + ~dir:(Filename.dirname txt.name) + ~filter:"*.{ml,mli}" + ~file:(Filename.basename txt.name) + ~sync:true ~usepath:false () end; - file_menu#add_command "Close File" command:self#close_file; - file_menu#add_command "Close Window" command:self#quit underline:6; + file_menu#add_command "Close File" ~command:self#close_file; + file_menu#add_command "Close Window" ~command:self#quit ~underline:6; (* Edit menu *) - edit_menu#add_command "Paste selection" command: + edit_menu#add_command "Paste selection" ~command: begin fun () -> - Text.insert current_tw index:(`Mark"insert",[]) - text:(Selection.get displayof:top ()) + Text.insert current_tw ~index:(`Mark"insert",[]) + ~text:(Selection.get ~displayof:top ()) end; - edit_menu#add_command "Goto..." accelerator:"C-g" - command:(fun () -> goto_line current_tw); - edit_menu#add_command "Search..." accelerator:"C-s" - command:(fun () -> Jg_text.search_string current_tw); - edit_menu#add_command "To shell" accelerator:"M-x" - command:(fun () -> send_phrase (List.hd windows)); + edit_menu#add_command "Goto..." ~accelerator:"C-g" + ~command:(fun () -> goto_line current_tw); + edit_menu#add_command "Search..." ~accelerator:"C-s" + ~command:(fun () -> Jg_text.search_string current_tw); + edit_menu#add_command "To shell" ~accelerator:"M-x" + ~command:(fun () -> send_phrase (List.hd windows)); edit_menu#add_command "Select shell..." - command:(fun () -> select_shell (List.hd windows)); + ~command:(fun () -> select_shell (List.hd windows)); (* Compiler menu *) compiler_menu#add_command "Preferences..." - command:compiler_preferences; - compiler_menu#add_command "Lex" accelerator:"M-l" - command:self#lex; - compiler_menu#add_command "Typecheck" accelerator:"M-t" - command:self#typecheck; + ~command:compiler_preferences; + compiler_menu#add_command "Lex" ~accelerator:"M-l" + ~command:self#lex; + compiler_menu#add_command "Typecheck" ~accelerator:"M-t" + ~command:self#typecheck; compiler_menu#add_command "Clear errors" - command:self#clear_errors; - compiler_menu#add_command "Signature..." command: + ~command:self#clear_errors; + compiler_menu#add_command "Signature..." ~command: begin fun () -> let txt = List.hd windows in if txt.signature <> [] then let basename = Filename.basename txt.name in @@ -571,47 +571,47 @@ class editor :top :menus = object (self) Env.add_module (Ident.create modname) (Types.Tmty_signature txt.signature) Env.initial - in Viewer.view_defined (Longident.Lident modname) :env + in Viewer.view_defined (Longident.Lident modname) ~env end; (* Modules *) module_menu#add_command "Path editor..." - command:(fun () -> Setpath.set dir:current_dir); + ~command:(fun () -> Setpath.set ~dir:current_dir); module_menu#add_command "Reset cache" - command:(fun () -> Setpath.exec_update_hooks (); Env.reset_cache ()); + ~command:(fun () -> Setpath.exec_update_hooks (); Env.reset_cache ()); module_menu#add_command "Search symbol..." - command:Viewer.search_symbol; + ~command:Viewer.search_symbol; module_menu#add_command "Close all" - command:Viewer.close_all_views; + ~command:Viewer.close_all_views; (* pack everything *) - pack (List.map f:(fun m -> coe m#button) + pack (List.map ~f:(fun m -> coe m#button) [file_menu; edit_menu; compiler_menu; module_menu; window_menu] @ [coe label]) - side:`Left ipadx:5 anchor:`W; - pack [menus] before:(List.hd windows).frame side:`Top fill:`X + ~side:`Left ~ipadx:5 ~anchor:`W; + pack [menus] ~before:(List.hd windows).frame ~side:`Top ~fill:`X end (* The main function starts here ! *) let already_open : editor option ref = ref None -let editor ?:file ?(:pos=0) () = +let editor ?file ?(pos=0) () = if match !already_open with None -> false | Some ed -> - try ed#reopen :file :pos; true + try ed#reopen ~file ~pos; true with Protocol.TkError _ -> already_open := None; false then () else let top = Jg_toplevel.titled "Editor" in - let menus = Frame.create top name:"menubar" in - let ed = new editor :top :menus in + let menus = Frame.create top ~name:"menubar" in + let ed = new editor ~top ~menus in already_open := Some ed; - if file <> None then ed#reopen :file :pos + if file <> None then ed#reopen ~file ~pos -let f ?:file ?:pos ?(:opendialog=false) () = +let f ?file ?pos ?(opendialog=false) () = if opendialog then - Fileselect.f title:"Open File" - action:(function [file] -> editor :file () | _ -> ()) - filter:("*.{ml,mli}") sync:true () - else editor ?:file ?:pos () + Fileselect.f ~title:"Open File" + ~action:(function [file] -> editor ~file () | _ -> ()) + ~filter:("*.{ml,mli}") ~sync:true () + else editor ?file ?pos () |