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