annotate src/gtk-glue.c @ 5146:88bd4f3ef8e4

make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-03-15 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (c_readonly): * alloc.c (deadbeef_memory): * alloc.c (make_compiled_function): * alloc.c (make_button_data): * alloc.c (make_motion_data): * alloc.c (make_process_data): * alloc.c (make_timeout_data): * alloc.c (make_magic_data): * alloc.c (make_magic_eval_data): * alloc.c (make_eval_data): * alloc.c (make_misc_user_data): * alloc.c (noseeum_make_marker): * alloc.c (ADDITIONAL_FREE_string): * alloc.c (common_init_alloc_early): * alloc.c (init_alloc_once_early): * bytecode.c (print_compiled_function): * bytecode.c (mark_compiled_function): * casetab.c: * casetab.c (print_case_table): * console.c: * console.c (print_console): * database.c (print_database): * database.c (finalize_database): * device-msw.c (sync_printer_with_devmode): * device-msw.c (print_devmode): * device-msw.c (finalize_devmode): * device.c: * device.c (print_device): * elhash.c: * elhash.c (print_hash_table): * eval.c (print_multiple_value): * eval.c (mark_multiple_value): * events.c (deinitialize_event): * events.c (print_event): * events.c (event_equal): * extents.c: * extents.c (soe_dump): * extents.c (soe_insert): * extents.c (soe_delete): * extents.c (soe_move): * extents.c (extent_fragment_update): * extents.c (print_extent_1): * extents.c (print_extent): * extents.c (vars_of_extents): * frame.c: * frame.c (print_frame): * free-hook.c: * free-hook.c (check_free): * glyphs.c: * glyphs.c (print_image_instance): * glyphs.c (print_glyph): * gui.c: * gui.c (copy_gui_item): * hash.c: * hash.c (NULL_ENTRY): * hash.c (KEYS_DIFFER_P): * keymap.c (print_keymap): * keymap.c (MARKED_SLOT): * lisp.h: * lrecord.h: * lrecord.h (LISP_OBJECT_UID): * lrecord.h (set_lheader_implementation): * lrecord.h (struct old_lcrecord_header): * lstream.c (print_lstream): * lstream.c (finalize_lstream): * marker.c (print_marker): * marker.c (marker_equal): * mc-alloc.c (visit_all_used_page_headers): * mule-charset.c: * mule-charset.c (print_charset): * objects.c (print_color_instance): * objects.c (print_font_instance): * objects.c (finalize_font_instance): * opaque.c (print_opaque): * opaque.c (print_opaque_ptr): * opaque.c (equal_opaque_ptr): * print.c (internal_object_printer): * print.c (enum printing_badness): * rangetab.c (print_range_table): * rangetab.c (range_table_equal): * specifier.c (print_specifier): * specifier.c (finalize_specifier): * symbols.c: * symbols.c (print_symbol_value_magic): * tooltalk.c: * tooltalk.c (print_tooltalk_message): * tooltalk.c (print_tooltalk_pattern): * window.c (print_window): * window.c (debug_print_window): (1) Make lrecord UID's have a separate UID space for each object. Otherwise, with 20-bit UID's, we rapidly wrap around, especially when common objects like conses and strings increment the UID value for every object created. (Originally I tried making two UID spaces, one for objects that always print readably and hence don't display the UID, and one for other objects. But certain objects like markers for which a UID is displayed are still generated rapidly enough that UID overflow is a serious issue.) This also has the advantage of making UID values smaller, hence easier to remember -- their main purpose is to make it easier to keep track of different objects of the same type when debugging code. Make sure we dump lrecord UID's so that we don't have problems with pdumped and non-dumped objects having the same UID. (2) Display UID's consistently whenever an object (a) doesn't consistently print readably (objects like cons and string, which always print readably, can't display a UID), and (b) doesn't otherwise have a unique property that makes objects of a particular type distinguishable. (E.g. buffers didn't and still don't print an ID, but the buffer name uniquely identifies the buffer.) Some types, such as event, extent, compiled-function, didn't always (or didn't ever) display an ID; others (such as marker, extent, lstream, opaque, opaque-ptr, any object using internal_object_printer()) used to display the actual machine pointer instead. (3) Rename NORMAL_LISP_OBJECT_UID to LISP_OBJECT_UID; make it work over all Lisp objects and take a Lisp object, not a struct pointer. (4) Some misc cleanups in alloc.c, elhash.c. (5) Change code in events.c that "deinitializes" an event so that it doesn't increment the event UID counter in the process. Also use deadbeef_memory() to overwrite memory instead of doing the same with custom code. In the process, make deadbeef_memory() in alloc.c always available, and delete extraneous copy in mc-alloc.c. Also capitalize all uses of 0xDEADBEEF. Similarly in elhash.c call deadbeef_memory(). (6) Resurrect "debug SOE" code in extents.c. Make it conditional on DEBUG_XEMACS and on a `debug-soe' variable, rather than on SOE_DEBUG. Make it output to stderr, not stdout. (7) Delete some custom print methods that were identical to external_object_printer().
author Ben Wing <ben@xemacs.org>
date Mon, 15 Mar 2010 16:35:38 -0500
parents 5502045ec510
children 97eb4942aec8
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
19 GtkType GTK_TYPE_ARRAY = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
20 GtkType GTK_TYPE_STRING_ARRAY = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
21 GtkType GTK_TYPE_FLOAT_ARRAY = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
22 GtkType GTK_TYPE_INT_ARRAY = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
23 GtkType GTK_TYPE_LISTOF = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
24 GtkType GTK_TYPE_STRING_LIST = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
25 GtkType GTK_TYPE_OBJECT_LIST = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
26 GtkType GTK_TYPE_GDK_GC = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
27
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
28 #include "console-gtk.h"
876
890f3cafe600 [xemacs-hg @ 2002-06-23 09:25:11 by stephent]
stephent
parents: 778
diff changeset
29 #include "objects-gtk-impl.h"
890f3cafe600 [xemacs-hg @ 2002-06-23 09:25:11 by stephent]
stephent
parents: 778
diff changeset
30
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
31 static GtkType
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
32 xemacs_type_register (gchar *name, GtkType parent)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
33 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
34 GtkType type_id;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
35 GtkTypeInfo info;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
36
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
37 info.type_name = name;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
38 info.object_size = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
39 info.class_size = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
40 info.class_init_func = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
41 info.object_init_func = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
42 info.reserved_1 = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
43 info.reserved_2 = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
44
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
45 type_id = gtk_type_unique (parent, &info);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
46
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
47 return (type_id);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
48 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
49
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
50 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
51 xemacs_init_gtk_classes (void)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
52 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
53 if (!GTK_TYPE_ARRAY)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
54 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
55 GTK_TYPE_ARRAY = xemacs_type_register ("GtkArrayOf", 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
56 GTK_TYPE_STRING_ARRAY = xemacs_type_register ("GtkArrayOfString", GTK_TYPE_ARRAY);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
57 GTK_TYPE_FLOAT_ARRAY = xemacs_type_register ("GtkArrayOfFloat", GTK_TYPE_ARRAY);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
58 GTK_TYPE_INT_ARRAY = xemacs_type_register ("GtkArrayOfInteger", GTK_TYPE_ARRAY);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
59 GTK_TYPE_LISTOF = xemacs_type_register ("GtkListOf", 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60 GTK_TYPE_STRING_LIST = xemacs_type_register ("GtkListOfString", GTK_TYPE_LISTOF);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
61 GTK_TYPE_OBJECT_LIST = xemacs_type_register ("GtkListOfObject", GTK_TYPE_LISTOF);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 GTK_TYPE_GDK_GC = xemacs_type_register ("GdkGC", GTK_TYPE_BOXED);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
64 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
65
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
66 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
67 xemacs_list_to_gtklist (Lisp_Object obj, GtkArg *arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
68 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
69 CHECK_LIST (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
70
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
71 if (arg->type == GTK_TYPE_STRING_LIST)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
72 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
73 Lisp_Object temp = obj;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
74 GList *strings = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
75
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
76 while (!NILP (temp))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
77 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
78 CHECK_STRING (XCAR (temp));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
79 temp = XCDR (temp);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
80 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
81
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
82 temp = obj;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
83
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
84 while (!NILP (temp))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
85 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
86 strings = g_list_append (strings, XSTRING_DATA (XCAR (temp)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
87 temp = XCDR (temp);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
88 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
89
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
90 GTK_VALUE_POINTER (*arg) = strings;
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
91 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
92 else if (arg->type == GTK_TYPE_OBJECT_LIST)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
93 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
94 Lisp_Object temp = obj;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
95 GList *objects = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
96
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
97 while (!NILP (temp))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
98 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
99 CHECK_GTK_OBJECT (XCAR (temp));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
100 temp = XCDR (temp);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
101 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
102
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
103 temp = obj;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
104
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
105 while (!NILP (temp))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
106 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
107 objects = g_list_append (objects, XGTK_OBJECT (XCAR (temp))->object);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
108 temp = XCDR (temp);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
109 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
110
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
111 GTK_VALUE_POINTER (*arg) = objects;
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
112 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
113 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
114 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
115 ABORT ();
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
116 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
117 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
118
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
119 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
120 __make_gtk_object_mapper (gpointer data, gpointer user_data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
121 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
122 Lisp_Object *rv = (Lisp_Object *) user_data;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
123
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
124 *rv = Fcons (build_gtk_object (GTK_OBJECT (data)), *rv);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
125 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
126
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
127 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
128 __make_string_mapper (gpointer data, gpointer user_data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
129 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
130 Lisp_Object *rv = (Lisp_Object *) user_data;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
131
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
132 *rv = Fcons (build_cistring ((char *)data), *rv);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
133 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
134
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
135 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
136 xemacs_gtklist_to_list (GtkArg *arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
137 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
138 Lisp_Object rval = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
139
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
140 if (GTK_VALUE_POINTER (*arg))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
141 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
142 if (arg->type == GTK_TYPE_STRING_LIST)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
143 {
2054
91d4c8c65a0f [xemacs-hg @ 2004-05-02 04:06:51 by malcolmp]
malcolmp
parents: 1204
diff changeset
144 g_list_foreach ((GList*) GTK_VALUE_POINTER (*arg), __make_string_mapper, &rval);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
145 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
146 else if (arg->type == GTK_TYPE_OBJECT_LIST)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
147 {
2054
91d4c8c65a0f [xemacs-hg @ 2004-05-02 04:06:51 by malcolmp]
malcolmp
parents: 1204
diff changeset
148 g_list_foreach ((GList*) GTK_VALUE_POINTER (*arg), __make_gtk_object_mapper, &rval);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
149 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
150 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
151 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
152 ABORT ();
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
153 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
154 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
155 return (rval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
156 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
157
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
158 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
159 xemacs_list_to_array (Lisp_Object obj, GtkArg *arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
160 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
161 CHECK_LIST (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
162
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
163 #define FROB(ret_type,check_fn,extract_fn) \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
164 do { \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
165 Lisp_Object temp = obj; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
166 int length = 0; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
167 ret_type *array = NULL; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
168 \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
169 while (!NILP (temp)) \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
170 { \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
171 check_fn (XCAR (temp)); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
172 length++; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
173 temp = XCDR (temp); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
174 } \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
175 \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
176 array = xnew_array_and_zero (ret_type, length + 2); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
177 temp = obj; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
178 length = 0; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
179 \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
180 while (!NILP (temp)) \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
181 { \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
182 array[length++] = extract_fn (XCAR (temp)); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
183 temp = XCDR (temp); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
184 } \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
185 \
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
186 GTK_VALUE_POINTER (*arg) = array; \
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
187 } while (0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
188
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
189 if (arg->type == GTK_TYPE_STRING_ARRAY)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
190 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
191 FROB (gchar *, CHECK_STRING, (gchar*) XSTRING_DATA);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
192 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
193 else if (arg->type == GTK_TYPE_FLOAT_ARRAY)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
194 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
195 FROB (gfloat, CHECK_FLOAT, extract_float);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
196 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
197 else if (arg->type == GTK_TYPE_INT_ARRAY)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
198 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
199 FROB (gint, CHECK_INT, XINT);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
200 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
201 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
202 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
203 ABORT ();
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
204 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
205 #undef FROB
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
206 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
207
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
208 static GdkGC *
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
209 face_to_gc (Lisp_Object face)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
210 {
5074
8af6a32b170d Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents: 4962
diff changeset
211 Lisp_Object frame = Fselected_frame (Qnil);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
212
5074
8af6a32b170d Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents: 4962
diff changeset
213 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
214 Fspecifier_instance (Fget (face, Qfont, 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, Qforeground, 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, Qnil),
5074
8af6a32b170d Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents: 4962
diff changeset
219 frame, Qnil, Qnil),
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
220 Fspecifier_instance (Fget (face, Qbackground_pixmap,
5074
8af6a32b170d Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents: 4962
diff changeset
221 Qnil),
8af6a32b170d Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents: 4962
diff changeset
222 frame, Qnil, Qnil),
5080
5502045ec510 The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents: 5074
diff changeset
223 Fspecifier_instance (Fget (face, Qbackground_placement,
5502045ec510 The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents: 5074
diff changeset
224 Qnil),
5502045ec510 The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents: 5074
diff changeset
225 frame, Qnil, Qnil),
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
226 Qnil));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
227 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
228
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
229 static GtkStyle *
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
230 face_to_style (Lisp_Object face)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
231 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
232 Lisp_Object device = Fselected_device (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
233 GtkStyle *style = gtk_style_new ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
234 int i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
235
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
236 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
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 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
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 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
241 device, Qnil, Qnil);
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
242 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
243 Qnil), device, Qnil, Qnil);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
244
4908
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->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
247 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
248 style->bg[i] = *COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (bg));
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
249
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
250 if (IMAGE_INSTANCEP (pm))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
251 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
252 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
253 style->bg_pixmap[i] = XIMAGE_INSTANCE_GTK_PIXMAP (pm);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
254 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
255
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
256 style->font = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
257
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
258 return (style);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
259 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
260
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
261 static Lisp_Object
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
262 gdk_event_to_emacs_event (GdkEvent *ev)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
263 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
264 Lisp_Object event = Qnil;
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
265
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
266 if (ev)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
267 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
268 Lisp_Event *emacs_event;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
269
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
270 event = Fmake_event (Qnil, Qnil);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
271 emacs_event = XEVENT (event);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
272
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
273 if (!gtk_event_to_emacs_event (NULL, ev, emacs_event))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
274 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
275 /* We need to handle a few more cases than the normal event
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
276 ** loop does. Mainly the double/triple click events.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
277 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
278 if ((ev->type == GDK_2BUTTON_PRESS) || (ev->type == GDK_3BUTTON_PRESS))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
279 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
280 set_event_type (emacs_event, misc_user_event);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
281 SET_EVENT_MISC_USER_BUTTON (emacs_event, ev->button.button);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
282 SET_EVENT_MISC_USER_MODIFIERS (emacs_event, 0);
2054
91d4c8c65a0f [xemacs-hg @ 2004-05-02 04:06:51 by malcolmp]
malcolmp
parents: 1204
diff changeset
283 SET_EVENT_MISC_USER_X (emacs_event, (int) ev->button.x);
91d4c8c65a0f [xemacs-hg @ 2004-05-02 04:06:51 by malcolmp]
malcolmp
parents: 1204
diff changeset
284 SET_EVENT_MISC_USER_Y (emacs_event, (int) ev->button.y);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
285 if (ev->type == GDK_2BUTTON_PRESS)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
286 SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("double-click"));
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
287 else
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
288 SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("triple-click"));
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
289 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
290 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
291 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
292 Fdeallocate_event (event);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
293 event = Qnil;
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
294 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
295 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
296 }
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
297 return (event);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
298 }