open Utils
open Property

open TiBase
open TiContainer


class tiwindow ~widget ~name ~parent_tree ~pos ?(insert_evbox=true)
    parent_window =
object(self)
  val window = widget
  inherit ticontainer ~name ~widget
      ~insert_evbox:false ~parent_tree ~pos parent_window as container

  method connect_event = window#event#connect

  method private class_name = "GWindow.window"

  method private get_mandatory_props = [ "title" ]

(*  method private save_clean_proplist =
    List.remove_assoc "title" container#save_clean_proplist

  method private emit_clean_proplist plist =
    List.remove_assoc "title" (container#emit_clean_proplist plist)
*)
  method remove_me () =
    let sref = ref "" in
    self#save_to_string sref;
    let lexbuf = Lexing.from_string !sref in
    let node = Load_parser.window Load_lexer.token lexbuf in
    add_undo (Add_window node);
    self#remove_me_without_undo ()

  method copy () = self#copy_to_sel window_selection

  method remove_me_without_undo () =
    self#forall ~callback:(fun tiw -> tiw#remove_me_without_undo ());
    parent_window#remove_sel (self : #tiwidget0 :> tiwidget0);
    name_list := list_remove !name_list ~f:(fun n -> n=name);
    Hashtbl.remove widget_map name;
    Propwin.remove name;
    widget#destroy ()

  method private get_packing packing = ""

  method emit_code f param_list =
    let param_string =
      match param_list with
      |	 [] -> ""
      |	_ -> "['" ^
	  (String.concat ~sep:", '"
	     (List.map ~f:(fun c -> (String.make 1 c)) param_list)) ^
	  "] " in
    Format.fprintf f "(* Code for %s *)@\n@\n@[<hv 2>class %s%s () ="
      name param_string name;
    self#emit_init_code f ~packing:"";
    Format.fprintf f "@]@\n@[<hv 2>object (self)";
    self#emit_method_code f;
    Format.fprintf f "@ method show () = %s#show ()" name;
    Format.fprintf f "@ @[<v 2>initializer";
    self#emit_initializer_code f;
    Format.fprintf f "@ ()@]@]@ end@\n@\n"

(*  method private save_start formatter =
    Format.fprintf formatter "@[<0>@\n@[<2><window name=%s>" name;
    Format.fprintf formatter "@\ntitle=\"%s\""
      (List.assoc "title" proplist)#get
*)
  method private save_end formatter =
    Format.fprintf formatter "@]@\n</window>@\n@]"

  method private menu ~time =
    let menu = GMenu.menu () and menu_add = GMenu.menu () in
    List.iter
      ~f:(fun n ->
	let mi = GMenu.menu_item ~packing:menu_add#append ~label:n ()
	in mi#connect#activate
	  ~callback:(fun () -> self#add_child n (); ()); ())
      widget_add_list;      
    let mi_add = GMenu.menu_item ~packing:menu#append ~label:("add to "^ name) ()
    and mi_paste = GMenu.menu_item ~packing:menu#append ~label:"Paste" ()
    in
    mi_add#set_submenu menu_add;
    if !selection <> ""
    then begin mi_paste#connect#activate ~callback:self#paste; () end
    else mi_paste#misc#set_sensitive false;
    menu#popup ~button:3 ~time


  initializer
    classe <- "window";
    window#set_title name;
    proplist <-	proplist @
      [ "title",
	new prop_string ~name:"title" ~init:name ~set:(ftrue window#set_title);
	"allow_shrink",	new prop_bool ~name:"allow_shrink" ~init:"false"
	                  ~set:(ftrue window#set_allow_shrink);
	"allow_grow", new prop_bool ~name:"allow_grow" ~init:"true"
	                ~set:(ftrue window#set_allow_grow);
	"auto_shrink", new prop_bool ~name:"auto_shrink" ~init:"false"
	                 ~set:(ftrue window#set_auto_shrink);
	"x position", new prop_int ~name:"x" ~init:"-2"
	  ~set:(fun x -> window#misc#set_geometry ~x (); true);
	"y position", new prop_int ~name:"y" ~init:"-2"
	  ~set:(fun y -> window#misc#set_geometry ~y (); true) ]
end

let new_tiwindow ~name ?(listprop = []) =
  let w = GWindow.window ~show:true () in
  w#misc#set_can_focus false;
  w#misc#set_can_default false;
  new tiwindow ~widget:w ~name