Mercurial > hg > xemacs-beta
annotate src/gtk-glue.c @ 5464:e79916901603 r21-5-30
XEmacs 21.5.30 "garlic" is released.
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Wed, 27 Apr 2011 01:24:28 +0900 |
| parents | cd167465bf69 |
| children | b9167d522a9a |
| rev | line source |
|---|---|
|
5287
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
1 /* gtk-glue.c --- GTK interfaces with XEmacs |
|
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
2 |
|
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
3 Copyright (C) 2000, 2001 William M. Perry |
|
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
4 |
|
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
|
5 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
|
6 |
|
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 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
|
8 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
|
9 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
|
10 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
|
11 |
|
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 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
|
13 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
|
14 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
|
15 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
|
16 |
|
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 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
|
18 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
|
19 the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, |
|
5231
ba07c880114a
Fix up FSF's Franklin Street address in many files.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5178
diff
changeset
|
20 Boston, MA 02110-1301, USA. */ |
|
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
|
21 |
| 462 | 22 GtkType GTK_TYPE_ARRAY = 0; |
| 23 GtkType GTK_TYPE_STRING_ARRAY = 0; | |
| 24 GtkType GTK_TYPE_FLOAT_ARRAY = 0; | |
| 25 GtkType GTK_TYPE_INT_ARRAY = 0; | |
| 26 GtkType GTK_TYPE_LISTOF = 0; | |
| 27 GtkType GTK_TYPE_STRING_LIST = 0; | |
| 28 GtkType GTK_TYPE_OBJECT_LIST = 0; | |
| 29 GtkType GTK_TYPE_GDK_GC = 0; | |
| 30 | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
31 #include "console-gtk.h" |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
32 #include "fontcolor-gtk-impl.h" |
| 876 | 33 |
| 462 | 34 static GtkType |
| 35 xemacs_type_register (gchar *name, GtkType parent) | |
| 36 { | |
| 37 GtkType type_id; | |
| 38 GtkTypeInfo info; | |
| 39 | |
| 40 info.type_name = name; | |
| 41 info.object_size = 0; | |
| 42 info.class_size = 0; | |
| 43 info.class_init_func = NULL; | |
| 44 info.object_init_func = NULL; | |
| 45 info.reserved_1 = NULL; | |
| 46 info.reserved_2 = NULL; | |
| 47 | |
| 48 type_id = gtk_type_unique (parent, &info); | |
| 49 | |
| 50 return (type_id); | |
| 51 } | |
| 52 | |
| 53 static void | |
| 54 xemacs_init_gtk_classes (void) | |
| 55 { | |
| 56 if (!GTK_TYPE_ARRAY) | |
| 57 { | |
| 58 GTK_TYPE_ARRAY = xemacs_type_register ("GtkArrayOf", 0); | |
| 59 GTK_TYPE_STRING_ARRAY = xemacs_type_register ("GtkArrayOfString", GTK_TYPE_ARRAY); | |
| 60 GTK_TYPE_FLOAT_ARRAY = xemacs_type_register ("GtkArrayOfFloat", GTK_TYPE_ARRAY); | |
| 61 GTK_TYPE_INT_ARRAY = xemacs_type_register ("GtkArrayOfInteger", GTK_TYPE_ARRAY); | |
| 62 GTK_TYPE_LISTOF = xemacs_type_register ("GtkListOf", 0); | |
| 63 GTK_TYPE_STRING_LIST = xemacs_type_register ("GtkListOfString", GTK_TYPE_LISTOF); | |
| 64 GTK_TYPE_OBJECT_LIST = xemacs_type_register ("GtkListOfObject", GTK_TYPE_LISTOF); | |
| 65 GTK_TYPE_GDK_GC = xemacs_type_register ("GdkGC", GTK_TYPE_BOXED); | |
| 66 } | |
| 67 } | |
| 68 | |
| 69 static void | |
| 70 xemacs_list_to_gtklist (Lisp_Object obj, GtkArg *arg) | |
| 71 { | |
| 72 CHECK_LIST (obj); | |
| 73 | |
| 74 if (arg->type == GTK_TYPE_STRING_LIST) | |
| 75 { | |
| 76 Lisp_Object temp = obj; | |
| 77 GList *strings = NULL; | |
| 78 | |
| 79 while (!NILP (temp)) | |
| 80 { | |
| 81 CHECK_STRING (XCAR (temp)); | |
| 82 temp = XCDR (temp); | |
| 83 } | |
| 84 | |
| 85 temp = obj; | |
| 86 | |
| 87 while (!NILP (temp)) | |
| 88 { | |
| 89 strings = g_list_append (strings, XSTRING_DATA (XCAR (temp))); | |
| 90 temp = XCDR (temp); | |
| 91 } | |
| 92 | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
93 GTK_VALUE_POINTER (*arg) = strings; |
| 462 | 94 } |
| 95 else if (arg->type == GTK_TYPE_OBJECT_LIST) | |
| 96 { | |
| 97 Lisp_Object temp = obj; | |
| 98 GList *objects = NULL; | |
| 99 | |
| 100 while (!NILP (temp)) | |
| 101 { | |
| 102 CHECK_GTK_OBJECT (XCAR (temp)); | |
| 103 temp = XCDR (temp); | |
| 104 } | |
| 105 | |
| 106 temp = obj; | |
| 107 | |
| 108 while (!NILP (temp)) | |
| 109 { | |
| 110 objects = g_list_append (objects, XGTK_OBJECT (XCAR (temp))->object); | |
| 111 temp = XCDR (temp); | |
| 112 } | |
| 113 | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
114 GTK_VALUE_POINTER (*arg) = objects; |
| 462 | 115 } |
| 116 else | |
| 117 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
118 ABORT (); |
| 462 | 119 } |
| 120 } | |
| 121 | |
| 122 static void | |
| 123 __make_gtk_object_mapper (gpointer data, gpointer user_data) | |
| 124 { | |
| 125 Lisp_Object *rv = (Lisp_Object *) user_data; | |
| 126 | |
| 127 *rv = Fcons (build_gtk_object (GTK_OBJECT (data)), *rv); | |
| 128 } | |
| 129 | |
| 130 static void | |
| 131 __make_string_mapper (gpointer data, gpointer user_data) | |
| 132 { | |
| 133 Lisp_Object *rv = (Lisp_Object *) user_data; | |
| 134 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
135 *rv = Fcons (build_cistring ((char *)data), *rv); |
| 462 | 136 } |
| 137 | |
| 138 static Lisp_Object | |
| 139 xemacs_gtklist_to_list (GtkArg *arg) | |
| 140 { | |
| 141 Lisp_Object rval = Qnil; | |
| 142 | |
| 143 if (GTK_VALUE_POINTER (*arg)) | |
| 144 { | |
| 145 if (arg->type == GTK_TYPE_STRING_LIST) | |
| 146 { | |
| 2054 | 147 g_list_foreach ((GList*) GTK_VALUE_POINTER (*arg), __make_string_mapper, &rval); |
| 462 | 148 } |
| 149 else if (arg->type == GTK_TYPE_OBJECT_LIST) | |
| 150 { | |
| 2054 | 151 g_list_foreach ((GList*) GTK_VALUE_POINTER (*arg), __make_gtk_object_mapper, &rval); |
| 462 | 152 } |
| 153 else | |
| 154 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
155 ABORT (); |
| 462 | 156 } |
| 157 } | |
| 158 return (rval); | |
| 159 } | |
| 160 | |
| 161 static void | |
| 162 xemacs_list_to_array (Lisp_Object obj, GtkArg *arg) | |
| 163 { | |
| 164 CHECK_LIST (obj); | |
| 165 | |
| 166 #define FROB(ret_type,check_fn,extract_fn) \ | |
| 167 do { \ | |
| 168 Lisp_Object temp = obj; \ | |
| 169 int length = 0; \ | |
| 170 ret_type *array = NULL; \ | |
| 171 \ | |
| 172 while (!NILP (temp)) \ | |
| 173 { \ | |
| 174 check_fn (XCAR (temp)); \ | |
| 175 length++; \ | |
| 176 temp = XCDR (temp); \ | |
| 177 } \ | |
| 178 \ | |
| 179 array = xnew_array_and_zero (ret_type, length + 2); \ | |
| 180 temp = obj; \ | |
| 181 length = 0; \ | |
| 182 \ | |
| 183 while (!NILP (temp)) \ | |
| 184 { \ | |
| 185 array[length++] = extract_fn (XCAR (temp)); \ | |
| 186 temp = XCDR (temp); \ | |
| 187 } \ | |
| 188 \ | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
189 GTK_VALUE_POINTER (*arg) = array; \ |
| 462 | 190 } while (0); |
| 191 | |
| 192 if (arg->type == GTK_TYPE_STRING_ARRAY) | |
| 193 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
194 FROB (gchar *, CHECK_STRING, (gchar*) XSTRING_DATA); |
| 462 | 195 } |
| 196 else if (arg->type == GTK_TYPE_FLOAT_ARRAY) | |
| 197 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
198 FROB (gfloat, CHECK_FLOAT, extract_float); |
| 462 | 199 } |
| 200 else if (arg->type == GTK_TYPE_INT_ARRAY) | |
| 201 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
202 FROB (gint, CHECK_INT, XINT); |
| 462 | 203 } |
| 204 else | |
| 205 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
206 ABORT (); |
| 462 | 207 } |
| 208 #undef FROB | |
| 209 } | |
| 210 | |
| 211 static GdkGC * | |
| 212 face_to_gc (Lisp_Object face) | |
| 213 { | |
|
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
214 Lisp_Object frame = Fselected_frame (Qnil); |
| 462 | 215 |
|
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
216 return (gtk_get_gc (XFRAME (frame), |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
217 Fspecifier_instance (Fget (face, Qfont, Qnil), |
|
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
218 frame, Qnil, Qnil), |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
219 Fspecifier_instance (Fget (face, Qforeground, Qnil), |
|
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
220 frame, Qnil, Qnil), |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
221 Fspecifier_instance (Fget (face, Qbackground, Qnil), |
|
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
222 frame, Qnil, Qnil), |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
223 Fspecifier_instance (Fget (face, Qbackground_pixmap, |
|
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
224 Qnil), |
|
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
225 frame, Qnil, Qnil), |
|
5080
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
5074
diff
changeset
|
226 Fspecifier_instance (Fget (face, Qbackground_placement, |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
5074
diff
changeset
|
227 Qnil), |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
5074
diff
changeset
|
228 frame, Qnil, Qnil), |
| 462 | 229 Qnil)); |
| 230 } | |
| 231 | |
| 232 static GtkStyle * | |
| 233 face_to_style (Lisp_Object face) | |
| 234 { | |
| 235 Lisp_Object device = Fselected_device (Qnil); | |
| 236 GtkStyle *style = gtk_style_new (); | |
| 237 int i; | |
| 238 | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
239 Lisp_Object font = Fspecifier_instance (Fget (face, Qfont, Qnil), |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
240 device, Qnil, Qnil); |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
241 Lisp_Object fg = Fspecifier_instance (Fget (face, Qforeground, Qnil), |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
242 device, Qnil, Qnil); |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
243 Lisp_Object bg = Fspecifier_instance (Fget (face, Qbackground, Qnil), |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
244 device, Qnil, Qnil); |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
245 Lisp_Object pm = Fspecifier_instance (Fget (face, Qbackground_pixmap, |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
246 Qnil), device, Qnil, Qnil); |
| 462 | 247 |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
248 for (i = 0; i < 5; i++) |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
249 style->fg[i] = *COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (fg)); |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
250 for (i = 0; i < 5; i++) |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
251 style->bg[i] = *COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (bg)); |
| 462 | 252 |
| 253 if (IMAGE_INSTANCEP (pm)) | |
| 254 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
255 for (i = 0; i < 5; i++) |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
256 style->bg_pixmap[i] = XIMAGE_INSTANCE_GTK_PIXMAP (pm); |
| 462 | 257 } |
| 258 | |
| 259 style->font = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font)); | |
| 260 | |
| 261 return (style); | |
| 262 } | |
| 263 | |
| 264 static Lisp_Object | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
265 gdk_event_to_emacs_event (GdkEvent *ev) |
| 462 | 266 { |
| 1204 | 267 Lisp_Object event = Qnil; |
| 462 | 268 |
| 269 if (ev) | |
| 270 { | |
| 1204 | 271 Lisp_Event *emacs_event; |
| 272 | |
| 273 event = Fmake_event (Qnil, Qnil); | |
| 274 emacs_event = XEVENT (event); | |
| 275 | |
| 276 if (!gtk_event_to_emacs_event (NULL, ev, emacs_event)) | |
| 462 | 277 { |
| 278 /* We need to handle a few more cases than the normal event | |
| 279 ** loop does. Mainly the double/triple click events. | |
| 280 */ | |
| 281 if ((ev->type == GDK_2BUTTON_PRESS) || (ev->type == GDK_3BUTTON_PRESS)) | |
| 282 { | |
| 1204 | 283 set_event_type (emacs_event, misc_user_event); |
| 284 SET_EVENT_MISC_USER_BUTTON (emacs_event, ev->button.button); | |
| 285 SET_EVENT_MISC_USER_MODIFIERS (emacs_event, 0); | |
| 2054 | 286 SET_EVENT_MISC_USER_X (emacs_event, (int) ev->button.x); |
| 287 SET_EVENT_MISC_USER_Y (emacs_event, (int) ev->button.y); | |
| 462 | 288 if (ev->type == GDK_2BUTTON_PRESS) |
| 1204 | 289 SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("double-click")); |
| 462 | 290 else |
| 1204 | 291 SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("triple-click")); |
| 462 | 292 } |
| 293 else | |
| 294 { | |
| 1204 | 295 Fdeallocate_event (event); |
| 296 event = Qnil; | |
| 462 | 297 } |
| 298 } | |
| 299 } | |
| 1204 | 300 return (event); |
| 462 | 301 } |