helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtknew.c

   1 /* $Id$ */
   2
   3 #include <gtk/gtk.h>
   4 #include <caml/mlvalues.h>
   5 #include <caml/alloc.h>
   6 #include <caml/memory.h>
   7 #include <caml/callback.h>
   8 #include <caml/fail.h>
   9
  10 #include "wrappers.h"
  11 #include "ml_glib.h"
  12 #include "ml_gdk.h"
  13 #include "ml_gtk.h"
  14
  15 static value ml_class_init=0;
  16
  17 static void class_init (value class)
  18 {
  19   callback(ml_class_init, class);
  20 }
  21
  22
  23 value set_ml_class_init (value class_func)
  24 {
  25   if (!ml_class_init) register_global_root (&ml_class_init);
  26   ml_class_init = class_func;
  27   return Val_unit;
  28 }
  29
  30 value ml_gtk_type_new (value type)
  31 {
  32   return Val_GtkWidget_sink(gtk_type_new(Int_val(type)));
  33 }
  34
  35
  36 struct widget_info {
  37   guint size;
  38   guint class_size;
  39   guint (*get_type_func)(void);
  40 }
  41 widget_info_array[] = {
  42   { sizeof(GtkObject), sizeof(GtkObjectClass), gtk_object_get_type },
  43   { sizeof(GtkWidget), sizeof(GtkWidgetClass), gtk_widget_get_type },
  44   { sizeof(GtkMisc), sizeof(GtkMiscClass), gtk_misc_get_type },
  45   { sizeof(GtkLabel), sizeof(GtkLabelClass), gtk_label_get_type },
  46   { sizeof(GtkAccelLabel), sizeof(GtkAccelLabelClass), gtk_accel_label_get_type },
  47   { sizeof(GtkTipsQuery), sizeof(GtkTipsQueryClass), gtk_tips_query_get_type },
  48   { sizeof(GtkArrow), sizeof(GtkArrowClass), gtk_arrow_get_type },
  49   { sizeof(GtkImage), sizeof(GtkImageClass), gtk_image_get_type },
  50   { sizeof(GtkPixmap), sizeof(GtkPixmapClass), gtk_pixmap_get_type },
  51   { sizeof(GtkContainer), sizeof(GtkContainerClass), gtk_container_get_type },
  52   { sizeof(GtkBin), sizeof(GtkBinClass), gtk_bin_get_type },
  53   { sizeof(GtkAlignment), sizeof(GtkAlignmentClass), gtk_alignment_get_type },
  54   { sizeof(GtkFrame), sizeof(GtkFrameClass), gtk_frame_get_type },
  55   { sizeof(GtkAspectFrame), sizeof(GtkAspectFrameClass), gtk_aspect_frame_get_type },
  56   { sizeof(GtkButton), sizeof(GtkButtonClass), gtk_button_get_type },
  57   { sizeof(GtkToggleButton), sizeof(GtkToggleButtonClass), gtk_toggle_button_get_type },
  58   { sizeof(GtkCheckButton), sizeof(GtkCheckButtonClass), gtk_check_button_get_type },
  59   { sizeof(GtkRadioButton), sizeof(GtkRadioButtonClass), gtk_radio_button_get_type },
  60   { sizeof(GtkOptionMenu), sizeof(GtkOptionMenuClass), gtk_option_menu_get_type },
  61   { sizeof(GtkItem), sizeof(GtkItemClass), gtk_item_get_type },
  62   { sizeof(GtkMenuItem), sizeof(GtkMenuItemClass), gtk_menu_item_get_type },
  63   { sizeof(GtkCheckMenuItem), sizeof(GtkCheckMenuItemClass), gtk_check_menu_item_get_type },
  64   { sizeof(GtkRadioMenuItem), sizeof(GtkRadioMenuItemClass), gtk_radio_menu_item_get_type },
  65   { sizeof(GtkTearoffMenuItem), sizeof(GtkTearoffMenuItemClass), gtk_tearoff_menu_item_get_type },
  66   { sizeof(GtkListItem), sizeof(GtkListItemClass), gtk_list_item_get_type },
  67   { sizeof(GtkTreeItem), sizeof(GtkTreeItemClass), gtk_tree_item_get_type },
  68   { sizeof(GtkWindow), sizeof(GtkWindowClass), gtk_window_get_type },
  69   { sizeof(GtkColorSelectionDialog), sizeof(GtkColorSelectionDialogClass), gtk_color_selection_dialog_get_type },
  70   { sizeof(GtkDialog), sizeof(GtkDialogClass), gtk_dialog_get_type },
  71   { sizeof(GtkInputDialog), sizeof(GtkInputDialogClass), gtk_input_dialog_get_type },
  72   { sizeof(GtkFileSelection), sizeof(GtkFileSelectionClass), gtk_file_selection_get_type },
  73   { sizeof(GtkFontSelectionDialog), sizeof(GtkFontSelectionDialogClass), gtk_font_selection_dialog_get_type },
  74   { sizeof(GtkPlug), sizeof(GtkPlugClass), gtk_plug_get_type },
  75   { sizeof(GtkEventBox), sizeof(GtkEventBoxClass), gtk_event_box_get_type },
  76   { sizeof(GtkHandleBox), sizeof(GtkHandleBoxClass), gtk_handle_box_get_type },
  77   { sizeof(GtkScrolledWindow), sizeof(GtkScrolledWindowClass), gtk_scrolled_window_get_type },
  78   { sizeof(GtkViewport), sizeof(GtkViewportClass), gtk_viewport_get_type },
  79   { sizeof(GtkBox), sizeof(GtkBoxClass), gtk_box_get_type },
  80   { sizeof(GtkButtonBox), sizeof(GtkButtonBoxClass), gtk_button_box_get_type },
  81   { sizeof(GtkHButtonBox), sizeof(GtkHButtonBoxClass), gtk_hbutton_box_get_type },
  82   { sizeof(GtkVButtonBox), sizeof(GtkVButtonBoxClass), gtk_vbutton_box_get_type },
  83   { sizeof(GtkVBox), sizeof(GtkVBoxClass), gtk_vbox_get_type },
  84   { sizeof(GtkColorSelection), sizeof(GtkColorSelectionClass), gtk_color_selection_get_type },
  85   { sizeof(GtkGammaCurve), sizeof(GtkGammaCurveClass), gtk_gamma_curve_get_type },
  86   { sizeof(GtkHBox), sizeof(GtkHBoxClass), gtk_hbox_get_type },
  87   { sizeof(GtkCombo), sizeof(GtkComboClass), gtk_combo_get_type },
  88   { sizeof(GtkStatusbar), sizeof(GtkStatusbarClass), gtk_statusbar_get_type },
  89   { sizeof(GtkCList), sizeof(GtkCListClass), gtk_clist_get_type },
  90   { sizeof(GtkCTree), sizeof(GtkCTreeClass), gtk_ctree_get_type },
  91   { sizeof(GtkFixed), sizeof(GtkFixedClass), gtk_fixed_get_type },
  92   { sizeof(GtkNotebook), sizeof(GtkNotebookClass), gtk_notebook_get_type },
  93   { sizeof(GtkFontSelection), sizeof(GtkFontSelectionClass), gtk_font_selection_get_type },
  94   { sizeof(GtkPaned), sizeof(GtkPanedClass), gtk_paned_get_type },
  95   { sizeof(GtkHPaned), sizeof(GtkHPanedClass), gtk_hpaned_get_type },
  96   { sizeof(GtkVPaned), sizeof(GtkVPanedClass), gtk_vpaned_get_type },
  97   { sizeof(GtkLayout), sizeof(GtkLayoutClass), gtk_layout_get_type },
  98   { sizeof(GtkList), sizeof(GtkListClass), gtk_list_get_type },
  99   { sizeof(GtkMenuShell), sizeof(GtkMenuShellClass), gtk_menu_shell_get_type },
 100   { sizeof(GtkMenuBar), sizeof(GtkMenuBarClass), gtk_menu_bar_get_type },
 101   { sizeof(GtkMenu), sizeof(GtkMenuClass), gtk_menu_get_type },
 102   { sizeof(GtkPacker), sizeof(GtkPackerClass), gtk_packer_get_type },
 103   { sizeof(GtkSocket), sizeof(GtkSocketClass), gtk_socket_get_type },
 104   { sizeof(GtkTable), sizeof(GtkTableClass), gtk_table_get_type },
 105   { sizeof(GtkToolbar), sizeof(GtkToolbarClass), gtk_toolbar_get_type },
 106   { sizeof(GtkTree), sizeof(GtkTreeClass), gtk_tree_get_type },
 107   { sizeof(GtkCalendar), sizeof(GtkCalendarClass), gtk_calendar_get_type },
 108   { sizeof(GtkDrawingArea), sizeof(GtkDrawingAreaClass), gtk_drawing_area_get_type },
 109   { sizeof(GtkCurve), sizeof(GtkCurveClass), gtk_curve_get_type },
 110   { sizeof(GtkEditable), sizeof(GtkEditableClass), gtk_editable_get_type },
 111   { sizeof(GtkEntry), sizeof(GtkEntryClass), gtk_entry_get_type },
 112   { sizeof(GtkSpinButton), sizeof(GtkSpinButtonClass), gtk_spin_button_get_type },
 113   { sizeof(GtkText), sizeof(GtkTextClass), gtk_text_get_type },
 114   { sizeof(GtkRuler), sizeof(GtkRulerClass), gtk_ruler_get_type },
 115   { sizeof(GtkHRuler), sizeof(GtkHRulerClass), gtk_hruler_get_type },
 116   { sizeof(GtkVRuler), sizeof(GtkVRulerClass), gtk_vruler_get_type },
 117   { sizeof(GtkRange), sizeof(GtkRangeClass), gtk_range_get_type },
 118   { sizeof(GtkScale), sizeof(GtkScaleClass), gtk_scale_get_type },
 119   { sizeof(GtkHScale), sizeof(GtkHScaleClass), gtk_hscale_get_type },
 120   { sizeof(GtkVScale), sizeof(GtkVScaleClass), gtk_vscale_get_type },
 121   { sizeof(GtkScrollbar), sizeof(GtkScrollbarClass), gtk_scrollbar_get_type },
 122   { sizeof(GtkHScrollbar), sizeof(GtkHScrollbarClass), gtk_hscrollbar_get_type },
 123   { sizeof(GtkVScrollbar), sizeof(GtkVScrollbarClass), gtk_vscrollbar_get_type },
 124   { sizeof(GtkSeparator), sizeof(GtkSeparatorClass), gtk_separator_get_type },
 125   { sizeof(GtkHSeparator), sizeof(GtkHSeparatorClass), gtk_hseparator_get_type },
 126   { sizeof(GtkVSeparator), sizeof(GtkVSeparatorClass), gtk_vseparator_get_type },
 127   { sizeof(GtkPreview), sizeof(GtkPreviewClass), gtk_preview_get_type },
 128   { sizeof(GtkProgress), sizeof(GtkProgressClass), gtk_progress_get_type },
 129   { sizeof(GtkProgressBar), sizeof(GtkProgressBarClass), gtk_progress_bar_get_type },
 130   { sizeof(GtkData), sizeof(GtkDataClass), gtk_data_get_type },
 131   { sizeof(GtkAdjustment), sizeof(GtkAdjustmentClass), gtk_adjustment_get_type },
 132   { sizeof(GtkTooltips), sizeof(GtkTooltipsClass), gtk_tooltips_get_type },
 133   { sizeof(GtkItemFactory), sizeof(GtkItemFactoryClass), gtk_item_factory_get_type }
 134 };
 135
 136
 137 value ml_gtk_type_unique (value name, value parent, value nsignals)
 138 {
 139   struct widget_info * wi;
 140   GtkTypeInfo ttt_info;
 141
 142   wi = widget_info_array + Int_val(parent);
 143   ttt_info.type_name = String_val(name);
 144   ttt_info.object_size = wi->size;
 145   ttt_info.class_size = wi->class_size + Int_val(nsignals)*sizeof(void *);
 146   ttt_info.class_init_func = (GtkClassInitFunc) class_init;
 147   ttt_info.object_init_func = (GtkObjectInitFunc) NULL;
 148   ttt_info.reserved_1 = NULL;
 149   ttt_info.reserved_2 = NULL;
 150   ttt_info.base_class_init_func = (GtkClassInitFunc) NULL;
 151
 152   return Val_int(gtk_type_unique(wi->get_type_func (), &ttt_info));
 153 }
 154
 155 static guint sig[100];
 156
 157 value ml_gtk_object_class_add_signals (value class, value signals,
 158                                        value nsignals)
 159 {
 160   int i;
 161   for (i=0; i<nsignals; i++)
 162     sig[i] = Int_val(Field(signals, i));
 163   gtk_object_class_add_signals ((GtkObjectClass *)class,
 164                sig, Int_val(nsignals));
 165   return Val_unit;
 166 }
 167
 168 value ml_gtk_signal_new (value name, value run_type, value classe,
 169                          value parent, value num)
 170 {
 171   struct widget_info * wi;
 172   int offset;
 173
 174   wi = widget_info_array + Int_val(parent);
 175   offset = wi->class_size+Int_val(num)*sizeof(void *);
 176   return Val_int(gtk_signal_new (String_val(name), Int_val(run_type),
 177                    ((GtkObjectClass *)classe)->type, offset,
 178                    gtk_signal_default_marshaller, GTK_TYPE_NONE, 0));
 179   *(((int *)classe)+offset) = 0;
 180 }