Mercurial > hg > xemacs-beta
annotate src/gtk-glue.c @ 4709:db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
are missing. This is done with Bill Perry's stated permission, in private
email to me.
author | Jerry James <james@xemacs.org> |
---|---|
date | Mon, 05 Oct 2009 11:08:59 -0600 |
parents | 3d8143fc88e1 |
children | b3ce27ca7647 304aebb79cd3 |
rev | line source |
---|---|
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
1 /* |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
2 This file is part of XEmacs. |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
3 |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
4 XEmacs is free software; you can redistribute it and/or modify it |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
5 under the terms of the GNU General Public License as published by the |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
6 Free Software Foundation; either version 2, or (at your option) any |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
7 later version. |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
8 |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
9 XEmacs is distributed in the hope that it will be useful, but WITHOUT |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
10 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
11 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
12 for more details. |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
13 |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
14 You should have received a copy of the GNU General Public License |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
15 along with XEmacs; see the file COPYING. If not, write to |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
16 the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
17 Boston, MA 02111-1301, USA. */ |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
18 |
462 | 19 GtkType GTK_TYPE_ARRAY = 0; |
20 GtkType GTK_TYPE_STRING_ARRAY = 0; | |
21 GtkType GTK_TYPE_FLOAT_ARRAY = 0; | |
22 GtkType GTK_TYPE_INT_ARRAY = 0; | |
23 GtkType GTK_TYPE_LISTOF = 0; | |
24 GtkType GTK_TYPE_STRING_LIST = 0; | |
25 GtkType GTK_TYPE_OBJECT_LIST = 0; | |
26 GtkType GTK_TYPE_GDK_GC = 0; | |
27 | |
876 | 28 #include "objects-gtk-impl.h" |
29 | |
462 | 30 static GtkType |
31 xemacs_type_register (gchar *name, GtkType parent) | |
32 { | |
33 GtkType type_id; | |
34 GtkTypeInfo info; | |
35 | |
36 info.type_name = name; | |
37 info.object_size = 0; | |
38 info.class_size = 0; | |
39 info.class_init_func = NULL; | |
40 info.object_init_func = NULL; | |
41 info.reserved_1 = NULL; | |
42 info.reserved_2 = NULL; | |
43 | |
44 type_id = gtk_type_unique (parent, &info); | |
45 | |
46 return (type_id); | |
47 } | |
48 | |
49 static void | |
50 xemacs_init_gtk_classes (void) | |
51 { | |
52 if (!GTK_TYPE_ARRAY) | |
53 { | |
54 GTK_TYPE_ARRAY = xemacs_type_register ("GtkArrayOf", 0); | |
55 GTK_TYPE_STRING_ARRAY = xemacs_type_register ("GtkArrayOfString", GTK_TYPE_ARRAY); | |
56 GTK_TYPE_FLOAT_ARRAY = xemacs_type_register ("GtkArrayOfFloat", GTK_TYPE_ARRAY); | |
57 GTK_TYPE_INT_ARRAY = xemacs_type_register ("GtkArrayOfInteger", GTK_TYPE_ARRAY); | |
58 GTK_TYPE_LISTOF = xemacs_type_register ("GtkListOf", 0); | |
59 GTK_TYPE_STRING_LIST = xemacs_type_register ("GtkListOfString", GTK_TYPE_LISTOF); | |
60 GTK_TYPE_OBJECT_LIST = xemacs_type_register ("GtkListOfObject", GTK_TYPE_LISTOF); | |
61 GTK_TYPE_GDK_GC = xemacs_type_register ("GdkGC", GTK_TYPE_BOXED); | |
62 } | |
63 } | |
64 | |
65 static void | |
66 xemacs_list_to_gtklist (Lisp_Object obj, GtkArg *arg) | |
67 { | |
68 CHECK_LIST (obj); | |
69 | |
70 if (arg->type == GTK_TYPE_STRING_LIST) | |
71 { | |
72 Lisp_Object temp = obj; | |
73 GList *strings = NULL; | |
74 | |
75 while (!NILP (temp)) | |
76 { | |
77 CHECK_STRING (XCAR (temp)); | |
78 temp = XCDR (temp); | |
79 } | |
80 | |
81 temp = obj; | |
82 | |
83 while (!NILP (temp)) | |
84 { | |
85 strings = g_list_append (strings, XSTRING_DATA (XCAR (temp))); | |
86 temp = XCDR (temp); | |
87 } | |
88 | |
89 GTK_VALUE_POINTER(*arg) = strings; | |
90 } | |
91 else if (arg->type == GTK_TYPE_OBJECT_LIST) | |
92 { | |
93 Lisp_Object temp = obj; | |
94 GList *objects = NULL; | |
95 | |
96 while (!NILP (temp)) | |
97 { | |
98 CHECK_GTK_OBJECT (XCAR (temp)); | |
99 temp = XCDR (temp); | |
100 } | |
101 | |
102 temp = obj; | |
103 | |
104 while (!NILP (temp)) | |
105 { | |
106 objects = g_list_append (objects, XGTK_OBJECT (XCAR (temp))->object); | |
107 temp = XCDR (temp); | |
108 } | |
109 | |
110 GTK_VALUE_POINTER(*arg) = objects; | |
111 } | |
112 else | |
113 { | |
2500 | 114 ABORT(); |
462 | 115 } |
116 } | |
117 | |
118 static void | |
119 __make_gtk_object_mapper (gpointer data, gpointer user_data) | |
120 { | |
121 Lisp_Object *rv = (Lisp_Object *) user_data; | |
122 | |
123 *rv = Fcons (build_gtk_object (GTK_OBJECT (data)), *rv); | |
124 } | |
125 | |
126 static void | |
127 __make_string_mapper (gpointer data, gpointer user_data) | |
128 { | |
129 Lisp_Object *rv = (Lisp_Object *) user_data; | |
130 | |
131 *rv = Fcons (build_string ((char *)data), *rv); | |
132 } | |
133 | |
134 static Lisp_Object | |
135 xemacs_gtklist_to_list (GtkArg *arg) | |
136 { | |
137 Lisp_Object rval = Qnil; | |
138 | |
139 if (GTK_VALUE_POINTER (*arg)) | |
140 { | |
141 if (arg->type == GTK_TYPE_STRING_LIST) | |
142 { | |
2054 | 143 g_list_foreach ((GList*) GTK_VALUE_POINTER (*arg), __make_string_mapper, &rval); |
462 | 144 } |
145 else if (arg->type == GTK_TYPE_OBJECT_LIST) | |
146 { | |
2054 | 147 g_list_foreach ((GList*) GTK_VALUE_POINTER (*arg), __make_gtk_object_mapper, &rval); |
462 | 148 } |
149 else | |
150 { | |
2500 | 151 ABORT(); |
462 | 152 } |
153 } | |
154 return (rval); | |
155 } | |
156 | |
157 static void | |
158 xemacs_list_to_array (Lisp_Object obj, GtkArg *arg) | |
159 { | |
160 CHECK_LIST (obj); | |
161 | |
162 #define FROB(ret_type,check_fn,extract_fn) \ | |
163 do { \ | |
164 Lisp_Object temp = obj; \ | |
165 int length = 0; \ | |
166 ret_type *array = NULL; \ | |
167 \ | |
168 while (!NILP (temp)) \ | |
169 { \ | |
170 check_fn (XCAR (temp)); \ | |
171 length++; \ | |
172 temp = XCDR (temp); \ | |
173 } \ | |
174 \ | |
175 array = xnew_array_and_zero (ret_type, length + 2); \ | |
176 temp = obj; \ | |
177 length = 0; \ | |
178 \ | |
179 while (!NILP (temp)) \ | |
180 { \ | |
181 array[length++] = extract_fn (XCAR (temp)); \ | |
182 temp = XCDR (temp); \ | |
183 } \ | |
184 \ | |
185 GTK_VALUE_POINTER(*arg) = array; \ | |
186 } while (0); | |
187 | |
188 if (arg->type == GTK_TYPE_STRING_ARRAY) | |
189 { | |
2054 | 190 FROB(gchar *, CHECK_STRING, (gchar*) XSTRING_DATA); |
462 | 191 } |
192 else if (arg->type == GTK_TYPE_FLOAT_ARRAY) | |
193 { | |
194 FROB(gfloat, CHECK_FLOAT, extract_float); | |
195 } | |
196 else if (arg->type == GTK_TYPE_INT_ARRAY) | |
197 { | |
198 FROB(gint, CHECK_INT, XINT); | |
199 } | |
200 else | |
201 { | |
2500 | 202 ABORT(); |
462 | 203 } |
204 #undef FROB | |
205 } | |
206 | |
207 extern GdkGC *gtk_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, Lisp_Object bg, | |
208 Lisp_Object bg_pmap, Lisp_Object lwidth); | |
209 | |
210 static GdkGC * | |
211 face_to_gc (Lisp_Object face) | |
212 { | |
213 Lisp_Object device = Fselected_device (Qnil); | |
214 | |
215 return (gtk_get_gc (XDEVICE (device), | |
216 Fspecifier_instance (Fget (face, Qfont, Qnil), device, Qnil, Qnil), | |
217 Fspecifier_instance (Fget (face, Qforeground, Qnil), device, Qnil, Qnil), | |
218 Fspecifier_instance (Fget (face, Qbackground, Qnil), device, Qnil, Qnil), | |
219 Fspecifier_instance (Fget (face, Qbackground_pixmap, Qnil), device, Qnil, Qnil), | |
220 Qnil)); | |
221 } | |
222 | |
223 static GtkStyle * | |
224 face_to_style (Lisp_Object face) | |
225 { | |
226 Lisp_Object device = Fselected_device (Qnil); | |
227 GtkStyle *style = gtk_style_new (); | |
228 int i; | |
229 | |
230 Lisp_Object font = Fspecifier_instance (Fget (face, Qfont, Qnil), device, Qnil, Qnil); | |
231 Lisp_Object fg = Fspecifier_instance (Fget (face, Qforeground, Qnil), device, Qnil, Qnil); | |
232 Lisp_Object bg = Fspecifier_instance (Fget (face, Qbackground, Qnil), device, Qnil, Qnil); | |
233 Lisp_Object pm = Fspecifier_instance (Fget (face, Qbackground_pixmap, Qnil), device, Qnil, Qnil); | |
234 | |
235 for (i = 0; i < 5; i++) style->fg[i] = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (fg)); | |
236 for (i = 0; i < 5; i++) style->bg[i] = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (bg)); | |
237 | |
238 if (IMAGE_INSTANCEP (pm)) | |
239 { | |
240 for (i = 0; i < 5; i++) style->bg_pixmap[i] = XIMAGE_INSTANCE_GTK_PIXMAP (pm); | |
241 } | |
242 | |
243 style->font = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font)); | |
244 | |
245 return (style); | |
246 } | |
247 | |
248 static Lisp_Object | |
249 gdk_event_to_emacs_event(GdkEvent *ev) | |
250 { | |
1204 | 251 Lisp_Object event = Qnil; |
462 | 252 |
253 if (ev) | |
254 { | |
1204 | 255 Lisp_Event *emacs_event; |
256 | |
257 event = Fmake_event (Qnil, Qnil); | |
258 emacs_event = XEVENT (event); | |
259 | |
260 if (!gtk_event_to_emacs_event (NULL, ev, emacs_event)) | |
462 | 261 { |
262 /* We need to handle a few more cases than the normal event | |
263 ** loop does. Mainly the double/triple click events. | |
264 */ | |
265 if ((ev->type == GDK_2BUTTON_PRESS) || (ev->type == GDK_3BUTTON_PRESS)) | |
266 { | |
1204 | 267 set_event_type (emacs_event, misc_user_event); |
268 SET_EVENT_MISC_USER_BUTTON (emacs_event, ev->button.button); | |
269 SET_EVENT_MISC_USER_MODIFIERS (emacs_event, 0); | |
2054 | 270 SET_EVENT_MISC_USER_X (emacs_event, (int) ev->button.x); |
271 SET_EVENT_MISC_USER_Y (emacs_event, (int) ev->button.y); | |
462 | 272 if (ev->type == GDK_2BUTTON_PRESS) |
1204 | 273 SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("double-click")); |
462 | 274 else |
1204 | 275 SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("triple-click")); |
462 | 276 } |
277 else | |
278 { | |
1204 | 279 Fdeallocate_event (event); |
280 event = Qnil; | |
462 | 281 } |
282 } | |
283 } | |
1204 | 284 return (event); |
462 | 285 } |