|
462
|
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
|
|
876
|
10 #include "objects-gtk-impl.h"
|
|
|
11
|
|
462
|
12 static GtkType
|
|
|
13 xemacs_type_register (gchar *name, GtkType parent)
|
|
|
14 {
|
|
|
15 GtkType type_id;
|
|
|
16 GtkTypeInfo info;
|
|
|
17
|
|
|
18 info.type_name = name;
|
|
|
19 info.object_size = 0;
|
|
|
20 info.class_size = 0;
|
|
|
21 info.class_init_func = NULL;
|
|
|
22 info.object_init_func = NULL;
|
|
|
23 info.reserved_1 = NULL;
|
|
|
24 info.reserved_2 = NULL;
|
|
|
25
|
|
|
26 type_id = gtk_type_unique (parent, &info);
|
|
|
27
|
|
|
28 return (type_id);
|
|
|
29 }
|
|
|
30
|
|
|
31 static void
|
|
|
32 xemacs_init_gtk_classes (void)
|
|
|
33 {
|
|
|
34 if (!GTK_TYPE_ARRAY)
|
|
|
35 {
|
|
|
36 GTK_TYPE_ARRAY = xemacs_type_register ("GtkArrayOf", 0);
|
|
|
37 GTK_TYPE_STRING_ARRAY = xemacs_type_register ("GtkArrayOfString", GTK_TYPE_ARRAY);
|
|
|
38 GTK_TYPE_FLOAT_ARRAY = xemacs_type_register ("GtkArrayOfFloat", GTK_TYPE_ARRAY);
|
|
|
39 GTK_TYPE_INT_ARRAY = xemacs_type_register ("GtkArrayOfInteger", GTK_TYPE_ARRAY);
|
|
|
40 GTK_TYPE_LISTOF = xemacs_type_register ("GtkListOf", 0);
|
|
|
41 GTK_TYPE_STRING_LIST = xemacs_type_register ("GtkListOfString", GTK_TYPE_LISTOF);
|
|
|
42 GTK_TYPE_OBJECT_LIST = xemacs_type_register ("GtkListOfObject", GTK_TYPE_LISTOF);
|
|
|
43 GTK_TYPE_GDK_GC = xemacs_type_register ("GdkGC", GTK_TYPE_BOXED);
|
|
|
44 }
|
|
|
45 }
|
|
|
46
|
|
|
47 static void
|
|
|
48 xemacs_list_to_gtklist (Lisp_Object obj, GtkArg *arg)
|
|
|
49 {
|
|
|
50 CHECK_LIST (obj);
|
|
|
51
|
|
|
52 if (arg->type == GTK_TYPE_STRING_LIST)
|
|
|
53 {
|
|
|
54 Lisp_Object temp = obj;
|
|
|
55 GList *strings = NULL;
|
|
|
56
|
|
|
57 while (!NILP (temp))
|
|
|
58 {
|
|
|
59 CHECK_STRING (XCAR (temp));
|
|
|
60 temp = XCDR (temp);
|
|
|
61 }
|
|
|
62
|
|
|
63 temp = obj;
|
|
|
64
|
|
|
65 while (!NILP (temp))
|
|
|
66 {
|
|
|
67 strings = g_list_append (strings, XSTRING_DATA (XCAR (temp)));
|
|
|
68 temp = XCDR (temp);
|
|
|
69 }
|
|
|
70
|
|
|
71 GTK_VALUE_POINTER(*arg) = strings;
|
|
|
72 }
|
|
|
73 else if (arg->type == GTK_TYPE_OBJECT_LIST)
|
|
|
74 {
|
|
|
75 Lisp_Object temp = obj;
|
|
|
76 GList *objects = NULL;
|
|
|
77
|
|
|
78 while (!NILP (temp))
|
|
|
79 {
|
|
|
80 CHECK_GTK_OBJECT (XCAR (temp));
|
|
|
81 temp = XCDR (temp);
|
|
|
82 }
|
|
|
83
|
|
|
84 temp = obj;
|
|
|
85
|
|
|
86 while (!NILP (temp))
|
|
|
87 {
|
|
|
88 objects = g_list_append (objects, XGTK_OBJECT (XCAR (temp))->object);
|
|
|
89 temp = XCDR (temp);
|
|
|
90 }
|
|
|
91
|
|
|
92 GTK_VALUE_POINTER(*arg) = objects;
|
|
|
93 }
|
|
|
94 else
|
|
|
95 {
|
|
|
96 abort();
|
|
|
97 }
|
|
|
98 }
|
|
|
99
|
|
|
100 static void
|
|
|
101 __make_gtk_object_mapper (gpointer data, gpointer user_data)
|
|
|
102 {
|
|
|
103 Lisp_Object *rv = (Lisp_Object *) user_data;
|
|
|
104
|
|
|
105 *rv = Fcons (build_gtk_object (GTK_OBJECT (data)), *rv);
|
|
|
106 }
|
|
|
107
|
|
|
108 static void
|
|
|
109 __make_string_mapper (gpointer data, gpointer user_data)
|
|
|
110 {
|
|
|
111 Lisp_Object *rv = (Lisp_Object *) user_data;
|
|
|
112
|
|
|
113 *rv = Fcons (build_string ((char *)data), *rv);
|
|
|
114 }
|
|
|
115
|
|
|
116 static Lisp_Object
|
|
|
117 xemacs_gtklist_to_list (GtkArg *arg)
|
|
|
118 {
|
|
|
119 Lisp_Object rval = Qnil;
|
|
|
120
|
|
|
121 if (GTK_VALUE_POINTER (*arg))
|
|
|
122 {
|
|
|
123 if (arg->type == GTK_TYPE_STRING_LIST)
|
|
|
124 {
|
|
|
125 g_list_foreach (GTK_VALUE_POINTER (*arg), __make_string_mapper, &rval);
|
|
|
126 }
|
|
|
127 else if (arg->type == GTK_TYPE_OBJECT_LIST)
|
|
|
128 {
|
|
|
129 g_list_foreach (GTK_VALUE_POINTER (*arg), __make_gtk_object_mapper, &rval);
|
|
|
130 }
|
|
|
131 else
|
|
|
132 {
|
|
|
133 abort();
|
|
|
134 }
|
|
|
135 }
|
|
|
136 return (rval);
|
|
|
137 }
|
|
|
138
|
|
|
139 static void
|
|
|
140 xemacs_list_to_array (Lisp_Object obj, GtkArg *arg)
|
|
|
141 {
|
|
|
142 CHECK_LIST (obj);
|
|
|
143
|
|
|
144 #define FROB(ret_type,check_fn,extract_fn) \
|
|
|
145 do { \
|
|
|
146 Lisp_Object temp = obj; \
|
|
|
147 int length = 0; \
|
|
|
148 ret_type *array = NULL; \
|
|
|
149 \
|
|
|
150 while (!NILP (temp)) \
|
|
|
151 { \
|
|
|
152 check_fn (XCAR (temp)); \
|
|
|
153 length++; \
|
|
|
154 temp = XCDR (temp); \
|
|
|
155 } \
|
|
|
156 \
|
|
|
157 array = xnew_array_and_zero (ret_type, length + 2); \
|
|
|
158 temp = obj; \
|
|
|
159 length = 0; \
|
|
|
160 \
|
|
|
161 while (!NILP (temp)) \
|
|
|
162 { \
|
|
|
163 array[length++] = extract_fn (XCAR (temp)); \
|
|
|
164 temp = XCDR (temp); \
|
|
|
165 } \
|
|
|
166 \
|
|
|
167 GTK_VALUE_POINTER(*arg) = array; \
|
|
|
168 } while (0);
|
|
|
169
|
|
|
170 if (arg->type == GTK_TYPE_STRING_ARRAY)
|
|
|
171 {
|
|
|
172 FROB(gchar *, CHECK_STRING, XSTRING_DATA);
|
|
|
173 }
|
|
|
174 else if (arg->type == GTK_TYPE_FLOAT_ARRAY)
|
|
|
175 {
|
|
|
176 FROB(gfloat, CHECK_FLOAT, extract_float);
|
|
|
177 }
|
|
|
178 else if (arg->type == GTK_TYPE_INT_ARRAY)
|
|
|
179 {
|
|
|
180 FROB(gint, CHECK_INT, XINT);
|
|
|
181 }
|
|
|
182 else
|
|
|
183 {
|
|
|
184 abort();
|
|
|
185 }
|
|
|
186 #undef FROB
|
|
|
187 }
|
|
|
188
|
|
|
189 extern GdkGC *gtk_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, Lisp_Object bg,
|
|
|
190 Lisp_Object bg_pmap, Lisp_Object lwidth);
|
|
|
191
|
|
|
192 static GdkGC *
|
|
|
193 face_to_gc (Lisp_Object face)
|
|
|
194 {
|
|
|
195 Lisp_Object device = Fselected_device (Qnil);
|
|
|
196
|
|
|
197 return (gtk_get_gc (XDEVICE (device),
|
|
|
198 Fspecifier_instance (Fget (face, Qfont, Qnil), device, Qnil, Qnil),
|
|
|
199 Fspecifier_instance (Fget (face, Qforeground, Qnil), device, Qnil, Qnil),
|
|
|
200 Fspecifier_instance (Fget (face, Qbackground, Qnil), device, Qnil, Qnil),
|
|
|
201 Fspecifier_instance (Fget (face, Qbackground_pixmap, Qnil), device, Qnil, Qnil),
|
|
|
202 Qnil));
|
|
|
203 }
|
|
|
204
|
|
|
205 static GtkStyle *
|
|
|
206 face_to_style (Lisp_Object face)
|
|
|
207 {
|
|
|
208 Lisp_Object device = Fselected_device (Qnil);
|
|
|
209 GtkStyle *style = gtk_style_new ();
|
|
|
210 int i;
|
|
|
211
|
|
|
212 Lisp_Object font = Fspecifier_instance (Fget (face, Qfont, Qnil), device, Qnil, Qnil);
|
|
|
213 Lisp_Object fg = Fspecifier_instance (Fget (face, Qforeground, Qnil), device, Qnil, Qnil);
|
|
|
214 Lisp_Object bg = Fspecifier_instance (Fget (face, Qbackground, Qnil), device, Qnil, Qnil);
|
|
|
215 Lisp_Object pm = Fspecifier_instance (Fget (face, Qbackground_pixmap, Qnil), device, Qnil, Qnil);
|
|
|
216
|
|
|
217 for (i = 0; i < 5; i++) style->fg[i] = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (fg));
|
|
|
218 for (i = 0; i < 5; i++) style->bg[i] = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (bg));
|
|
|
219
|
|
|
220 if (IMAGE_INSTANCEP (pm))
|
|
|
221 {
|
|
|
222 for (i = 0; i < 5; i++) style->bg_pixmap[i] = XIMAGE_INSTANCE_GTK_PIXMAP (pm);
|
|
|
223 }
|
|
|
224
|
|
|
225 style->font = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font));
|
|
|
226
|
|
|
227 return (style);
|
|
|
228 }
|
|
|
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 }
|
