Mercurial > hg > xemacs-beta
annotate src/gtk-glue.c @ 5925:08cfc8f77fb6 cygwin
make space for long ptr, and store as such, for frame in WINDOW data,
add a bit more debugging to debug-mswindow,
Vin Shelton patch to fix M-x shell
| author | Henry Thompson <ht@markup.co.uk> |
|---|---|
| date | Fri, 27 Feb 2015 17:41:20 +0000 |
| parents | 56144c8593a8 |
| children |
| 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 |
|
5405
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
7 XEmacs is free software: you can redistribute it and/or modify it |
|
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
|
8 under the terms of the GNU General Public License as published by the |
|
5405
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
9 Free Software Foundation, either version 3 of the License, or (at your |
|
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
10 option) any later version. |
|
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
|
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 |
|
5405
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
|
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
|
19 |
| 462 | 20 GtkType GTK_TYPE_ARRAY = 0; |
| 21 GtkType GTK_TYPE_STRING_ARRAY = 0; | |
| 22 GtkType GTK_TYPE_FLOAT_ARRAY = 0; | |
| 23 GtkType GTK_TYPE_INT_ARRAY = 0; | |
| 24 GtkType GTK_TYPE_LISTOF = 0; | |
| 25 GtkType GTK_TYPE_STRING_LIST = 0; | |
| 26 GtkType GTK_TYPE_OBJECT_LIST = 0; | |
| 27 GtkType GTK_TYPE_GDK_GC = 0; | |
| 28 | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
29 #include "console-gtk.h" |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
30 #include "fontcolor-gtk-impl.h" |
| 876 | 31 |
| 462 | 32 static GtkType |
| 33 xemacs_type_register (gchar *name, GtkType parent) | |
| 34 { | |
| 35 GtkType type_id; | |
| 36 GtkTypeInfo info; | |
| 37 | |
| 38 info.type_name = name; | |
| 39 info.object_size = 0; | |
| 40 info.class_size = 0; | |
| 41 info.class_init_func = NULL; | |
| 42 info.object_init_func = NULL; | |
| 43 info.reserved_1 = NULL; | |
| 44 info.reserved_2 = NULL; | |
| 45 | |
| 46 type_id = gtk_type_unique (parent, &info); | |
| 47 | |
| 48 return (type_id); | |
| 49 } | |
| 50 | |
| 51 static void | |
| 52 xemacs_init_gtk_classes (void) | |
| 53 { | |
| 54 if (!GTK_TYPE_ARRAY) | |
| 55 { | |
| 56 GTK_TYPE_ARRAY = xemacs_type_register ("GtkArrayOf", 0); | |
| 57 GTK_TYPE_STRING_ARRAY = xemacs_type_register ("GtkArrayOfString", GTK_TYPE_ARRAY); | |
| 58 GTK_TYPE_FLOAT_ARRAY = xemacs_type_register ("GtkArrayOfFloat", GTK_TYPE_ARRAY); | |
| 59 GTK_TYPE_INT_ARRAY = xemacs_type_register ("GtkArrayOfInteger", GTK_TYPE_ARRAY); | |
| 60 GTK_TYPE_LISTOF = xemacs_type_register ("GtkListOf", 0); | |
| 61 GTK_TYPE_STRING_LIST = xemacs_type_register ("GtkListOfString", GTK_TYPE_LISTOF); | |
| 62 GTK_TYPE_OBJECT_LIST = xemacs_type_register ("GtkListOfObject", GTK_TYPE_LISTOF); | |
| 63 GTK_TYPE_GDK_GC = xemacs_type_register ("GdkGC", GTK_TYPE_BOXED); | |
| 64 } | |
| 65 } | |
| 66 | |
| 67 static void | |
| 68 xemacs_list_to_gtklist (Lisp_Object obj, GtkArg *arg) | |
| 69 { | |
| 70 CHECK_LIST (obj); | |
| 71 | |
| 72 if (arg->type == GTK_TYPE_STRING_LIST) | |
| 73 { | |
| 74 Lisp_Object temp = obj; | |
| 75 GList *strings = NULL; | |
| 76 | |
| 77 while (!NILP (temp)) | |
| 78 { | |
| 79 CHECK_STRING (XCAR (temp)); | |
| 80 temp = XCDR (temp); | |
| 81 } | |
| 82 | |
| 83 temp = obj; | |
| 84 | |
| 85 while (!NILP (temp)) | |
| 86 { | |
| 87 strings = g_list_append (strings, XSTRING_DATA (XCAR (temp))); | |
| 88 temp = XCDR (temp); | |
| 89 } | |
| 90 | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
91 GTK_VALUE_POINTER (*arg) = strings; |
| 462 | 92 } |
| 93 else if (arg->type == GTK_TYPE_OBJECT_LIST) | |
| 94 { | |
| 95 Lisp_Object temp = obj; | |
| 96 GList *objects = NULL; | |
| 97 | |
| 98 while (!NILP (temp)) | |
| 99 { | |
| 100 CHECK_GTK_OBJECT (XCAR (temp)); | |
| 101 temp = XCDR (temp); | |
| 102 } | |
| 103 | |
| 104 temp = obj; | |
| 105 | |
| 106 while (!NILP (temp)) | |
| 107 { | |
| 108 objects = g_list_append (objects, XGTK_OBJECT (XCAR (temp))->object); | |
| 109 temp = XCDR (temp); | |
| 110 } | |
| 111 | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
112 GTK_VALUE_POINTER (*arg) = objects; |
| 462 | 113 } |
| 114 else | |
| 115 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
116 ABORT (); |
| 462 | 117 } |
| 118 } | |
| 119 | |
| 120 static void | |
| 121 __make_gtk_object_mapper (gpointer data, gpointer user_data) | |
| 122 { | |
| 123 Lisp_Object *rv = (Lisp_Object *) user_data; | |
| 124 | |
| 125 *rv = Fcons (build_gtk_object (GTK_OBJECT (data)), *rv); | |
| 126 } | |
| 127 | |
| 128 static void | |
| 129 __make_string_mapper (gpointer data, gpointer user_data) | |
| 130 { | |
| 131 Lisp_Object *rv = (Lisp_Object *) user_data; | |
| 132 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
133 *rv = Fcons (build_cistring ((char *)data), *rv); |
| 462 | 134 } |
| 135 | |
| 136 static Lisp_Object | |
| 137 xemacs_gtklist_to_list (GtkArg *arg) | |
| 138 { | |
| 139 Lisp_Object rval = Qnil; | |
| 140 | |
| 141 if (GTK_VALUE_POINTER (*arg)) | |
| 142 { | |
| 143 if (arg->type == GTK_TYPE_STRING_LIST) | |
| 144 { | |
| 2054 | 145 g_list_foreach ((GList*) GTK_VALUE_POINTER (*arg), __make_string_mapper, &rval); |
| 462 | 146 } |
| 147 else if (arg->type == GTK_TYPE_OBJECT_LIST) | |
| 148 { | |
| 2054 | 149 g_list_foreach ((GList*) GTK_VALUE_POINTER (*arg), __make_gtk_object_mapper, &rval); |
| 462 | 150 } |
| 151 else | |
| 152 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
153 ABORT (); |
| 462 | 154 } |
| 155 } | |
| 156 return (rval); | |
| 157 } | |
| 158 | |
| 159 static void | |
| 160 xemacs_list_to_array (Lisp_Object obj, GtkArg *arg) | |
| 161 { | |
| 162 CHECK_LIST (obj); | |
| 163 | |
| 164 #define FROB(ret_type,check_fn,extract_fn) \ | |
| 165 do { \ | |
| 166 Lisp_Object temp = obj; \ | |
| 167 int length = 0; \ | |
| 168 ret_type *array = NULL; \ | |
| 169 \ | |
| 170 while (!NILP (temp)) \ | |
| 171 { \ | |
| 172 check_fn (XCAR (temp)); \ | |
| 173 length++; \ | |
| 174 temp = XCDR (temp); \ | |
| 175 } \ | |
| 176 \ | |
| 177 array = xnew_array_and_zero (ret_type, length + 2); \ | |
| 178 temp = obj; \ | |
| 179 length = 0; \ | |
| 180 \ | |
| 181 while (!NILP (temp)) \ | |
| 182 { \ | |
| 183 array[length++] = extract_fn (XCAR (temp)); \ | |
| 184 temp = XCDR (temp); \ | |
| 185 } \ | |
| 186 \ | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
187 GTK_VALUE_POINTER (*arg) = array; \ |
| 462 | 188 } while (0); |
| 189 | |
| 190 if (arg->type == GTK_TYPE_STRING_ARRAY) | |
| 191 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
192 FROB (gchar *, CHECK_STRING, (gchar*) XSTRING_DATA); |
| 462 | 193 } |
| 194 else if (arg->type == GTK_TYPE_FLOAT_ARRAY) | |
| 195 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
196 FROB (gfloat, CHECK_FLOAT, extract_float); |
| 462 | 197 } |
| 198 else if (arg->type == GTK_TYPE_INT_ARRAY) | |
| 199 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5420
diff
changeset
|
200 FROB (gint, CHECK_FIXNUM, XFIXNUM); |
| 462 | 201 } |
| 202 else | |
| 203 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
204 ABORT (); |
| 462 | 205 } |
| 206 #undef FROB | |
| 207 } | |
| 208 | |
| 209 static GdkGC * | |
| 210 face_to_gc (Lisp_Object face) | |
| 211 { | |
|
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
212 Lisp_Object frame = Fselected_frame (Qnil); |
| 462 | 213 |
|
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
214 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
|
215 Fspecifier_instance (Fget (face, Qfont, Qnil), |
|
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
216 frame, Qnil, Qnil), |
|
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, Qforeground, 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, Qbackground, 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_pixmap, |
|
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
222 Qnil), |
|
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
223 frame, Qnil, Qnil), |
|
5080
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
5074
diff
changeset
|
224 Fspecifier_instance (Fget (face, Qbackground_placement, |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
5074
diff
changeset
|
225 Qnil), |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
5074
diff
changeset
|
226 frame, Qnil, Qnil), |
| 462 | 227 Qnil)); |
| 228 } | |
| 229 | |
| 230 static GtkStyle * | |
| 231 face_to_style (Lisp_Object face) | |
| 232 { | |
| 233 Lisp_Object device = Fselected_device (Qnil); | |
| 234 GtkStyle *style = gtk_style_new (); | |
| 235 int i; | |
| 236 | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
237 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
|
238 device, Qnil, Qnil); |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
239 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
|
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 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
|
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 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
|
244 Qnil), device, Qnil, Qnil); |
| 462 | 245 |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
246 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
|
247 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
|
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->bg[i] = *COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (bg)); |
| 462 | 250 |
| 251 if (IMAGE_INSTANCEP (pm)) | |
| 252 { | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
253 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
|
254 style->bg_pixmap[i] = XIMAGE_INSTANCE_GTK_PIXMAP (pm); |
| 462 | 255 } |
| 256 | |
| 257 style->font = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font)); | |
| 258 | |
| 259 return (style); | |
| 260 } | |
| 261 | |
| 262 static Lisp_Object | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
263 gdk_event_to_emacs_event (GdkEvent *ev) |
| 462 | 264 { |
| 1204 | 265 Lisp_Object event = Qnil; |
| 462 | 266 |
| 267 if (ev) | |
| 268 { | |
| 1204 | 269 Lisp_Event *emacs_event; |
| 270 | |
| 271 event = Fmake_event (Qnil, Qnil); | |
| 272 emacs_event = XEVENT (event); | |
| 273 | |
| 274 if (!gtk_event_to_emacs_event (NULL, ev, emacs_event)) | |
| 462 | 275 { |
| 276 /* We need to handle a few more cases than the normal event | |
| 277 ** loop does. Mainly the double/triple click events. | |
| 278 */ | |
| 279 if ((ev->type == GDK_2BUTTON_PRESS) || (ev->type == GDK_3BUTTON_PRESS)) | |
| 280 { | |
| 1204 | 281 set_event_type (emacs_event, misc_user_event); |
| 282 SET_EVENT_MISC_USER_BUTTON (emacs_event, ev->button.button); | |
| 283 SET_EVENT_MISC_USER_MODIFIERS (emacs_event, 0); | |
| 2054 | 284 SET_EVENT_MISC_USER_X (emacs_event, (int) ev->button.x); |
| 285 SET_EVENT_MISC_USER_Y (emacs_event, (int) ev->button.y); | |
| 462 | 286 if (ev->type == GDK_2BUTTON_PRESS) |
| 1204 | 287 SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("double-click")); |
| 462 | 288 else |
| 1204 | 289 SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("triple-click")); |
| 462 | 290 } |
| 291 else | |
| 292 { | |
| 1204 | 293 Fdeallocate_event (event); |
| 294 event = Qnil; | |
| 462 | 295 } |
| 296 } | |
| 297 } | |
| 1204 | 298 return (event); |
| 462 | 299 } |