open Utils
open Property

open TiBase

class ticlist ~(widget : 'a GList.clist) ~name ~parent_tree ~pos
    ?(insert_evbox=true) parent_window ~columns ~titles =
  object(self)
    val clist = widget
    inherit tiwidget ~name ~widget ~parent_tree ~pos
	~insert_evbox parent_window as widget

    val param = parent_window#add_param

    method private class_name = "GList.clist"

    method private get_mandatory_props = [ "columns" ]

    method remove_me_without_undo () =
      parent_window#remove_param param;
      widget#remove_me_without_undo ()

    method emit_init_code formatter ~packing =
      Format.fprintf formatter 
	"@ @[<hv 2>let (%s : '%c GList.clist) =@ @[<hov 2>GList.clist"
	name param;
      List.iter self#get_mandatory_props ~f:
	begin fun name ->
	  Format.fprintf formatter "@ ~%s:%s" name
	    (List.assoc name proplist)#code
	end;
      let packing = self#get_packing packing in
      if packing <> "" then Format.fprintf formatter "@ %s" packing;
      self#emit_prop_code formatter;
      Format.fprintf formatter "@ ()@ in@]@]"


    initializer
      classe <- "clist";
      proplist <- proplist @
      [ "columns",
	new prop_int ~name:"columns" ~init:(string_of_int columns)
	  ~set:(fun _ -> true);
	"titles",
	new prop_clist_titles ~name:"titles" ~init:(String.concat ~sep:" " titles)
	  ~set:(fun v ->
	    let v = Array.of_list v in
	    for i = 0 to Array.length v - 1 do
	      clist#set_column i ~title:v.(i)
	    done;
	    true)
      ]
end

let new_clist ~name ?(listprop = []) =
  let c, lp = match listprop with
  | [] -> (get_a_number "number of columns" 3), []
  | ("columns", n)::tl -> (int_of_string n), tl
  | _ -> failwith "new_clist"
  in
  let rtitles = ref [] in
  for i = c downto 1 do rtitles := ("column" ^(string_of_int i)):: !rtitles done;
  new ticlist ~name ~widget:(GList.clist ~columns:c ~titles: !rtitles ()) ~columns:c ~titles: !rtitles