|
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
|
|
|
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 }
|
