--- /dev/null
+(* $Id$ *)
+
+open Gaux
+open Gtk
+open Tags
+open GtkBase
+
+module Progress = struct
+ let cast w : progress obj = Object.try_cast w "GtkProgress"
+ external set_show_text : [>`progress] obj -> bool -> unit
+ = "ml_gtk_progress_set_show_text"
+ external set_text_alignment :
+ [>`progress] obj -> ?x:float -> ?y:float -> unit -> unit
+ = "ml_gtk_progress_set_show_text"
+ external set_format_string : [>`progress] obj -> string -> unit
+ = "ml_gtk_progress_set_format_string"
+ external set_adjustment : [>`progress] obj -> [>`adjustment] obj -> unit
+ = "ml_gtk_progress_set_adjustment"
+ external configure :
+ [>`progress] obj -> current:float -> min:float -> max:float -> unit
+ = "ml_gtk_progress_configure"
+ external set_percentage : [>`progress] obj -> float -> unit
+ = "ml_gtk_progress_set_percentage"
+ external set_value : [>`progress] obj -> float -> unit
+ = "ml_gtk_progress_set_value"
+ external get_value : [>`progress] obj -> float
+ = "ml_gtk_progress_get_value"
+ external get_percentage : [>`progress] obj -> float
+ = "ml_gtk_progress_get_current_percentage"
+ external set_activity_mode : [>`progress] obj -> bool -> unit
+ = "ml_gtk_progress_set_activity_mode"
+ external get_current_text : [>`progress] obj -> string
+ = "ml_gtk_progress_get_current_text"
+ external get_adjustment : [>`progress] obj -> adjustment obj
+ = "ml_gtk_progress_get_adjustment"
+ let set ?value ?percentage ?activity_mode
+ ?show_text ?format_string ?text_xalign ?text_yalign w =
+ may value ~f:(set_value w);
+ may percentage ~f:(set_percentage w);
+ may activity_mode ~f:(set_activity_mode w);
+ may show_text ~f:(set_show_text w);
+ may format_string ~f:(set_format_string w);
+ if text_xalign <> None || text_yalign <> None then
+ set_text_alignment w ?x:text_xalign ?y:text_yalign ()
+end
+
+module ProgressBar = struct
+ let cast w : progress_bar obj = Object.try_cast w "GtkProgressBar"
+ external create : unit -> progress_bar obj = "ml_gtk_progress_bar_new"
+ external create_with_adjustment : [>`adjustment] obj -> progress_bar obj
+ = "ml_gtk_progress_bar_new_with_adjustment"
+ external set_bar_style :
+ [>`progressbar] obj -> [`CONTINUOUS|`DISCRETE] -> unit
+ = "ml_gtk_progress_bar_set_bar_style"
+ external set_discrete_blocks : [>`progressbar] obj -> int -> unit
+ = "ml_gtk_progress_bar_set_discrete_blocks"
+ external set_activity_step : [>`progressbar] obj -> int -> unit
+ = "ml_gtk_progress_bar_set_activity_step"
+ external set_activity_blocks : [>`progressbar] obj -> int -> unit
+ = "ml_gtk_progress_bar_set_activity_blocks"
+ external set_orientation :
+ [>`progressbar] obj -> Tags.progress_bar_orientation -> unit
+ = "ml_gtk_progress_bar_set_orientation"
+ let set ?bar_style ?discrete_blocks ?activity_step ?activity_blocks w =
+ let may_set f opt = may opt ~f:(f w) in
+ may_set set_bar_style bar_style;
+ may_set set_discrete_blocks discrete_blocks;
+ may_set set_activity_step activity_step;
+ may_set set_activity_blocks activity_blocks
+end
+
+module Range = struct
+ let cast w : range obj = Object.try_cast w "GtkRange"
+ external coerce : [>`range] obj -> range obj = "%identity"
+ external get_adjustment : [>`range] obj -> adjustment obj
+ = "ml_gtk_range_get_adjustment"
+ external set_adjustment : [>`range] obj -> [>`adjustment] obj -> unit
+ = "ml_gtk_range_set_adjustment"
+ external set_update_policy : [>`range] obj -> update_type -> unit
+ = "ml_gtk_range_set_update_policy"
+ let set ?adjustment ?update_policy w =
+ may adjustment ~f:(set_adjustment w);
+ may update_policy ~f:(set_update_policy w)
+end
+
+module Scale = struct
+ let cast w : scale obj = Object.try_cast w "GtkScale"
+ external hscale_new : [>`adjustment] optobj -> scale obj
+ = "ml_gtk_hscale_new"
+ external vscale_new : [>`adjustment] optobj -> scale obj
+ = "ml_gtk_vscale_new"
+ let create ?adjustment (dir : orientation) =
+ let create = if dir = `HORIZONTAL then hscale_new else vscale_new in
+ create (Gpointer.optboxed adjustment)
+ external set_digits : [>`scale] obj -> int -> unit
+ = "ml_gtk_scale_set_digits"
+ external set_draw_value : [>`scale] obj -> bool -> unit
+ = "ml_gtk_scale_set_draw_value"
+ external set_value_pos : [>`scale] obj -> position -> unit
+ = "ml_gtk_scale_set_value_pos"
+ external get_value_width : [>`scale] obj -> int
+ = "ml_gtk_scale_get_value_width"
+ external draw_value : [>`scale] obj -> unit
+ = "ml_gtk_scale_draw_value"
+ let set ?digits ?draw_value ?value_pos w =
+ may digits ~f:(set_digits w);
+ may draw_value ~f:(set_draw_value w);
+ may value_pos ~f:(set_value_pos w)
+end
+
+module Scrollbar = struct
+ let cast w : scrollbar obj = Object.try_cast w "GtkScrollbar"
+ external hscrollbar_new : [>`adjustment] optobj -> scrollbar obj
+ = "ml_gtk_hscrollbar_new"
+ external vscrollbar_new : [>`adjustment] optobj -> scrollbar obj
+ = "ml_gtk_vscrollbar_new"
+ let create ?adjustment (dir : orientation) =
+ let create = if dir = `HORIZONTAL then hscrollbar_new else vscrollbar_new
+ in create (Gpointer.optboxed adjustment)
+end
+
+module Ruler = struct
+ let cast w : ruler obj = Object.try_cast w "GtkRuler"
+ external hruler_new : unit -> ruler obj = "ml_gtk_hruler_new"
+ external vruler_new : unit -> ruler obj = "ml_gtk_vruler_new"
+ let create (dir : orientation) =
+ if dir = `HORIZONTAL then hruler_new () else vruler_new ()
+ external set_metric : [>`ruler] obj -> metric_type -> unit
+ = "ml_gtk_ruler_set_metric"
+ external set_range :
+ [>`ruler] obj ->
+ lower:float -> upper:float -> position:float -> max_size:float -> unit
+ = "ml_gtk_ruler_set_range"
+ external get_lower : [>`ruler] obj -> float = "ml_gtk_ruler_get_lower"
+ external get_upper : [>`ruler] obj -> float = "ml_gtk_ruler_get_upper"
+ external get_position : [>`ruler] obj -> float = "ml_gtk_ruler_get_position"
+ external get_max_size : [>`ruler] obj -> float = "ml_gtk_ruler_get_max_size"
+ let set_range ?lower ?upper ?position ?max_size w =
+ set_range w ~lower:(may_default get_lower w ~opt:lower)
+ ~upper:(may_default get_upper w ~opt:upper)
+ ~position:(may_default get_position w ~opt:position)
+ ~max_size:(may_default get_max_size w ~opt:max_size)
+ let set ?metric ?lower ?upper ?position ?max_size w =
+ may metric ~f:(set_metric w);
+ if lower <> None || upper <> None || position <> None || max_size <> None
+ then set_range w ?lower ?upper ?position ?max_size
+end
projects / helm.git / blobdiff