helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/applications/radtest/tiList.ml

   1
   2 open Utils
   3 open Property
   4
   5 open TiBase
   6
   7 class ticlist ~(widget : 'a GList.clist) ~name ~parent_tree ~pos
   8     ?(insert_evbox=true) parent_window ~columns ~titles =
   9   object(self)
  10     val clist = widget
  11     inherit tiwidget ~name ~widget ~parent_tree ~pos
  12         ~insert_evbox parent_window as widget
  13
  14     val param = parent_window#add_param
  15
  16     method private class_name = "GList.clist"
  17
  18     method private get_mandatory_props = [ "columns" ]
  19
  20     method remove_me_without_undo () =
  21       parent_window#remove_param param;
  22       widget#remove_me_without_undo ()
  23
  24     method emit_init_code formatter ~packing =
  25       Format.fprintf formatter
  26         "@ @[<hv 2>let (%s : '%c GList.clist) =@ @[<hov 2>GList.clist"
  27         name param;
  28       List.iter self#get_mandatory_props ~f:
  29         begin fun name ->
  30           Format.fprintf formatter "@ ~%s:%s" name
  31             (List.assoc name proplist)#code
  32         end;
  33       let packing = self#get_packing packing in
  34       if packing <> "" then Format.fprintf formatter "@ %s" packing;
  35       self#emit_prop_code formatter;
  36       Format.fprintf formatter "@ ()@ in@]@]"
  37
  38
  39     initializer
  40       classe <- "clist";
  41       proplist <- proplist @
  42       [ "columns",
  43         new prop_int ~name:"columns" ~init:(string_of_int columns)
  44           ~set:(fun _ -> true);
  45         "titles",
  46         new prop_clist_titles ~name:"titles" ~init:(String.concat ~sep:" " titles)
  47           ~set:(fun v ->
  48             let v = Array.of_list v in
  49             for i = 0 to Array.length v - 1 do
  50               clist#set_column i ~title:v.(i)
  51             done;
  52             true)
  53       ]
  54 end
  55
  56 let new_clist ~name ?(listprop = []) =
  57   let c, lp = match listprop with
  58   | [] -> (get_a_number "number of columns" 3), []
  59   | ("columns", n)::tl -> (int_of_string n), tl
  60   | _ -> failwith "new_clist"
  61   in
  62   let rtitles = ref [] in
  63   for i = c downto 1 do rtitles := ("column" ^(string_of_int i)):: !rtitles done;
  64   new ticlist ~name ~widget:(GList.clist ~columns:c ~titles: !rtitles ()) ~columns:c ~titles: !rtitles
  65
  66