Mercurial > hg > xemacs-beta

comparison src/gtk-glue.c @ 462:0784d089fdc9 r21-2-46

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-46
author cvs
date Mon, 13 Aug 2007 11:44:37 +0200
parents
children 2923009caf47
comparison
equal deleted inserted replaced
461:120ed4009e51 462:0784d089fdc9
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 }