--- /dev/null
+(* $Id$ *)
+
+open Gaux
+open Gtk
+open Tags
+
+module AccelGroup = struct
+ external create : unit -> accel_group = "ml_gtk_accel_group_new"
+ external activate :
+ accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool
+ = "ml_gtk_accel_group_activate"
+ external groups_activate :
+ 'a obj -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool
+ = "ml_gtk_accel_groups_activate"
+ external attach : accel_group -> 'a obj -> unit
+ = "ml_gtk_accel_group_attach"
+ external detach : accel_group -> 'a obj -> unit
+ = "ml_gtk_accel_group_detach"
+ external lock : accel_group -> unit
+ = "ml_gtk_accel_group_lock"
+ external unlock : accel_group -> unit
+ = "ml_gtk_accel_group_unlock"
+ external lock_entry :
+ accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool
+ = "ml_gtk_accel_group_lock_entry"
+ external add :
+ accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list ->
+ ?flags:accel_flag list ->
+ call:'a obj -> sgn:('a,unit->unit) GtkSignal.t -> unit
+ = "ml_gtk_accel_group_add_bc" "ml_gtk_accel_group_add"
+ external remove :
+ accel_group ->
+ key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> call:'a obj -> unit
+ = "ml_gtk_accel_group_remove"
+ external valid : key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool
+ = "ml_gtk_accelerator_valid"
+ external set_default_mod_mask : Gdk.Tags.modifier list option -> unit
+ = "ml_gtk_accelerator_set_default_mod_mask"
+end
+
+module Style = struct
+ external create : unit -> style = "ml_gtk_style_new"
+ external copy : style -> style = "ml_gtk_style_copy"
+ external attach : style -> Gdk.window -> style = "ml_gtk_style_attach"
+ external detach : style -> unit = "ml_gtk_style_detach"
+ external set_background : style -> Gdk.window -> state_type -> unit
+ = "ml_gtk_style_set_background"
+ external draw_hline :
+ style -> Gdk.window -> state_type -> x:int -> x:int -> y:int -> unit
+ = "ml_gtk_draw_hline_bc" "ml_gtk_draw_hline"
+ external draw_vline :
+ style -> Gdk.window -> state_type -> y:int -> y:int -> x:int -> unit
+ = "ml_gtk_draw_vline_bc" "ml_gtk_draw_vline"
+ external get_bg : style -> state:state_type -> Gdk.Color.t
+ = "ml_gtk_style_get_bg"
+ external set_bg : style -> state:state_type -> color:Gdk.Color.t -> unit
+ = "ml_gtk_style_set_bg"
+ external get_dark_gc : style -> state:state_type -> Gdk.gc
+ = "ml_gtk_style_get_dark_gc"
+ external get_light_gc : style -> state:state_type -> Gdk.gc
+ = "ml_gtk_style_get_light_gc"
+ external get_colormap : style -> Gdk.colormap = "ml_gtk_style_get_colormap"
+ external get_font : style -> Gdk.font = "ml_gtk_style_get_font"
+ external set_font : style -> Gdk.font -> unit = "ml_gtk_style_set_font"
+(*
+ let set st ?:background ?:font =
+ let may_set f = may fun:(f st) in
+ may_set set_background background;
+ may_set set_font font
+*)
+end
+
+module Data = struct
+ module Signals = struct
+ open GtkSignal
+ let disconnect : ([>`data],_) t =
+ { name = "disconnect"; marshaller = marshal_unit }
+ end
+end
+
+module Adjustment = struct
+ external create :
+ value:float -> lower:float -> upper:float ->
+ step_incr:float -> page_incr:float -> page_size:float -> adjustment obj
+ = "ml_gtk_adjustment_new_bc" "ml_gtk_adjustment_new"
+ external set_value : [>`adjustment] obj -> float -> unit
+ = "ml_gtk_adjustment_set_value"
+ external clamp_page :
+ [>`adjustment] obj -> lower:float -> upper:float -> unit
+ = "ml_gtk_adjustment_clamp_page"
+ external get_lower : [>`adjustment] obj -> float
+ = "ml_gtk_adjustment_get_lower"
+ external get_upper : [>`adjustment] obj -> float
+ = "ml_gtk_adjustment_get_upper"
+ external get_value : [>`adjustment] obj -> float
+ = "ml_gtk_adjustment_get_value"
+ external get_step_increment : [>`adjustment] obj -> float
+ = "ml_gtk_adjustment_get_step_increment"
+ external get_page_increment : [>`adjustment] obj -> float
+ = "ml_gtk_adjustment_get_page_increment"
+ external get_page_size : [>`adjustment] obj -> float
+ = "ml_gtk_adjustment_get_page_size"
+ module Signals = struct
+ open GtkSignal
+ let changed : ([>`adjustment],_) t =
+ { name = "changed"; marshaller = marshal_unit }
+ let value_changed : ([>`adjustment],_) t =
+ { name = "value_changed"; marshaller = marshal_unit }
+ end
+end
+
+module Tooltips = struct
+ external create : unit -> tooltips obj = "ml_gtk_tooltips_new"
+ external enable : [>`tooltips] obj -> unit = "ml_gtk_tooltips_enable"
+ external disable : [>`tooltips] obj -> unit = "ml_gtk_tooltips_disable"
+ external set_delay : [>`tooltips] obj -> int -> unit
+ = "ml_gtk_tooltips_set_delay"
+ external set_tip :
+ [>`tooltips] obj ->
+ [>`widget] obj -> ?text:string -> ?privat:string -> unit
+ = "ml_gtk_tooltips_set_tip"
+ external set_colors :
+ [>`tooltips] obj ->
+ ?foreground:Gdk.Color.t -> ?background:Gdk.Color.t -> unit -> unit
+ = "ml_gtk_tooltips_set_colors"
+ let set ?delay ?foreground ?background tt =
+ may ~f:(set_delay tt) delay;
+ if foreground <> None || background <> None then
+ set_colors tt ?foreground ?background ()
+end
+
+
+module Selection = struct
+ type t
+ external selection : t -> Gdk.atom
+ = "ml_gtk_selection_data_selection"
+ external target : t -> Gdk.atom
+ = "ml_gtk_selection_data_target"
+ external seltype : t -> Gdk.atom
+ = "ml_gtk_selection_data_type"
+ external format : t -> int
+ = "ml_gtk_selection_data_format"
+ external get_data : t -> string
+ = "ml_gtk_selection_data_get_data" (* May raise Gpointer.null *)
+ external set :
+ t -> typ:Gdk.atom -> format:int -> ?data:string -> unit
+ = "ml_gtk_selection_data_set"
+end
projects / helm.git / blobdiff