helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gWindow.ml

   1 (* $Id$ *)
   2
   3 open Gaux
   4 open Gtk
   5 open GtkBase
   6 open GtkWindow
   7 open GtkMisc
   8 open GObj
   9 open GContainer
  10
  11 class ['a] window_skel obj = object
  12   constraint 'a = _ #window_skel
  13   inherit container obj
  14   method event = new GObj.event_ops obj
  15   method as_window = Window.coerce obj
  16   method activate_focus () = Window.activate_focus obj
  17   method activate_default () = Window.activate_default obj
  18   method add_accel_group = Window.add_accel_group obj
  19   method set_modal = Window.set_modal obj
  20   method set_default_size = Window.set_default_size obj
  21   method set_position = Window.set_position obj
  22   method set_resize_mode = Container.set_resize_mode obj
  23   method set_transient_for (w : 'a) =
  24     Window.set_transient_for obj w#as_window
  25   method set_title = Window.set_title obj
  26   method set_wm_name name = Window.set_wmclass obj ~name
  27   method set_wm_class cls = Window.set_wmclass obj ~clas:cls
  28   method set_allow_shrink allow_shrink = Window.set_policy obj ~allow_shrink
  29   method set_allow_grow allow_grow = Window.set_policy obj ~allow_grow
  30   method set_auto_shrink auto_shrink = Window.set_policy obj ~auto_shrink
  31   method show () = Widget.show obj
  32 end
  33
  34 class window obj = object
  35   inherit [window] window_skel (Window.coerce obj)
  36   method connect = new container_signals obj
  37 end
  38
  39 let window ?kind:(t=`TOPLEVEL) ?title ?wm_name ?wm_class ?position
  40     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y
  41     ?border_width ?width ?height ?(show=false) () =
  42   let w = Window.create t in
  43   Window.set w ?title ?wm_name ?wm_class ?position
  44     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y;
  45   Container.set w ?border_width ?width ?height;
  46   if show then Widget.show w;
  47   new window w
  48
  49 class dialog obj = object
  50   inherit [window] window_skel (Dialog.coerce obj)
  51   method connect = new container_signals obj
  52   method action_area = new GPack.box (Dialog.action_area obj)
  53   method vbox = new GPack.box (Dialog.vbox obj)
  54 end
  55
  56 let dialog ?title ?wm_name ?wm_class ?position ?allow_shrink
  57     ?allow_grow ?auto_shrink ?modal ?x ?y ?border_width ?width ?height
  58     ?(show=false) () =
  59   let w = Dialog.create () in
  60   Window.set w ?title ?wm_name ?wm_class ?position
  61     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y;
  62   Container.set w ?border_width ?width ?height;
  63   if show then Widget.show w;
  64   new dialog w
  65
  66 class color_selection_dialog obj = object
  67   inherit [window] window_skel (obj : Gtk.color_selection_dialog obj)
  68   method connect = new container_signals obj
  69   method ok_button =
  70     new GButton.button (ColorSelection.ok_button obj)
  71   method cancel_button =
  72     new GButton.button (ColorSelection.cancel_button obj)
  73   method help_button =
  74     new GButton.button (ColorSelection.help_button obj)
  75   method colorsel =
  76     new GMisc.color_selection (ColorSelection.colorsel obj)
  77 end
  78
  79 let color_selection_dialog ?(title="Pick a color")
  80     ?wm_name ?wm_class ?position
  81     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y
  82     ?border_width ?width ?height ?(show=false) () =
  83   let w = ColorSelection.create_dialog title in
  84   Window.set w ?wm_name ?wm_class ?position
  85     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y;
  86   Container.set w ?border_width ?width ?height;
  87   if show then Widget.show w;
  88   new color_selection_dialog w
  89
  90 class file_selection obj = object
  91   inherit [window] window_skel (obj : Gtk.file_selection obj)
  92   method connect = new container_signals obj
  93   method set_filename = FileSelection.set_filename obj
  94   method get_filename = FileSelection.get_filename obj
  95   method set_fileop_buttons = FileSelection.set_fileop_buttons obj
  96   method ok_button = new GButton.button (FileSelection.get_ok_button obj)
  97   method cancel_button =
  98     new GButton.button (FileSelection.get_cancel_button obj)
  99   method help_button = new GButton.button (FileSelection.get_help_button obj)
 100 end
 101
 102 let file_selection ?(title="Choose a file") ?filename
 103     ?(fileop_buttons=false)
 104     ?wm_name ?wm_class ?position
 105     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y
 106     ?border_width ?width ?height ?(show=false) () =
 107   let w = FileSelection.create title in
 108   FileSelection.set w ?filename ~fileop_buttons;
 109   Window.set w ?wm_name ?wm_class ?position
 110     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y;
 111   Container.set w ?border_width ?width ?height;
 112   if show then Widget.show w;
 113   new file_selection w
 114
 115 class font_selection_dialog obj = object
 116   inherit [window] window_skel (obj : Gtk.font_selection_dialog obj)
 117   method connect = new container_signals obj
 118 (*
 119   method font = FontSelectionDialog.get_font obj
 120   method font_name = FontSelectionDialog.get_font_name obj
 121   method set_font_name = FontSelectionDialog.set_font_name obj
 122   method preview_text = FontSelectionDialog.get_preview_text obj
 123   method set_preview_text = FontSelectionDialog.set_preview_text obj
 124   method set_filter = FontSelectionDialog.set_filter obj
 125 *)
 126   method selection =
 127     new GMisc.font_selection (FontSelectionDialog.font_selection obj)
 128   method ok_button =  new GButton.button (FontSelectionDialog.ok_button obj)
 129   method apply_button =
 130     new GButton.button (FontSelectionDialog.apply_button obj)
 131   method cancel_button =
 132     new GButton.button (FontSelectionDialog.cancel_button obj)
 133 end
 134
 135 let font_selection_dialog ?title ?wm_name ?wm_class ?position
 136     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y
 137     ?border_width ?width ?height ?(show=false) () =
 138   let w = FontSelectionDialog.create ?title () in
 139   Window.set w ?wm_name ?wm_class ?position
 140     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y;
 141   Container.set w ?border_width ?width ?height;
 142   if show then Widget.show w;
 143   new font_selection_dialog w
 144
 145 class plug (obj : Gtk.plug obj) = window obj
 146
 147 let plug ~window:xid ?border_width ?width ?height ?(show=false) () =
 148   let w = Plug.create xid in
 149   Container.set w ?border_width ?width ?height;
 150   if show then Widget.show w;
 151   new plug w