(*********************************************************************************)

(*                Cameleon                                                       *)
(*                                                                               *)
(*    Copyright (C) 2005,2006 Institut National de Recherche en Informatique     *)
(*    et en Automatique. All rights reserved.                                    *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Library General Public License as            *)
(*    published by the Free Software Foundation; either version 2 of the         *)
(*    License, or  any later version.                                            *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
(*    GNU Library General Public License for more details.                       *)
(*                                                                               *)
(*    You should have received a copy of the GNU Library General Public          *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)


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
  
(* There is only one output view *)
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 ->
           (* should have a view now, orelse it means that
              the ocamloutput factory is not associated to the special filename,
              In this case, we must bufferize the string to output, to display it
              when a view will be created.
              *)

            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);;


(**

Factory

*)


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);;

(* Make sur the ocamloutput view is associated to the special filename *)
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)
;;