git.chise.org Git - chise/xemacs-chise.git-/blob - src/gtk-glue.c

   1 GtkType GTK_TYPE_ARRAY = 0;
   2 GtkType GTK_TYPE_STRING_ARRAY = 0;
   3 GtkType GTK_TYPE_FLOAT_ARRAY = 0;
   4 GtkType GTK_TYPE_INT_ARRAY = 0;
   5 GtkType GTK_TYPE_LISTOF = 0;
   6 GtkType GTK_TYPE_STRING_LIST = 0;
   7 GtkType GTK_TYPE_OBJECT_LIST = 0;
   8 GtkType GTK_TYPE_GDK_GC = 0;
   9
  10 static GtkType
  11 xemacs_type_register (gchar *name, GtkType parent)
  12 {
  13   GtkType type_id;
  14   GtkTypeInfo info;
  15
  16   info.type_name = name;
  17   info.object_size = 0;
  18   info.class_size = 0;
  19   info.class_init_func = NULL;
  20   info.object_init_func = NULL;
  21   info.reserved_1 = NULL;
  22   info.reserved_2 = NULL;
  23
  24   type_id = gtk_type_unique (parent, &info);
  25
  26   return (type_id);
  27 }
  28
  29 static void
  30 xemacs_init_gtk_classes (void)
  31 {
  32   if (!GTK_TYPE_ARRAY)
  33     {
  34       GTK_TYPE_ARRAY = xemacs_type_register ("GtkArrayOf", 0);
  35       GTK_TYPE_STRING_ARRAY = xemacs_type_register ("GtkArrayOfString", GTK_TYPE_ARRAY);
  36       GTK_TYPE_FLOAT_ARRAY = xemacs_type_register ("GtkArrayOfFloat", GTK_TYPE_ARRAY);
  37       GTK_TYPE_INT_ARRAY = xemacs_type_register ("GtkArrayOfInteger", GTK_TYPE_ARRAY);
  38       GTK_TYPE_LISTOF = xemacs_type_register ("GtkListOf", 0);
  39       GTK_TYPE_STRING_LIST = xemacs_type_register ("GtkListOfString", GTK_TYPE_LISTOF);
  40       GTK_TYPE_OBJECT_LIST = xemacs_type_register ("GtkListOfObject", GTK_TYPE_LISTOF);
  41       GTK_TYPE_GDK_GC = xemacs_type_register ("GdkGC", GTK_TYPE_BOXED);
  42   }
  43 }
  44
  45 static void
  46 xemacs_list_to_gtklist (Lisp_Object obj, GtkArg *arg)
  47 {
  48   CHECK_LIST (obj);
  49
  50   if (arg->type == GTK_TYPE_STRING_LIST)
  51     {
  52       Lisp_Object temp = obj;
  53       GList *strings = NULL;
  54
  55       while (!NILP (temp))
  56         {
  57           CHECK_STRING (XCAR (temp));
  58           temp = XCDR (temp);
  59         }
  60
  61       temp = obj;
  62
  63       while (!NILP (temp))
  64         {
  65           strings = g_list_append (strings, XSTRING_DATA (XCAR (temp)));
  66           temp = XCDR (temp);
  67         }
  68
  69       GTK_VALUE_POINTER(*arg) = strings;
  70     }
  71   else if (arg->type == GTK_TYPE_OBJECT_LIST)
  72     {
  73       Lisp_Object temp = obj;
  74       GList *objects = NULL;
  75
  76       while (!NILP (temp))
  77         {
  78           CHECK_GTK_OBJECT (XCAR (temp));
  79           temp = XCDR (temp);
  80         }
  81
  82       temp = obj;
  83
  84       while (!NILP (temp))
  85         {
  86           objects = g_list_append (objects, XGTK_OBJECT (XCAR (temp))->object);
  87           temp = XCDR (temp);
  88         }
  89
  90       GTK_VALUE_POINTER(*arg) = objects;
  91     }
  92   else
  93     {
  94       ABORT();
  95     }
  96 }
  97
  98 static void
  99 __make_gtk_object_mapper (gpointer data, gpointer user_data)
 100 {
 101   Lisp_Object *rv = (Lisp_Object *) user_data;
 102
 103   *rv = Fcons (build_gtk_object (GTK_OBJECT (data)), *rv);
 104 }
 105
 106 static void
 107 __make_string_mapper (gpointer data, gpointer user_data)
 108 {
 109   Lisp_Object *rv = (Lisp_Object *) user_data;
 110
 111   *rv = Fcons (build_string ((char *)data), *rv);
 112 }
 113
 114 static Lisp_Object
 115 xemacs_gtklist_to_list (GtkArg *arg)
 116 {
 117   Lisp_Object rval = Qnil;
 118
 119   if (GTK_VALUE_POINTER (*arg))
 120     {
 121       if (arg->type == GTK_TYPE_STRING_LIST)
 122         {
 123           g_list_foreach (GTK_VALUE_POINTER (*arg), __make_string_mapper, &rval);
 124         }
 125       else if (arg->type == GTK_TYPE_OBJECT_LIST)
 126         {
 127           g_list_foreach (GTK_VALUE_POINTER (*arg), __make_gtk_object_mapper, &rval);
 128         }
 129       else
 130         {
 131           ABORT();
 132         }
 133     }
 134   return (rval);
 135 }
 136
 137 static void
 138 xemacs_list_to_array (Lisp_Object obj, GtkArg *arg)
 139 {
 140   CHECK_LIST (obj);
 141
 142 #define FROB(ret_type,check_fn,extract_fn) \
 143   do {                                                          \
 144     Lisp_Object temp = obj;                                     \
 145     int length = 0;                                             \
 146     ret_type *array = NULL;                                     \
 147                                                                 \
 148     while (!NILP (temp))                                        \
 149       {                                                         \
 150         check_fn (XCAR (temp));                                 \
 151         length++;                                               \
 152         temp = XCDR (temp);                                     \
 153       }                                                         \
 154                                                                 \
 155     array = xnew_array_and_zero (ret_type, length + 2);         \
 156     temp = obj;                                                 \
 157     length = 0;                                                 \
 158                                                                 \
 159     while (!NILP (temp))                                        \
 160       {                                                         \
 161         array[length++] = extract_fn (XCAR (temp));             \
 162         temp = XCDR (temp);                                     \
 163       }                                                         \
 164                                                                 \
 165     GTK_VALUE_POINTER(*arg) = array;                            \
 166   } while (0);
 167
 168   if (arg->type == GTK_TYPE_STRING_ARRAY)
 169     {
 170       FROB(gchar *, CHECK_STRING, XSTRING_DATA);
 171     }
 172   else if (arg->type == GTK_TYPE_FLOAT_ARRAY)
 173     {
 174       FROB(gfloat, CHECK_FLOAT, extract_float);
 175     }
 176   else if (arg->type == GTK_TYPE_INT_ARRAY)
 177     {
 178       FROB(gint, CHECK_INT, XINT);
 179     }
 180   else
 181     {
 182       ABORT();
 183     }
 184 #undef FROB
 185 }
 186
 187 extern GdkGC *gtk_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, Lisp_Object bg,
 188                           Lisp_Object bg_pmap, Lisp_Object lwidth);
 189
 190 static GdkGC *
 191 face_to_gc (Lisp_Object face)
 192 {
 193   Lisp_Object device = Fselected_device (Qnil);
 194
 195   return (gtk_get_gc (XDEVICE (device),
 196                       Fspecifier_instance (Fget (face, Qfont, Qnil), device, Qnil, Qnil),
 197                       Fspecifier_instance (Fget (face, Qforeground, Qnil), device, Qnil, Qnil),
 198                       Fspecifier_instance (Fget (face, Qbackground, Qnil), device, Qnil, Qnil),
 199                       Fspecifier_instance (Fget (face, Qbackground_pixmap, Qnil), device, Qnil, Qnil),
 200                       Qnil));
 201 }
 202
 203 static GtkStyle *
 204 face_to_style (Lisp_Object face)
 205 {
 206   Lisp_Object device = Fselected_device (Qnil);
 207   GtkStyle *style = gtk_style_new ();
 208   int i;
 209
 210   Lisp_Object font = Fspecifier_instance (Fget (face, Qfont, Qnil), device, Qnil, Qnil);
 211   Lisp_Object fg = Fspecifier_instance (Fget (face, Qforeground, Qnil), device, Qnil, Qnil);
 212   Lisp_Object bg = Fspecifier_instance (Fget (face, Qbackground, Qnil), device, Qnil, Qnil);
 213   Lisp_Object pm = Fspecifier_instance (Fget (face, Qbackground_pixmap, Qnil), device, Qnil, Qnil);
 214
 215   for (i = 0; i < 5; i++) style->fg[i] = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (fg));
 216   for (i = 0; i < 5; i++) style->bg[i] = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (bg));
 217
 218   if (IMAGE_INSTANCEP (pm))
 219     {
 220       for (i = 0; i < 5; i++) style->bg_pixmap[i] = XIMAGE_INSTANCE_GTK_PIXMAP (pm);
 221     }
 222
 223   style->font = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font));
 224
 225   return (style);
 226 }
 227
 228 extern int gtk_event_to_emacs_event (struct frame *, GdkEvent *, struct Lisp_Event *);
 229
 230 static Lisp_Object
 231 gdk_event_to_emacs_event(GdkEvent *ev)
 232 {
 233   Lisp_Object emacs_event = Qnil;
 234
 235   if (ev)
 236     {
 237       emacs_event = Fmake_event (Qnil, Qnil);
 238       if (!gtk_event_to_emacs_event (NULL, ev, XEVENT (emacs_event)))
 239         {
 240           /* We need to handle a few more cases than the normal event
 241           ** loop does.  Mainly the double/triple click events.
 242           */
 243           if ((ev->type == GDK_2BUTTON_PRESS) || (ev->type == GDK_3BUTTON_PRESS))
 244             {
 245               struct Lisp_Event *le = XEVENT (emacs_event);
 246
 247               le->event_type = misc_user_event;
 248               le->event.misc.button = ev->button.button;
 249               le->event.misc.modifiers = 0;
 250               le->event.misc.x = ev->button.x;
 251               le->event.misc.y = ev->button.y;
 252               if (ev->type == GDK_2BUTTON_PRESS)
 253                 le->event.misc.function = intern ("double-click");
 254               else
 255                 le->event.misc.function = intern ("triple-click");
 256             }
 257           else
 258             {
 259               Fdeallocate_event (emacs_event);
 260               emacs_event = Qnil;
 261             }
 262         }
 263     }
 264   return (emacs_event);
 265 }