let factory_name = Ed_ocamloutput_rc.factory_name;;
let get_att_f = Ed_sourceview.get_att_f;;
class outputview ?(attributes=[]) (topwin : Ed_view.topwin)
f_on_destroy =
let vbox = GPack.vbox () in
let wscroll = GBin.scrolled_window
~packing: (vbox#pack ~expand: true ~fill: true ~padding: 0)
~border_width: 0
~vpolicy: `AUTOMATIC ~hpolicy: `AUTOMATIC () in
let show_line_numbers =
get_att_f Ed_misc.bool_of_string "line_numbers" attributes = Some true
in
let show_line_markers =
get_att_f Ed_misc.bool_of_string "line_markers" attributes = Some true
in
let wrap_mode =
get_att_f ~default: Ed_sourceview_rc.default_wrap_mode#get
Ed_sourceview_rc.wrap_mode_of_string "wrap_mode" attributes
in
let buffer = GSourceView.source_buffer () in
let source_view =
GSourceView.source_view
~source_buffer: buffer
~editable: true
~auto_indent:true
~insert_spaces_instead_of_tabs:true ~tabs_width:2
~show_line_numbers
~show_line_markers
?wrap_mode
~smart_home_end:true
~packing: wscroll#add
()
in
let hbox_state = GPack.hbox ~packing: vbox#pack () in
let add_state text = GMisc.label ~text ~packing: hbox_state#pack ~xpad: 5 () in
let () = ignore(add_state Ed_ocamloutput_rc.special_filename#get) in
let ref_on_destroy = ref (fun () -> ()) in
object(self)
inherit Ed_view.dyn_label
inherit Ed_view.dyn_destroyable
(fun () -> !ref_on_destroy () ; source_view#destroy ();vbox#destroy();)
method minibuffer = topwin#minibuffer
method source_view = source_view
method source_buffer = buffer
method box = vbox#coerce
method save : (unit -> unit) option = None
method save_as : (unit -> unit) option = None
method reload : (unit -> unit) option = None
method paste : (unit -> unit) option = None
method copy : (unit -> unit) option = None
method cut : (unit -> unit) option = None
method dup : Ed_view.topwin -> Ed_view.gui_view option = fun _ -> None
method close = self#destroy
method kind = factory_name
method filename = Ed_ocamloutput_rc.special_filename#get
method attributes =
[
"line_numbers", (Ed_misc.string_of_bool source_view#show_line_numbers) ;
"line_markers", (Ed_misc.string_of_bool source_view#show_line_markers) ;
"wrap_mode", (Ed_sourceview_rc.string_of_wrap_mode source_view#wrap_mode) ;
]
val mutable on_focus_in = fun () -> ()
method set_on_focus_in (f: unit -> unit) =
on_focus_in <- f
method grab_focus =
source_view#misc#grab_focus ();
source_view#scroll_to_mark `INSERT
method key_bindings : (Okey.keyhit_state * string) list = []
method menus : (string * GToolbox.menu_entry list) list = []
method print s =
buffer#insert ~iter: buffer#end_iter (Ed_misc.to_utf8 s)
initializer
Gtksv_utils.register_source_view source_view;
Gtksv_utils.apply_sourceview_props source_view (Gtksv_utils.read_sourceview_props ()) ;
ref_on_destroy := (fun () -> f_on_destroy self);
ignore(source_view#event#connect#focus_in (fun _ -> on_focus_in (); false));
(
match Gtksv_utils.source_languages_manager#get_language_from_mime_type "text/x-ocaml" with
None -> ()
| Some l -> buffer#set_language l
);
buffer#set_highlight true;
source_view#set_editable false;
self#set_label self#filename;
end
let view = ref None
let on_view_destroy v =
match !view with
Some v2 when Oo.id v = Oo.id v2 ->
view := None
| Some _
| None -> ()
;;
let delayed_text = Buffer.create 256;;
let open_view topwin _ ?(attributes=[]) _ =
match !view with
| Some v -> `Use_view (v:> Ed_view.gui_view)
| None ->
let v = new outputview ~attributes topwin on_view_destroy in
ignore(v#source_view#connect#destroy (fun () -> on_view_destroy v));
view := Some v;
v#print (Buffer.contents delayed_text);
Buffer.reset delayed_text;
`New_view (v :> Ed_view.gui_view)
let print_ocaml_output args =
if Array.length args < 1 then
()
else
begin
(match !view with
None ->
Cam_commands.launch_command "open_file" [| Ed_ocamloutput_rc.special_filename#get |];
| Some _ -> ()
);
(match !view with
None ->
Buffer.add_string delayed_text args.(0)
| Some v ->
v#print args.(0);
v#grab_focus;
)
end;;
Cam_commands.register
(Cam_commands.create_com "print_ocaml_output" [|"string"|] print_ocaml_output);;
class factory : Ed_view.view_factory =
object
method name = factory_name
method open_file = open_view
method open_hidden = None
method on_start = ()
method on_exit = ()
end;;
Ed_view.register_view_factory factory_name (new factory);;
let _ =
let def_exp = Ed_ocamloutput_rc.special_filename_exp#get in
let pred (exp, fac) = exp = def_exp && fac = factory_name in
let pats = Ed_view_rc.filename_view_patterns#get in
if not (List.exists pred pats) then
Ed_view_rc.filename_view_patterns#set ((def_exp, factory_name) :: pats)
;;