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

   1 (* $Id$ *)
   2
   3 open Gaux
   4 open Gtk
   5 open Tags
   6 open GtkBase
   7
   8 module Window = struct
   9   let cast w : window obj = Object.try_cast w "GtkWindow"
  10   external coerce : [>`window] obj -> window obj = "%identity"
  11   external create : window_type -> window obj = "ml_gtk_window_new"
  12   external set_title : [>`window] obj -> string -> unit
  13       = "ml_gtk_window_set_title"
  14   external set_wmclass : [>`window] obj -> name:string -> clas:string -> unit
  15       = "ml_gtk_window_set_title"
  16   external get_wmclass_name : [>`window] obj -> string
  17       = "ml_gtk_window_get_wmclass_name"
  18   external get_wmclass_class : [>`window] obj -> string
  19       = "ml_gtk_window_get_wmclass_class"
  20   (* set_focus/default are called by Widget.grab_focus/default *)
  21   external set_focus : [>`window] obj -> [>`widget] obj -> unit
  22       = "ml_gtk_window_set_focus"
  23   external set_default : [>`window] obj -> [>`widget] obj -> unit
  24       = "ml_gtk_window_set_default"
  25   external set_policy :
  26       [>`window] obj ->
  27       allow_shrink:bool -> allow_grow:bool -> auto_shrink:bool -> unit
  28       = "ml_gtk_window_set_policy"
  29   external get_allow_shrink : [>`window] obj -> bool
  30       = "ml_gtk_window_get_allow_shrink"
  31   external get_allow_grow : [>`window] obj -> bool
  32       = "ml_gtk_window_get_allow_grow"
  33   external get_auto_shrink : [>`window] obj -> bool
  34       = "ml_gtk_window_get_auto_shrink"
  35   external activate_focus : [>`window] obj -> bool
  36       = "ml_gtk_window_activate_focus"
  37   external activate_default : [>`window] obj -> bool
  38       = "ml_gtk_window_activate_default"
  39   external set_modal : [>`window] obj -> bool -> unit
  40       = "ml_gtk_window_set_modal"
  41   external set_default_size :
  42       [>`window] obj -> width:int -> height:int -> unit
  43       = "ml_gtk_window_set_default_size"
  44   external set_position : [>`window] obj -> window_position -> unit
  45       = "ml_gtk_window_set_position"
  46   external set_transient_for : [>`window] obj ->[>`window] obj -> unit
  47       = "ml_gtk_window_set_transient_for"
  48
  49   let set_wmclass ?name ?clas:wm_class w =
  50     set_wmclass w ~name:(may_default get_wmclass_name w ~opt:name)
  51       ~clas:(may_default get_wmclass_class w ~opt:wm_class)
  52   let set_policy ?allow_shrink ?allow_grow ?auto_shrink w =
  53     set_policy w
  54       ~allow_shrink:(may_default get_allow_shrink w ~opt:allow_shrink)
  55       ~allow_grow:(may_default get_allow_grow w ~opt:allow_grow)
  56       ~auto_shrink:(may_default get_auto_shrink w ~opt:auto_shrink)
  57   let set ?title ?wm_name ?wm_class ?position ?allow_shrink ?allow_grow
  58       ?auto_shrink ?modal ?(x = -2) ?(y = -2) w =
  59     may title ~f:(set_title w);
  60     if wm_name <> None || wm_class <> None then
  61       set_wmclass w ?name:wm_name ?clas:wm_class;
  62     may position ~f:(set_position w);
  63     if allow_shrink <> None || allow_grow <> None || auto_shrink <> None then
  64       set_policy w ?allow_shrink ?allow_grow ?auto_shrink;
  65     may ~f:(set_modal w) modal;
  66     if x <> -2 || y <> -2 then Widget.set_uposition w ~x ~y
  67   external add_accel_group : [>`window] obj -> accel_group -> unit
  68       = "ml_gtk_window_add_accel_group"
  69   external remove_accel_group :
  70       [>`window] obj -> accel_group -> unit
  71       = "ml_gtk_window_remove_accel_group"
  72   external activate_focus : [>`window] obj -> unit
  73       = "ml_gtk_window_activate_focus"
  74   external activate_default : [>`window] obj -> unit
  75       = "ml_gtk_window_activate_default"
  76   module Signals = struct
  77     open GtkSignal
  78     let move_resize : ([>`window],_) t =
  79       { name = "move_resize"; marshaller = marshal_unit }
  80     let set_focus : ([>`window],_) t =
  81       { name = "set_focus"; marshaller = Widget.Signals.marshal_opt }
  82   end
  83 end
  84
  85 module Dialog = struct
  86   let cast w : dialog obj = Object.try_cast w "GtkDialog"
  87   external coerce : [>`dialog] obj -> dialog obj = "%identity"
  88   external create : unit -> dialog obj = "ml_gtk_dialog_new"
  89   external action_area : [>`dialog] obj -> box obj
  90       = "ml_GtkDialog_action_area"
  91   external vbox : [>`dialog] obj -> box obj
  92       = "ml_GtkDialog_vbox"
  93 end
  94
  95 module InputDialog = struct
  96   let cast w : input_dialog obj = Object.try_cast w "GtkInputDialog"
  97   external create : unit -> input_dialog obj = "ml_gtk_input_dialog_new"
  98   module Signals = struct
  99     open GtkSignal
 100     let enable_device : ([>`inputdialog],_) t =
 101       { name = "enable_device"; marshaller = marshal_int }
 102     let disable_device : ([>`inputdialog],_) t =
 103       { name = "disable_device"; marshaller = marshal_int }
 104   end
 105 end
 106
 107 module FileSelection = struct
 108   let cast w : file_selection obj = Object.try_cast w "GtkFileSelection"
 109   external create : string -> file_selection obj = "ml_gtk_file_selection_new"
 110   external set_filename : [>`filesel] obj -> string -> unit
 111       = "ml_gtk_file_selection_set_filename"
 112   external get_filename : [>`filesel] obj -> string
 113       = "ml_gtk_file_selection_get_filename"
 114   external show_fileop_buttons : [>`filesel] obj -> unit
 115       = "ml_gtk_file_selection_show_fileop_buttons"
 116   external hide_fileop_buttons : [>`filesel] obj -> unit
 117       = "ml_gtk_file_selection_hide_fileop_buttons"
 118   external get_ok_button : [>`filesel] obj -> button obj
 119       = "ml_gtk_file_selection_get_ok_button"
 120   external get_cancel_button : [>`filesel] obj -> button obj
 121       = "ml_gtk_file_selection_get_cancel_button"
 122   external get_help_button : [>`filesel] obj -> button obj
 123       = "ml_gtk_file_selection_get_help_button"
 124   let set_fileop_buttons w = function
 125       true -> show_fileop_buttons w
 126     | false -> hide_fileop_buttons w
 127   let set ?filename ?fileop_buttons w =
 128     may filename ~f:(set_filename w);
 129     may fileop_buttons ~f:(set_fileop_buttons w)
 130 end
 131
 132 module FontSelectionDialog = struct
 133   let cast w : font_selection_dialog obj =
 134     Object.try_cast w "GtkFontSelectionDialog"
 135   external create : ?title:string -> unit -> font_selection_dialog obj
 136       = "ml_gtk_font_selection_dialog_new"
 137   external font_selection : [>`fontseldialog] obj -> font_selection obj
 138       = "ml_gtk_font_selection_dialog_fontsel"
 139   external ok_button : [>`fontseldialog] obj -> button obj
 140       = "ml_gtk_font_selection_dialog_ok_button"
 141   external apply_button : [>`fontseldialog] obj -> button obj
 142       = "ml_gtk_font_selection_dialog_apply_button"
 143   external cancel_button : [>`fontseldialog] obj -> button obj
 144       = "ml_gtk_font_selection_dialog_cancel_button"
 145 (*
 146   type null_terminated
 147   let null_terminated arg : null_terminated =
 148     match arg with None -> Obj.magic Gpointer.raw_null
 149     | Some l ->
 150         let len = List.length l in
 151         let arr = Array.create (len + 1) "" in
 152         let rec loop i = function
 153             [] -> arr.(i) <- Obj.magic Gpointer.raw_null
 154           | s::l -> arr.(i) <- s; loop (i+1) l
 155         in loop 0 l;
 156         Obj.magic (arr : string array)
 157   external get_font : [>`fontseldialog] obj -> Gdk.font
 158       = "ml_gtk_font_selection_dialog_get_font"
 159   let get_font w =
 160     try Some (get_font w) with Gpointer.Null -> None
 161   external get_font_name : [>`fontseldialog] obj -> string
 162       = "ml_gtk_font_selection_dialog_get_font_name"
 163   let get_font_name w =
 164     try Some (get_font_name w) with Gpointer.Null -> None
 165   external set_font_name : [>`fontseldialog] obj -> string -> unit
 166       = "ml_gtk_font_selection_dialog_set_font_name"
 167   external set_filter :
 168     [>`fontseldialog] obj -> font_filter_type -> font_type list ->
 169     null_terminated -> null_terminated -> null_terminated ->
 170     null_terminated -> null_terminated -> null_terminated -> unit
 171     = "ml_gtk_font_selection_dialog_set_filter_bc"
 172       "ml_gtk_font_selection_dialog_set_filter"
 173   let set_filter w ?kind:(tl=[`ALL]) ?foundry
 174       ?weight ?slant ?setwidth ?spacing ?charset filter =
 175     set_filter w filter tl (null_terminated foundry)
 176       (null_terminated weight) (null_terminated slant)
 177       (null_terminated setwidth) (null_terminated spacing)
 178       (null_terminated charset)
 179   external get_preview_text : [>`fontseldialog] obj -> string
 180       = "ml_gtk_font_selection_dialog_get_preview_text"
 181   external set_preview_text : [>`fontseldialog] obj -> string -> unit
 182       = "ml_gtk_font_selection_dialog_set_preview_text"
 183 *)
 184 end
 185
 186 module Plug = struct
 187   let cast w : plug obj = Object.try_cast w "GtkPlug"
 188   external create : Gdk.xid -> plug obj = "ml_gtk_plug_new"
 189 end