596 lines
21 KiB
OCaml
596 lines
21 KiB
OCaml
(* $Id$ *)
|
|
|
|
open Tk
|
|
open Parsetree
|
|
open Location
|
|
open Jg_tk
|
|
open Mytypes
|
|
|
|
let lex_on_load = ref true
|
|
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 =
|
|
let variable = Textvariable.create on:tl () in
|
|
if !ref then Textvariable.set variable to:"1";
|
|
Checkbutton.create tl :text :variable,
|
|
(fun () -> ref := Textvariable.get variable = "1")
|
|
in
|
|
let chkbuttons, setflags = List.split
|
|
(List.map fun:(fun (text, ref) -> mk_chkbutton :text :ref)
|
|
["No pervasives", Clflags.nopervasives;
|
|
"No warnings", Typecheck.nowarnings;
|
|
"Classic", Clflags.classic;
|
|
"Lex on load", lex_on_load;
|
|
"Type on load", type_on_load])
|
|
in
|
|
let buttons = Frame.create tl in
|
|
let ok = Button.create buttons text:"Ok" padx:(`Pix 20) command:
|
|
begin fun () ->
|
|
List.iter fun:(fun f -> f ()) setflags;
|
|
destroy tl
|
|
end
|
|
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
|
|
|
|
let rec exclude key:txt = function
|
|
[] -> []
|
|
| x :: l -> if txt.number = x.number then l else x :: exclude key:txt l
|
|
|
|
let goto_line tw =
|
|
let tl = Jg_toplevel.titled "Go to" in
|
|
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
|
|
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:
|
|
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", []);
|
|
destroy tl
|
|
end
|
|
and cancel = Jg_button.create_destroyer tl parent:buttons text:"Cancel" in
|
|
|
|
Focus.set il;
|
|
List.iter [il; ic] fun:
|
|
begin fun w ->
|
|
Jg_bind.enter_focus w;
|
|
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
|
|
|
|
let select_shell txt =
|
|
let shells = Shell.get_all () 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:"
|
|
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:
|
|
begin fun () ->
|
|
try
|
|
let name = Listbox.get box index:`Active in
|
|
txt.shell <- Some (name, List.assoc key:name shells);
|
|
destroy tl
|
|
with Not_found -> txt.shell <- None; destroy tl
|
|
end
|
|
in
|
|
Listbox.insert box index:`End texts:(List.map fun:fst shells);
|
|
Listbox.configure box height:(List.length shells);
|
|
bind box events:[[],`KeyPressDetail"Return"]
|
|
action:(`Setbreakable([], fun _ -> Button.invoke ok; break ()));
|
|
bind box events:[[`Double],`ButtonPressDetail 1]
|
|
action:(`Setbreakable([`MouseX;`MouseY], 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
|
|
|
|
open Parser
|
|
|
|
let send_phrase txt =
|
|
if txt.shell = None then begin
|
|
match Shell.get_all () with [] -> ()
|
|
| [sh] -> txt.shell <- Some sh
|
|
| l -> select_shell txt
|
|
end;
|
|
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
|
|
sh#send phrase;
|
|
try
|
|
ignore(Str.search_forward phrase pat:(Str.regexp ";;") pos:0);
|
|
sh#send "\n"
|
|
with Not_found ->
|
|
sh#send ";;\n"
|
|
with Not_found | Protocol.TkError _ ->
|
|
let text = Text.get txt.tw start:tstart end:tend in
|
|
let buffer = Lexing.from_string text in
|
|
let start = ref 0
|
|
and block_start = ref []
|
|
and pend = ref (-1)
|
|
and after = ref false in
|
|
while !pend = -1 do
|
|
let token = Lexer.token buffer in
|
|
let pos = Lexing.lexeme_start buffer in
|
|
if not !after &&
|
|
Text.compare txt.tw index:(tpos pos) op:`Gt
|
|
index:(`Mark"insert",[])
|
|
then begin
|
|
after := true;
|
|
if !block_start <> [] then begin
|
|
start := List.hd !block_start;
|
|
block_start := []
|
|
end
|
|
end;
|
|
let bol = (pos = 0) || text.[pos-1] = '\n' in
|
|
match token with
|
|
CLASS | EXTERNAL | EXCEPTION | FUNCTOR
|
|
| LET | MODULE | OPEN | TYPE | VAL | SHARP when bol ->
|
|
if !block_start = [] then
|
|
if !after then pend := pos else start := pos
|
|
else block_start := pos :: List.tl !block_start
|
|
| SEMISEMI ->
|
|
let pos' = Lexing.lexeme_end buffer in
|
|
if !block_start = [] then
|
|
if !after then pend := pos else start := pos'
|
|
else block_start := pos' :: List.tl !block_start
|
|
| BEGIN | OBJECT | STRUCT | SIG ->
|
|
block_start := Lexing.lexeme_end buffer :: !block_start
|
|
| END ->
|
|
if !block_start = [] then
|
|
if !after then pend := pos else ()
|
|
else block_start := List.tl !block_start
|
|
| EOF ->
|
|
pend := pos
|
|
| _ ->
|
|
()
|
|
done;
|
|
let phrase = String.sub text pos:!start len:(!pend - !start) in
|
|
sh#send phrase;
|
|
sh#send ";;\n"
|
|
|
|
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 text = Jg_text.get_all txt.tw in
|
|
let pos = Searchpos.lines_to_chars l in:text + c in
|
|
try if txt.structure <> [] then
|
|
try Searchpos.search_pos_structure txt.structure :pos
|
|
with Searchpos.Found_str (kind, env) ->
|
|
Searchpos.view_type kind :env
|
|
else
|
|
try Searchpos.search_pos_signature
|
|
txt.psignature :pos env:!Searchid.start_env;
|
|
()
|
|
with Searchpos.Found_sig (kind, lid, env) ->
|
|
Searchpos.view_decl lid :kind :env
|
|
with Not_found -> ()
|
|
|
|
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 text = Jg_text.get_all txt.tw in
|
|
let pos = Searchpos.lines_to_chars l in:text + c in
|
|
try if txt.structure <> [] then
|
|
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 x = x + Winfo.rootx txt.tw and y = y + Winfo.rooty txt.tw - 10 in
|
|
Menu.popup menu :x :y
|
|
else
|
|
try Searchpos.search_pos_signature
|
|
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 x = x + Winfo.rootx txt.tw and y = y + Winfo.rooty txt.tw - 10 in
|
|
Menu.popup menu :x :y
|
|
with Not_found -> ()
|
|
|
|
let string_width s =
|
|
let width = ref 0 in
|
|
for i = 0 to String.length s - 1 do
|
|
if s.[i] = '\t' then width := (!width / 8 + 1) * 8
|
|
else incr width
|
|
done;
|
|
!width
|
|
|
|
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,[]) in
|
|
Str.string_match pat:reg line pos:0;
|
|
if Str.match_end () < c then
|
|
Text.insert tw index:(ins,[]) text:"\t"
|
|
else let indent =
|
|
if l <= 1 then 2 else
|
|
let previous =
|
|
Text.get tw start:(ins,[`Line(-1);`Linestart])
|
|
end:(ins,[`Line(-1);`Lineend]) in
|
|
Str.string_match pat:reg previous pos:0;
|
|
let previous = Str.matched_string previous in
|
|
let width = string_width line
|
|
and 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 len: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
|
|
val label =
|
|
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 mutable window_counter = 0
|
|
|
|
method reset_window_menu =
|
|
Menu.delete window_menu#menu first:(`Num 0) last:`End;
|
|
List.iter
|
|
(Sort.list windows order:
|
|
(fun w1 w2 -> Filename.basename w1.name < Filename.basename w2.name))
|
|
fun:
|
|
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)
|
|
end
|
|
|
|
method set_edit txt =
|
|
if windows <> [] then
|
|
Pack.forget [(List.hd windows).frame];
|
|
windows <- txt :: exclude key:txt windows;
|
|
self#reset_window_menu;
|
|
current_tw <- txt.tw;
|
|
Checkbutton.configure label text:(Filename.basename txt.name)
|
|
variable:txt.modified;
|
|
Textvariable.set vwindow to:txt.number;
|
|
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;
|
|
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 ();
|
|
shell = None;
|
|
structure = []; signature = []; psignature = [] }
|
|
in
|
|
let control c = Char.chr (Char.code c - 96) in
|
|
bind tw events:[[`Alt], `KeyPress] action:(`Set ([], fun _ -> ()));
|
|
bind tw events:[[], `KeyPress]
|
|
action:(`Set ([`Char], fun ev ->
|
|
if ev.ev_Char <> "" &
|
|
(ev.ev_Char.[0] >= ' ' or
|
|
List.mem key:ev.ev_Char.[0]
|
|
(List.map fun:control ['d'; 'h'; 'i'; 'k'; 'o'; 't'; 'w'; 'y']))
|
|
then Textvariable.set txt.modified to:"modified"));
|
|
bind tw events:[[],`KeyPressDetail"Tab"]
|
|
action:(`Setbreakable ([], fun _ ->
|
|
indent_line tw;
|
|
Textvariable.set txt.modified to:"modified";
|
|
break ()));
|
|
bind tw events:[[`Control],`KeyPressDetail"k"]
|
|
action:(`Set ([], fun _ ->
|
|
let text =
|
|
Text.get tw start:(`Mark"insert",[]) end:(`Mark"insert",[`Lineend])
|
|
in 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 ()
|
|
end));
|
|
bind tw events:[[], `KeyRelease]
|
|
action:(`Set ([`Char], fun ev ->
|
|
if ev.ev_Char <> "" then
|
|
Lexical.tag tw start:(`Mark"insert", [`Linestart])
|
|
end:(`Mark"insert", [`Lineend])));
|
|
bind tw events:[[], `Motion] action:(`Set ([], fun _ -> Focus.set tw));
|
|
bind tw events:[[], `ButtonPressDetail 2]
|
|
action:(`Set ([], fun _ ->
|
|
Textvariable.set txt.modified to:"modified";
|
|
Lexical.tag txt.tw start:(`Mark"insert", [`Linestart])
|
|
end:(`Mark"insert", [`Lineend])));
|
|
bind tw events:[[`Double], `ButtonPressDetail 1]
|
|
action:(`Set ([`MouseX;`MouseY], fun ev ->
|
|
search_pos_window txt x:ev.ev_MouseX y:ev.ev_MouseY));
|
|
bind tw events:[[], `ButtonPressDetail 3]
|
|
action:(`Set ([`MouseX;`MouseY], 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;
|
|
List.iter error_messages
|
|
fun:(fun tl -> try destroy tl with Protocol.TkError _ -> ());
|
|
error_messages <- []
|
|
|
|
method typecheck () =
|
|
self#clear_errors ();
|
|
error_messages <- Typecheck.f (List.hd windows)
|
|
|
|
method lex () =
|
|
Text.tag_remove current_tw tag:"error" start:tstart end:tend;
|
|
Lexical.tag current_tw
|
|
|
|
method save_text ?name:l txt =
|
|
let l = match l with None -> [txt.name] | Some l -> l in
|
|
if l = [] then () else
|
|
let name = List.hd l in
|
|
if txt.name <> name then current_dir <- Filename.dirname name;
|
|
try
|
|
if Sys.file_exists name then
|
|
if txt.name = name then
|
|
Sys.rename old:name new:(name ^ "~")
|
|
else begin match
|
|
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
|
|
output_string text to:file;
|
|
close_out file;
|
|
Checkbutton.configure label text:(Filename.basename name);
|
|
Checkbutton.deselect label;
|
|
txt.name <- name
|
|
with
|
|
Sys_error _ | Exit -> ()
|
|
|
|
method load_text l =
|
|
if l = [] then () else
|
|
let name = List.hd l in
|
|
try
|
|
let index =
|
|
try
|
|
self#set_edit (List.find windows pred:(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"
|
|
("`" ^ 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", []), [])
|
|
with Not_found -> self#new_window name; tstart
|
|
in
|
|
current_dir <- Filename.dirname name;
|
|
let file = open_in name
|
|
and tw = current_tw
|
|
and len = ref 0
|
|
and buf = String.create len:4096 in
|
|
Text.delete tw start:tstart end:tend;
|
|
while
|
|
len := input file :buf pos:0 len:4096;
|
|
!len > 0
|
|
do
|
|
Jg_text.output tw :buf pos:0 len:!len
|
|
done;
|
|
close_in file;
|
|
Text.mark_set tw mark:"insert" :index;
|
|
Text.see tw :index;
|
|
if Filename.check_suffix name suff:".ml" or
|
|
Filename.check_suffix name suff:".mli"
|
|
then begin
|
|
if !lex_on_load then self#lex ();
|
|
if !type_on_load then self#typecheck ()
|
|
end
|
|
with
|
|
Sys_error _ | Exit -> ()
|
|
|
|
method close_window txt =
|
|
try
|
|
if Textvariable.get txt.modified = "modified" then
|
|
begin match Jg_message.ask master:top title:"Close"
|
|
("`" ^ Filename.basename txt.name ^ "' modified. Save it?")
|
|
with `yes -> self#save_text txt
|
|
| `no -> ()
|
|
| `cancel -> raise Exit
|
|
end;
|
|
windows <- exclude key:txt windows;
|
|
if windows = [] then
|
|
self#new_window (current_dir ^ "/untitled")
|
|
else self#set_edit (List.hd windows);
|
|
destroy txt.frame
|
|
with Exit -> ()
|
|
|
|
method open_file () =
|
|
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)
|
|
|
|
method close_file () = self#close_window (List.hd windows)
|
|
|
|
method quit () =
|
|
try List.iter windows
|
|
fun:(fun txt ->
|
|
if Textvariable.get txt.modified = "modified" then
|
|
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);
|
|
bind top events:[[],`Destroy] action:`Remove;
|
|
destroy top; break ()
|
|
with Exit -> break ()
|
|
|
|
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.yview_index current_tw
|
|
index:(`Linechar(1,0),[`Char pos; `Line (-2)])
|
|
|
|
initializer
|
|
(* Create a first window *)
|
|
self#new_window (current_dir ^ "/untitled");
|
|
|
|
(* Bindings for the main window *)
|
|
List.iter
|
|
[ [`Control], "s", (fun () -> Jg_text.search_string current_tw);
|
|
[`Control], "g", (fun () -> goto_line current_tw);
|
|
[`Alt], "x", (fun () -> send_phrase (List.hd windows));
|
|
[`Alt], "l", self#lex;
|
|
[`Alt], "t", self#typecheck ]
|
|
fun:begin fun (modi,key,act) ->
|
|
bind top events:[modi, `KeyPressDetail key]
|
|
action:(`Setbreakable ([], fun _ -> act (); break ()))
|
|
end;
|
|
|
|
bind top events:[[],`Destroy]
|
|
action:(`Setbreakable
|
|
([`Widget], fun ev ->
|
|
if Widget.name ev.ev_Widget = Widget.name top
|
|
then self#quit ()));
|
|
|
|
(* File menu *)
|
|
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;
|
|
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 ()
|
|
end;
|
|
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:
|
|
begin fun () ->
|
|
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 "Select shell..."
|
|
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;
|
|
compiler_menu#add_command "Clear errors"
|
|
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
|
|
let modname = String.capitalize
|
|
(try Filename.chop_extension basename with _ -> basename) in
|
|
let env =
|
|
Env.add_module (Ident.create modname)
|
|
(Types.Tmty_signature txt.signature)
|
|
Env.initial
|
|
in Viewer.view_defined (Longident.Lident modname) :env
|
|
end;
|
|
|
|
(* Modules *)
|
|
module_menu#add_command "Path editor..."
|
|
command:(fun () -> Setpath.f dir:current_dir; ());
|
|
module_menu#add_command "Reset cache"
|
|
command:(fun () -> Setpath.exec_update_hooks (); Env.reset_cache ());
|
|
module_menu#add_command "Search symbol..."
|
|
command:Viewer.search_symbol;
|
|
module_menu#add_command "Close all"
|
|
command:Viewer.close_all_views;
|
|
|
|
(* pack everything *)
|
|
pack (List.map fun:(fun m -> coe m#button)
|
|
[file_menu; edit_menu; compiler_menu; module_menu; window_menu]
|
|
@ [coe label])
|
|
side:`Left ipadx:(`Pix 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) () =
|
|
|
|
if match !already_open with None -> false
|
|
| Some ed ->
|
|
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
|
|
already_open := Some ed;
|
|
if file <> None then ed#reopen :file :pos
|
|
|
|
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 ()
|