annotate src/ui-gtk.c @ 844:047d37eb70d7

[xemacs-hg @ 2002-05-16 13:30:23 by ben] ui fixes for things that were bothering me bytecode.c, editfns.c, lisp.h, lread.c: Fix save-restriction to use markers rather than pseudo-markers (integers representing the amount of text on either side of the region). That way, all inserts are handled correctly, not just those inside old restriction. Add buffer argument to save_restriction_save(). process.c: Clean up very dirty and kludgy code that outputs into a buffer -- use proper unwind protects, etc. font-lock.c: Do save-restriction/widen around the function -- otherwise, incorrect results will ensue when a buffer has been narrowed before a call to e.g. `buffer-syntactic-context' -- something that happens quite often. fileio.c: Look for a handler for make-temp-name. window.c, winslots.h: Try to solve this annoying problem: have two frames displaying the buffer, in different places; in one, temporarily switch away to another buffer and then back -- and you've lost your position; it's reset to the other one in the other frame. My current solution involves window-level caches of buffers and points (also a cache for window-start); when set-window-buffer is called, it looks to see if the buffer was previously visited in the window, and if so, uses the most recent point at that time. (It's a marker, so it handles changes.) #### Note: It could be argued that doing it on the frame level would be better -- e.g. if you visit a buffer temporarily through a grep, and then go back to that buffer, you presumably want the grep's position rather than some previous position provided everything was in the same frame, even though the grep was in another window in the frame. However, doing it on the frame level fails when you have two windows on the same frame. Perhaps we keep both a window and a frame cache, and use the frame cache if there are no other windows on the frame showing the buffer, else the window's cache? This is probably something to be configurable using a specifier. Suggestions please please please? window.c: Clean up a bit code that deals with the annoyance of window-point vs. point. dialog.el: Function to ask a multiple-choice question, automatically choosing a dialog box or minibuffer representation as necessary. Generalized version of yes-or-no-p, y-or-n-p. files.el: Use get-user-response to ask "yes/no/diff" question when recovering. "diff" means that a diff is displayed between the current file and the autosave. (Converts/deconverts escape-quoted as necessary. No more complaints from you, Mr. Turnbull!) One known problem: when a dialog is used, it's modal, so you can't scroll the diff. Will fix soon. lisp-mode.el: If we're filling a string, don't treat semicolon as a comment, which would give very unfriendly results. Uses `buffer-syntactic-context'. simple.el: all changes back to the beginning. (Useful if you've saved the file in the middle of the changes.) simple.el: Add option kill-word-into-kill-ring, which controls whether words deleted with kill-word, backward-kill-word, etc. are "cut" into the kill ring, or "cleared" into nothingness. (My preference is the latter, by far. I'd almost go so far as suggesting we make it the default, as you can always select a word and then cut it if you want it cut.) menubar-items.el: Add option corresponding to kill-word-into-kill-ring.
author ben
date Thu, 16 May 2002 13:30:58 +0000
parents 6728e641994e
children 804517e16990
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1 /* ui-gtk.c
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2 **
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
3 ** Description: Creating 'real' UIs from lisp.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
4 **
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
5 ** Created by: William M. Perry <wmperry@gnu.org>
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
6 ** Copyright (c) 2000 William M. Perry <wmperry@gnu.org>
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
7 **
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
8 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
9
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
10 #include <config.h>
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
11 #include "lisp.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
12 #include "buffer.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
13 #include "console-gtk.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
14 #include "device.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
15 #include "window.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
16 #include "glyphs-gtk.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
17 #include "objects-gtk.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
18 #include "ui-gtk.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
19 #include "faces.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
20 #include "gui-gtk.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
21 #include "sysdll.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
22 #include "hash.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
23 #include "events.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
24 #include "elhash.h"
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 563
diff changeset
25 #include "event-gtk.h"
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
26
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
27 /* XEmacs specific GTK types */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
28 #include "gtk-glue.c"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
29
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
30 Lisp_Object Qemacs_ffip;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
31 Lisp_Object Qemacs_gtk_objectp;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
32 Lisp_Object Qemacs_gtk_boxedp;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
33 Lisp_Object Qvoid;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
34 Lisp_Object Venumeration_info;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
35
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
36 static GHashTable *dll_cache;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
37
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
38 Lisp_Object gtk_type_to_lisp (GtkArg *arg);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
39 int lisp_to_gtk_type (Lisp_Object obj, GtkArg *arg);
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 563
diff changeset
40 #if 0
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
41 void describe_gtk_arg (GtkArg *arg);
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 563
diff changeset
42 #endif
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
43 guint symbol_to_enum (Lisp_Object obj, GtkType t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
44 static guint lisp_to_flag (Lisp_Object obj, GtkType t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
45 static Lisp_Object flags_to_list (guint value, GtkType t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
46 static Lisp_Object enum_to_symbol (guint value, GtkType t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
47
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
48 #define NIL_OR_VOID_P(x) (NILP (x) || EQ (x, Qvoid))
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 initialize_dll_cache (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 (!dll_cache)
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 dll_cache = g_hash_table_new (g_str_hash, g_str_equal);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
56
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
57 g_hash_table_insert (dll_cache, "---XEmacs Internal Handle---", dll_open (NULL));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
58 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
59 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
61 DEFUN ("dll-load", Fdll_load, 1, 1, 0, /*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 Load a shared library DLL into XEmacs. No initialization routines are required.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 This is for loading dependency DLLs into XEmacs.
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 (dll))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
66 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
67 dll_handle h;
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_STRING (dll);
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 initialize_dll_cache ();
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 /* If the dll name has a directory component in it, then we should
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
74 expand it. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
75 if (!NILP (Fstring_match (build_string ("/"), dll, Qnil, Qnil)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
76 dll = Fexpand_file_name (dll, Qnil);
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 if we have already opened it first */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
79 h = g_hash_table_lookup (dll_cache, XSTRING_DATA (dll));
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 if (!h)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
82 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
83 h = dll_open ((char *) XSTRING_DATA (dll));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
84
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
85 if (h)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
86 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
87 g_hash_table_insert (dll_cache, g_strdup (XSTRING_DATA (dll)), h);
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 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
90 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
91 signal_error (Qfile_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
92 "dll_open error", build_string (dll_error (NULL)));
462
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 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
95 return (h ? Qt : Qnil);
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
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 /* Gtk object importing */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
100 EXFUN (Fgtk_import_type, 1);
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 static struct hash_table *internal_type_hash;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
103
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
104 static int
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
105 type_hash_equal(const void *arg1, const void *arg2)
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 return ((GtkType) arg1 == (GtkType) arg2);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
108 }
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 static unsigned long
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
111 type_hash_hash(const void *arg)
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 return ((unsigned long) arg);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
114 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
115
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
116 static int
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
117 type_already_imported_p (GtkType t)
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 void *retval = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
120
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
121 /* These are cases that we don't need to import */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
122 switch (GTK_FUNDAMENTAL_TYPE (t))
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 case GTK_TYPE_CHAR:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
125 case GTK_TYPE_UCHAR:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
126 case GTK_TYPE_BOOL:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
127 case GTK_TYPE_INT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
128 case GTK_TYPE_UINT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
129 case GTK_TYPE_LONG:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
130 case GTK_TYPE_ULONG:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
131 case GTK_TYPE_FLOAT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
132 case GTK_TYPE_DOUBLE:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
133 case GTK_TYPE_STRING:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
134 case GTK_TYPE_BOXED:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
135 case GTK_TYPE_POINTER:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
136 case GTK_TYPE_SIGNAL:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
137 case GTK_TYPE_ARGS:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
138 case GTK_TYPE_CALLBACK:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
139 case GTK_TYPE_C_CALLBACK:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
140 case GTK_TYPE_FOREIGN:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
141 return (1);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
142 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
143
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
144 if (!internal_type_hash)
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 internal_type_hash = make_general_hash_table (163, type_hash_hash, type_hash_equal);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
147 return (0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
148 }
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 if (gethash ((void *)t, internal_type_hash, (const void **)&retval))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
151 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
152 return (1);
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 return (0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
155 }
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 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
158 mark_type_as_imported (GtkType t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
159 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
160 if (type_already_imported_p (t))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
161 return;
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 puthash ((void *) t, (void *) 1, internal_type_hash);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
164 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
165
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
166 static void import_gtk_type (GtkType t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
167
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
168 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
169 import_gtk_object_internal (GtkType the_type)
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 GtkType original_type = the_type;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
172 int first_time = 1;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
173
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
174 do
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 GtkArg *args;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
177 guint32 *flags;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
178 guint n_args;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
179 guint i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
180 #if 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
181 GtkObjectClass *klass;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
182 GtkSignalQuery *query;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
183 guint32 *signals;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
184 guint n_signals;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
185 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
186
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
187 /* Register the type before we do anything else with it... */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
188 if (!first_time)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
189 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
190 if (!type_already_imported_p (the_type))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
191 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
192 import_gtk_type (the_type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
193 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
194 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
195 else
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 /* We need to mark the object type as imported here or we
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
198 run the risk of SERIOUS recursion when we do automatic
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
199 argument type importing. mark_type_as_imported() is
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
200 smart enough to be a noop if we attempt to register
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
201 things twice. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
202 first_time = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
203 mark_type_as_imported (the_type);
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
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
206 args = gtk_object_query_args(the_type,&flags,&n_args);
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 /* First get the arguments the object can accept */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
209 for (i = 0; i < n_args; i++)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
210 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
211 if ((args[i].type != original_type) && !type_already_imported_p (args[i].type))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
212 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
213 import_gtk_type (args[i].type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
214 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
215 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
216
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
217 g_free(args);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
218 g_free(flags);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
219
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
220 #if 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
221 /* Now lets publish the signals */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
222 klass = (GtkObjectClass *) gtk_type_class (the_type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
223 signals = klass->signals;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
224 n_signals = klass->nsignals;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
225
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
226 for (i = 0; i < n_signals; i++)
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 query = gtk_signal_query (signals[i]);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
229 /* What do we want to do here? */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
230 g_free (query);
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 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
233
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
234 the_type = gtk_type_parent(the_type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
235 } while (the_type != GTK_TYPE_INVALID);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
236 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
237
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
238 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
239 import_gtk_enumeration_internal (GtkType the_type)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
240 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
241 GtkEnumValue *vals = gtk_type_enum_get_values (the_type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
242 Lisp_Object assoc = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
243
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
244 if (NILP (Venumeration_info))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
245 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
246 Venumeration_info = call2 (intern ("make-hashtable"), make_int (100), Qequal);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
247 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
248
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
249 while (vals && vals->value_name)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
250 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
251 assoc = Fcons (Fcons (intern (vals->value_nick), make_int (vals->value)), assoc);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
252 assoc = Fcons (Fcons (intern (vals->value_name), make_int (vals->value)), assoc);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
253 vals++;
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 assoc = Fnreverse (assoc);
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 Fputhash (make_int (the_type), assoc, Venumeration_info);
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 void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
262 import_gtk_type (GtkType t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
263 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
264 if (type_already_imported_p (t))
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 return;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
267 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
268
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
269 switch (GTK_FUNDAMENTAL_TYPE (t))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
270 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
271 case GTK_TYPE_ENUM:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
272 case GTK_TYPE_FLAGS:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
273 import_gtk_enumeration_internal (t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
274 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
275 case GTK_TYPE_OBJECT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
276 import_gtk_object_internal (t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
277 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
278 default:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
279 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
280 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
281
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
282 mark_type_as_imported (t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
283 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
284
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
285
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
286 /* Foreign function calls */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
287 static emacs_ffi_data *
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
288 allocate_ffi_data (void)
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 emacs_ffi_data *data = alloc_lcrecord_type (emacs_ffi_data, &lrecord_emacs_ffi);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
291
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
292 data->return_type = GTK_TYPE_NONE;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
293 data->n_args = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
294 data->function_name = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
295 data->function_ptr = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
296 data->marshal = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
297
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
298 return (data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
299 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
300
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
301 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
302 mark_ffi_data (Lisp_Object obj)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
303 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
304 emacs_ffi_data *data = (emacs_ffi_data *) XFFI (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
305
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
306 mark_object (data->function_name);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
307 return (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
308 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
309
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
310 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
311 ffi_object_printer (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
312 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
313 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
314 printing_unreadable_object ("#<ffi %p>", XFFI (obj)->function_ptr);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
315
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 797
diff changeset
316 write_fmt_string_lisp (printcharfun, "#<ffi %S", 1, XFFI (obj)->function_name);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
317 if (XFFI (obj)->n_args)
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 797
diff changeset
318 write_fmt_string (printcharfun, " %d arguments", XFFI (obj)->n_args);
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 797
diff changeset
319 write_fmt_string (printcharfun, " %p>", (void *)XFFI (obj)->function_ptr);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
320 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
321
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
322 DEFINE_LRECORD_IMPLEMENTATION ("ffi", emacs_ffi,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
323 mark_ffi_data, ffi_object_printer,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
324 0, 0, 0, NULL, emacs_ffi_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
325
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
326 typedef GtkObject * (*__OBJECT_fn) ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
327 typedef gint (*__INT_fn) ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
328 typedef void (*__NONE_fn) ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
329 typedef gchar * (*__STRING_fn) ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
330 typedef gboolean (*__BOOL_fn) ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
331 typedef gfloat (*__FLOAT_fn) ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
332 typedef void * (*__POINTER_fn) ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
333 typedef GList * (*__LIST_fn) ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
334
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
335 /* An auto-generated file of marshalling functions. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
336 #include "emacs-marshals.c"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
337
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
338 #define CONVERT_SINGLE_TYPE(var,nam,tp) case GTK_TYPE_##nam: GTK_VALUE_##nam (var) = * (tp *) v; break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
339 #define CONVERT_RETVAL(a,freep) \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
340 do { \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
341 void *v = GTK_VALUE_POINTER(a); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
342 switch (GTK_FUNDAMENTAL_TYPE (a.type)) \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
343 { \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
344 CONVERT_SINGLE_TYPE(a,CHAR,gchar); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
345 CONVERT_SINGLE_TYPE(a,UCHAR,guchar); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
346 CONVERT_SINGLE_TYPE(a,BOOL,gboolean); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
347 CONVERT_SINGLE_TYPE(a,INT,gint); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
348 CONVERT_SINGLE_TYPE(a,UINT,guint); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
349 CONVERT_SINGLE_TYPE(a,LONG,glong); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
350 CONVERT_SINGLE_TYPE(a,ULONG,gulong); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
351 CONVERT_SINGLE_TYPE(a,FLOAT,gfloat); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
352 CONVERT_SINGLE_TYPE(a,DOUBLE,gdouble); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
353 CONVERT_SINGLE_TYPE(a,STRING,gchar *); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
354 CONVERT_SINGLE_TYPE(a,ENUM,gint); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
355 CONVERT_SINGLE_TYPE(a,FLAGS,guint); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
356 CONVERT_SINGLE_TYPE(a,BOXED,void *); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
357 CONVERT_SINGLE_TYPE(a,POINTER,void *); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
358 CONVERT_SINGLE_TYPE(a,OBJECT,GtkObject *); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
359 default: \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
360 GTK_VALUE_POINTER (a) = * (void **) v; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
361 break; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
362 } \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
363 if (freep) xfree(v); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
364 } while (0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
365
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 563
diff changeset
366 static gpointer __allocate_object_storage (GtkType t)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
367 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
368 size_t s = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
369 void *rval = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
370
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
371 switch (GTK_FUNDAMENTAL_TYPE (t))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
372 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
373 /* flag types */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
374 case GTK_TYPE_CHAR:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
375 s = (sizeof (gchar));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
376 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
377 case GTK_TYPE_UCHAR:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
378 s = (sizeof (guchar));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
379 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
380 case GTK_TYPE_BOOL:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
381 s = (sizeof (gboolean));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
382 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
383 case GTK_TYPE_INT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
384 s = (sizeof (gint));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
385 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
386 case GTK_TYPE_UINT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
387 s = (sizeof (guint));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
388 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
389 case GTK_TYPE_LONG:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
390 s = (sizeof (glong));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
391 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
392 case GTK_TYPE_ULONG:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
393 s = (sizeof (gulong));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
394 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
395 case GTK_TYPE_FLOAT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
396 s = (sizeof (gfloat));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
397 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
398 case GTK_TYPE_DOUBLE:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
399 s = (sizeof (gdouble));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
400 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
401 case GTK_TYPE_STRING:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
402 s = (sizeof (gchar *));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
403 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
404 case GTK_TYPE_ENUM:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
405 case GTK_TYPE_FLAGS:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
406 s = (sizeof (guint));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
407 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
408 case GTK_TYPE_BOXED:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
409 case GTK_TYPE_POINTER:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
410 s = (sizeof (void *));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
411 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
412
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
413 /* base type of the object system */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
414 case GTK_TYPE_OBJECT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
415 s = (sizeof (GtkObject *));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
416 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
417
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
418 default:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
419 if (GTK_FUNDAMENTAL_TYPE (t) == GTK_TYPE_LISTOF)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
420 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
421 s = (sizeof (void *));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
422 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
423 rval = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
424 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
425 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
426
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
427 if (s)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
428 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
429 rval = xmalloc (s);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
430 memset (rval, '\0', s);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
431 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
432
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
433 return (rval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
434 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
435
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 563
diff changeset
436 static Lisp_Object type_to_marshaller_type (GtkType t)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
437 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
438 switch (GTK_FUNDAMENTAL_TYPE (t))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
439 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
440 case GTK_TYPE_NONE:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
441 return (build_string ("NONE"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
442 /* flag types */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
443 case GTK_TYPE_CHAR:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
444 case GTK_TYPE_UCHAR:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
445 return (build_string ("CHAR"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
446 case GTK_TYPE_BOOL:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
447 return (build_string ("BOOL"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
448 case GTK_TYPE_ENUM:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
449 case GTK_TYPE_FLAGS:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
450 case GTK_TYPE_INT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
451 case GTK_TYPE_UINT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
452 return (build_string ("INT"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
453 case GTK_TYPE_LONG:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
454 case GTK_TYPE_ULONG:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
455 return (build_string ("LONG"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
456 case GTK_TYPE_FLOAT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
457 case GTK_TYPE_DOUBLE:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
458 return (build_string ("FLOAT"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
459 case GTK_TYPE_STRING:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
460 return (build_string ("STRING"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
461 case GTK_TYPE_BOXED:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
462 case GTK_TYPE_POINTER:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
463 return (build_string ("POINTER"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
464 case GTK_TYPE_OBJECT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
465 return (build_string ("OBJECT"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
466 case GTK_TYPE_CALLBACK:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
467 return (build_string ("CALLBACK"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
468 default:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
469 /* I can't put this in the main switch statement because it is a
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
470 new fundamental type that is not fixed at compile time.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
471 *sigh*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
472 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
473 if (GTK_FUNDAMENTAL_TYPE (t) == GTK_TYPE_ARRAY)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
474 return (build_string ("ARRAY"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
475
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
476 if (GTK_FUNDAMENTAL_TYPE (t) == GTK_TYPE_LISTOF)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
477 return (build_string ("LIST"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
478 return (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
479 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
480 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
481
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
482 struct __dll_mapper_closure {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
483 void * (*func) (dll_handle, const char *);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
484 const char *obj_name;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
485 void **storage;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
486 };
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
487
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
488 static void __dll_mapper (gpointer key, gpointer value, gpointer user_data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
489 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
490 struct __dll_mapper_closure *closure = (struct __dll_mapper_closure *) user_data;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
491
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
492 if (*(closure->storage) == NULL)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
493 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
494 /* Need to see if it is in this one */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
495 *(closure->storage) = closure->func ((dll_handle) value, closure->obj_name);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
496 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
497 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
498
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
499 DEFUN ("gtk-import-variable-internal", Fgtk_import_variable_internal, 2, 2, 0, /*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
500 Import a variable into the XEmacs namespace.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
501 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
502 (type, name))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
503 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
504 void *var = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
505 GtkArg arg;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
506
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
507 if (SYMBOLP (type)) type = Fsymbol_name (type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
508
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
509 CHECK_STRING (type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
510 CHECK_STRING (name);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
511
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
512 initialize_dll_cache ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
513 xemacs_init_gtk_classes ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
514
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
515 arg.type = gtk_type_from_name ((char *) XSTRING_DATA (type));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
516
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
517 if (arg.type == GTK_TYPE_INVALID)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
518 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
519 sferror ("Unknown type", type);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
520 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
521
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
522 /* Need to look thru the already-loaded dlls */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
523 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
524 struct __dll_mapper_closure closure;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
525
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
526 closure.func = dll_variable;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
527 closure.obj_name = XSTRING_DATA (name);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
528 closure.storage = &var;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
529
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
530 g_hash_table_foreach (dll_cache, __dll_mapper, &closure);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
531 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
532
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
533 if (!var)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
534 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
535 gui_error ("Could not locate variable", name);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
536 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
537
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
538 GTK_VALUE_POINTER(arg) = var;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
539 CONVERT_RETVAL (arg, 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
540 return (gtk_type_to_lisp (&arg));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
541 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
542
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
543 DEFUN ("gtk-import-function-internal", Fgtk_import_function_internal, 2, 3, 0, /*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
544 Import a function into the XEmacs namespace.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
545 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
546 (rettype, name, args))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
547 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
548 Lisp_Object rval = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
549 Lisp_Object marshaller = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
550 emacs_ffi_data *data = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
551 gint n_args = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
552 #if 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
553 dll_handle h = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
554 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
555 ffi_marshalling_function marshaller_func = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
556 ffi_actual_function name_func = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
557
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
558 CHECK_SYMBOL (rettype);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
559 CHECK_STRING (name);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
560 CHECK_LIST (args);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
561
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
562 initialize_dll_cache ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
563 xemacs_init_gtk_classes ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
564
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
565 /* Need to look thru the already-loaded dlls */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
566 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
567 struct __dll_mapper_closure closure;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
568
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
569 closure.func = dll_function;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
570 closure.obj_name = XSTRING_DATA (name);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
571 closure.storage = (void **) &name_func;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
572
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
573 g_hash_table_foreach (dll_cache, __dll_mapper, &closure);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
574 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
575
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
576 if (!name_func)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
577 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
578 gui_error ("Could not locate function", name);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
579 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
580
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
581 data = allocate_ffi_data ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
582
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
583 if (NILP (rettype))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
584 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
585 rettype = Qvoid;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
586 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
587
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
588 if (!NILP (args))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
589 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
590 Lisp_Object tail = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
591 Lisp_Object value = args;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
592 Lisp_Object type = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
593
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
594 EXTERNAL_LIST_LOOP (tail, value)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
595 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
596 GtkType the_type;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
597 Lisp_Object marshaller_type = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
598
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
599 CHECK_SYMBOL (XCAR (tail));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
600
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
601 type = Fsymbol_name (XCAR (tail));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
602
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
603 the_type = gtk_type_from_name ((char *) XSTRING_DATA (type));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
604
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
605 if (the_type == GTK_TYPE_INVALID)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
606 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
607 invalid_argument ("Unknown argument type", type);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
608 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
609
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
610 /* All things must be reduced to their basest form... */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
611 import_gtk_type (the_type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
612 data->args[n_args] = the_type; /* GTK_FUNDAMENTAL_TYPE (the_type); */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
613
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
614 /* Now lets build up another chunk of our marshaller function name */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
615 marshaller_type = type_to_marshaller_type (data->args[n_args]);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
616
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
617 if (NILP (marshaller_type))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
618 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
619 invalid_argument ("Do not know how to marshal", type);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
620 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
621 marshaller = concat3 (marshaller, build_string ("_"), marshaller_type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
622 n_args++;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
623 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
624 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
625 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
626 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
627 marshaller = concat3 (marshaller, build_string ("_"), type_to_marshaller_type (GTK_TYPE_NONE));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
628 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
629
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
630 rettype = Fsymbol_name (rettype);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
631 data->return_type = gtk_type_from_name ((char *) XSTRING_DATA (rettype));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
632
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
633 if (data->return_type == GTK_TYPE_INVALID)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
634 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
635 invalid_argument ("Unknown return type", rettype);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
636 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
637
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
638 import_gtk_type (data->return_type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
639
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
640 marshaller = concat3 (type_to_marshaller_type (data->return_type), build_string ("_"), marshaller);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
641 marshaller = concat2 (build_string ("emacs_gtk_marshal_"), marshaller);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
642
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
643 marshaller_func = (ffi_marshalling_function) find_marshaller ((char *) XSTRING_DATA (marshaller));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
644
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
645 if (!marshaller_func)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
646 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
647 gui_error ("Could not locate marshaller function", marshaller);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
648 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
649
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
650 data->n_args = n_args;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
651 data->function_name = name;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
652 data->function_ptr = name_func;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
653 data->marshal = marshaller_func;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
654
797
776fcda0ee36 [xemacs-hg @ 2002-03-29 13:51:37 by wmperry]
wmperry
parents: 793
diff changeset
655 rval = wrap_emacs_ffi (data);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
656 return (rval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
657 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
658
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
659 DEFUN ("gtk-call-function", Fgtk_call_function, 1, 2, 0, /*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
660 Call an external function.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
661 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
662 (func, args))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
663 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
664 GtkArg the_args[MAX_GTK_ARGS];
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
665 gint n_args = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
666 Lisp_Object retval = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
667
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
668 CHECK_FFI (func);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
669 CHECK_LIST (args);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
670
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
671 n_args = XINT (Flength (args));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
672
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
673 #ifdef XEMACS_IS_SMARTER_THAN_THE_PROGRAMMER
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
674 /* #### I think this is too dangerous to enable by default.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
675 ** #### Genuine program bugs would probably be allowed to
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
676 ** #### slip by, and not be very easy to find.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
677 ** #### Bill Perry July 9, 2000
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
678 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
679 if (n_args != XFFI(func)->n_args)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
680 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
681 Lisp_Object for_append[3];
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
682
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
683 /* Signal an error if they pass in too many arguments */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
684 if (n_args > XFFI(func)->n_args)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
685 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
686 return Fsignal (Qwrong_number_of_arguments,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
687 list2 (func, make_int (n_args)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
688 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
689
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
690 /* If they did not provide enough arguments, be nice and assume
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
691 ** they wanted `nil' in there.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
692 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
693 for_append[0] = args;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
694 for_append[1] = Fmake_list (make_int (XFFI(func)->n_args - n_args), Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
695
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
696 args = Fappend (2, for_append);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
697 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
698 #else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
699 if (n_args != XFFI(func)->n_args)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
700 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
701 /* Signal an error if they do not pass in the correct # of arguments */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
702 return Fsignal (Qwrong_number_of_arguments,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
703 list2 (func, make_int (n_args)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
704 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
705 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
706
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
707 if (!NILP (args))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
708 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
709 Lisp_Object tail = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
710 Lisp_Object value = args;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
711
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
712 CHECK_LIST (args);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
713 n_args = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
714
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
715 /* First we convert all of the arguments from Lisp to GtkArgs */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
716 EXTERNAL_LIST_LOOP (tail, value)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
717 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
718 the_args[n_args].type = XFFI (func)->args[n_args];
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
719
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
720 if (lisp_to_gtk_type (XCAR (tail), &the_args[n_args]))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
721 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
722 /* There was some sort of an error */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
723 gui_error ("Error converting arguments", args);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
724 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
725 n_args++;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
726 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
727 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
728
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
729 /* Now we need to tack on space for a return value, if they have
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
730 asked for one */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
731 if (XFFI (func)->return_type != GTK_TYPE_NONE)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
732 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
733 the_args[n_args].type = XFFI (func)->return_type;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
734 GTK_VALUE_POINTER (the_args[n_args]) = __allocate_object_storage (the_args[n_args].type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
735 n_args++;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
736 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
737
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
738 XFFI (func)->marshal ((ffi_actual_function) (XFFI (func)->function_ptr), the_args);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
739
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
740 if (XFFI (func)->return_type != GTK_TYPE_NONE)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
741 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
742 CONVERT_RETVAL (the_args[n_args - 1], 1);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
743 retval = gtk_type_to_lisp (&the_args[n_args - 1]);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
744 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
745
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
746 /* Need to free any array or list pointers */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
747 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
748 int i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
749 for (i = 0; i < n_args; i++)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
750 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
751 if (GTK_FUNDAMENTAL_TYPE (the_args[i].type) == GTK_TYPE_ARRAY)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
752 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
753 g_free (GTK_VALUE_POINTER (the_args[i]));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
754 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
755 else if (GTK_FUNDAMENTAL_TYPE (the_args[i].type) == GTK_TYPE_LISTOF)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
756 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
757 /* g_list_free (GTK_VALUE_POINTER (the_args[i])); */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
758 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
759 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
760 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
761
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
762 return (retval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
763 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
764
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
765
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
766
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
767 /* GtkObject wrapping for Lisp */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
768 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
769 emacs_gtk_object_printer (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
770 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
771 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
772 printing_unreadable_object ("#<GtkObject %p>", XGTK_OBJECT (obj)->object);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
773
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
774 write_c_string (printcharfun, "#<GtkObject (");
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
775 if (XGTK_OBJECT (obj)->alive_p)
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
776 write_c_string (printcharfun, gtk_type_name (GTK_OBJECT_TYPE (XGTK_OBJECT (obj)->object)));
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
777 else
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
778 write_c_string (printcharfun, "dead");
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 797
diff changeset
779 write_fmt_string (printcharfun, ") %p>", (void *) XGTK_OBJECT (obj)->object);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
780 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
781
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
782 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
783 object_getprop (Lisp_Object obj, Lisp_Object prop)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
784 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
785 Lisp_Object rval = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
786 Lisp_Object prop_name = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
787 GtkArgInfo *info = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
788 char *err;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
789 GtkArg args[2];
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
790
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
791 CHECK_SYMBOL (prop); /* Shouldn't need to ever do this, but I'm paranoid */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
792
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
793 prop_name = Fsymbol_name (prop);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
794
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
795 args[0].name = (char *) XSTRING_DATA (prop_name);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
796
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
797 err = gtk_object_arg_get_info (GTK_OBJECT_TYPE (XGTK_OBJECT (obj)->object),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
798 args[0].name,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
799 &info);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
800
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
801 if (err)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
802 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
803 /* Not a magic symbol, fall back to just looking in our real plist */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
804 g_free (err);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
805
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
806 return (Fplist_get (XGTK_OBJECT (obj)->plist, prop, Qunbound));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
807 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
808
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
809 if (!(info->arg_flags & GTK_ARG_READABLE))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
810 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
811 invalid_operation ("Attempt to get write-only property", prop);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
812 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
813
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
814 gtk_object_getv (XGTK_OBJECT (obj)->object, 1, args);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
815
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
816 if (args[0].type == GTK_TYPE_INVALID)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
817 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
818 /* If we can't get the attribute, then let the code in Fget know
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
819 so it can use the default value supplied by the caller */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
820 return (Qunbound);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
821 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
822
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
823 rval = gtk_type_to_lisp (&args[0]);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
824
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
825 /* Free up any memory. According to the documentation and Havoc's
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
826 book, if the fundamental type of the returned value is
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
827 GTK_TYPE_STRING, GTK_TYPE_BOXED, or GTK_TYPE_ARGS, you are
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
828 responsible for freeing it. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
829 switch (GTK_FUNDAMENTAL_TYPE (args[0].type))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
830 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
831 case GTK_TYPE_STRING:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
832 g_free (GTK_VALUE_STRING (args[0]));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
833 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
834 case GTK_TYPE_BOXED:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
835 g_free (GTK_VALUE_BOXED (args[0]));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
836 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
837 case GTK_TYPE_ARGS:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
838 g_free (GTK_VALUE_ARGS (args[0]).args);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
839 default:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
840 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
841 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
842
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
843 return (rval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
844 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
845
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
846 static int
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
847 object_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
848 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
849 GtkArgInfo *info = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
850 Lisp_Object prop_name = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
851 GtkArg args[2];
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
852 char *err = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
853
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
854 prop_name = Fsymbol_name (prop);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
855
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
856 args[0].name = (char *) XSTRING_DATA (prop_name);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
857
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
858 err = gtk_object_arg_get_info (GTK_OBJECT_TYPE (XGTK_OBJECT (obj)->object),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
859 args[0].name,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
860 &info);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
861
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
862 if (err)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
863 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
864 /* Not a magic symbol, fall back to just storing in our real plist */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
865 g_free (err);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
866
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
867 XGTK_OBJECT (obj)->plist = Fplist_put (XGTK_OBJECT (obj)->plist, prop, value);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
868 return (1);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
869 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
870
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
871 args[0].type = info->type;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
872
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
873 if (lisp_to_gtk_type (value, &args[0]))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
874 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
875 gui_error ("Error converting to GtkType", value);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
876 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
877
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
878 if (!(info->arg_flags & GTK_ARG_WRITABLE))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
879 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
880 invalid_operation ("Attempt to set read-only argument", prop);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
881 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
882
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
883 gtk_object_setv (XGTK_OBJECT (obj)->object, 1, args);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
884
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
885 return (1);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
886 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
887
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
888 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
889 mark_gtk_object_data (Lisp_Object obj)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
890 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
891 return (XGTK_OBJECT (obj)->plist);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
892 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
893
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
894 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
895 emacs_gtk_object_finalizer (void *header, int for_disksave)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
896 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
897 emacs_gtk_object_data *data = (emacs_gtk_object_data *) header;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
898
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
899 if (for_disksave)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
900 {
797
776fcda0ee36 [xemacs-hg @ 2002-03-29 13:51:37 by wmperry]
wmperry
parents: 793
diff changeset
901 Lisp_Object obj = wrap_emacs_gtk_object (data);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 778
diff changeset
902
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
903
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
904 invalid_operation
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
905 ("Can't dump an emacs containing GtkObject objects", obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
906 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
907
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
908 if (data->alive_p)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
909 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
910 gtk_object_unref (data->object);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
911 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
912 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
913
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
914 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("GtkObject", emacs_gtk_object,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
915 mark_gtk_object_data, /* marker function */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
916 emacs_gtk_object_printer, /* print function */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
917 emacs_gtk_object_finalizer, /* finalizer */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
918 0, /* equality */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
919 0, /* hash */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
920 NULL, /* desc */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
921 object_getprop, /* get prop */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
922 object_putprop, /* put prop */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
923 0, /* rem prop */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
924 0, /* plist */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
925 emacs_gtk_object_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
926
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
927 static emacs_gtk_object_data *
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
928 allocate_emacs_gtk_object_data (void)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
929 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
930 emacs_gtk_object_data *data = alloc_lcrecord_type (emacs_gtk_object_data,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
931 &lrecord_emacs_gtk_object);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
932
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
933 data->object = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
934 data->alive_p = FALSE;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
935 data->plist = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
936
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
937 return (data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
938 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
939
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
940 /* We need to keep track of when the object is destroyed so that we
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
941 can mark it as dead, otherwise even our print routine (which calls
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
942 GTK_OBJECT_TYPE) will crap out and die. This is also used in the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
943 lisp_to_gtk_type() routine to defend against passing dead objects
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
944 to GTK routines. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
945 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
946 __notice_object_destruction (GtkObject *obj, gpointer user_data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
947 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
948 ungcpro_popup_callbacks ((GUI_ID) user_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
949 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
950
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
951 Lisp_Object build_gtk_object (GtkObject *obj)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
952 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
953 Lisp_Object retval = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
954 emacs_gtk_object_data *data = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
955 GUI_ID id = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
956
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
957 id = (GUI_ID) gtk_object_get_data (obj, "xemacs::gui_id");
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
958
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
959 if (id)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
960 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
961 retval = get_gcpro_popup_callbacks (id);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
962 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
963
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
964 if (NILP (retval))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
965 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
966 data = allocate_emacs_gtk_object_data ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
967
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
968 data->object = obj;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
969 data->alive_p = TRUE;
797
776fcda0ee36 [xemacs-hg @ 2002-03-29 13:51:37 by wmperry]
wmperry
parents: 793
diff changeset
970 retval = wrap_emacs_gtk_object (data);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
971
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
972 id = new_gui_id ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
973 gtk_object_set_data (obj, "xemacs::gui_id", (gpointer) id);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
974 gcpro_popup_callbacks (id, retval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
975 gtk_object_ref (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
976 gtk_signal_connect (obj, "destroy", GTK_SIGNAL_FUNC (__notice_object_destruction), (gpointer)id);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
977 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
978
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
979 return (retval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
980 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
981
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
982 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
983 __internal_callback_destroy (gpointer data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
984 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
985 Lisp_Object lisp_data;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
986
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
987 lisp_data = VOID_TO_LISP (data);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
988
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
989 ungcpro_popup_callbacks (XINT (XCAR (lisp_data)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
990 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
991
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
992 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
993 __internal_callback_marshal (GtkObject *obj, gpointer data, guint n_args, GtkArg *args)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
994 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
995 Lisp_Object arg_list = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
996 Lisp_Object callback_fn = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
997 Lisp_Object callback_data = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
998 Lisp_Object newargs[3];
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
999 Lisp_Object rval = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1000 struct gcpro gcpro1;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1001 int i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1002
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
1003 callback_fn = VOID_TO_LISP (data);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1004
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1005 /* Nuke the GUI_ID off the front */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1006 callback_fn = XCDR (callback_fn);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1007
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1008 callback_data = XCAR (callback_fn);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1009 callback_fn = XCDR (callback_fn);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1010
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1011 /* The callback data goes at the very end of the argument list */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1012 arg_list = Fcons (callback_data, Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1013
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1014 /* Build up the argument list, lisp style */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1015 for (i = n_args - 1; i >= 0; i--)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1016 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1017 arg_list = Fcons (gtk_type_to_lisp (&args[i]), arg_list);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1018 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1019
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1020 /* We always pass the widget as the first parameter at the very least */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1021 arg_list = Fcons (build_gtk_object (obj), arg_list);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1022
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1023 GCPRO1 ((arg_list));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1024
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1025 newargs[0] = callback_fn;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1026 newargs[1] = arg_list;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1027
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1028 rval = Fapply (2, newargs);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1029 signal_fake_event ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1030
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1031 if (args[n_args].type != GTK_TYPE_NONE)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1032 lisp_to_gtk_type (rval, &args[n_args]);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1033
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1034 UNGCPRO;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1035 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1036
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1037 DEFUN ("gtk-signal-connect", Fgtk_signal_connect, 3, 6, 0, /*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1038 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1039 (obj, name, func, cb_data, object_signal, after_p))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1040 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1041 int c_after;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1042 int c_object_signal;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1043 GUI_ID id = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1044
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1045 CHECK_GTK_OBJECT (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1046
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1047 if (SYMBOLP (name))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1048 name = Fsymbol_name (name);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1049
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1050 CHECK_STRING (name);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1051
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1052 if (NILP (object_signal))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1053 c_object_signal = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1054 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1055 c_object_signal = 1;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1056
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1057 if (NILP (after_p))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1058 c_after = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1059 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1060 c_after = 1;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1061
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1062 id = new_gui_id ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1063 func = Fcons (cb_data, func);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1064 func = Fcons (make_int (id), func);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1065
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1066 gcpro_popup_callbacks (id, func);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1067
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1068 gtk_signal_connect_full (XGTK_OBJECT (obj)->object, (char *) XSTRING_DATA (name),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1069 NULL, __internal_callback_marshal, LISP_TO_VOID (func),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1070 __internal_callback_destroy, c_object_signal, c_after);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1071 return (Qt);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1072 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1073
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1074
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1075 /* GTK_TYPE_BOXED wrapper for Emacs lisp */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1076 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1077 emacs_gtk_boxed_printer (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1078 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1079 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1080 printing_unreadable_object ("#<GtkBoxed %p>", XGTK_BOXED (obj)->object);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1081
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
1082 write_c_string (printcharfun, "#<GtkBoxed (");
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
1083 write_c_string (printcharfun, gtk_type_name (XGTK_BOXED (obj)->object_type));
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 797
diff changeset
1084 write_fmt_string (printcharfun, ") %p>", (void *) XGTK_BOXED (obj)->object);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1085 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1086
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1087 static int
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1088 emacs_gtk_boxed_equality (Lisp_Object o1, Lisp_Object o2, int depth)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1089 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1090 emacs_gtk_boxed_data *data1 = XGTK_BOXED(o1);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1091 emacs_gtk_boxed_data *data2 = XGTK_BOXED(o2);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1092
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1093 return ((data1->object == data2->object) &&
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1094 (data1->object_type == data2->object_type));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1095 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1096
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1097 static unsigned long
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1098 emacs_gtk_boxed_hash (Lisp_Object obj, int depth)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1099 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1100 emacs_gtk_boxed_data *data = XGTK_BOXED(obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1101 return (HASH2 ((unsigned long)data->object, data->object_type));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1102 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1103
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1104 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("GtkBoxed", emacs_gtk_boxed,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1105 0, /* marker function */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1106 emacs_gtk_boxed_printer, /* print function */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1107 0, /* nuker */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1108 emacs_gtk_boxed_equality, /* equality */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1109 emacs_gtk_boxed_hash, /* hash */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1110 NULL, /* desc */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1111 0, /* get prop */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1112 0, /* put prop */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1113 0, /* rem prop */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1114 0, /* plist */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1115 emacs_gtk_boxed_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1116
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1117 /* Currently defined GTK_TYPE_BOXED structures are:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1118
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1119 GtkAccelGroup -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1120 GtkSelectionData -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1121 GtkStyle -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1122 GtkCTreeNode -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1123 GdkColormap -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1124 GdkVisual -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1125 GdkFont -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1126 GdkWindow -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1127 GdkDragContext -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1128 GdkEvent -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1129 GdkColor -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1130 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1131 static emacs_gtk_boxed_data *
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1132 allocate_emacs_gtk_boxed_data (void)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1133 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1134 emacs_gtk_boxed_data *data = alloc_lcrecord_type (emacs_gtk_boxed_data,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1135 &lrecord_emacs_gtk_boxed);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1136
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1137 data->object = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1138 data->object_type = GTK_TYPE_INVALID;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1139
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1140 return (data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1141 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1142
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1143 Lisp_Object build_gtk_boxed (void *obj, GtkType t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1144 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1145 Lisp_Object retval = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1146 emacs_gtk_boxed_data *data = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1147
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1148 if (GTK_FUNDAMENTAL_TYPE (t) != GTK_TYPE_BOXED)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1149 abort();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1150
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1151 data = allocate_emacs_gtk_boxed_data ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1152 data->object = obj;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1153 data->object_type = t;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1154
797
776fcda0ee36 [xemacs-hg @ 2002-03-29 13:51:37 by wmperry]
wmperry
parents: 793
diff changeset
1155 retval = wrap_emacs_gtk_boxed (data);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1156
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1157 return (retval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1158 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1159
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1160
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1161 /* The automatically generated structure access routines */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1162 #include "emacs-widget-accessors.c"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1163
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1164 /* The hand generated funky functions that we can't just import using the FFI */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1165 #include "ui-byhand.c"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1166
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1167 /* The glade support */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1168 #include "glade.c"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1169
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1170
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1171 /* Type manipulation */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1172 DEFUN ("gtk-fundamental-type", Fgtk_fundamental_type, 1, 1, 0, /*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1173 Load a shared library DLL into XEmacs. No initialization routines are required.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1174 This is for loading dependency DLLs into XEmacs.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1175 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1176 (type))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1177 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1178 GtkType t;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1179
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1180 if (SYMBOLP (type))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1181 type = Fsymbol_name (type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1182
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1183 CHECK_STRING (type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1184
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1185 t = gtk_type_from_name ((char *) XSTRING_DATA (type));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1186
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1187 if (t == GTK_TYPE_INVALID)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1188 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1189 invalid_argument ("Not a GTK type", type);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1190 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1191 return (make_int (GTK_FUNDAMENTAL_TYPE (t)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1192 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1193
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1194 DEFUN ("gtk-object-type", Fgtk_object_type, 1, 1, 0, /*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1195 Return the GtkType of OBJECT.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1196 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1197 (object))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1198 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1199 CHECK_GTK_OBJECT (object);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1200 return (make_int (GTK_OBJECT_TYPE (XGTK_OBJECT (object)->object)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1201 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1202
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1203 DEFUN ("gtk-describe-type", Fgtk_describe_type, 1, 1, 0, /*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1204 Returns a cons of two lists describing the Gtk object TYPE.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1205 The car is a list of all the signals that it will emit.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1206 The cdr is a list of all the magic properties it has.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1207 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1208 (type))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1209 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1210 Lisp_Object rval, signals, props;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1211 GtkType t;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1212
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1213 props = signals = rval = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1214
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1215 if (SYMBOLP (type))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1216 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1217 type = Fsymbol_name (type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1218 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1219
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1220 if (STRINGP (type))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1221 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1222 t = gtk_type_from_name (XSTRING_DATA (type));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1223 if (t == GTK_TYPE_INVALID)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1224 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1225 invalid_argument ("Not a GTK type", type);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1226 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1227 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1228 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1229 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1230 CHECK_INT (type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1231 t = XINT (type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1232 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1233
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1234 if (GTK_FUNDAMENTAL_TYPE (t) != GTK_TYPE_OBJECT)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1235 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1236 invalid_argument ("Not a GtkObject", type);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1237 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1238
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1239 /* Need to do stupid shit like this to get the args
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1240 ** registered... damn GTK and its lazy loading
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1241 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1242 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1243 GtkArg args[3];
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1244 GtkObject *obj = gtk_object_newv (t, 0, args);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1245
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1246 gtk_object_destroy(obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1247 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1248
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1249 do
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1250 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1251 guint i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1252
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1253 /* Do the magic arguments first */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1254 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1255 GtkArg *args;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1256 guint32 *flags;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1257 guint n_args;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1258
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1259 args = gtk_object_query_args(t,&flags,&n_args);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1260
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1261 for (i = 0; i < n_args; i++)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1262 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1263 props = Fcons (Fcons (intern (gtk_type_name(args[i].type)),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1264 intern (args[i].name)), props);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1265 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1266
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1267 g_free (args);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1268 g_free (flags);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1269 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1270
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1271 /* Now the signals */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1272 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1273 GtkObjectClass *klass;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1274 GtkSignalQuery *query;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1275 guint32 *gtk_signals;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1276 guint n_signals;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1277
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1278 klass = (GtkObjectClass *) gtk_type_class (t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1279 gtk_signals = klass->signals;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1280 n_signals = klass->nsignals;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1281
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1282 for (i = 0; i < n_signals; i++)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1283 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1284 Lisp_Object params = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1285
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1286 query = gtk_signal_query (gtk_signals[i]);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1287
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1288 if (query)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1289 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1290 if (query->nparams)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1291 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1292 int j;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1293
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1294 for (j = query->nparams - 1; j >= 0; j--)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1295 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1296 params = Fcons (intern (gtk_type_name (query->params[j])), params);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1297 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1298 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1299
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1300 signals = Fcons (Fcons (intern (gtk_type_name (query->return_val)),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1301 Fcons (intern (query->signal_name),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1302 params)),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1303 signals);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1304
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1305 g_free (query);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1306 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1307 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1308 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1309 t = gtk_type_parent(t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1310 } while (t != GTK_TYPE_INVALID);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1311
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1312 rval = Fcons (signals, props);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1313
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1314 return (rval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1315 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1316
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1317
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1318 void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1319 syms_of_ui_gtk (void)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1320 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1321 INIT_LRECORD_IMPLEMENTATION (emacs_ffi);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1322 INIT_LRECORD_IMPLEMENTATION (emacs_gtk_object);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1323 INIT_LRECORD_IMPLEMENTATION (emacs_gtk_boxed);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1324 DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_ffip);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1325 DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_gtk_objectp);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1326 DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_gtk_boxedp);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1327 DEFSYMBOL (Qvoid);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1328 DEFSUBR (Fdll_load);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1329 DEFSUBR (Fgtk_import_function_internal);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1330 DEFSUBR (Fgtk_import_variable_internal);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1331 DEFSUBR (Fgtk_signal_connect);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1332 DEFSUBR (Fgtk_call_function);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1333 DEFSUBR (Fgtk_fundamental_type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1334 DEFSUBR (Fgtk_object_type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1335 DEFSUBR (Fgtk_describe_type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1336 syms_of_widget_accessors ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1337 syms_of_ui_byhand ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1338 syms_of_glade ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1339 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1340
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1341 void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1342 vars_of_ui_gtk (void)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1343 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1344 Fprovide (intern ("gtk-ui"));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1345 DEFVAR_LISP ("gtk-enumeration-info", &Venumeration_info /*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1346 A hashtable holding type information about GTK enumerations and flags.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1347 Do NOT modify unless you really understand ui-gtk.c.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1348 */);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1349
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1350 Venumeration_info = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1351 vars_of_glade ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1352 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1353
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1354
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1355 /* Various utility functions */
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 563
diff changeset
1356 #if 0
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1357 void describe_gtk_arg (GtkArg *arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1358 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1359 GtkArg a = *arg;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1360
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1361 switch (GTK_FUNDAMENTAL_TYPE (a.type))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1362 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1363 /* flag types */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1364 case GTK_TYPE_CHAR:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1365 stderr_out ("char: %c\n", GTK_VALUE_CHAR (a));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1366 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1367 case GTK_TYPE_UCHAR:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1368 stderr_out ("uchar: %c\n", GTK_VALUE_CHAR (a));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1369 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1370 case GTK_TYPE_BOOL:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1371 stderr_out ("uchar: %s\n", GTK_VALUE_BOOL (a) ? "true" : "false");
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1372 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1373 case GTK_TYPE_INT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1374 stderr_out ("int: %d\n", GTK_VALUE_INT (a));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1375 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1376 case GTK_TYPE_UINT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1377 stderr_out ("uint: %du\n", GTK_VALUE_UINT (a));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1378 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1379 case GTK_TYPE_LONG:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1380 stderr_out ("long: %ld\n", GTK_VALUE_LONG (a));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1381 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1382 case GTK_TYPE_ULONG:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1383 stderr_out ("ulong: %lu\n", GTK_VALUE_ULONG (a));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1384 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1385 case GTK_TYPE_FLOAT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1386 stderr_out ("float: %g\n", GTK_VALUE_FLOAT (a));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1387 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1388 case GTK_TYPE_DOUBLE:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1389 stderr_out ("double: %f\n", GTK_VALUE_DOUBLE (a));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1390 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1391 case GTK_TYPE_STRING:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1392 stderr_out ("string: %s\n", GTK_VALUE_STRING (a));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1393 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1394 case GTK_TYPE_ENUM:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1395 case GTK_TYPE_FLAGS:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1396 stderr_out ("%s: ", (a.type == GTK_TYPE_ENUM) ? "enum" : "flag");
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1397 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1398 GtkEnumValue *vals = gtk_type_enum_get_values (a.type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1399
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1400 while (vals && vals->value_name && (vals->value != GTK_VALUE_ENUM(a))) vals++;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1401
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1402 stderr_out ("%s\n", vals ? vals->value_name : "!!! UNKNOWN ENUM VALUE !!!");
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1403 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1404 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1405 case GTK_TYPE_BOXED:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1406 stderr_out ("boxed: %p\n", GTK_VALUE_BOXED (a));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1407 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1408 case GTK_TYPE_POINTER:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1409 stderr_out ("pointer: %p\n", GTK_VALUE_BOXED (a));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1410 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1411
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1412 /* structured types */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1413 case GTK_TYPE_SIGNAL:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1414 case GTK_TYPE_ARGS: /* This we can do as a list of values */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1415 abort();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1416 case GTK_TYPE_CALLBACK:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1417 stderr_out ("callback fn: ...\n");
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1418 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1419 case GTK_TYPE_C_CALLBACK:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1420 case GTK_TYPE_FOREIGN:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1421 abort();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1422
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1423 /* base type of the object system */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1424 case GTK_TYPE_OBJECT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1425 if (GTK_VALUE_OBJECT (a))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1426 stderr_out ("object: %s\n", gtk_type_name (GTK_OBJECT_TYPE (GTK_VALUE_OBJECT (a))));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1427 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1428 stderr_out ("object: NULL\n");
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1429 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1430
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1431 default:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1432 abort();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1433 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1434 }
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 563
diff changeset
1435 #endif
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1436
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1437 Lisp_Object gtk_type_to_lisp (GtkArg *arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1438 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1439 switch (GTK_FUNDAMENTAL_TYPE (arg->type))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1440 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1441 case GTK_TYPE_NONE:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1442 return (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1443 case GTK_TYPE_CHAR:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1444 return (make_char (GTK_VALUE_CHAR (*arg)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1445 case GTK_TYPE_UCHAR:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1446 return (make_char (GTK_VALUE_UCHAR (*arg)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1447 case GTK_TYPE_BOOL:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1448 return (GTK_VALUE_BOOL (*arg) ? Qt : Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1449 case GTK_TYPE_INT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1450 return (make_int (GTK_VALUE_INT (*arg)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1451 case GTK_TYPE_UINT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1452 return (make_int (GTK_VALUE_INT (*arg)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1453 case GTK_TYPE_LONG: /* I think these are wrong! */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1454 return (make_int (GTK_VALUE_INT (*arg)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1455 case GTK_TYPE_ULONG: /* I think these are wrong! */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1456 return (make_int (GTK_VALUE_INT (*arg)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1457 case GTK_TYPE_FLOAT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1458 return (make_float (GTK_VALUE_FLOAT (*arg)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1459 case GTK_TYPE_DOUBLE:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1460 return (make_float (GTK_VALUE_DOUBLE (*arg)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1461 case GTK_TYPE_STRING:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1462 return (build_string (GTK_VALUE_STRING (*arg)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1463 case GTK_TYPE_FLAGS:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1464 return (flags_to_list (GTK_VALUE_FLAGS (*arg), arg->type));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1465 case GTK_TYPE_ENUM:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1466 return (enum_to_symbol (GTK_VALUE_ENUM (*arg), arg->type));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1467 case GTK_TYPE_BOXED:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1468 if (arg->type == GTK_TYPE_GDK_EVENT)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1469 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1470 return (gdk_event_to_emacs_event((GdkEvent *) GTK_VALUE_BOXED (*arg)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1471 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1472
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1473 if (GTK_VALUE_BOXED (*arg))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1474 return (build_gtk_boxed (GTK_VALUE_BOXED (*arg), arg->type));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1475 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1476 return (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1477 case GTK_TYPE_POINTER:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1478 if (GTK_VALUE_POINTER (*arg))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1479 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1480 Lisp_Object rval;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1481
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
1482 rval = VOID_TO_LISP (GTK_VALUE_POINTER (*arg));
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1483 return (rval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1484 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1485 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1486 return (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1487 case GTK_TYPE_OBJECT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1488 if (GTK_VALUE_OBJECT (*arg))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1489 return (build_gtk_object (GTK_VALUE_OBJECT (*arg)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1490 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1491 return (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1492
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1493 case GTK_TYPE_CALLBACK:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1494 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1495 Lisp_Object rval;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1496
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
1497 rval = VOID_TO_LISP (GTK_VALUE_CALLBACK (*arg).data);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1498
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1499 return (rval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1500 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1501
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1502 default:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1503 if (GTK_FUNDAMENTAL_TYPE (arg->type) == GTK_TYPE_LISTOF)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1504 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1505 if (!GTK_VALUE_POINTER (*arg))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1506 return (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1507 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1508 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1509 return (xemacs_gtklist_to_list (arg));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1510 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1511 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1512 stderr_out ("Do not know how to convert `%s' to lisp!\n", gtk_type_name (arg->type));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1513 abort ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1514 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1515 /* This is chuck reminding GCC to... SHUT UP! */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1516 return (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1517 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1518
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1519 int lisp_to_gtk_type (Lisp_Object obj, GtkArg *arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1520 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1521 switch (GTK_FUNDAMENTAL_TYPE (arg->type))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1522 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1523 /* flag types */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1524 case GTK_TYPE_NONE:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1525 return (0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1526 case GTK_TYPE_CHAR:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1527 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1528 Emchar c;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1529
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1530 CHECK_CHAR_COERCE_INT (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1531 c = XCHAR (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1532 GTK_VALUE_CHAR (*arg) = c;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1533 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1534 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1535 case GTK_TYPE_UCHAR:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1536 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1537 Emchar c;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1538
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1539 CHECK_CHAR_COERCE_INT (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1540 c = XCHAR (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1541 GTK_VALUE_CHAR (*arg) = c;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1542 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1543 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1544 case GTK_TYPE_BOOL:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1545 GTK_VALUE_BOOL (*arg) = NILP (obj) ? FALSE : TRUE;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1546 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1547 case GTK_TYPE_INT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1548 case GTK_TYPE_UINT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1549 if (NILP (obj) || EQ (Qt, obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1550 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1551 /* For we are a kind mistress and allow sending t/nil for
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1552 1/0 to stupid GTK functions that say they take guint or
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1553 gint in the header files, but actually treat it like a
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1554 bool. *sigh*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1555 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1556 GTK_VALUE_INT(*arg) = NILP (obj) ? 0 : 1;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1557 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1558 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1559 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1560 CHECK_INT (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1561 GTK_VALUE_INT(*arg) = XINT (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1562 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1563 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1564 case GTK_TYPE_LONG:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1565 case GTK_TYPE_ULONG:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1566 abort();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1567 case GTK_TYPE_FLOAT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1568 CHECK_INT_OR_FLOAT (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1569 GTK_VALUE_FLOAT(*arg) = extract_float (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1570 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1571 case GTK_TYPE_DOUBLE:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1572 CHECK_INT_OR_FLOAT (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1573 GTK_VALUE_DOUBLE(*arg) = extract_float (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1574 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1575 case GTK_TYPE_STRING:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1576 if (NILP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1577 GTK_VALUE_STRING (*arg) = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1578 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1579 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1580 CHECK_STRING (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1581 GTK_VALUE_STRING (*arg) = (char *) XSTRING_DATA (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1582 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1583 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1584 case GTK_TYPE_ENUM:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1585 case GTK_TYPE_FLAGS:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1586 /* Convert a lisp symbol to a GTK enum */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1587 GTK_VALUE_ENUM(*arg) = lisp_to_flag (obj, arg->type);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1588 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1589 case GTK_TYPE_BOXED:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1590 if (NILP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1591 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1592 GTK_VALUE_BOXED(*arg) = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1593 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1594 else if (GTK_BOXEDP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1595 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1596 GTK_VALUE_BOXED(*arg) = XGTK_BOXED (obj)->object;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1597 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1598 else if (arg->type == GTK_TYPE_STYLE)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1599 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1600 obj = Ffind_face (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1601 CHECK_FACE (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1602 GTK_VALUE_BOXED(*arg) = face_to_style (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1603 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1604 else if (arg->type == GTK_TYPE_GDK_GC)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1605 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1606 obj = Ffind_face (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1607 CHECK_FACE (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1608 GTK_VALUE_BOXED(*arg) = face_to_gc (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1609 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1610 else if (arg->type == GTK_TYPE_GDK_WINDOW)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1611 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1612 if (GLYPHP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1613 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1614 Lisp_Object window = Fselected_window (Qnil);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 778
diff changeset
1615 Lisp_Object instance =
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 778
diff changeset
1616 glyph_image_instance (obj, window, ERROR_ME_DEBUG_WARN, 1);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1617 struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (instance);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1618
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1619 switch (XIMAGE_INSTANCE_TYPE (instance))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1620 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1621 case IMAGE_TEXT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1622 case IMAGE_POINTER:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1623 case IMAGE_SUBWINDOW:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1624 case IMAGE_NOTHING:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1625 GTK_VALUE_BOXED(*arg) = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1626 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1627
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1628 case IMAGE_MONO_PIXMAP:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1629 case IMAGE_COLOR_PIXMAP:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1630 GTK_VALUE_BOXED(*arg) = IMAGE_INSTANCE_GTK_PIXMAP (p);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1631 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1632 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1633 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1634 else if (GTK_OBJECTP (obj) && GTK_IS_WIDGET (XGTK_OBJECT (obj)->object))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1635 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1636 GTK_VALUE_BOXED(*arg) = GTK_WIDGET (XGTK_OBJECT (obj))->window;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1637 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1638 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1639 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1640 invalid_argument ("Don't know how to convert object to GDK_WINDOW", obj);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1641 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1642 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1643 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1644 else if (arg->type == GTK_TYPE_GDK_COLOR)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1645 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1646 if (COLOR_SPECIFIERP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1647 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1648 /* If it is a specifier, we just convert it to an
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1649 instance, and let the ifs below handle it.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1650 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1651 obj = Fspecifier_instance (obj, Qnil, Qnil, Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1652 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1653
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1654 if (COLOR_INSTANCEP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1655 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1656 /* Easiest one */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1657 GTK_VALUE_BOXED(*arg) = COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (obj));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1658 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1659 else if (STRINGP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1660 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1661 invalid_argument ("Please use a color specifier or instance, not a string", obj);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1662 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1663 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1664 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1665 invalid_argument ("Don't know how to convert to GdkColor", obj);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1666 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1667 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1668 else if (arg->type == GTK_TYPE_GDK_FONT)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1669 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1670 if (SYMBOLP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1671 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1672 /* If it is a symbol, we treat that as a face name */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1673 obj = Ffind_face (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1674 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1675
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1676 if (FACEP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1677 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1678 /* If it is a face, we just grab the font specifier, and
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1679 cascade down until we finally reach a FONT_INSTANCE
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1680 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1681 obj = Fget (obj, Qfont, Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1682 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1683
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1684 if (FONT_SPECIFIERP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1685 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1686 /* If it is a specifier, we just convert it to an
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1687 instance, and let the ifs below handle it
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1688 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1689 obj = Fspecifier_instance (obj, Qnil, Qnil, Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1690 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1691
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1692 if (FONT_INSTANCEP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1693 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1694 /* Easiest one */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1695 GTK_VALUE_BOXED(*arg) = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (obj));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1696 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1697 else if (STRINGP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1698 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1699 invalid_argument ("Please use a font specifier or instance, not a string", obj);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1700 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1701 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1702 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1703 invalid_argument ("Don't know how to convert to GdkColor", obj);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1704 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1705 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1706 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1707 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1708 /* Unknown type to convert to boxed */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1709 stderr_out ("Don't know how to convert to boxed!\n");
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1710 GTK_VALUE_BOXED(*arg) = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1711 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1712 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1713
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1714 case GTK_TYPE_POINTER:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1715 if (NILP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1716 GTK_VALUE_POINTER(*arg) = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1717 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1718 GTK_VALUE_POINTER(*arg) = LISP_TO_VOID (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1719 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1720
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1721 /* structured types */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1722 case GTK_TYPE_SIGNAL:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1723 case GTK_TYPE_ARGS: /* This we can do as a list of values */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1724 case GTK_TYPE_C_CALLBACK:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1725 case GTK_TYPE_FOREIGN:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1726 stderr_out ("Do not know how to convert `%s' from lisp!\n", gtk_type_name (arg->type));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1727 return (-1);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1728
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1729 #if 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1730 /* #### BILL! */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1731 /* This is not used, and does not work with union type */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1732 case GTK_TYPE_CALLBACK:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1733 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1734 GUI_ID id;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1735
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1736 id = new_gui_id ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1737 obj = Fcons (Qnil, obj); /* Empty data */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1738 obj = Fcons (make_int (id), obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1739
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1740 gcpro_popup_callbacks (id, obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1741
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1742 GTK_VALUE_CALLBACK(*arg).marshal = __internal_callback_marshal;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1743 GTK_VALUE_CALLBACK(*arg).data = (gpointer) obj;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1744 GTK_VALUE_CALLBACK(*arg).notify = __internal_callback_destroy;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1745 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1746 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1747 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1748
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1749 /* base type of the object system */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1750 case GTK_TYPE_OBJECT:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1751 if (NILP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1752 GTK_VALUE_OBJECT (*arg) = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1753 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1754 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1755 CHECK_GTK_OBJECT (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1756 if (XGTK_OBJECT (obj)->alive_p)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1757 GTK_VALUE_OBJECT (*arg) = XGTK_OBJECT (obj)->object;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1758 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1759 invalid_argument ("Attempting to pass dead object to GTK function", obj);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1760 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1761 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1762
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1763 default:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1764 if (GTK_FUNDAMENTAL_TYPE (arg->type) == GTK_TYPE_ARRAY)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1765 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1766 if (NILP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1767 GTK_VALUE_POINTER(*arg) = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1768 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1769 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1770 xemacs_list_to_array (obj, arg);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1771 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1772 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1773 else if (GTK_FUNDAMENTAL_TYPE (arg->type) == GTK_TYPE_LISTOF)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1774 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1775 if (NILP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1776 GTK_VALUE_POINTER(*arg) = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1777 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1778 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1779 xemacs_list_to_gtklist (obj, arg);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1780 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1781 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1782 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1783 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1784 stderr_out ("Do not know how to convert `%s' from lisp!\n", gtk_type_name (arg->type));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1785 abort();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1786 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1787 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1788 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1789
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1790 return (0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1791 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1792
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1793 /* This is used in glyphs-gtk.c as well */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1794 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1795 get_enumeration (GtkType t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1796 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1797 Lisp_Object alist;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1798
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1799 if (NILP (Venumeration_info))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1800 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1801 Venumeration_info = call2 (intern ("make-hashtable"), make_int (100), Qequal);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1802 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1803
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1804 alist = Fgethash (make_int (t), Venumeration_info, Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1805
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1806 if (NILP (alist))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1807 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1808 import_gtk_enumeration_internal (t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1809 alist = Fgethash (make_int (t), Venumeration_info, Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1810 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1811 return (alist);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1812 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1813
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1814 guint
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1815 symbol_to_enum (Lisp_Object obj, GtkType t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1816 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1817 Lisp_Object alist = get_enumeration (t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1818 Lisp_Object value = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1819
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1820 if (NILP (alist))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1821 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1822 invalid_argument ("Unknown enumeration", build_string (gtk_type_name (t)));
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1823 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1824
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1825 value = Fassq (obj, alist);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1826
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1827 if (NILP (value))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1828 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1829 invalid_argument ("Unknown value", obj);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1830 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1831
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1832 CHECK_INT (XCDR (value));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1833
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1834 return (XINT (XCDR (value)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1835 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1836
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1837 static guint
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1838 lisp_to_flag (Lisp_Object obj, GtkType t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1839 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1840 guint val = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1841
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1842 if (NILP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1843 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1844 /* Do nothing */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1845 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1846 else if (SYMBOLP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1847 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1848 val = symbol_to_enum (obj, t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1849 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1850 else if (LISTP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1851 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1852 while (!NILP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1853 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1854 val |= symbol_to_enum (XCAR (obj), t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1855 obj = XCDR (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1856 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1857 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1858 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1859 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1860 /* abort ()? */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1861 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1862 return (val);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1863 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1864
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1865 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1866 flags_to_list (guint value, GtkType t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1867 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1868 Lisp_Object rval = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1869 Lisp_Object alist = get_enumeration (t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1870
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1871 while (!NILP (alist))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1872 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1873 if (value & XINT (XCDR (XCAR (alist))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1874 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1875 rval = Fcons (XCAR (XCAR (alist)), rval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1876 value &= ~(XINT (XCDR (XCAR (alist))));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1877 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1878 alist = XCDR (alist);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1879 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1880 return (rval);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1881 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1882
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1883 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1884 enum_to_symbol (guint value, GtkType t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1885 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1886 Lisp_Object alist = get_enumeration (t);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1887 Lisp_Object cell = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1888
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1889 if (NILP (alist))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1890 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1891 invalid_argument ("Unknown enumeration", build_string (gtk_type_name (t)));
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1892 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1893
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1894 cell = Frassq (make_int (value), alist);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1895
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1896 return (NILP (cell) ? Qnil : XCAR (cell));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1897 }