|
Packit |
bd2e5d |
(*************************************************************************)
|
|
Packit |
bd2e5d |
(* *)
|
|
Packit |
bd2e5d |
(* OCaml LablTk library *)
|
|
Packit |
bd2e5d |
(* *)
|
|
Packit |
bd2e5d |
(* Jacques Garrigue, Kyoto University RIMS *)
|
|
Packit |
bd2e5d |
(* *)
|
|
Packit |
bd2e5d |
(* Copyright 1999 Institut National de Recherche en Informatique et *)
|
|
Packit |
bd2e5d |
(* en Automatique and Kyoto University. All rights reserved. *)
|
|
Packit |
bd2e5d |
(* This file is distributed under the terms of the GNU Library *)
|
|
Packit |
bd2e5d |
(* General Public License, with the special exception on linking *)
|
|
Packit |
bd2e5d |
(* described in file ../../../LICENSE. *)
|
|
Packit |
bd2e5d |
(* *)
|
|
Packit |
bd2e5d |
(*************************************************************************)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* $Id$ *)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
open StdLabels
|
|
Packit |
bd2e5d |
open Tk
|
|
Packit |
bd2e5d |
open Parsetree
|
|
Packit |
bd2e5d |
open Location
|
|
Packit |
bd2e5d |
open Jg_tk
|
|
Packit |
bd2e5d |
open Mytypes
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let lex_on_load = ref true
|
|
Packit |
bd2e5d |
and type_on_load = ref false
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let compiler_preferences master =
|
|
Packit |
bd2e5d |
let tl = Jg_toplevel.titled "Compiler" in
|
|
Packit |
bd2e5d |
Wm.transient_set tl ~master;
|
|
Packit |
bd2e5d |
let mk_chkbutton ~text ~ref ~invert =
|
|
Packit |
bd2e5d |
let variable = Textvariable.create ~on:tl () in
|
|
Packit |
bd2e5d |
if (if invert then not !ref else !ref) then
|
|
Packit |
bd2e5d |
Textvariable.set variable "1";
|
|
Packit |
bd2e5d |
Checkbutton.create tl ~text ~variable,
|
|
Packit |
bd2e5d |
(fun () ->
|
|
Packit |
bd2e5d |
ref := Textvariable.get variable = (if invert then "0" else "1"))
|
|
Packit |
bd2e5d |
in
|
|
Packit |
bd2e5d |
let use_pp = ref (!Clflags.preprocessor <> None) in
|
|
Packit |
bd2e5d |
let chkbuttons, setflags = List.split
|
|
Packit |
bd2e5d |
(List.map
|
|
Packit |
bd2e5d |
~f:(fun (text, ref, invert) -> mk_chkbutton ~text ~ref ~invert)
|
|
Packit |
bd2e5d |
[ "No pervasives", Clflags.nopervasives, false;
|
|
Packit |
bd2e5d |
"No warnings", Typecheck.nowarnings, false;
|
|
Packit |
bd2e5d |
"No labels", Clflags.classic, false;
|
|
Packit |
bd2e5d |
"Recursive types", Clflags.recursive_types, false;
|
|
Packit |
bd2e5d |
"Lex on load", lex_on_load, false;
|
|
Packit |
bd2e5d |
"Type on load", type_on_load, false;
|
|
Packit |
bd2e5d |
"Preprocessor", use_pp, false ])
|
|
Packit |
bd2e5d |
in
|
|
Packit |
bd2e5d |
let pp_command = Entry.create tl (* ~state:(if !use_pp then `Normal else`Disabled) *) in
|
|
Packit |
bd2e5d |
begin match !Clflags.preprocessor with None -> ()
|
|
Packit |
bd2e5d |
| Some pp -> Entry.insert pp_command ~index:(`Num 0) ~text:pp
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
let buttons = Frame.create tl in
|
|
Packit |
bd2e5d |
let ok = Button.create buttons ~text:"Ok" ~padx:20 ~command:
|
|
Packit |
bd2e5d |
begin fun () ->
|
|
Packit |
bd2e5d |
List.iter ~f:(fun f -> f ()) setflags;
|
|
Packit |
bd2e5d |
Clflags.preprocessor :=
|
|
Packit |
bd2e5d |
if !use_pp then Some (Entry.get pp_command) else None;
|
|
Packit |
bd2e5d |
destroy tl
|
|
Packit |
bd2e5d |
end
|
|
Packit |
bd2e5d |
and cancel = Jg_button.create_destroyer tl ~parent:buttons ~text:"Cancel"
|
|
Packit |
bd2e5d |
in
|
|
Packit |
bd2e5d |
pack chkbuttons ~side:`Top ~anchor:`W;
|
|
Packit |
bd2e5d |
pack [pp_command] ~side:`Top ~anchor:`E;
|
|
Packit |
bd2e5d |
pack [ok;cancel] ~side:`Left ~fill:`X ~expand:true;
|
|
Packit |
bd2e5d |
pack [buttons] ~side:`Bottom ~fill:`X
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let rec exclude txt = function
|
|
Packit |
bd2e5d |
[] -> []
|
|
Packit |
bd2e5d |
| x :: l -> if txt.number = x.number then l else x :: exclude txt l
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let goto_line tw =
|
|
Packit |
bd2e5d |
let tl = Jg_toplevel.titled "Go to" in
|
|
Packit |
bd2e5d |
Wm.transient_set tl ~master:(Winfo.toplevel tw);
|
|
Packit |
bd2e5d |
Jg_bind.escape_destroy tl;
|
|
Packit |
bd2e5d |
let ef = Frame.create tl in
|
|
Packit |
bd2e5d |
let fl = Frame.create ef
|
|
Packit |
bd2e5d |
and fi = Frame.create ef in
|
|
Packit |
bd2e5d |
let ll = Label.create fl ~text:"Line ~number:"
|
|
Packit |
bd2e5d |
and il = Entry.create fi ~width:10
|
|
Packit |
bd2e5d |
and lc = Label.create fl ~text:"Col ~number:"
|
|
Packit |
bd2e5d |
and ic = Entry.create fi ~width:10
|
|
Packit |
bd2e5d |
and get_int ew =
|
|
Packit |
bd2e5d |
try int_of_string (Entry.get ew)
|
|
Packit |
bd2e5d |
with Failure _ (*"int_of_string"*) -> 0
|
|
Packit |
bd2e5d |
in
|
|
Packit |
bd2e5d |
let buttons = Frame.create tl in
|
|
Packit |
bd2e5d |
let ok = Button.create buttons ~text:"Ok" ~command:
|
|
Packit |
bd2e5d |
begin fun () ->
|
|
Packit |
bd2e5d |
let l = get_int il
|
|
Packit |
bd2e5d |
and c = get_int ic in
|
|
Packit |
bd2e5d |
Text.mark_set tw ~mark:"insert" ~index:(`Linechar (l,0), [`Char c]);
|
|
Packit |
bd2e5d |
Text.see tw ~index:(`Mark "insert", []);
|
|
Packit |
bd2e5d |
destroy tl
|
|
Packit |
bd2e5d |
end
|
|
Packit |
bd2e5d |
and cancel = Jg_button.create_destroyer tl ~parent:buttons ~text:"Cancel" in
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
Focus.set il;
|
|
Packit |
bd2e5d |
List.iter [il; ic] ~f:
|
|
Packit |
bd2e5d |
begin fun w ->
|
|
Packit |
bd2e5d |
Jg_bind.enter_focus w;
|
|
Packit |
bd2e5d |
Jg_bind.return_invoke w ~button:ok
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
pack [ll; lc] ~side:`Top ~anchor:`W;
|
|
Packit |
bd2e5d |
pack [il; ic] ~side:`Top ~fill:`X ~expand:true;
|
|
Packit |
bd2e5d |
pack [fl; fi] ~side:`Left ~fill:`X ~expand:true;
|
|
Packit |
bd2e5d |
pack [ok; cancel] ~side:`Left ~fill:`X ~expand:true;
|
|
Packit |
bd2e5d |
pack [ef; buttons] ~side:`Top ~fill:`X ~expand:true
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let select_shell txt =
|
|
Packit |
bd2e5d |
let shells = Shell.get_all () in
|
|
Packit |
bd2e5d |
let shells = List.sort shells ~cmp:compare in
|
|
Packit |
bd2e5d |
let tl = Jg_toplevel.titled "Select Shell" in
|
|
Packit |
bd2e5d |
Jg_bind.escape_destroy tl;
|
|
Packit |
bd2e5d |
Wm.transient_set tl ~master:(Winfo.toplevel txt.tw);
|
|
Packit |
bd2e5d |
let label = Label.create tl ~text:"Send to:"
|
|
Packit |
bd2e5d |
and box = Listbox.create tl
|
|
Packit |
bd2e5d |
and frame = Frame.create tl in
|
|
Packit |
bd2e5d |
Jg_bind.enter_focus box;
|
|
Packit |
bd2e5d |
let cancel = Jg_button.create_destroyer tl ~parent:frame ~text:"Cancel"
|
|
Packit |
bd2e5d |
and ok = Button.create frame ~text:"Ok" ~command:
|
|
Packit |
bd2e5d |
begin fun () ->
|
|
Packit |
bd2e5d |
try
|
|
Packit |
bd2e5d |
let name = Listbox.get box ~index:`Active in
|
|
Packit |
bd2e5d |
txt.shell <- Some (name, List.assoc name shells);
|
|
Packit |
bd2e5d |
destroy tl
|
|
Packit |
bd2e5d |
with Not_found -> txt.shell <- None; destroy tl
|
|
Packit |
bd2e5d |
end
|
|
Packit |
bd2e5d |
in
|
|
Packit |
bd2e5d |
Listbox.insert box ~index:`End ~texts:(List.map ~f:fst shells);
|
|
Packit |
bd2e5d |
Listbox.configure box ~height:(List.length shells);
|
|
Packit |
bd2e5d |
bind box ~events:[`KeyPressDetail"Return"] ~breakable:true
|
|
Packit |
bd2e5d |
~action:(fun _ -> Button.invoke ok; break ());
|
|
Packit |
bd2e5d |
bind box ~events:[`Modified([`Double],`ButtonPressDetail 1)] ~breakable:true
|
|
Packit |
bd2e5d |
~fields:[`MouseX;`MouseY]
|
|
Packit |
bd2e5d |
~action:(fun ev ->
|
|
Packit |
bd2e5d |
Listbox.activate box ~index:(`Atxy (ev.ev_MouseX, ev.ev_MouseY));
|
|
Packit |
bd2e5d |
Button.invoke ok; break ());
|
|
Packit |
bd2e5d |
pack [label] ~side:`Top ~anchor:`W;
|
|
Packit |
bd2e5d |
pack [box] ~side:`Top ~fill:`Both;
|
|
Packit |
bd2e5d |
pack [frame] ~side:`Bottom ~fill:`X ~expand:true;
|
|
Packit |
bd2e5d |
pack [ok;cancel] ~side:`Left ~fill:`X ~expand:true
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
open Parser
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let send_phrase txt =
|
|
Packit |
bd2e5d |
if txt.shell = None then begin
|
|
Packit |
bd2e5d |
match Shell.get_all () with [] -> ()
|
|
Packit |
bd2e5d |
| [sh] -> txt.shell <- Some sh
|
|
Packit |
bd2e5d |
| l -> select_shell txt
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
match txt.shell with None -> ()
|
|
Packit |
bd2e5d |
| Some (_,sh) ->
|
|
Packit |
bd2e5d |
try
|
|
Packit |
bd2e5d |
let i1,i2 = Text.tag_nextrange txt.tw ~tag:"sel" ~start:tstart in
|
|
Packit |
bd2e5d |
let phrase = Text.get txt.tw ~start:(i1,[]) ~stop:(i2,[]) in
|
|
Packit |
bd2e5d |
sh#send phrase;
|
|
Packit |
bd2e5d |
if Str.string_match (Str.regexp ";;") phrase 0
|
|
Packit |
bd2e5d |
then sh#send "\n" else sh#send ";;\n"
|
|
Packit |
bd2e5d |
with Not_found | Protocol.TkError _ ->
|
|
Packit |
bd2e5d |
let text = Text.get txt.tw ~start:tstart ~stop:tend in
|
|
Packit |
bd2e5d |
let buffer = Lexing.from_string text in
|
|
Packit |
bd2e5d |
let start = ref 0
|
|
Packit |
bd2e5d |
and block_start = ref []
|
|
Packit |
bd2e5d |
and pend = ref (-1)
|
|
Packit |
bd2e5d |
and after = ref false in
|
|
Packit |
bd2e5d |
while !pend = -1 do
|
|
Packit |
bd2e5d |
let token = Lexer.token buffer in
|
|
Packit |
bd2e5d |
let pos =
|
|
Packit |
bd2e5d |
if token = SEMISEMI then Lexing.lexeme_end buffer
|
|
Packit |
bd2e5d |
else Lexing.lexeme_start buffer
|
|
Packit |
bd2e5d |
in
|
|
Packit |
bd2e5d |
let bol = (pos = 0) || text.[pos-1] = '\n' in
|
|
Packit |
bd2e5d |
if not !after &&
|
|
Packit |
bd2e5d |
Text.compare txt.tw ~index:(tpos pos) ~op:(if bol then `Gt else `Ge)
|
|
Packit |
bd2e5d |
~index:(`Mark"insert",[])
|
|
Packit |
bd2e5d |
then begin
|
|
Packit |
bd2e5d |
after := true;
|
|
Packit |
bd2e5d |
let anon, real =
|
|
Packit |
bd2e5d |
List.partition !block_start ~f:(fun x -> x = -1) in
|
|
Packit |
bd2e5d |
block_start := anon;
|
|
Packit |
bd2e5d |
if real <> [] then start := List.hd real;
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
match token with
|
|
Packit |
bd2e5d |
CLASS | EXTERNAL | EXCEPTION | FUNCTOR
|
|
Packit |
bd2e5d |
| LET | MODULE | OPEN | TYPE | VAL | HASH when bol ->
|
|
Packit |
bd2e5d |
if !block_start = [] then
|
|
Packit |
bd2e5d |
if !after then pend := pos else start := pos
|
|
Packit |
bd2e5d |
else block_start := pos :: List.tl !block_start
|
|
Packit |
bd2e5d |
| SEMISEMI ->
|
|
Packit |
bd2e5d |
if !block_start = [] then
|
|
Packit |
bd2e5d |
if !after then pend := Lexing.lexeme_start buffer
|
|
Packit |
bd2e5d |
else start := pos
|
|
Packit |
bd2e5d |
else block_start := pos :: List.tl !block_start
|
|
Packit |
bd2e5d |
| BEGIN | OBJECT ->
|
|
Packit |
bd2e5d |
block_start := -1 :: !block_start
|
|
Packit |
bd2e5d |
| STRUCT | SIG ->
|
|
Packit |
bd2e5d |
block_start := Lexing.lexeme_end buffer :: !block_start
|
|
Packit |
bd2e5d |
| END ->
|
|
Packit |
bd2e5d |
if !block_start = [] then
|
|
Packit |
bd2e5d |
if !after then pend := pos else ()
|
|
Packit |
bd2e5d |
else block_start := List.tl !block_start
|
|
Packit |
bd2e5d |
| EOF ->
|
|
Packit |
bd2e5d |
pend := pos
|
|
Packit |
bd2e5d |
| _ ->
|
|
Packit |
bd2e5d |
()
|
|
Packit |
bd2e5d |
done;
|
|
Packit |
bd2e5d |
let phrase = String.sub text ~pos:!start ~len:(!pend - !start) in
|
|
Packit |
bd2e5d |
sh#send phrase;
|
|
Packit |
bd2e5d |
sh#send ";;\n"
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let search_pos_window txt ~x ~y =
|
|
Packit |
bd2e5d |
if txt.type_info = [] && txt.psignature = [] then () else
|
|
Packit |
bd2e5d |
let `Linechar (l, c) = Text.index txt.tw ~index:(`Atxy(x,y), []) in
|
|
Packit |
bd2e5d |
let text = Jg_text.get_all txt.tw in
|
|
Packit |
bd2e5d |
let pos = Searchpos.lines_to_chars l ~text + c in
|
|
Packit |
bd2e5d |
try if txt.type_info <> [] then begin match
|
|
Packit |
bd2e5d |
Searchpos.search_pos_info txt.type_info ~pos
|
|
Packit |
bd2e5d |
with [] -> ()
|
|
Packit |
bd2e5d |
| (kind, env, loc) :: _ -> Searchpos.view_type kind ~env
|
|
Packit |
bd2e5d |
end else begin match
|
|
Packit |
bd2e5d |
Searchpos.search_pos_signature txt.psignature ~pos ~env:!Searchid.start_env
|
|
Packit |
bd2e5d |
with [] -> ()
|
|
Packit |
bd2e5d |
| ((kind, lid), env, loc) :: _ ->
|
|
Packit |
bd2e5d |
Searchpos.view_decl lid ~kind ~env
|
|
Packit |
bd2e5d |
end
|
|
Packit |
bd2e5d |
with Not_found -> ()
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let search_pos_menu txt ~x ~y =
|
|
Packit |
bd2e5d |
if txt.type_info = [] && txt.psignature = [] then () else
|
|
Packit |
bd2e5d |
let `Linechar (l, c) = Text.index txt.tw ~index:(`Atxy(x,y), []) in
|
|
Packit |
bd2e5d |
let text = Jg_text.get_all txt.tw in
|
|
Packit |
bd2e5d |
let pos = Searchpos.lines_to_chars l ~text + c in
|
|
Packit |
bd2e5d |
try if txt.type_info <> [] then begin match
|
|
Packit |
bd2e5d |
Searchpos.search_pos_info txt.type_info ~pos
|
|
Packit |
bd2e5d |
with [] -> ()
|
|
Packit |
bd2e5d |
| (kind, env, loc) :: _ ->
|
|
Packit |
bd2e5d |
let menu = Searchpos.view_type_menu kind ~env ~parent:txt.tw in
|
|
Packit |
bd2e5d |
let x = x + Winfo.rootx txt.tw and y = y + Winfo.rooty txt.tw - 10 in
|
|
Packit |
bd2e5d |
Menu.popup menu ~x ~y
|
|
Packit |
bd2e5d |
end else begin match
|
|
Packit |
bd2e5d |
Searchpos.search_pos_signature txt.psignature ~pos ~env:!Searchid.start_env
|
|
Packit |
bd2e5d |
with [] -> ()
|
|
Packit |
bd2e5d |
| ((kind, lid), env, loc) :: _ ->
|
|
Packit |
bd2e5d |
let menu = Searchpos.view_decl_menu lid ~kind ~env ~parent:txt.tw in
|
|
Packit |
bd2e5d |
let x = x + Winfo.rootx txt.tw and y = y + Winfo.rooty txt.tw - 10 in
|
|
Packit |
bd2e5d |
Menu.popup menu ~x ~y
|
|
Packit |
bd2e5d |
end
|
|
Packit |
bd2e5d |
with Not_found -> ()
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let string_width s =
|
|
Packit |
bd2e5d |
let width = ref 0 in
|
|
Packit |
bd2e5d |
for i = 0 to String.length s - 1 do
|
|
Packit |
bd2e5d |
if s.[i] = '\t' then width := (!width / 8 + 1) * 8
|
|
Packit |
bd2e5d |
else incr width
|
|
Packit |
bd2e5d |
done;
|
|
Packit |
bd2e5d |
!width
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let indent_line =
|
|
Packit |
bd2e5d |
let ins = `Mark"insert" and reg = Str.regexp "[ \t]*" in
|
|
Packit |
bd2e5d |
fun tw ->
|
|
Packit |
bd2e5d |
let `Linechar(l,c) = Text.index tw ~index:(ins,[])
|
|
Packit |
bd2e5d |
and line = Text.get tw ~start:(ins,[`Linestart]) ~stop:(ins,[`Lineend]) in
|
|
Packit |
bd2e5d |
ignore (Str.string_match reg line 0);
|
|
Packit |
bd2e5d |
let len = Str.match_end () in
|
|
Packit |
bd2e5d |
if len < c then Text.insert tw ~index:(ins,[]) ~text:"\t" else
|
|
Packit |
bd2e5d |
let width = string_width (Str.matched_string line) in
|
|
Packit |
bd2e5d |
Text.mark_set tw ~mark:"insert" ~index:(ins,[`Linestart;`Char len]);
|
|
Packit |
bd2e5d |
let indent =
|
|
Packit |
bd2e5d |
if l <= 1 then 2 else
|
|
Packit |
bd2e5d |
let previous =
|
|
Packit |
bd2e5d |
Text.get tw ~start:(ins,[`Line(-1);`Linestart])
|
|
Packit |
bd2e5d |
~stop:(ins,[`Line(-1);`Lineend]) in
|
|
Packit |
bd2e5d |
ignore (Str.string_match reg previous 0);
|
|
Packit |
bd2e5d |
let previous = Str.matched_string previous in
|
|
Packit |
bd2e5d |
let width_previous = string_width previous in
|
|
Packit |
bd2e5d |
if width_previous <= width then 2 else width_previous - width
|
|
Packit |
bd2e5d |
in
|
|
Packit |
bd2e5d |
Text.insert tw ~index:(ins,[]) ~text:(String.make indent ' ')
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* The editor class *)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
class editor ~top ~menus = object (self)
|
|
Packit |
bd2e5d |
val file_menu = new Jg_menu.c "File" ~parent:menus
|
|
Packit |
bd2e5d |
val edit_menu = new Jg_menu.c "Edit" ~parent:menus
|
|
Packit |
bd2e5d |
val compiler_menu = new Jg_menu.c "Compiler" ~parent:menus
|
|
Packit |
bd2e5d |
val module_menu = new Jg_menu.c "Modules" ~parent:menus
|
|
Packit |
bd2e5d |
val window_menu = new Jg_menu.c "Windows" ~parent:menus
|
|
Packit |
bd2e5d |
initializer
|
|
Packit |
bd2e5d |
Menu.add_checkbutton menus ~state:`Disabled
|
|
Packit |
bd2e5d |
~onvalue:"modified" ~offvalue:"unchanged"
|
|
Packit |
bd2e5d |
val mutable current_dir = Unix.getcwd ()
|
|
Packit |
bd2e5d |
val mutable error_messages = []
|
|
Packit |
bd2e5d |
val mutable windows = []
|
|
Packit |
bd2e5d |
val mutable current_tw = Text.create top
|
|
Packit |
bd2e5d |
val vwindow = Textvariable.create ~on:top ()
|
|
Packit |
bd2e5d |
val mutable window_counter = 0
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method has_window name =
|
|
Packit |
bd2e5d |
List.exists windows ~f:(fun x -> x.name = name)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method reset_window_menu =
|
|
Packit |
bd2e5d |
Menu.delete window_menu#menu ~first:(`Num 0) ~last:`End;
|
|
Packit |
bd2e5d |
List.iter
|
|
Packit |
bd2e5d |
(List.sort windows ~cmp:
|
|
Packit |
bd2e5d |
(fun w1 w2 ->
|
|
Packit |
bd2e5d |
compare (Filename.basename w1.name) (Filename.basename w2.name)))
|
|
Packit |
bd2e5d |
~f:
|
|
Packit |
bd2e5d |
begin fun txt ->
|
|
Packit |
bd2e5d |
Menu.add_radiobutton window_menu#menu
|
|
Packit |
bd2e5d |
~label:(Filename.basename txt.name)
|
|
Packit |
bd2e5d |
~variable:vwindow ~value:txt.number
|
|
Packit |
bd2e5d |
~command:(fun () -> self#set_edit txt)
|
|
Packit |
bd2e5d |
end
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method set_file_name txt =
|
|
Packit |
bd2e5d |
Menu.configure_checkbutton menus `Last
|
|
Packit |
bd2e5d |
~label:(Filename.basename txt.name)
|
|
Packit |
bd2e5d |
~variable:txt.modified
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method set_edit txt =
|
|
Packit |
bd2e5d |
if windows <> [] then
|
|
Packit |
bd2e5d |
Pack.forget [(List.hd windows).frame];
|
|
Packit |
bd2e5d |
windows <- txt :: exclude txt windows;
|
|
Packit |
bd2e5d |
self#reset_window_menu;
|
|
Packit |
bd2e5d |
current_tw <- txt.tw;
|
|
Packit |
bd2e5d |
self#set_file_name txt;
|
|
Packit |
bd2e5d |
Textvariable.set vwindow txt.number;
|
|
Packit |
bd2e5d |
Text.yview txt.tw ~scroll:(`Page 0);
|
|
Packit |
bd2e5d |
pack [txt.frame] ~fill:`Both ~expand:true ~side:`Bottom
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method new_window name =
|
|
Packit |
bd2e5d |
let tl, tw, sb = Jg_text.create_with_scrollbar top in
|
|
Packit |
bd2e5d |
Text.configure tw ~background:`White;
|
|
Packit |
bd2e5d |
Jg_bind.enter_focus tw;
|
|
Packit |
bd2e5d |
window_counter <- window_counter + 1;
|
|
Packit |
bd2e5d |
let txt =
|
|
Packit |
bd2e5d |
{ name = name; tw = tw; frame = tl;
|
|
Packit |
bd2e5d |
number = string_of_int window_counter;
|
|
Packit |
bd2e5d |
modified = Textvariable.create ~on:tw ();
|
|
Packit |
bd2e5d |
shell = None;
|
|
Packit |
bd2e5d |
structure = []; type_info = []; signature = []; psignature = [] }
|
|
Packit |
bd2e5d |
in
|
|
Packit |
bd2e5d |
let control c = Char.chr (Char.code c - 96) in
|
|
Packit |
bd2e5d |
bind tw ~events:[`Modified([`Alt], `KeyPress)] ~action:ignore;
|
|
Packit |
bd2e5d |
bind tw ~events:[`KeyPress] ~fields:[`Char]
|
|
Packit |
bd2e5d |
~action:(fun ev ->
|
|
Packit |
bd2e5d |
if ev.ev_Char <> "" &&
|
|
Packit |
bd2e5d |
(ev.ev_Char.[0] >= ' ' ||
|
|
Packit |
bd2e5d |
List.mem ev.ev_Char.[0]
|
|
Packit |
bd2e5d |
(List.map ~f:control ['d'; 'h'; 'i'; 'k'; 'o'; 't'; 'w'; 'y']))
|
|
Packit |
bd2e5d |
then Textvariable.set txt.modified "modified");
|
|
Packit |
bd2e5d |
bind tw ~events:[`KeyPressDetail"Tab"] ~breakable:true
|
|
Packit |
bd2e5d |
~action:(fun _ ->
|
|
Packit |
bd2e5d |
indent_line tw;
|
|
Packit |
bd2e5d |
Textvariable.set txt.modified "modified";
|
|
Packit |
bd2e5d |
break ());
|
|
Packit |
bd2e5d |
bind tw ~events:[`Modified([`Control],`KeyPressDetail"k")]
|
|
Packit |
bd2e5d |
~action:(fun _ ->
|
|
Packit |
bd2e5d |
let text =
|
|
Packit |
bd2e5d |
Text.get tw ~start:(`Mark"insert",[]) ~stop:(`Mark"insert",[`Lineend])
|
|
Packit |
bd2e5d |
in ignore (Str.string_match (Str.regexp "[ \t]*") text 0);
|
|
Packit |
bd2e5d |
if Str.match_end () <> String.length text then begin
|
|
Packit |
bd2e5d |
Clipboard.clear ();
|
|
Packit |
bd2e5d |
Clipboard.append ~data:text ()
|
|
Packit |
bd2e5d |
end);
|
|
Packit |
bd2e5d |
bind tw ~events:[`KeyRelease] ~fields:[`Char]
|
|
Packit |
bd2e5d |
~action:(fun ev ->
|
|
Packit |
bd2e5d |
if ev.ev_Char <> "" then
|
|
Packit |
bd2e5d |
Lexical.tag tw ~start:(`Mark"insert", [`Linestart])
|
|
Packit |
bd2e5d |
~stop:(`Mark"insert", [`Lineend]));
|
|
Packit |
bd2e5d |
bind tw ~events:[`Motion] ~action:(fun _ -> Focus.set tw);
|
|
Packit |
bd2e5d |
bind tw ~events:[`ButtonPressDetail 2]
|
|
Packit |
bd2e5d |
~action:(fun _ ->
|
|
Packit |
bd2e5d |
Textvariable.set txt.modified "modified";
|
|
Packit |
bd2e5d |
Lexical.tag txt.tw ~start:(`Mark"insert", [`Linestart])
|
|
Packit |
bd2e5d |
~stop:(`Mark"insert", [`Lineend]));
|
|
Packit |
bd2e5d |
bind tw ~events:[`Modified([`Double], `ButtonPressDetail 1)]
|
|
Packit |
bd2e5d |
~fields:[`MouseX;`MouseY]
|
|
Packit |
bd2e5d |
~action:(fun ev -> search_pos_window txt ~x:ev.ev_MouseX ~y:ev.ev_MouseY);
|
|
Packit |
bd2e5d |
bind tw ~events:[`ButtonPressDetail 3] ~fields:[`MouseX;`MouseY]
|
|
Packit |
bd2e5d |
~action:(fun ev -> search_pos_menu txt ~x:ev.ev_MouseX ~y:ev.ev_MouseY);
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
pack [sb] ~fill:`Y ~side:`Right;
|
|
Packit |
bd2e5d |
pack [tw] ~fill:`Both ~expand:true ~side:`Left;
|
|
Packit |
bd2e5d |
self#set_edit txt;
|
|
Packit |
bd2e5d |
Textvariable.set txt.modified "unchanged";
|
|
Packit |
bd2e5d |
Lexical.init_tags txt.tw
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method clear_errors () =
|
|
Packit |
bd2e5d |
Text.tag_remove current_tw ~tag:"error" ~start:tstart ~stop:tend;
|
|
Packit |
bd2e5d |
List.iter error_messages
|
|
Packit |
bd2e5d |
~f:(fun tl -> try destroy tl with Protocol.TkError _ -> ());
|
|
Packit |
bd2e5d |
error_messages <- []
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method typecheck () =
|
|
Packit |
bd2e5d |
self#clear_errors ();
|
|
Packit |
bd2e5d |
error_messages <- Typecheck.f (List.hd windows)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method lex () =
|
|
Packit |
bd2e5d |
List.iter [ Widget.default_toplevel; top ]
|
|
Packit |
bd2e5d |
~f:(Toplevel.configure ~cursor:(`Xcursor "watch"));
|
|
Packit |
bd2e5d |
Text.configure current_tw ~cursor:(`Xcursor "watch");
|
|
Packit |
bd2e5d |
ignore (Timer.add ~ms:1 ~callback:
|
|
Packit |
bd2e5d |
begin fun () ->
|
|
Packit |
bd2e5d |
Text.tag_remove current_tw ~tag:"error" ~start:tstart ~stop:tend;
|
|
Packit |
bd2e5d |
Lexical.tag current_tw;
|
|
Packit |
bd2e5d |
Text.configure current_tw ~cursor:(`Xcursor "xterm");
|
|
Packit |
bd2e5d |
List.iter [ Widget.default_toplevel; top ]
|
|
Packit |
bd2e5d |
~f:(Toplevel.configure ~cursor:(`Xcursor ""))
|
|
Packit |
bd2e5d |
end)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method save_text ?name:l txt =
|
|
Packit |
bd2e5d |
let l = match l with None -> [txt.name] | Some l -> l in
|
|
Packit |
bd2e5d |
if l = [] then () else
|
|
Packit |
bd2e5d |
let name = List.hd l in
|
|
Packit |
bd2e5d |
if txt.name <> name then current_dir <- Filename.dirname name;
|
|
Packit |
bd2e5d |
try
|
|
Packit |
bd2e5d |
if Sys.file_exists name then
|
|
Packit |
bd2e5d |
if txt.name = name then begin
|
|
Packit |
bd2e5d |
let backup = name ^ "~" in
|
|
Packit |
bd2e5d |
if Sys.file_exists backup then Sys.remove backup;
|
|
Packit |
bd2e5d |
try Sys.rename name backup with Sys_error _ -> ()
|
|
Packit |
bd2e5d |
end else begin
|
|
Packit |
bd2e5d |
match Jg_message.ask ~master:top ~title:"Save"
|
|
Packit |
bd2e5d |
("File `" ^ name ^ "' exists. Overwrite it?")
|
|
Packit |
bd2e5d |
with `Yes -> Sys.remove name
|
|
Packit |
bd2e5d |
| `No -> raise (Sys_error "")
|
|
Packit |
bd2e5d |
| `Cancel -> raise Exit
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
let file = open_out name in
|
|
Packit |
bd2e5d |
let text = Text.get txt.tw ~start:tstart ~stop:(tposend 1) in
|
|
Packit |
bd2e5d |
output_string file text;
|
|
Packit |
bd2e5d |
close_out file;
|
|
Packit |
bd2e5d |
txt.name <- name;
|
|
Packit |
bd2e5d |
self#set_file_name txt
|
|
Packit |
bd2e5d |
with
|
|
Packit |
bd2e5d |
Sys_error _ ->
|
|
Packit |
bd2e5d |
Jg_message.info ~master:top ~title:"Error"
|
|
Packit |
bd2e5d |
("Could not save `" ^ name ^ "'.")
|
|
Packit |
bd2e5d |
| Exit -> ()
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method load_text l =
|
|
Packit |
bd2e5d |
if l = [] then () else
|
|
Packit |
bd2e5d |
let name = List.hd l in
|
|
Packit |
bd2e5d |
try
|
|
Packit |
bd2e5d |
let index =
|
|
Packit |
bd2e5d |
try
|
|
Packit |
bd2e5d |
self#set_edit (List.find windows ~f:(fun x -> x.name = name));
|
|
Packit |
bd2e5d |
let txt = List.hd windows in
|
|
Packit |
bd2e5d |
if Textvariable.get txt.modified = "modified" then
|
|
Packit |
bd2e5d |
begin match Jg_message.ask ~master:top ~title:"Open"
|
|
Packit |
bd2e5d |
("`" ^ Filename.basename txt.name ^ "' modified. Save it?")
|
|
Packit |
bd2e5d |
with `Yes -> self#save_text txt
|
|
Packit |
bd2e5d |
| `No -> ()
|
|
Packit |
bd2e5d |
| `Cancel -> raise Exit
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
Textvariable.set txt.modified "unchanged";
|
|
Packit |
bd2e5d |
(Text.index current_tw ~index:(`Mark"insert", []), [])
|
|
Packit |
bd2e5d |
with Not_found -> self#new_window name; tstart
|
|
Packit |
bd2e5d |
in
|
|
Packit |
bd2e5d |
current_dir <- Filename.dirname name;
|
|
Packit |
bd2e5d |
let file = open_in name
|
|
Packit |
bd2e5d |
and tw = current_tw
|
|
Packit |
bd2e5d |
and len = ref 0
|
|
Packit |
bd2e5d |
and buf = Bytes.create 4096 in
|
|
Packit |
bd2e5d |
Text.delete tw ~start:tstart ~stop:tend;
|
|
Packit |
bd2e5d |
while
|
|
Packit |
bd2e5d |
len := input file buf 0 4096;
|
|
Packit |
bd2e5d |
!len > 0
|
|
Packit |
bd2e5d |
do
|
|
Packit |
bd2e5d |
Jg_text.output tw ~buf:(Bytes.unsafe_to_string buf) ~pos:0 ~len:!len
|
|
Packit |
bd2e5d |
done;
|
|
Packit |
bd2e5d |
close_in file;
|
|
Packit |
bd2e5d |
Text.mark_set tw ~mark:"insert" ~index;
|
|
Packit |
bd2e5d |
Text.see tw ~index;
|
|
Packit |
bd2e5d |
if Filename.check_suffix name ".ml" ||
|
|
Packit |
bd2e5d |
Filename.check_suffix name ".mli"
|
|
Packit |
bd2e5d |
then begin
|
|
Packit |
bd2e5d |
if !lex_on_load then self#lex ();
|
|
Packit |
bd2e5d |
if !type_on_load then self#typecheck ()
|
|
Packit |
bd2e5d |
end
|
|
Packit |
bd2e5d |
with
|
|
Packit |
bd2e5d |
Sys_error _ | Exit -> ()
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method close_window txt =
|
|
Packit |
bd2e5d |
try
|
|
Packit |
bd2e5d |
if Textvariable.get txt.modified = "modified" then
|
|
Packit |
bd2e5d |
begin match Jg_message.ask ~master:top ~title:"Close"
|
|
Packit |
bd2e5d |
("`" ^ Filename.basename txt.name ^ "' modified. Save it?")
|
|
Packit |
bd2e5d |
with `Yes -> self#save_text txt
|
|
Packit |
bd2e5d |
| `No -> ()
|
|
Packit |
bd2e5d |
| `Cancel -> raise Exit
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
windows <- exclude txt windows;
|
|
Packit |
bd2e5d |
if windows = [] then
|
|
Packit |
bd2e5d |
self#new_window (current_dir ^ "/untitled")
|
|
Packit |
bd2e5d |
else self#set_edit (List.hd windows);
|
|
Packit |
bd2e5d |
destroy txt.frame
|
|
Packit |
bd2e5d |
with Exit -> ()
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method open_file () =
|
|
Packit |
bd2e5d |
Fileselect.f ~title:"Open File" ~action:self#load_text
|
|
Packit |
bd2e5d |
~dir:current_dir ~filter:("*.{ml,mli}") ~sync:true ()
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method save_file () = self#save_text (List.hd windows)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method close_file () = self#close_window (List.hd windows)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method quit ?(cancel=true) () =
|
|
Packit |
bd2e5d |
try
|
|
Packit |
bd2e5d |
List.iter windows ~f:
|
|
Packit |
bd2e5d |
begin fun txt ->
|
|
Packit |
bd2e5d |
if Textvariable.get txt.modified = "modified" then
|
|
Packit |
bd2e5d |
match Jg_message.ask ~master:top ~title:"Quit" ~cancel
|
|
Packit |
bd2e5d |
("`" ^ Filename.basename txt.name ^ "' modified. Save it?")
|
|
Packit |
bd2e5d |
with `Yes -> self#save_text txt
|
|
Packit |
bd2e5d |
| `No -> ()
|
|
Packit |
bd2e5d |
| `Cancel -> raise Exit
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
bind top ~events:[`Destroy];
|
|
Packit |
bd2e5d |
destroy top
|
|
Packit |
bd2e5d |
with Exit -> ()
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
method reopen ~file ~pos =
|
|
Packit |
bd2e5d |
if not (Winfo.ismapped top) then Wm.deiconify top;
|
|
Packit |
bd2e5d |
match file with None -> ()
|
|
Packit |
bd2e5d |
| Some file ->
|
|
Packit |
bd2e5d |
self#load_text [file];
|
|
Packit |
bd2e5d |
Text.mark_set current_tw ~mark:"insert" ~index:(tpos pos);
|
|
Packit |
bd2e5d |
try
|
|
Packit |
bd2e5d |
let index =
|
|
Packit |
bd2e5d |
Text.search current_tw ~switches:[`Backwards] ~pattern:"*)"
|
|
Packit |
bd2e5d |
~start:(tpos pos) ~stop:(tpos pos ~modi:[`Line(-1)]) in
|
|
Packit |
bd2e5d |
let index =
|
|
Packit |
bd2e5d |
Text.search current_tw ~switches:[`Backwards] ~pattern:"(*"
|
|
Packit |
bd2e5d |
~start:(index,[]) ~stop:(tpos pos ~modi:[`Line(-20)]) in
|
|
Packit |
bd2e5d |
let s = Text.get current_tw ~start:(index,[`Line(-1);`Linestart])
|
|
Packit |
bd2e5d |
~stop:(index,[`Line(-1);`Lineend]) in
|
|
Packit |
bd2e5d |
for i = 0 to String.length s - 1 do
|
|
Packit |
bd2e5d |
match s.[i] with '\t'|' ' -> () | _ -> raise Not_found
|
|
Packit |
bd2e5d |
done;
|
|
Packit |
bd2e5d |
Text.yview_index current_tw ~index:(index,[`Line(-1)])
|
|
Packit |
bd2e5d |
with _ ->
|
|
Packit |
bd2e5d |
Text.yview_index current_tw ~index:(tpos pos ~modi:[`Line(-2)])
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
initializer
|
|
Packit |
bd2e5d |
(* Create a first window *)
|
|
Packit |
bd2e5d |
self#new_window (current_dir ^ "/untitled");
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Bindings for the main window *)
|
|
Packit |
bd2e5d |
List.iter
|
|
Packit |
bd2e5d |
[ [`Control], "s", (fun () -> Jg_text.search_string current_tw);
|
|
Packit |
bd2e5d |
[`Control], "g", (fun () -> goto_line current_tw);
|
|
Packit |
bd2e5d |
[`Alt], "s", self#save_file;
|
|
Packit |
bd2e5d |
[`Alt], "x", (fun () -> send_phrase (List.hd windows));
|
|
Packit |
bd2e5d |
[`Alt], "l", self#lex;
|
|
Packit |
bd2e5d |
[`Alt], "t", self#typecheck ]
|
|
Packit |
bd2e5d |
~f:begin fun (modi,key,act) ->
|
|
Packit |
bd2e5d |
bind top ~events:[`Modified(modi, `KeyPressDetail key)] ~breakable:true
|
|
Packit |
bd2e5d |
~action:(fun _ -> act (); break ())
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
bind top ~events:[`Destroy] ~fields:[`Widget] ~action:
|
|
Packit |
bd2e5d |
begin fun ev ->
|
|
Packit |
bd2e5d |
if Widget.name ev.ev_Widget = Widget.name top
|
|
Packit |
bd2e5d |
then self#quit ~cancel:false ()
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* File menu *)
|
|
Packit |
bd2e5d |
file_menu#add_command "Open File..." ~command:self#open_file;
|
|
Packit |
bd2e5d |
file_menu#add_command "Reopen"
|
|
Packit |
bd2e5d |
~command:(fun () -> self#load_text [(List.hd windows).name]);
|
|
Packit |
bd2e5d |
file_menu#add_command "Save File" ~command:self#save_file ~accelerator:"M-s";
|
|
Packit |
bd2e5d |
file_menu#add_command "Save As..." ~underline:5 ~command:
|
|
Packit |
bd2e5d |
begin fun () ->
|
|
Packit |
bd2e5d |
let txt = List.hd windows in
|
|
Packit |
bd2e5d |
Fileselect.f ~title:"Save as File"
|
|
Packit |
bd2e5d |
~action:(fun name -> self#save_text txt ~name)
|
|
Packit |
bd2e5d |
~dir:(Filename.dirname txt.name)
|
|
Packit |
bd2e5d |
~filter:"*.{ml,mli}"
|
|
Packit |
bd2e5d |
~file:(Filename.basename txt.name)
|
|
Packit |
bd2e5d |
~sync:true ~usepath:false ()
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
file_menu#add_command "Close File" ~command:self#close_file;
|
|
Packit |
bd2e5d |
file_menu#add_command "Close Window" ~command:self#quit ~underline:6;
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Edit menu *)
|
|
Packit |
bd2e5d |
edit_menu#add_command "Paste selection" ~command:
|
|
Packit |
bd2e5d |
begin fun () ->
|
|
Packit |
bd2e5d |
Text.insert current_tw ~index:(`Mark"insert",[])
|
|
Packit |
bd2e5d |
~text:(Selection.get ~displayof:top ())
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
edit_menu#add_command "Goto..." ~accelerator:"C-g"
|
|
Packit |
bd2e5d |
~command:(fun () -> goto_line current_tw);
|
|
Packit |
bd2e5d |
edit_menu#add_command "Search..." ~accelerator:"C-s"
|
|
Packit |
bd2e5d |
~command:(fun () -> Jg_text.search_string current_tw);
|
|
Packit |
bd2e5d |
edit_menu#add_command "To shell" ~accelerator:"M-x"
|
|
Packit |
bd2e5d |
~command:(fun () -> send_phrase (List.hd windows));
|
|
Packit |
bd2e5d |
edit_menu#add_command "Select shell..."
|
|
Packit |
bd2e5d |
~command:(fun () -> select_shell (List.hd windows));
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Compiler menu *)
|
|
Packit |
bd2e5d |
compiler_menu#add_command "Preferences..."
|
|
Packit |
bd2e5d |
~command:(fun () -> compiler_preferences top);
|
|
Packit |
bd2e5d |
compiler_menu#add_command "Lex" ~accelerator:"M-l"
|
|
Packit |
bd2e5d |
~command:self#lex;
|
|
Packit |
bd2e5d |
compiler_menu#add_command "Typecheck" ~accelerator:"M-t"
|
|
Packit |
bd2e5d |
~command:self#typecheck;
|
|
Packit |
bd2e5d |
compiler_menu#add_command "Clear errors"
|
|
Packit |
bd2e5d |
~command:self#clear_errors;
|
|
Packit |
bd2e5d |
compiler_menu#add_command "Signature..." ~command:
|
|
Packit |
bd2e5d |
begin fun () ->
|
|
Packit |
bd2e5d |
let txt = List.hd windows in if txt.signature <> [] then
|
|
Packit |
bd2e5d |
let basename = Filename.basename txt.name in
|
|
Packit |
bd2e5d |
let modname = String.capitalize_ascii
|
|
Packit |
bd2e5d |
(try Filename.chop_extension basename with _ -> basename) in
|
|
Packit |
bd2e5d |
let env =
|
|
Packit |
bd2e5d |
Env.add_module (Ident.create modname)
|
|
Packit |
bd2e5d |
(Types.Mty_signature txt.signature)
|
|
Packit |
bd2e5d |
!Searchid.start_env
|
|
Packit |
bd2e5d |
in Viewer.view_defined (Longident.Lident modname) ~env ~show_all:true
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Modules *)
|
|
Packit |
bd2e5d |
module_menu#add_command "Path editor..."
|
|
Packit |
bd2e5d |
~command:(fun () -> Setpath.set ~dir:current_dir);
|
|
Packit |
bd2e5d |
module_menu#add_command "Reset cache"
|
|
Packit |
bd2e5d |
~command:(fun () -> Setpath.exec_update_hooks (); Env.reset_cache ());
|
|
Packit |
bd2e5d |
module_menu#add_command "Search symbol..."
|
|
Packit |
bd2e5d |
~command:Viewer.search_symbol;
|
|
Packit |
bd2e5d |
module_menu#add_command "Close all"
|
|
Packit |
bd2e5d |
~command:Viewer.close_all_views;
|
|
Packit |
bd2e5d |
end
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* The main function starts here ! *)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let already_open : editor list ref = ref []
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let editor ?file ?(pos=0) ?(reuse=false) () =
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
if !already_open <> [] &&
|
|
Packit |
bd2e5d |
let ed = List.hd !already_open
|
|
Packit |
bd2e5d |
(* try
|
|
Packit |
bd2e5d |
let name = match file with Some f -> f | None -> raise Not_found in
|
|
Packit |
bd2e5d |
List.find !already_open ~f:(fun ed -> ed#has_window name)
|
|
Packit |
bd2e5d |
with Not_found -> List.hd !already_open *)
|
|
Packit |
bd2e5d |
in try
|
|
Packit |
bd2e5d |
ed#reopen ~file ~pos;
|
|
Packit |
bd2e5d |
true
|
|
Packit |
bd2e5d |
with Protocol.TkError _ ->
|
|
Packit |
bd2e5d |
already_open := [] (* List.filter !already_open ~f:((<>) ed) *);
|
|
Packit |
bd2e5d |
false
|
|
Packit |
bd2e5d |
then () else
|
|
Packit |
bd2e5d |
let top = Jg_toplevel.titled "OCamlBrowser Editor" in
|
|
Packit |
bd2e5d |
let menus = Jg_menu.menubar top in
|
|
Packit |
bd2e5d |
let ed = new editor ~top ~menus in
|
|
Packit |
bd2e5d |
already_open := !already_open @ [ed];
|
|
Packit |
bd2e5d |
if file <> None then ed#reopen ~file ~pos
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let f ?file ?pos ?(opendialog=false) () =
|
|
Packit |
bd2e5d |
if opendialog then
|
|
Packit |
bd2e5d |
Fileselect.f ~title:"Open File"
|
|
Packit |
bd2e5d |
~action:(function [file] -> editor ~file () | _ -> ())
|
|
Packit |
bd2e5d |
~filter:("*.{ml,mli}") ~sync:true ()
|
|
Packit |
bd2e5d |
else editor ?file ?pos ~reuse:(file <> None) ()
|