update.
[chise/xemacs-chise.git.1] / 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 }