helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkData.ml

   1 (* $Id$ *)
   2
   3 open Gaux
   4 open Gtk
   5 open Tags
   6
   7 module AccelGroup = struct
   8   external create : unit -> accel_group = "ml_gtk_accel_group_new"
   9   external activate :
  10       accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool
  11       = "ml_gtk_accel_group_activate"
  12   external groups_activate :
  13       'a obj -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool
  14       = "ml_gtk_accel_groups_activate"
  15   external attach : accel_group -> 'a obj -> unit
  16       = "ml_gtk_accel_group_attach"
  17   external detach : accel_group -> 'a obj -> unit
  18       = "ml_gtk_accel_group_detach"
  19   external lock : accel_group -> unit
  20       = "ml_gtk_accel_group_lock"
  21   external unlock : accel_group -> unit
  22       = "ml_gtk_accel_group_unlock"
  23   external lock_entry :
  24       accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool
  25       = "ml_gtk_accel_group_lock_entry"
  26   external add :
  27       accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list ->
  28       ?flags:accel_flag list ->
  29       call:'a obj -> sgn:('a,unit->unit) GtkSignal.t -> unit
  30       = "ml_gtk_accel_group_add_bc" "ml_gtk_accel_group_add"
  31   external remove :
  32       accel_group ->
  33       key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> call:'a obj -> unit
  34       = "ml_gtk_accel_group_remove"
  35   external valid : key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool
  36       = "ml_gtk_accelerator_valid"
  37   external set_default_mod_mask : Gdk.Tags.modifier list option -> unit
  38       = "ml_gtk_accelerator_set_default_mod_mask"
  39 end
  40
  41 module Style = struct
  42   external create : unit -> style = "ml_gtk_style_new"
  43   external copy : style -> style = "ml_gtk_style_copy"
  44   external attach : style -> Gdk.window -> style = "ml_gtk_style_attach"
  45   external detach : style -> unit = "ml_gtk_style_detach"
  46   external set_background : style -> Gdk.window -> state_type -> unit
  47       = "ml_gtk_style_set_background"
  48   external draw_hline :
  49       style -> Gdk.window -> state_type -> x:int -> x:int -> y:int -> unit
  50       = "ml_gtk_draw_hline_bc" "ml_gtk_draw_hline"
  51   external draw_vline :
  52       style -> Gdk.window -> state_type -> y:int -> y:int -> x:int -> unit
  53       = "ml_gtk_draw_vline_bc" "ml_gtk_draw_vline"
  54   external get_bg : style -> state:state_type -> Gdk.Color.t
  55       = "ml_gtk_style_get_bg"
  56   external set_bg : style -> state:state_type -> color:Gdk.Color.t -> unit
  57       = "ml_gtk_style_set_bg"
  58   external get_dark_gc : style -> state:state_type -> Gdk.gc
  59       = "ml_gtk_style_get_dark_gc"
  60   external get_light_gc : style -> state:state_type -> Gdk.gc
  61       = "ml_gtk_style_get_light_gc"
  62   external get_colormap : style -> Gdk.colormap = "ml_gtk_style_get_colormap"
  63   external get_font : style -> Gdk.font = "ml_gtk_style_get_font"
  64   external set_font : style -> Gdk.font -> unit = "ml_gtk_style_set_font"
  65 (*
  66   let set st ?:background ?:font =
  67     let may_set f = may fun:(f st) in
  68     may_set set_background background;
  69     may_set set_font font
  70 *)
  71 end
  72
  73 module Data = struct
  74   module Signals = struct
  75     open GtkSignal
  76     let disconnect : ([>`data],_) t =
  77       { name = "disconnect"; marshaller = marshal_unit }
  78   end
  79 end
  80
  81 module Adjustment = struct
  82   external create :
  83       value:float -> lower:float -> upper:float ->
  84       step_incr:float -> page_incr:float -> page_size:float -> adjustment obj
  85       = "ml_gtk_adjustment_new_bc" "ml_gtk_adjustment_new"
  86   external set_value : [>`adjustment] obj -> float -> unit
  87       = "ml_gtk_adjustment_set_value"
  88   external clamp_page :
  89       [>`adjustment] obj -> lower:float -> upper:float -> unit
  90       = "ml_gtk_adjustment_clamp_page"
  91   external get_lower : [>`adjustment] obj -> float
  92       = "ml_gtk_adjustment_get_lower"
  93   external get_upper : [>`adjustment] obj -> float
  94       = "ml_gtk_adjustment_get_upper"
  95   external get_value : [>`adjustment] obj -> float
  96       = "ml_gtk_adjustment_get_value"
  97   external get_step_increment : [>`adjustment] obj -> float
  98       = "ml_gtk_adjustment_get_step_increment"
  99   external get_page_increment : [>`adjustment] obj -> float
 100       = "ml_gtk_adjustment_get_page_increment"
 101   external get_page_size : [>`adjustment] obj -> float
 102       = "ml_gtk_adjustment_get_page_size"
 103   module Signals = struct
 104     open GtkSignal
 105     let changed : ([>`adjustment],_) t =
 106       { name = "changed"; marshaller = marshal_unit }
 107     let value_changed : ([>`adjustment],_) t =
 108       { name = "value_changed"; marshaller = marshal_unit }
 109   end
 110 end
 111
 112 module Tooltips = struct
 113   external create : unit -> tooltips obj = "ml_gtk_tooltips_new"
 114   external enable : [>`tooltips] obj -> unit = "ml_gtk_tooltips_enable"
 115   external disable : [>`tooltips] obj -> unit = "ml_gtk_tooltips_disable"
 116   external set_delay : [>`tooltips] obj -> int -> unit
 117       = "ml_gtk_tooltips_set_delay"
 118   external set_tip :
 119       [>`tooltips] obj ->
 120       [>`widget] obj -> ?text:string -> ?privat:string -> unit
 121       = "ml_gtk_tooltips_set_tip"
 122   external set_colors :
 123       [>`tooltips] obj ->
 124       ?foreground:Gdk.Color.t -> ?background:Gdk.Color.t -> unit -> unit
 125       = "ml_gtk_tooltips_set_colors"
 126   let set ?delay ?foreground ?background tt =
 127     may ~f:(set_delay tt) delay;
 128     if foreground <> None || background <> None then
 129       set_colors tt ?foreground ?background ()
 130 end
 131
 132
 133 module Selection = struct
 134   type t
 135   external selection : t -> Gdk.atom
 136       = "ml_gtk_selection_data_selection"
 137   external target : t -> Gdk.atom
 138       = "ml_gtk_selection_data_target"
 139   external seltype : t -> Gdk.atom
 140       = "ml_gtk_selection_data_type"
 141   external format : t -> int
 142       = "ml_gtk_selection_data_format"
 143   external get_data : t -> string
 144       = "ml_gtk_selection_data_get_data"       (* May raise Gpointer.null *)
 145   external set :
 146       t -> typ:Gdk.atom -> format:int -> ?data:string -> unit
 147       = "ml_gtk_selection_data_set"
 148 end