Mercurial > hg > xemacs-beta
annotate src/device-x.c @ 5348:39304a35b6b3
Don't commit suicide when an X device dies.
2011-01-30 Michael Sperber <mike@xemacs.org>
* redisplay.h:
* redisplay.c:
(redisplay_cancel_ritual_suicide):
* eval.c (throw_or_bomb_out_unsafe):
* device-x.c (x_IO_error_handler): Don't commit suicide when an X
device dies.
author | Mike Sperber <sperber@deinprogramm.de> |
---|---|
date | Sun, 30 Jan 2011 12:20:19 +0100 |
parents | f19e6bc25969 |
children | 0af042a0c116 |
rev | line source |
---|---|
428 | 1 /* Device functions for X windows. |
2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. | |
3 Copyright (C) 1994, 1995 Free Software Foundation, Inc. | |
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
4 Copyright (C) 2001, 2002, 2004, 2010 Ben Wing. |
428 | 5 |
6 This file is part of XEmacs. | |
7 | |
8 XEmacs is free software; you can redistribute it and/or modify it | |
9 under the terms of the GNU General Public License as published by the | |
10 Free Software Foundation; either version 2, or (at your option) any | |
11 later version. | |
12 | |
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
19 along with XEmacs; see the file COPYING. If not, write to | |
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
21 Boston, MA 02111-1307, USA. */ | |
22 | |
23 /* Synched up with: Not in FSF. */ | |
24 | |
442 | 25 /* 7-8-00 !!#### This file needs definite Mule review. */ |
26 | |
428 | 27 /* Original authors: Jamie Zawinski and the FSF */ |
28 /* Rewritten by Ben Wing and Chuck Thompson. */ | |
29 | |
30 #include <config.h> | |
31 #include "lisp.h" | |
32 | |
33 #include "buffer.h" | |
872 | 34 #include "device-impl.h" |
428 | 35 #include "elhash.h" |
36 #include "events.h" | |
37 #include "faces.h" | |
3707 | 38 #include "file-coding.h" |
872 | 39 #include "frame-impl.h" |
2684 | 40 #include "process.h" /* for egetenv */ |
428 | 41 #include "redisplay.h" |
42 #include "sysdep.h" | |
43 #include "window.h" | |
44 | |
872 | 45 #include "console-x-impl.h" |
800 | 46 #include "glyphs-x.h" |
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
5052
diff
changeset
|
47 #include "fontcolor-x.h" |
800 | 48 |
428 | 49 #include "sysfile.h" |
50 #include "systime.h" | |
51 | |
800 | 52 #include "xintrinsicp.h" /* CoreP.h needs this */ |
53 #include <X11/CoreP.h> /* Numerous places access the fields of | |
54 a core widget directly. We could | |
55 use XtGetValues(), but ... */ | |
4917 | 56 #include "gccache-x.h" |
800 | 57 #include <X11/Shell.h> |
4769
5460287a3327
Remove support for pre-X11R5 systems, including systems without Xmu. See
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
58 #include <X11/Xmu/Error.h> |
800 | 59 |
442 | 60 #if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D) |
440 | 61 #include "sysdll.h" |
442 | 62 #endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */ |
440 | 63 |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
64 Lisp_Object Vx_app_defaults_directory; |
771 | 65 #ifdef MULE |
66 Lisp_Object Qget_coding_system_from_locale; | |
428 | 67 #endif |
68 | |
69 /* Qdisplay in general.c */ | |
70 Lisp_Object Qx_error; | |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
71 Lisp_Object Qmake_device_early_x_entry_point, Qmake_device_late_x_entry_point; |
428 | 72 |
73 /* The application class of Emacs. */ | |
74 Lisp_Object Vx_emacs_application_class; | |
75 | |
76 Lisp_Object Vx_initial_argv_list; /* #### ugh! */ | |
77 | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
78 /* Shut up G++ 4.3. */ |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
79 #define Xrm_ODR(option,resource,type,default) \ |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
80 { (String) option, (String) resource, type, default } |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
81 |
428 | 82 static XrmOptionDescRec emacs_options[] = |
83 { | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
84 Xrm_ODR ("-geometry", ".geometry", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
85 Xrm_ODR ("-iconic", ".iconic", XrmoptionNoArg, (String) "yes"), |
428 | 86 |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
87 Xrm_ODR ("-internal-border-width", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
88 Xrm_ODR ("-ib", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
89 Xrm_ODR ("-scrollbar-width", "*EmacsFrame.scrollBarWidth", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
90 Xrm_ODR ("-scrollbar-height", "*EmacsFrame.scrollBarHeight", XrmoptionSepArg, NULL), |
428 | 91 |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
92 Xrm_ODR ("-privatecolormap", ".privateColormap", XrmoptionNoArg, (String) "yes"), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
93 Xrm_ODR ("-visual", ".EmacsVisual", XrmoptionSepArg, NULL), |
428 | 94 |
95 /* #### Beware! If the type of the shell changes, update this. */ | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
96 Xrm_ODR ("-T", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
97 Xrm_ODR ("-wn", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
98 Xrm_ODR ("-title", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL), |
428 | 99 |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
100 Xrm_ODR ("-iconname", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
101 Xrm_ODR ("-in", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
102 Xrm_ODR ("-mc", "*pointerColor", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
103 Xrm_ODR ("-cr", "*cursorColor", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
104 Xrm_ODR ("-fontset", "*FontSet", XrmoptionSepArg, NULL), |
428 | 105 }; |
106 | |
1204 | 107 static const struct memory_description x_device_data_description_1 [] = { |
108 { XD_LISP_OBJECT, offsetof (struct x_device, x_keysym_map_hash_table) }, | |
109 { XD_LISP_OBJECT, offsetof (struct x_device, WM_COMMAND_frame) }, | |
110 { XD_END } | |
111 }; | |
112 | |
3092 | 113 #ifdef NEW_GC |
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4790
diff
changeset
|
114 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("x-device", x_device, |
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4790
diff
changeset
|
115 0, x_device_data_description_1, |
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4790
diff
changeset
|
116 Lisp_X_Device); |
3092 | 117 #else /* not NEW_GC */ |
1204 | 118 extern const struct sized_memory_description x_device_data_description; |
119 | |
120 const struct sized_memory_description x_device_data_description = { | |
121 sizeof (struct x_device), x_device_data_description_1 | |
122 }; | |
3092 | 123 #endif /* not NEW_GC */ |
1204 | 124 |
428 | 125 /* Functions to synchronize mirroring resources and specifiers */ |
126 int in_resource_setting; | |
127 | |
128 /************************************************************************/ | |
129 /* helper functions */ | |
130 /************************************************************************/ | |
131 | |
132 /* JH 97/11/25 removed the static declaration because I need it during setup in event-Xt... */ | |
133 struct device * get_device_from_display_1 (Display *dpy); | |
134 struct device * | |
135 get_device_from_display_1 (Display *dpy) | |
136 { | |
137 Lisp_Object devcons, concons; | |
138 | |
139 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
140 { | |
141 struct device *d = XDEVICE (XCAR (devcons)); | |
142 if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d) == dpy) | |
143 return d; | |
144 } | |
145 | |
146 return 0; | |
147 } | |
148 | |
149 struct device * | |
150 get_device_from_display (Display *dpy) | |
151 { | |
5228
5efbd1253905
Remove all support for InfoDock.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5204
diff
changeset
|
152 #define FALLBACK_RESOURCE_NAME "xemacs" |
428 | 153 struct device *d = get_device_from_display_1 (dpy); |
154 | |
853 | 155 if (!d) |
156 { | |
157 /* This isn't one of our displays. Let's crash? */ | |
158 stderr_out | |
159 ("\n%s: Fatal X Condition. Asked about display we don't own: \"%s\"\n", | |
160 (STRINGP (Vinvocation_name) ? | |
161 (char *) XSTRING_DATA (Vinvocation_name) : FALLBACK_RESOURCE_NAME), | |
162 DisplayString (dpy) ? DisplayString (dpy) : "???"); | |
2500 | 163 ABORT(); |
853 | 164 } |
428 | 165 |
166 #undef FALLBACK_RESOURCE_NAME | |
167 | |
168 return d; | |
169 } | |
170 | |
171 struct device * | |
172 decode_x_device (Lisp_Object device) | |
173 { | |
793 | 174 device = wrap_device (decode_device (device)); |
428 | 175 CHECK_X_DEVICE (device); |
176 return XDEVICE (device); | |
177 } | |
178 | |
179 static Display * | |
180 get_x_display (Lisp_Object device) | |
181 { | |
182 return DEVICE_X_DISPLAY (decode_x_device (device)); | |
183 } | |
184 | |
771 | 185 static Lisp_Object |
2333 | 186 coding_system_of_xrm_database (XrmDatabase USED_IF_MULE (db)) |
771 | 187 { |
188 #ifdef MULE | |
3707 | 189 const Extbyte *locale; |
190 Lisp_Object localestr; | |
191 static XrmDatabase last_xrm_db; | |
192 | |
193 /* This will always be zero, nil or an actual coding system object, so no | |
194 need to worry about GCPROing it--it'll be protected from garbage | |
195 collection by means of Vcoding_system_hash_table in file-coding.c. */ | |
196 static Lisp_Object last_coding_system; | |
197 | |
198 if (db == last_xrm_db) | |
199 { | |
200 return last_coding_system; | |
201 } | |
202 | |
203 last_xrm_db = db; | |
204 | |
205 locale = XrmLocaleOfDatabase (db); | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
206 localestr = build_extstring (locale, Qbinary); |
3707 | 207 last_coding_system = call1 (Qget_coding_system_from_locale, localestr); |
208 | |
209 return last_coding_system; | |
771 | 210 #else |
211 return Qbinary; | |
212 #endif | |
213 } | |
214 | |
428 | 215 |
216 /************************************************************************/ | |
217 /* initializing an X connection */ | |
218 /************************************************************************/ | |
219 | |
756 | 220 static struct device *device_being_initialized = NULL; |
221 | |
428 | 222 static void |
223 allocate_x_device_struct (struct device *d) | |
224 { | |
3092 | 225 #ifdef NEW_GC |
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
226 d->device_data = XX_DEVICE (ALLOC_NORMAL_LISP_OBJECT (x_device)); |
3092 | 227 #else /* not NEW_GC */ |
428 | 228 d->device_data = xnew_and_zero (struct x_device); |
3092 | 229 #endif /* not NEW_GC */ |
428 | 230 } |
231 | |
232 static void | |
233 Xatoms_of_device_x (struct device *d) | |
234 { | |
235 Display *D = DEVICE_X_DISPLAY (d); | |
236 | |
237 DEVICE_XATOM_WM_PROTOCOLS (d) = XInternAtom (D, "WM_PROTOCOLS", False); | |
238 DEVICE_XATOM_WM_DELETE_WINDOW(d) = XInternAtom (D, "WM_DELETE_WINDOW",False); | |
239 DEVICE_XATOM_WM_SAVE_YOURSELF(d) = XInternAtom (D, "WM_SAVE_YOURSELF",False); | |
240 DEVICE_XATOM_WM_TAKE_FOCUS (d) = XInternAtom (D, "WM_TAKE_FOCUS", False); | |
241 DEVICE_XATOM_WM_STATE (d) = XInternAtom (D, "WM_STATE", False); | |
242 } | |
243 | |
244 static void | |
245 sanity_check_geometry_resource (Display *dpy) | |
246 { | |
771 | 247 Extbyte *app_name, *app_class, *s; |
248 Extbyte buf1 [255], buf2 [255]; | |
249 Extbyte *type; | |
428 | 250 XrmValue value; |
251 XtGetApplicationNameAndClass (dpy, &app_name, &app_class); | |
252 strcpy (buf1, app_name); | |
253 strcpy (buf2, app_class); | |
254 for (s = buf1; *s; s++) if (*s == '.') *s = '_'; | |
255 strcat (buf1, "._no_._such_._resource_.geometry"); | |
256 strcat (buf2, "._no_._such_._resource_.Geometry"); | |
257 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True) | |
258 { | |
867 | 259 Ibyte *app_name_int, *app_class_int, *value_addr_int; |
771 | 260 Lisp_Object codesys = coding_system_of_xrm_database (XtDatabase (dpy)); |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
261 app_name_int = EXTERNAL_TO_ITEXT (app_name, codesys); |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
262 app_class_int = EXTERNAL_TO_ITEXT (app_class, codesys); |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
263 value_addr_int = EXTERNAL_TO_ITEXT (value.addr, codesys); |
771 | 264 |
428 | 265 warn_when_safe (Qgeometry, Qerror, |
266 "\n" | |
267 "Apparently \"%s*geometry: %s\" or \"%s*geometry: %s\" was\n" | |
268 "specified in the resource database. Specifying \"*geometry\" will make\n" | |
269 "XEmacs (and most other X programs) malfunction in obscure ways. (i.e.\n" | |
270 "the Xt or Xm libraries will probably crash, which is a very bad thing.)\n" | |
271 "You should always use \".geometry\" or \"*EmacsFrame.geometry\" instead.\n", | |
771 | 272 app_name_int, value_addr_int, |
273 app_class_int, value_addr_int); | |
428 | 274 suppress_early_error_handler_backtrace = 1; |
563 | 275 syntax_error ("Invalid geometry resource", Qunbound); |
428 | 276 } |
277 } | |
278 | |
279 static void | |
280 x_init_device_class (struct device *d) | |
281 { | |
282 if (DEVICE_X_DEPTH(d) > 2) | |
283 { | |
1204 | 284 switch (DEVICE_X_VISUAL(d)->X_CLASSFIELD) |
428 | 285 { |
286 case StaticGray: | |
287 case GrayScale: | |
288 DEVICE_CLASS (d) = Qgrayscale; | |
289 break; | |
290 default: | |
291 DEVICE_CLASS (d) = Qcolor; | |
292 } | |
293 } | |
294 else | |
295 DEVICE_CLASS (d) = Qmono; | |
296 } | |
297 | |
298 /* | |
299 * Figure out what application name to use for xemacs | |
300 * | |
301 * Since we have decomposed XtOpenDisplay into XOpenDisplay and | |
302 * XtDisplayInitialize, we no longer get this for free. | |
303 * | |
304 * If there is a `-name' argument in argv, use that. | |
305 * Otherwise use the last component of argv[0]. | |
306 * | |
307 * I have removed the gratuitous use of getenv("RESOURCE_NAME") | |
308 * which was in X11R5, but left the matching of any prefix of `-name'. | |
309 * Finally, if all else fails, return `xemacs', as it is more | |
310 * appropriate (X11R5 returns `main'). | |
311 */ | |
442 | 312 static Extbyte * |
313 compute_x_app_name (int argc, Extbyte **argv) | |
428 | 314 { |
315 int i; | |
442 | 316 Extbyte *ptr; |
428 | 317 |
318 for (i = 1; i < argc - 1; i++) | |
319 if (!strncmp(argv[i], "-name", max (2, strlen (argv[1])))) | |
320 return argv[i+1]; | |
321 | |
322 if (argc > 0 && argv[0] && *argv[0]) | |
323 return (ptr = strrchr (argv[0], '/')) ? ++ptr : argv[0]; | |
324 | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
325 return (Extbyte *) "xemacs"; /* shut up g++ 4.3 */ |
428 | 326 } |
327 | |
328 /* | |
329 * This function figures out whether the user has any resources of the | |
330 * form "XEmacs.foo" or "XEmacs*foo". | |
331 * | |
332 * Currently we only consult the display's global resources; to look | |
333 * for screen specific resources, we would need to also consult: | |
334 * xdefs = XScreenResourceString(ScreenOfDisplay(dpy, scrno)); | |
335 */ | |
336 static int | |
337 have_xemacs_resources_in_xrdb (Display *dpy) | |
338 { | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
339 const char *xdefs, *key; |
428 | 340 int len; |
341 | |
342 key = "XEmacs"; | |
343 len = strlen (key); | |
344 | |
345 if (!dpy) | |
346 return 0; | |
347 | |
348 xdefs = XResourceManagerString (dpy); /* don't free - owned by X */ | |
349 while (xdefs && *xdefs) | |
350 { | |
351 if (strncmp (xdefs, key, len) == 0 && | |
352 (xdefs[len] == '*' || xdefs[len] == '.')) | |
353 return 1; | |
354 | |
355 while (*xdefs && *xdefs++ != '\n') /* find start of next entry.. */ | |
356 ; | |
357 } | |
358 | |
359 return 0; | |
360 } | |
361 | |
362 /* Only the characters [-_A-Za-z0-9] are allowed in the individual | |
363 components of a resource. Convert invalid characters to `-' */ | |
364 | |
365 static char valid_resource_char_p[256]; | |
366 | |
367 static void | |
771 | 368 validify_resource_component (Extbyte *str, Bytecount len) |
428 | 369 { |
370 for (; len; len--, str++) | |
371 if (!valid_resource_char_p[(unsigned char) (*str)]) | |
372 *str = '-'; | |
373 } | |
374 | |
375 static void | |
771 | 376 Dynarr_add_validified_lisp_string (Extbyte_dynarr *cda, Lisp_Object str) |
428 | 377 { |
771 | 378 Bytecount len; |
379 Extbyte *data; | |
380 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
381 LISP_STRING_TO_SIZED_EXTERNAL (str, data, len, Qbinary); |
771 | 382 Dynarr_add_many (cda, data, len); |
383 validify_resource_component (Dynarr_atp (cda, Dynarr_length (cda) - len), | |
384 len); | |
428 | 385 } |
386 | |
387 #if 0 | |
388 /* compare visual info for qsorting */ | |
389 static int | |
390 x_comp_visual_info (const void *elem1, const void *elem2) | |
391 { | |
392 XVisualInfo *left, *right; | |
393 | |
394 left = (XVisualInfo *)elem1; | |
395 right = (XVisualInfo *)elem2; | |
396 | |
397 if ( left == NULL ) | |
398 return -1; | |
399 if ( right == NULL ) | |
400 return 1; | |
401 | |
771 | 402 if ( left->depth > right->depth ) |
428 | 403 return 1; |
771 | 404 else if ( left->depth == right->depth ) |
405 { | |
406 if ( left->colormap_size > right->colormap_size ) | |
407 return 1; | |
1204 | 408 if ( left->X_CLASSFIELD > right->X_CLASSFIELD ) |
771 | 409 return 1; |
1204 | 410 else if ( left->X_CLASSFIELD < right->X_CLASSFIELD ) |
771 | 411 return -1; |
412 else | |
413 return 0; | |
414 } | |
415 else | |
428 | 416 return -1; |
417 } | |
418 #endif /* if 0 */ | |
419 | |
420 #define XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN | |
421 static Visual * | |
422 x_try_best_visual_class (Screen *screen, int scrnum, int visual_class) | |
423 { | |
424 Display *dpy = DisplayOfScreen (screen); | |
425 XVisualInfo vi_in; | |
426 XVisualInfo *vi_out = NULL; | |
427 int out_count; | |
428 | |
1204 | 429 vi_in.X_CLASSFIELD = visual_class; |
428 | 430 vi_in.screen = scrnum; |
431 vi_out = XGetVisualInfo (dpy, (VisualClassMask | VisualScreenMask), | |
432 &vi_in, &out_count); | |
433 if ( vi_out ) | |
434 { | |
435 int i, best; | |
436 Visual *visual; | |
437 for (i = 0, best = 0; i < out_count; i++) | |
438 /* It's better if it's deeper, or if it's the same depth with | |
439 more cells (does that ever happen? Well, it could...) | |
440 NOTE: don't allow pseudo color to get larger than 8! */ | |
441 if (((vi_out [i].depth > vi_out [best].depth) || | |
442 ((vi_out [i].depth == vi_out [best].depth) && | |
443 (vi_out [i].colormap_size > vi_out [best].colormap_size))) | |
444 #ifdef XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN | |
445 /* For now, the image library doesn't like PseudoColor visuals | |
446 of depths other than 1 or 8. Depths greater than 8 only occur | |
447 on machines which have TrueColor anyway, so probably we'll end | |
448 up using that (it is the one that `Best' would pick) but if a | |
449 PseudoColor visual is explicitly specified, pick the 8 bit one. | |
450 */ | |
451 && (visual_class != PseudoColor || | |
452 vi_out [i].depth == 1 || | |
453 vi_out [i].depth == 8) | |
454 #endif | |
455 | |
456 /* SGI has 30-bit deep visuals. Ignore them. | |
457 (We only have 24-bit data anyway.) | |
458 */ | |
459 && (vi_out [i].depth <= 24) | |
460 ) | |
461 best = i; | |
462 visual = vi_out[best].visual; | |
463 XFree ((char *) vi_out); | |
464 return visual; | |
465 } | |
466 else | |
467 return 0; | |
468 } | |
469 | |
470 static int | |
471 x_get_visual_depth (Display *dpy, Visual *visual) | |
472 { | |
473 XVisualInfo vi_in; | |
474 XVisualInfo *vi_out; | |
475 int out_count, d; | |
476 | |
477 vi_in.visualid = XVisualIDFromVisual (visual); | |
478 vi_out = XGetVisualInfo (dpy, /*VisualScreenMask|*/VisualIDMask, | |
479 &vi_in, &out_count); | |
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
480 assert (vi_out); |
428 | 481 d = vi_out [0].depth; |
482 XFree ((char *) vi_out); | |
483 return d; | |
484 } | |
485 | |
486 static Visual * | |
487 x_try_best_visual (Display *dpy, int scrnum) | |
488 { | |
489 Visual *visual = NULL; | |
490 Screen *screen = ScreenOfDisplay (dpy, scrnum); | |
491 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor)) | |
492 && x_get_visual_depth (dpy, visual) >= 16 ) | |
493 return visual; | |
494 if ((visual = x_try_best_visual_class (screen, scrnum, PseudoColor))) | |
495 return visual; | |
496 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor))) | |
497 return visual; | |
498 #ifdef DIRECTCOLOR_WORKS | |
499 if ((visual = x_try_best_visual_class (screen, scrnum, DirectColor))) | |
500 return visual; | |
501 #endif | |
502 | |
503 visual = DefaultVisualOfScreen (screen); | |
504 if ( x_get_visual_depth (dpy, visual) >= 8 ) | |
505 return visual; | |
506 | |
507 if ((visual = x_try_best_visual_class (screen, scrnum, StaticGray))) | |
508 return visual; | |
509 if ((visual = x_try_best_visual_class (screen, scrnum, GrayScale))) | |
510 return visual; | |
511 return DefaultVisualOfScreen (screen); | |
512 } | |
513 | |
514 | |
515 static void | |
2286 | 516 x_init_device (struct device *d, Lisp_Object UNUSED (props)) |
428 | 517 { |
2367 | 518 /* !!#### */ |
428 | 519 Lisp_Object display; |
520 Display *dpy; | |
521 Widget app_shell; | |
522 int argc; | |
442 | 523 Extbyte **argv; |
524 const char *app_class; | |
525 const char *app_name; | |
526 const char *disp_name; | |
428 | 527 Visual *visual = NULL; |
528 int depth = 8; /* shut up the compiler */ | |
529 Colormap cmap; | |
530 int screen; | |
531 /* */ | |
532 int best_visual_found = 0; | |
533 | |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
534 /* Run the elisp side of the X device initialization, allowing it to set |
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
535 x-emacs-application-class and x-app-defaults-directory. */ |
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
536 call0 (Qmake_device_early_x_entry_point); |
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
537 |
442 | 538 #if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D) |
440 | 539 /* |
540 * In order to avoid the lossage with flat Athena widgets dynamically | |
541 * linking to one of the ThreeD variants, using the dynamic symbol helpers | |
542 * to look for symbols that shouldn't be there and refusing to run if they | |
543 * are seems a less toxic idea than having XEmacs crash when we try and | |
544 * use a subclass of a widget that has changed size. | |
545 * | |
546 * It's ugly, I know, and not going to work everywhere. It seems better to | |
547 * do our damnedest to try and tell the user what to expect rather than | |
548 * simply blow up though. | |
549 * | |
550 * All the ThreeD variants I have access to define the following function | |
551 * symbols in the shared library. The flat Xaw library does not define them: | |
552 * | |
553 * Xaw3dComputeBottomShadowRGB | |
554 * Xaw3dComputeTopShadowRGB | |
555 * | |
556 * So far only Linux has shown this problem. This seems to be portable to | |
557 * all the distributions (certainly all the ones I checked - Debian and | |
558 * Redhat) | |
559 * | |
560 * This will only work, sadly, with dlopen() -- the other dynamic linkers | |
561 * are simply not capable of doing what is needed. :/ | |
562 */ | |
563 | |
564 { | |
565 /* Get a dll handle to the main process. */ | |
1706 | 566 dll_handle xaw_dll_handle = dll_open (Qnil); |
440 | 567 |
568 /* Did that fail? If so, continue without error. | |
569 * We could die here but, well, that's unfriendly and all -- plus I feel | |
570 * better about some crashing somewhere rather than preventing a perfectly | |
571 * good configuration working just because dll_open failed. | |
572 */ | |
573 if (xaw_dll_handle != NULL) | |
574 { | |
575 /* Look for the Xaw3d function */ | |
576 dll_func xaw_function_handle = | |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
577 dll_function (xaw_dll_handle, |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
578 (const Ibyte *) "Xaw3dComputeTopShadowRGB"); |
440 | 579 |
580 /* If we found it, warn the user in big, nasty, unfriendly letters */ | |
581 if (xaw_function_handle != NULL) | |
582 { | |
793 | 583 warn_when_safe (Qdevice, Qcritical, "\n" |
440 | 584 "It seems that XEmacs is built dynamically linked to the flat Athena widget\n" |
585 "library but it finds a 3D Athena variant with the same name at runtime.\n" | |
586 "\n" | |
587 "This WILL cause your XEmacs process to dump core at some point.\n" | |
588 "You should not continue to use this binary without resolving this issue.\n" | |
589 "\n" | |
590 "This can be solved with the xaw-wrappers package under Debian\n" | |
591 "(register XEmacs as incompatible with all 3d widget sets, see\n" | |
592 "update-xaw-wrappers(8) and .../doc/xaw-wrappers/README.packagers). It\n" | |
593 "can be verified by checking the runtime path in /etc/ld.so.conf and by\n" | |
594 "using `ldd /path/to/xemacs' under other Linux distributions. One\n" | |
595 "solution is to use LD_PRELOAD or LD_LIBRARY_PATH to force ld.so to\n" | |
596 "load the flat Athena widget library instead of the aliased 3D widget\n" | |
597 "library (see ld.so(8) for use of these environment variables).\n\n" | |
598 ); | |
599 | |
600 } | |
601 | |
602 /* Otherwise release the handle to the library | |
603 * No error catch here; I can't think of a way to recover anyhow. | |
604 */ | |
605 dll_close (xaw_dll_handle); | |
606 } | |
607 } | |
442 | 608 #endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */ |
440 | 609 |
428 | 610 display = DEVICE_CONNECTION (d); |
611 | |
612 allocate_x_device_struct (d); | |
613 | |
614 make_argc_argv (Vx_initial_argv_list, &argc, &argv); | |
615 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
616 disp_name = LISP_STRING_TO_EXTERNAL (display, Qctext); |
428 | 617 |
618 /* | |
619 * Break apart the old XtOpenDisplay call into XOpenDisplay and | |
620 * XtDisplayInitialize so we can figure out whether there | |
621 * are any XEmacs resources in the resource database before | |
622 * we initialize Xt. This is so we can automagically support | |
623 * both `Emacs' and `XEmacs' application classes. | |
624 */ | |
625 slow_down_interrupts (); | |
626 /* May not be needed but XtOpenDisplay could not deal with signals here. */ | |
756 | 627 device_being_initialized = d; |
428 | 628 dpy = DEVICE_X_DISPLAY (d) = XOpenDisplay (disp_name); |
756 | 629 device_being_initialized = NULL; |
428 | 630 speed_up_interrupts (); |
631 | |
632 if (dpy == 0) | |
633 { | |
634 suppress_early_error_handler_backtrace = 1; | |
563 | 635 gui_error ("X server not responding\n", display); |
428 | 636 } |
637 | |
638 if (STRINGP (Vx_emacs_application_class) && | |
639 XSTRING_LENGTH (Vx_emacs_application_class) > 0) | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
640 app_class = LISP_STRING_TO_EXTERNAL (Vx_emacs_application_class, Qctext); |
428 | 641 else |
642 { | |
2681 | 643 if (egetenv ("USE_EMACS_AS_DEFAULT_APPLICATION_CLASS")) |
644 { | |
645 app_class = (NILP (Vx_emacs_application_class) && | |
646 have_xemacs_resources_in_xrdb (dpy)) | |
647 ? "XEmacs" | |
648 : "Emacs"; | |
649 } | |
650 else | |
651 { | |
652 app_class = "XEmacs"; | |
653 } | |
654 | |
428 | 655 /* need to update Vx_emacs_application_class: */ |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
656 Vx_emacs_application_class = build_cistring (app_class); |
428 | 657 } |
658 | |
659 slow_down_interrupts (); | |
660 /* May not be needed but XtOpenDisplay could not deal with signals here. | |
661 Yuck. */ | |
662 XtDisplayInitialize (Xt_app_con, dpy, compute_x_app_name (argc, argv), | |
663 app_class, emacs_options, | |
442 | 664 XtNumber (emacs_options), &argc, (char **) argv); |
428 | 665 speed_up_interrupts (); |
666 | |
667 screen = DefaultScreen (dpy); | |
668 | |
669 #ifdef MULE | |
670 { | |
671 /* Read in locale-specific resources from | |
672 data-directory/app-defaults/$LANG/Emacs. | |
673 This is in addition to the standard app-defaults files, and | |
674 does not override resources defined elsewhere */ | |
771 | 675 const Extbyte *data_dir; |
676 Extbyte *path; | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
677 const Extbyte *format; |
428 | 678 XrmDatabase db = XtDatabase (dpy); /* #### XtScreenDatabase(dpy) ? */ |
5204
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
679 Extbyte *locale = xstrdup (XrmLocaleOfDatabase (db)); |
3644 | 680 Extbyte *locale_end; |
428 | 681 |
682 if (STRINGP (Vx_app_defaults_directory) && | |
683 XSTRING_LENGTH (Vx_app_defaults_directory) > 0) | |
684 { | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
685 LISP_PATHNAME_CONVERT_OUT (Vx_app_defaults_directory, data_dir); |
2367 | 686 path = alloca_extbytes (strlen (data_dir) + strlen (locale) + 7); |
3644 | 687 format = "%s%s/Emacs"; |
428 | 688 } |
689 else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0) | |
690 { | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
691 LISP_PATHNAME_CONVERT_OUT (Vdata_directory, data_dir); |
2367 | 692 path = alloca_extbytes (strlen (data_dir) + 13 + strlen (locale) + 7); |
3644 | 693 format = "%sapp-defaults/%s/Emacs"; |
428 | 694 } |
4404
80e07b006f9c
Prevent access to uninitialized variables in x_init_device.
Jerry James <james@xemacs.org>
parents:
4117
diff
changeset
|
695 else |
80e07b006f9c
Prevent access to uninitialized variables in x_init_device.
Jerry James <james@xemacs.org>
parents:
4117
diff
changeset
|
696 { |
80e07b006f9c
Prevent access to uninitialized variables in x_init_device.
Jerry James <james@xemacs.org>
parents:
4117
diff
changeset
|
697 goto no_data_directory; |
80e07b006f9c
Prevent access to uninitialized variables in x_init_device.
Jerry James <james@xemacs.org>
parents:
4117
diff
changeset
|
698 } |
3644 | 699 |
700 /* | |
701 * The general form for $LANG is <language>_<country>.<encoding>. Try | |
702 * that form, <language>_<country> and <language> and load for first | |
703 * app-defaults file found. | |
704 */ | |
705 | |
706 sprintf (path, format, data_dir, locale); | |
707 if (!access (path, R_OK)) | |
708 XrmCombineFileDatabase (path, &db, False); | |
709 | |
5204
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
710 if ((locale_end = strchr (locale, '.'))) |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
711 { |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
712 *locale_end = '\0'; |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
713 sprintf (path, format, data_dir, locale); |
3644 | 714 |
5204
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
715 if (!access (path, R_OK)) |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
716 XrmCombineFileDatabase (path, &db, False); |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
717 } |
3644 | 718 |
5204
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
719 if ((locale_end = strchr (locale, '_'))) |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
720 { |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
721 *locale_end = '\0'; |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
722 sprintf (path, format, data_dir, locale); |
3644 | 723 |
5204
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
724 if (!access (path, R_OK)) |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
725 XrmCombineFileDatabase (path, &db, False); |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
726 } |
3644 | 727 |
4404
80e07b006f9c
Prevent access to uninitialized variables in x_init_device.
Jerry James <james@xemacs.org>
parents:
4117
diff
changeset
|
728 no_data_directory: |
5204
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
729 xfree (locale); |
428 | 730 } |
731 #endif /* MULE */ | |
732 | |
733 if (NILP (DEVICE_NAME (d))) | |
734 DEVICE_NAME (d) = display; | |
735 | |
736 /* We're going to modify the string in-place, so be a nice XEmacs */ | |
737 DEVICE_NAME (d) = Fcopy_sequence (DEVICE_NAME (d)); | |
738 /* colons and periods can't appear in individual elements of resource | |
739 strings */ | |
740 | |
741 XtGetApplicationNameAndClass (dpy, (char **) &app_name, (char **) &app_class); | |
742 /* search for a matching visual if requested by the user, or setup the display default */ | |
743 { | |
744 int resource_name_length = max (sizeof (".emacsVisual"), | |
745 sizeof (".privateColormap")); | |
746 char *buf1 = alloca_array (char, strlen (app_name) + resource_name_length); | |
747 char *buf2 = alloca_array (char, strlen (app_class) + resource_name_length); | |
748 char *type; | |
749 XrmValue value; | |
750 | |
751 sprintf (buf1, "%s.emacsVisual", app_name); | |
752 sprintf (buf2, "%s.EmacsVisual", app_class); | |
753 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True) | |
754 { | |
755 int cnt = 0; | |
756 int vis_class = PseudoColor; | |
757 XVisualInfo vinfo; | |
758 char *str = (char*) value.addr; | |
759 | |
760 #define CHECK_VIS_CLASS(visual_class) \ | |
761 else if (memcmp (str, #visual_class, sizeof (#visual_class) - 1) == 0) \ | |
762 cnt = sizeof (#visual_class) - 1, vis_class = visual_class | |
763 | |
764 if (1) | |
765 ; | |
766 CHECK_VIS_CLASS (StaticGray); | |
767 CHECK_VIS_CLASS (StaticColor); | |
768 CHECK_VIS_CLASS (TrueColor); | |
769 CHECK_VIS_CLASS (GrayScale); | |
770 CHECK_VIS_CLASS (PseudoColor); | |
771 CHECK_VIS_CLASS (DirectColor); | |
772 | |
773 if (cnt) | |
774 { | |
775 depth = atoi (str + cnt); | |
776 if (depth == 0) | |
777 { | |
771 | 778 stderr_out ("Invalid Depth specification in %s... " |
779 "ignoring...\n", str); | |
428 | 780 } |
781 else | |
782 { | |
783 if (XMatchVisualInfo (dpy, screen, depth, vis_class, &vinfo)) | |
784 { | |
785 visual = vinfo.visual; | |
786 } | |
787 else | |
788 { | |
771 | 789 stderr_out ("Can't match the requested visual %s... " |
790 "using defaults\n", str); | |
428 | 791 } |
792 } | |
793 } | |
794 else | |
795 { | |
771 | 796 stderr_out ("Invalid Visual specification in %s... " |
797 "ignoring.\n", str); | |
428 | 798 } |
799 } | |
800 if (visual == NULL) | |
801 { | |
802 /* | |
803 visual = DefaultVisual(dpy, screen); | |
804 depth = DefaultDepth(dpy, screen); | |
805 */ | |
806 visual = x_try_best_visual (dpy, screen); | |
807 depth = x_get_visual_depth (dpy, visual); | |
808 best_visual_found = (visual != DefaultVisual (dpy, screen)); | |
809 } | |
810 | |
811 /* If we've got the same visual as the default and it's PseudoColor, | |
812 check to see if the user specified that we need a private colormap */ | |
813 if (visual == DefaultVisual (dpy, screen)) | |
814 { | |
815 sprintf (buf1, "%s.privateColormap", app_name); | |
816 sprintf (buf2, "%s.PrivateColormap", app_class); | |
1204 | 817 if ((visual->X_CLASSFIELD == PseudoColor) && |
771 | 818 (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) |
819 == True)) | |
820 cmap = XCopyColormapAndFree (dpy, DefaultColormap (dpy, screen)); | |
428 | 821 else |
771 | 822 cmap = DefaultColormap (dpy, screen); |
428 | 823 } |
824 else | |
825 { | |
826 if ( best_visual_found ) | |
771 | 827 cmap = XCreateColormap (dpy, RootWindow (dpy, screen), visual, |
828 AllocNone); | |
428 | 829 else |
830 { | |
771 | 831 /* We have to create a matching colormap anyway... #### |
832 think about using standard colormaps (need the Xmu | |
833 libs?) */ | |
834 cmap = XCreateColormap (dpy, RootWindow (dpy, screen), visual, | |
835 AllocNone); | |
836 XInstallColormap (dpy, cmap); | |
428 | 837 } |
838 } | |
839 } | |
840 | |
841 DEVICE_X_VISUAL (d) = visual; | |
842 DEVICE_X_COLORMAP (d) = cmap; | |
843 DEVICE_X_DEPTH (d) = depth; | |
844 validify_resource_component ((char *) XSTRING_DATA (DEVICE_NAME (d)), | |
845 XSTRING_LENGTH (DEVICE_NAME (d))); | |
846 | |
2007 | 847 /* #### If we're going to implement X session management, this would |
848 be the place. Make sure it doesn't conflict with GNOME. */ | |
428 | 849 { |
850 Arg al[3]; | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
851 Xt_SET_ARG (al[0], XtNvisual, visual); |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
852 Xt_SET_ARG (al[1], XtNdepth, depth); |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
853 Xt_SET_ARG (al[2], XtNcolormap, cmap); |
428 | 854 |
855 app_shell = XtAppCreateShell (NULL, app_class, | |
856 applicationShellWidgetClass, | |
857 dpy, al, countof (al)); | |
858 } | |
859 | |
860 DEVICE_XT_APP_SHELL (d) = app_shell; | |
861 | |
862 #ifdef HAVE_XIM | |
863 XIM_init_device(d); | |
864 #endif /* HAVE_XIM */ | |
865 | |
866 /* Realize the app_shell so that its window exists for GC creation purposes, | |
867 and set it to the size of the root window for child placement purposes */ | |
868 { | |
869 Arg al[5]; | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
870 Xt_SET_ARG (al[0], XtNmappedWhenManaged, False); |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
871 Xt_SET_ARG (al[1], XtNx, 0); |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
872 Xt_SET_ARG (al[2], XtNy, 0); |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
873 Xt_SET_ARG (al[3], XtNwidth, |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
874 WidthOfScreen (ScreenOfDisplay (dpy, screen))); |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
875 Xt_SET_ARG (al[4], XtNheight, |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
876 HeightOfScreen (ScreenOfDisplay (dpy, screen))); |
428 | 877 XtSetValues (app_shell, al, countof (al)); |
878 XtRealizeWidget (app_shell); | |
879 } | |
880 | |
881 #ifdef HAVE_WMCOMMAND | |
882 { | |
883 int new_argc; | |
442 | 884 Extbyte **new_argv; |
428 | 885 make_argc_argv (Vcommand_line_args, &new_argc, &new_argv); |
442 | 886 XSetCommand (XtDisplay (app_shell), XtWindow (app_shell), |
887 (char **) new_argv, new_argc); | |
428 | 888 free_argc_argv (new_argv); |
889 } | |
890 #endif /* HAVE_WMCOMMAND */ | |
891 | |
892 Vx_initial_argv_list = make_arg_list (argc, argv); | |
893 free_argc_argv (argv); | |
894 | |
895 DEVICE_X_WM_COMMAND_FRAME (d) = Qnil; | |
896 | |
897 sanity_check_geometry_resource (dpy); | |
898 | |
899 /* In event-Xt.c */ | |
900 x_init_modifier_mapping (d); | |
901 | |
902 DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (dpy); | |
903 init_baud_rate (d); | |
904 init_one_device (d); | |
905 | |
771 | 906 DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow (app_shell)); |
428 | 907 DEVICE_X_GRAY_PIXMAP (d) = None; |
908 Xatoms_of_device_x (d); | |
440 | 909 Xatoms_of_select_x (d); |
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
5052
diff
changeset
|
910 Xatoms_of_fontcolor_x (d); |
428 | 911 x_init_device_class (d); |
912 } | |
913 | |
914 static void | |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
915 x_finish_init_device (struct device *d, Lisp_Object UNUSED (props)) |
428 | 916 { |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
917 call1 (Qmake_device_late_x_entry_point, wrap_device (d)); |
428 | 918 } |
919 | |
920 static void | |
921 x_mark_device (struct device *d) | |
922 { | |
923 mark_object (DEVICE_X_WM_COMMAND_FRAME (d)); | |
924 mark_object (DEVICE_X_DATA (d)->x_keysym_map_hash_table); | |
925 } | |
926 | |
927 | |
928 /************************************************************************/ | |
929 /* closing an X connection */ | |
930 /************************************************************************/ | |
931 | |
4117 | 932 #ifndef NEW_GC |
428 | 933 static void |
934 free_x_device_struct (struct device *d) | |
935 { | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
936 xfree (d->device_data); |
4117 | 937 } |
3092 | 938 #endif /* not NEW_GC */ |
428 | 939 |
940 static void | |
941 x_delete_device (struct device *d) | |
942 { | |
943 Display *display; | |
944 #ifdef FREE_CHECKING | |
945 extern void (*__free_hook) (void *); | |
946 int checking_free; | |
947 #endif | |
948 | |
949 display = DEVICE_X_DISPLAY (d); | |
950 | |
951 if (display) | |
952 { | |
953 #ifdef FREE_CHECKING | |
954 checking_free = (__free_hook != 0); | |
955 | |
956 /* Disable strict free checking, to avoid bug in X library */ | |
957 if (checking_free) | |
958 disable_strict_free_check (); | |
959 #endif | |
960 | |
961 free_gc_cache (DEVICE_X_GC_CACHE (d)); | |
962 if (DEVICE_X_DATA (d)->x_modifier_keymap) | |
963 XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap); | |
964 if (DEVICE_X_DATA (d)->x_keysym_map) | |
965 XFree ((char *) DEVICE_X_DATA (d)->x_keysym_map); | |
966 | |
967 if (DEVICE_XT_APP_SHELL (d)) | |
968 { | |
969 XtDestroyWidget (DEVICE_XT_APP_SHELL (d)); | |
970 DEVICE_XT_APP_SHELL (d) = NULL; | |
971 } | |
972 | |
973 XtCloseDisplay (display); | |
974 DEVICE_X_DISPLAY (d) = 0; | |
975 #ifdef FREE_CHECKING | |
976 if (checking_free) | |
977 enable_strict_free_check (); | |
978 #endif | |
979 } | |
980 | |
4117 | 981 #ifndef NEW_GC |
428 | 982 free_x_device_struct (d); |
4117 | 983 #endif /* not NEW_GC */ |
428 | 984 } |
985 | |
986 | |
987 /************************************************************************/ | |
988 /* handle X errors */ | |
989 /************************************************************************/ | |
990 | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
991 const Ascbyte * |
428 | 992 x_event_name (int event_type) |
993 { | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
994 static const Ascbyte *events[] = |
428 | 995 { |
996 "0: ERROR!", | |
997 "1: REPLY", | |
998 "KeyPress", | |
999 "KeyRelease", | |
1000 "ButtonPress", | |
1001 "ButtonRelease", | |
1002 "MotionNotify", | |
1003 "EnterNotify", | |
1004 "LeaveNotify", | |
1005 "FocusIn", | |
1006 "FocusOut", | |
1007 "KeymapNotify", | |
1008 "Expose", | |
1009 "GraphicsExpose", | |
1010 "NoExpose", | |
1011 "VisibilityNotify", | |
1012 "CreateNotify", | |
1013 "DestroyNotify", | |
1014 "UnmapNotify", | |
1015 "MapNotify", | |
1016 "MapRequest", | |
1017 "ReparentNotify", | |
1018 "ConfigureNotify", | |
1019 "ConfigureRequest", | |
1020 "GravityNotify", | |
1021 "ResizeRequest", | |
1022 "CirculateNotify", | |
1023 "CirculateRequest", | |
1024 "PropertyNotify", | |
1025 "SelectionClear", | |
1026 "SelectionRequest", | |
1027 "SelectionNotify", | |
1028 "ColormapNotify", | |
1029 "ClientMessage", | |
1030 "MappingNotify", | |
1031 "LASTEvent" | |
1032 }; | |
1033 | |
1034 if (event_type < 0 || event_type >= countof (events)) | |
1035 return NULL; | |
1036 return events [event_type]; | |
1037 } | |
1038 | |
1039 /* Handling errors. | |
1040 | |
1041 If an X error occurs which we are not expecting, we have no alternative | |
1042 but to print it to stderr. It would be nice to stuff it into a pop-up | |
1043 buffer, or to print it in the minibuffer, but that's not possible, because | |
1044 one is not allowed to do any I/O on the display connection from an error | |
1045 handler. The guts of Xlib expect these functions to either return or exit. | |
1046 | |
1047 However, there are occasions when we might expect an error to reasonably | |
1048 occur. The interface to this is as follows: | |
1049 | |
1050 Before calling some X routine which may error, call | |
1051 expect_x_error (dpy); | |
1052 | |
1053 Just after calling the X routine, call either: | |
1054 | |
1055 x_error_occurred_p (dpy); | |
1056 | |
1057 to ask whether an error happened (and was ignored), or: | |
1058 | |
1059 signal_if_x_error (dpy, resumable_p); | |
1060 | |
1061 which will call Fsignal() with args appropriate to the X error, if there | |
1062 was one. (Resumable_p is whether the debugger should be allowed to | |
1063 continue from the call to signal.) | |
1064 | |
1065 You must call one of these two routines immediately after calling the X | |
1066 routine; think of them as bookends like BLOCK_INPUT and UNBLOCK_INPUT. | |
1067 */ | |
1068 | |
1069 static int error_expected; | |
1070 static int error_occurred; | |
1071 static XErrorEvent last_error; | |
1072 | |
1073 /* OVERKILL! */ | |
1074 | |
1075 #ifdef EXTERNAL_WIDGET | |
1076 static Lisp_Object | |
1077 x_error_handler_do_enqueue (Lisp_Object frame) | |
1078 { | |
1079 enqueue_magic_eval_event (io_error_delete_frame, frame); | |
1080 return Qt; | |
1081 } | |
1082 | |
1083 static Lisp_Object | |
2333 | 1084 x_error_handler_error (Lisp_Object UNUSED (data), Lisp_Object UNUSED (dummy)) |
428 | 1085 { |
1086 return Qnil; | |
1087 } | |
1088 #endif /* EXTERNAL_WIDGET */ | |
1089 | |
1090 int | |
1091 x_error_handler (Display *disp, XErrorEvent *event) | |
1092 { | |
1093 if (error_expected) | |
1094 { | |
1095 error_expected = 0; | |
1096 error_occurred = 1; | |
1097 last_error = *event; | |
1098 } | |
1099 else | |
1100 { | |
853 | 1101 int depth; |
1102 | |
428 | 1103 #ifdef EXTERNAL_WIDGET |
1104 struct frame *f; | |
1105 struct device *d = get_device_from_display (disp); | |
1106 | |
1107 if ((event->error_code == BadWindow || | |
1108 event->error_code == BadDrawable) | |
1109 && ((f = x_any_window_to_frame (d, event->resourceid)) != 0)) | |
1110 { | |
1111 Lisp_Object frame; | |
1112 | |
1113 /* one of the windows comprising one of our frames has died. | |
1114 This occurs particularly with ExternalShell frames when the | |
1115 client that owns the ExternalShell's window dies. | |
1116 | |
1117 We cannot do any I/O on the display connection so we need | |
1118 to enqueue an eval event so that the deletion happens | |
1119 later. | |
1120 | |
1121 Furthermore, we need to trap any errors (out-of-memory) that | |
1122 may occur when Fenqueue_eval_event is called. | |
1123 */ | |
1124 | |
1125 if (f->being_deleted) | |
1126 return 0; | |
793 | 1127 frame = wrap_frame (f); |
428 | 1128 if (!NILP (condition_case_1 (Qerror, x_error_handler_do_enqueue, |
1129 frame, x_error_handler_error, Qnil))) | |
1130 { | |
1131 f->being_deleted = 1; | |
1132 f->visible = 0; | |
1133 } | |
1134 return 0; | |
1135 } | |
1136 #endif /* EXTERNAL_WIDGET */ | |
1137 | |
853 | 1138 /* #### this should issue a warning instead of outputting to stderr */ |
1139 depth = begin_dont_check_for_quit (); | |
2007 | 1140 #if 0 |
1141 /* This ends up calling X, which isn't allowed in an X error handler | |
1142 */ | |
428 | 1143 stderr_out ("\n%s: ", |
1144 (STRINGP (Vinvocation_name) | |
1145 ? (char *) XSTRING_DATA (Vinvocation_name) | |
1146 : "xemacs")); | |
2007 | 1147 #endif |
428 | 1148 XmuPrintDefaultErrorMessage (disp, event, stderr); |
853 | 1149 unbind_to (depth); |
428 | 1150 } |
1151 return 0; | |
1152 } | |
1153 | |
1154 void | |
1155 expect_x_error (Display *dpy) | |
1156 { | |
1157 assert (!error_expected); | |
1158 XSync (dpy, 0); /* handle pending errors before setting flag */ | |
1159 error_expected = 1; | |
1160 error_occurred = 0; | |
1161 } | |
1162 | |
1163 int | |
1164 x_error_occurred_p (Display *dpy) | |
1165 { | |
1166 int val; | |
1167 XSync (dpy, 0); /* handle pending errors before setting flag */ | |
1168 val = error_occurred; | |
1169 error_expected = 0; | |
1170 error_occurred = 0; | |
1171 return val; | |
1172 } | |
1173 | |
1174 int | |
1175 signal_if_x_error (Display *dpy, int resumable_p) | |
1176 { | |
771 | 1177 Extbyte buf[1024]; |
867 | 1178 Ibyte num[100]; |
428 | 1179 Lisp_Object data; |
1180 if (! x_error_occurred_p (dpy)) | |
1181 return 0; | |
1182 data = Qnil; | |
771 | 1183 qxesprintf (num, "0x%X", (unsigned int) last_error.resourceid); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1184 data = Fcons (build_istring (num), data); |
771 | 1185 qxesprintf (num, "%d", last_error.request_code); |
1186 XGetErrorDatabaseText (last_error.display, "XRequest", (char *) num, "", | |
1187 buf, sizeof (buf)); | |
1188 if (*buf) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1189 data = Fcons (build_extstring (buf, Qx_error_message_encoding), data); |
771 | 1190 else |
1191 { | |
1192 qxesprintf (num, "Request-%d", last_error.request_code); | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1193 data = Fcons (build_istring (num), data); |
771 | 1194 } |
428 | 1195 XGetErrorText (last_error.display, last_error.error_code, buf, sizeof (buf)); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1196 data = Fcons (build_extstring (buf, Qx_error_message_encoding), data); |
428 | 1197 again: |
1198 Fsignal (Qx_error, data); | |
1199 if (! resumable_p) goto again; | |
1200 return 1; | |
1201 } | |
1202 | |
1203 int | |
1204 x_IO_error_handler (Display *disp) | |
1205 { | |
1206 /* This function can GC */ | |
1207 Lisp_Object dev; | |
1208 struct device *d = get_device_from_display_1 (disp); | |
1209 | |
756 | 1210 if (!d) |
1211 d = device_being_initialized; | |
1212 | |
428 | 1213 assert (d != NULL); |
793 | 1214 dev = wrap_device (d); |
428 | 1215 |
1216 if (NILP (find_nonminibuffer_frame_not_on_device (dev))) | |
1217 { | |
853 | 1218 int depth = begin_dont_check_for_quit (); |
428 | 1219 /* We're going down. */ |
867 | 1220 Ibyte *errmess; |
771 | 1221 GET_STRERROR (errmess, errno); |
1222 stderr_out ("\n%s: Fatal I/O Error %d (%s) on display " | |
1223 "connection \"%s\"\n", | |
1224 (STRINGP (Vinvocation_name) ? | |
1225 (char *) XSTRING_DATA (Vinvocation_name) : "xemacs"), | |
1226 errno, errmess, DisplayString (disp)); | |
1227 stderr_out (" after %lu requests (%lu known processed) with %d " | |
1228 "events remaining.\n", | |
1229 NextRequest (disp) - 1, LastKnownRequestProcessed (disp), | |
1230 QLength (disp)); | |
428 | 1231 /* assert (!_Xdebug); */ |
853 | 1232 unbind_to (depth); |
428 | 1233 } |
1234 else | |
1235 { | |
867 | 1236 Ibyte *errmess; |
771 | 1237 GET_STRERROR (errmess, errno); |
428 | 1238 warn_when_safe |
1239 (Qx, Qcritical, | |
1240 "I/O Error %d (%s) on display connection\n" | |
2116 | 1241 " \"%s\" after %lu requests (%lu known processed)\n" |
428 | 1242 " with %d events remaining.\n" |
1243 " Throwing to top level.\n", | |
771 | 1244 errno, errmess, DisplayString (disp), |
428 | 1245 NextRequest (disp) - 1, LastKnownRequestProcessed (disp), |
1246 QLength (disp)); | |
1247 } | |
1248 | |
1249 /* According to X specs, we should not return from this function, or | |
1250 Xlib might just decide to exit(). So we mark the offending | |
1251 console for deletion and throw to top level. */ | |
1252 if (d) | |
3466 | 1253 { |
1254 enqueue_magic_eval_event (io_error_delete_device, dev); | |
1255 DEVICE_X_BEING_DELETED (d) = 1; | |
1256 } | |
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4548
diff
changeset
|
1257 |
5348
39304a35b6b3
Don't commit suicide when an X device dies.
Mike Sperber <sperber@deinprogramm.de>
parents:
5239
diff
changeset
|
1258 redisplay_cancel_ritual_suicide(); |
39304a35b6b3
Don't commit suicide when an X device dies.
Mike Sperber <sperber@deinprogramm.de>
parents:
5239
diff
changeset
|
1259 throw_or_bomb_out_unsafe (Qtop_level, Qnil, 0, Qnil, Qnil); |
428 | 1260 |
2268 | 1261 RETURN_NOT_REACHED (0); |
428 | 1262 } |
1263 | |
1264 DEFUN ("x-debug-mode", Fx_debug_mode, 1, 2, 0, /* | |
1265 With a true arg, make the connection to the X server synchronous. | |
1266 With false, make it asynchronous. Synchronous connections are much slower, | |
1267 but are useful for debugging. (If you get X errors, make the connection | |
1268 synchronous, and use a debugger to set a breakpoint on `x_error_handler'. | |
1269 Your backtrace of the C stack will now be useful. In asynchronous mode, | |
1270 the stack above `x_error_handler' isn't helpful because of buffering.) | |
1271 If DEVICE is not specified, the selected device is assumed. | |
1272 | |
1273 Calling this function is the same as calling the C function `XSynchronize', | |
1274 or starting the program with the `-sync' command line argument. | |
1275 */ | |
1276 (arg, device)) | |
1277 { | |
1278 struct device *d = decode_x_device (device); | |
1279 | |
1280 XSynchronize (DEVICE_X_DISPLAY (d), !NILP (arg)); | |
1281 | |
1282 if (!NILP (arg)) | |
1283 message ("X connection is synchronous"); | |
1284 else | |
1285 message ("X connection is asynchronous"); | |
1286 | |
1287 return arg; | |
1288 } | |
1289 | |
1290 | |
1291 /************************************************************************/ | |
1292 /* X resources */ | |
1293 /************************************************************************/ | |
1294 | |
1295 #if 0 /* bah humbug. The whole "widget == resource" stuff is such | |
1296 a crock of shit that I'm just going to ignore it all. */ | |
1297 | |
1298 /* If widget is NULL, we are retrieving device or global face data. */ | |
1299 | |
1300 static void | |
1301 construct_name_list (Display *display, Widget widget, char *fake_name, | |
1204 | 1302 char *fake_class, char *name, char *class_) |
428 | 1303 { |
1304 char *stack [100][2]; | |
2552 | 1305 Widget this_widget; |
428 | 1306 int count = 0; |
1307 char *name_tail, *class_tail; | |
1308 | |
1309 if (widget) | |
1310 { | |
2552 | 1311 for (this_widget = widget; this_widget; |
1312 this_widget = XtParent (this_widget)) | |
428 | 1313 { |
2552 | 1314 stack [count][0] = this_widget->core.name; |
1315 stack [count][1] = XtClass (this_widget)->core_class.class_name; | |
428 | 1316 count++; |
1317 } | |
1318 count--; | |
1319 } | |
1320 else if (fake_name && fake_class) | |
1321 { | |
1322 stack [count][0] = fake_name; | |
1323 stack [count][1] = fake_class; | |
1324 count++; | |
1325 } | |
1326 | |
1327 /* The root widget is an application shell; resource lookups use the | |
1328 specified application name and application class in preference to | |
1329 the name/class of that widget (which is argv[0] / "ApplicationShell"). | |
1330 Generally the app name and class will be argv[0] / "Emacs" but | |
1331 the former can be set via the -name command-line option, and the | |
1332 latter can be set by changing `x-emacs-application-class' in | |
1333 lisp/term/x-win.el. | |
1334 */ | |
1335 XtGetApplicationNameAndClass (display, | |
1336 &stack [count][0], | |
1337 &stack [count][1]); | |
1338 | |
1339 name [0] = 0; | |
1204 | 1340 class_ [0] = 0; |
428 | 1341 |
1342 name_tail = name; | |
1204 | 1343 class_tail = class_; |
428 | 1344 for (; count >= 0; count--) |
1345 { | |
1346 strcat (name_tail, stack [count][0]); | |
1347 for (; *name_tail; name_tail++) | |
1348 if (*name_tail == '.') *name_tail = '_'; | |
1349 strcat (name_tail, "."); | |
1350 name_tail++; | |
1351 | |
1352 strcat (class_tail, stack [count][1]); | |
1353 for (; *class_tail; class_tail++) | |
1354 if (*class_tail == '.') *class_tail = '_'; | |
1355 strcat (class_tail, "."); | |
1356 class_tail++; | |
1357 } | |
1358 } | |
1359 | |
1360 #endif /* 0 */ | |
1361 | |
771 | 1362 static Extbyte_dynarr *name_Extbyte_dynarr; |
1363 static Extbyte_dynarr *class_Extbyte_dynarr; | |
428 | 1364 |
1365 /* Given a locale and device specification from x-get-resource or | |
1366 x-get-resource-prefix, return the resource prefix and display to | |
1367 fetch the resource on. */ | |
1368 | |
1369 static void | |
1370 x_get_resource_prefix (Lisp_Object locale, Lisp_Object device, | |
771 | 1371 Display **display_out, Extbyte_dynarr *name, |
1204 | 1372 Extbyte_dynarr *class_) |
428 | 1373 { |
1374 if (NILP (locale)) | |
1375 locale = Qglobal; | |
1376 if (NILP (Fvalid_specifier_locale_p (locale))) | |
563 | 1377 invalid_argument ("Invalid locale", locale); |
428 | 1378 if (WINDOWP (locale)) |
1379 /* #### I can't come up with any coherent way of naming windows. | |
1380 By relative position? That seems tricky because windows | |
1381 can change position, be split, etc. By order of creation? | |
1382 That seems less than useful. */ | |
563 | 1383 signal_error (Qunimplemented, |
1384 "Windows currently can't be resourced", locale); | |
428 | 1385 |
1386 if (!NILP (device) && !DEVICEP (device)) | |
1387 CHECK_DEVICE (device); | |
1388 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device))) | |
1389 device = Qnil; | |
1390 if (NILP (device)) | |
1391 { | |
1392 device = DFW_DEVICE (locale); | |
1393 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device))) | |
1394 device = Qnil; | |
1395 if (NILP (device)) | |
872 | 1396 device = get_default_device (Qx); |
428 | 1397 if (NILP (device)) |
1398 { | |
1399 *display_out = 0; | |
1400 return; | |
1401 } | |
1402 } | |
1403 | |
1404 *display_out = DEVICE_X_DISPLAY (XDEVICE (device)); | |
1405 | |
1406 { | |
771 | 1407 Extbyte *appname, *appclass; |
428 | 1408 int name_len, class_len; |
1409 XtGetApplicationNameAndClass (*display_out, &appname, &appclass); | |
1410 name_len = strlen (appname); | |
1411 class_len = strlen (appclass); | |
771 | 1412 Dynarr_add_many (name, appname, name_len); |
1204 | 1413 Dynarr_add_many (class_, appclass, class_len); |
4967 | 1414 validify_resource_component (Dynarr_begin (name), name_len); |
1415 validify_resource_component (Dynarr_begin (class_), class_len); | |
428 | 1416 } |
1417 | |
1418 if (EQ (locale, Qglobal)) | |
1419 return; | |
1420 if (BUFFERP (locale)) | |
1421 { | |
1422 Dynarr_add_literal_string (name, ".buffer."); | |
1423 /* we know buffer is live; otherwise we got an error above. */ | |
1424 Dynarr_add_validified_lisp_string (name, Fbuffer_name (locale)); | |
1204 | 1425 Dynarr_add_literal_string (class_, ".EmacsLocaleType.EmacsBuffer"); |
428 | 1426 } |
1427 else if (FRAMEP (locale)) | |
1428 { | |
1429 Dynarr_add_literal_string (name, ".frame."); | |
1430 /* we know frame is live; otherwise we got an error above. */ | |
1431 Dynarr_add_validified_lisp_string (name, Fframe_name (locale)); | |
1204 | 1432 Dynarr_add_literal_string (class_, ".EmacsLocaleType.EmacsFrame"); |
428 | 1433 } |
1434 else | |
1435 { | |
1436 assert (DEVICEP (locale)); | |
1437 Dynarr_add_literal_string (name, ".device."); | |
1438 /* we know device is live; otherwise we got an error above. */ | |
1439 Dynarr_add_validified_lisp_string (name, Fdevice_name (locale)); | |
1204 | 1440 Dynarr_add_literal_string (class_, ".EmacsLocaleType.EmacsDevice"); |
428 | 1441 } |
1442 return; | |
1443 } | |
1444 | |
1445 DEFUN ("x-get-resource", Fx_get_resource, 3, 6, 0, /* | |
1446 Retrieve an X resource from the resource manager. | |
1447 | |
1448 The first arg is the name of the resource to retrieve, such as "font". | |
1449 The second arg is the class of the resource to retrieve, such as "Font". | |
3025 | 1450 The third arg must be one of the symbols `string', `integer', `natnum', or |
1451 `boolean', specifying the type of object that the database is searched for. | |
428 | 1452 The fourth arg is the locale to search for the resources on, and can |
3025 | 1453 currently be a buffer, a frame, a device, or `global'. If omitted, it |
1454 defaults to `global'. | |
428 | 1455 The fifth arg is the device to search for the resources on. (The resource |
1456 database for a particular device is constructed by combining non-device- | |
1457 specific resources such as any command-line resources specified and any | |
1458 app-defaults files found [or the fallback resources supplied by XEmacs, | |
1459 if no app-defaults file is found] with device-specific resources such as | |
1460 those supplied using xrdb.) If omitted, it defaults to the device of | |
1461 LOCALE, if a device can be derived (i.e. if LOCALE is a frame or device), | |
1462 and otherwise defaults to the value of `default-x-device'. | |
1463 The sixth arg NOERROR, if non-nil, means do not signal an error if a | |
1464 bogus resource specification was retrieved (e.g. if a non-integer was | |
1465 given when an integer was requested). In this case, a warning is issued | |
442 | 1466 instead, unless NOERROR is t, in which case no warning is issued. |
428 | 1467 |
1468 The resource names passed to this function are looked up relative to the | |
1469 locale. | |
1470 | |
1471 If you want to search for a subresource, you just need to specify the | |
1472 resource levels in NAME and CLASS. For example, NAME could be | |
1473 "modeline.attributeFont", and CLASS "Face.AttributeFont". | |
1474 | |
1475 Specifically, | |
1476 | |
1477 1) If LOCALE is a buffer, a call | |
1478 | |
1479 (x-get-resource "foreground" "Foreground" 'string SOME-BUFFER) | |
1480 | |
1481 is an interface to a C call something like | |
1482 | |
1483 XrmGetResource (db, "xemacs.buffer.BUFFER-NAME.foreground", | |
1484 "Emacs.EmacsLocaleType.EmacsBuffer.Foreground", | |
1485 "String"); | |
1486 | |
1487 2) If LOCALE is a frame, a call | |
1488 | |
1489 (x-get-resource "foreground" "Foreground" 'string SOME-FRAME) | |
1490 | |
1491 is an interface to a C call something like | |
1492 | |
1493 XrmGetResource (db, "xemacs.frame.FRAME-NAME.foreground", | |
1494 "Emacs.EmacsLocaleType.EmacsFrame.Foreground", | |
1495 "String"); | |
1496 | |
1497 3) If LOCALE is a device, a call | |
1498 | |
1499 (x-get-resource "foreground" "Foreground" 'string SOME-DEVICE) | |
1500 | |
1501 is an interface to a C call something like | |
1502 | |
1503 XrmGetResource (db, "xemacs.device.DEVICE-NAME.foreground", | |
1504 "Emacs.EmacsLocaleType.EmacsDevice.Foreground", | |
1505 "String"); | |
1506 | |
3025 | 1507 4) If LOCALE is `global', a call |
428 | 1508 |
1509 (x-get-resource "foreground" "Foreground" 'string 'global) | |
1510 | |
1511 is an interface to a C call something like | |
1512 | |
1513 XrmGetResource (db, "xemacs.foreground", | |
1514 "Emacs.Foreground", | |
1515 "String"); | |
1516 | |
3025 | 1517 Note that for `global', no prefix is added other than that of the |
428 | 1518 application itself; thus, you can use this locale to retrieve |
1519 arbitrary application resources, if you really want to. | |
1520 | |
1521 The returned value of this function is nil if the queried resource is not | |
1522 found. If the third arg is `string', a string is returned, and if it is | |
1523 `integer', an integer is returned. If the third arg is `boolean', then the | |
1524 returned value is the list (t) for true, (nil) for false, and is nil to | |
430 | 1525 mean ``unspecified''. |
428 | 1526 */ |
1204 | 1527 (name, class_, type, locale, device, noerror)) |
428 | 1528 { |
771 | 1529 Extbyte *name_string, *class_string; |
1530 Extbyte *raw_result; | |
428 | 1531 XrmDatabase db; |
1532 Display *display; | |
578 | 1533 Error_Behavior errb = decode_error_behavior_flag (noerror); |
771 | 1534 Lisp_Object codesys; |
428 | 1535 |
1536 CHECK_STRING (name); | |
1204 | 1537 CHECK_STRING (class_); |
428 | 1538 CHECK_SYMBOL (type); |
1539 | |
771 | 1540 Dynarr_reset (name_Extbyte_dynarr); |
1541 Dynarr_reset (class_Extbyte_dynarr); | |
428 | 1542 |
1543 x_get_resource_prefix (locale, device, &display, | |
771 | 1544 name_Extbyte_dynarr, class_Extbyte_dynarr); |
428 | 1545 if (!display) |
1546 return Qnil; | |
1547 | |
1548 db = XtDatabase (display); | |
771 | 1549 codesys = coding_system_of_xrm_database (db); |
1550 Dynarr_add (name_Extbyte_dynarr, '.'); | |
5038 | 1551 Dynarr_add_ext_lisp_string (name_Extbyte_dynarr, name, Qbinary); |
771 | 1552 Dynarr_add (class_Extbyte_dynarr, '.'); |
5038 | 1553 Dynarr_add_ext_lisp_string (class_Extbyte_dynarr, class_, Qbinary); |
771 | 1554 Dynarr_add (name_Extbyte_dynarr, '\0'); |
1555 Dynarr_add (class_Extbyte_dynarr, '\0'); | |
428 | 1556 |
4967 | 1557 name_string = Dynarr_begin (name_Extbyte_dynarr); |
1558 class_string = Dynarr_begin (class_Extbyte_dynarr); | |
428 | 1559 |
1560 { | |
1561 XrmValue xrm_value; | |
1562 XrmName namelist[100]; | |
1563 XrmClass classlist[100]; | |
1564 XrmName *namerest = namelist; | |
1565 XrmClass *classrest = classlist; | |
1566 XrmRepresentation xrm_type; | |
1567 XrmRepresentation string_quark; | |
1568 int result; | |
1569 XrmStringToNameList (name_string, namelist); | |
1570 XrmStringToClassList (class_string, classlist); | |
1571 string_quark = XrmStringToQuark ("String"); | |
1572 | |
1573 /* ensure that they have the same length */ | |
1574 while (namerest[0] && classrest[0]) | |
1575 namerest++, classrest++; | |
1576 if (namerest[0] || classrest[0]) | |
563 | 1577 { |
1578 maybe_signal_error_2 | |
1579 (Qstructure_formation_error, | |
1204 | 1580 "class list and name list must be the same length", name, class_, |
563 | 1581 Qresource, errb); |
1582 return Qnil; | |
1583 } | |
428 | 1584 result = XrmQGetResource (db, namelist, classlist, &xrm_type, &xrm_value); |
1585 | |
1586 if (result != True || xrm_type != string_quark) | |
1587 return Qnil; | |
771 | 1588 raw_result = (Extbyte *) xrm_value.addr; |
428 | 1589 } |
1590 | |
1591 if (EQ (type, Qstring)) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1592 return build_extstring (raw_result, codesys); |
428 | 1593 else if (EQ (type, Qboolean)) |
1594 { | |
771 | 1595 if (!strcasecmp (raw_result, "off") || |
1596 !strcasecmp (raw_result, "false") || | |
1597 !strcasecmp (raw_result, "no")) | |
428 | 1598 return Fcons (Qnil, Qnil); |
771 | 1599 if (!strcasecmp (raw_result, "on") || |
1600 !strcasecmp (raw_result, "true") || | |
1601 !strcasecmp (raw_result, "yes")) | |
428 | 1602 return Fcons (Qt, Qnil); |
563 | 1603 return maybe_signal_continuable_error_2 |
1604 (Qinvalid_operation, "Can't convert to a Boolean", | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1605 build_extstring (name_string, Qbinary), |
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1606 build_extstring (raw_result, codesys), Qresource, |
563 | 1607 errb); |
428 | 1608 } |
1609 else if (EQ (type, Qinteger) || EQ (type, Qnatnum)) | |
1610 { | |
1611 int i; | |
1612 char c; | |
1613 if (1 != sscanf (raw_result, "%d%c", &i, &c)) | |
563 | 1614 return maybe_signal_continuable_error_2 |
1615 (Qinvalid_operation, "Can't convert to an integer", | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1616 build_extstring (name_string, Qbinary), |
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1617 build_extstring (raw_result, codesys), Qresource, |
563 | 1618 errb); |
428 | 1619 else if (EQ (type, Qnatnum) && i < 0) |
563 | 1620 return maybe_signal_continuable_error_2 |
1621 (Qinvalid_argument, "Invalid numerical value for resource", | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1622 make_int (i), build_extstring (name_string, Qbinary), |
771 | 1623 Qresource, errb); |
428 | 1624 else |
1625 return make_int (i); | |
1626 } | |
1627 else | |
1628 { | |
1629 return maybe_signal_continuable_error | |
563 | 1630 (Qwrong_type_argument, "Should be string, integer, natnum or boolean", |
1631 type, Qresource, errb); | |
428 | 1632 } |
1633 } | |
1634 | |
1635 DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix, 1, 2, 0, /* | |
1636 Return the resource prefix for LOCALE on DEVICE. | |
1637 The resource prefix is the strings used to prefix resources if | |
1638 the LOCALE and DEVICE arguments were passed to `x-get-resource'. | |
1639 The returned value is a cons of a name prefix and a class prefix. | |
1640 For example, if LOCALE is a frame, the returned value might be | |
1641 \("xemacs.frame.FRAME-NAME" . "Emacs.EmacsLocaleType.EmacsFrame"). | |
1642 If no valid X device for resourcing can be obtained, this function | |
1643 returns nil. (In such a case, `x-get-resource' would always return nil.) | |
1644 */ | |
1645 (locale, device)) | |
1646 { | |
1647 Display *display; | |
1648 | |
771 | 1649 Dynarr_reset (name_Extbyte_dynarr ); |
1650 Dynarr_reset (class_Extbyte_dynarr); | |
428 | 1651 |
1652 x_get_resource_prefix (locale, device, &display, | |
771 | 1653 name_Extbyte_dynarr, class_Extbyte_dynarr); |
428 | 1654 if (!display) |
1655 return Qnil; | |
1656 | |
4967 | 1657 return Fcons (make_string ((Ibyte *) Dynarr_begin (name_Extbyte_dynarr), |
771 | 1658 Dynarr_length (name_Extbyte_dynarr)), |
4967 | 1659 make_string ((Ibyte *) Dynarr_begin (class_Extbyte_dynarr), |
771 | 1660 Dynarr_length (class_Extbyte_dynarr))); |
428 | 1661 } |
1662 | |
1663 DEFUN ("x-put-resource", Fx_put_resource, 1, 2, 0, /* | |
1664 Add a resource to the resource database for DEVICE. | |
1665 RESOURCE-LINE specifies the resource to add and should be a | |
1666 standard resource specification. | |
1667 */ | |
1668 (resource_line, device)) | |
1669 { | |
1670 struct device *d = decode_device (device); | |
1671 | |
1672 if (DEVICE_X_P (d)) | |
1673 { | |
1674 XrmDatabase db = XtDatabase (DEVICE_X_DISPLAY (d)); | |
771 | 1675 Extbyte *str, *colon_pos; |
1676 | |
1677 CHECK_STRING (resource_line); | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
1678 str = LISP_STRING_TO_EXTERNAL (resource_line, |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
1679 coding_system_of_xrm_database (db)); |
771 | 1680 if (!(colon_pos = strchr (str, ':')) || strchr (str, '\n')) |
1681 invalid: | |
1682 syntax_error ("Invalid resource line", resource_line); | |
1683 if ((int) | |
1684 strspn (str, | |
1685 /* Only the following chars are allowed before the colon */ | |
1686 " \t.*?abcdefghijklmnopqrstuvwxyz" | |
1687 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-") | |
1688 != colon_pos - str) | |
1689 goto invalid; | |
1690 | |
428 | 1691 XrmPutLineResource (&db, str); |
1692 } | |
1693 | |
1694 return Qnil; | |
1695 } | |
1696 | |
1697 | |
1698 /************************************************************************/ | |
1699 /* display information functions */ | |
1700 /************************************************************************/ | |
1701 | |
1702 DEFUN ("default-x-device", Fdefault_x_device, 0, 0, 0, /* | |
1703 Return the default X device for resourcing. | |
1704 This is the first-created X device that still exists. | |
872 | 1705 See also `default-device'. |
428 | 1706 */ |
1707 ()) | |
1708 { | |
872 | 1709 return get_default_device (Qx); |
428 | 1710 } |
1711 | |
1712 DEFUN ("x-display-visual-class", Fx_display_visual_class, 0, 1, 0, /* | |
1713 Return the visual class of the X display DEVICE is using. | |
1714 This can be altered from the default at startup using the XResource "EmacsVisual". | |
1715 The returned value will be one of the symbols `static-gray', `gray-scale', | |
1716 `static-color', `pseudo-color', `true-color', or `direct-color'. | |
1717 */ | |
1718 (device)) | |
1719 { | |
1720 Visual *vis = DEVICE_X_VISUAL (decode_x_device (device)); | |
1204 | 1721 switch (vis->X_CLASSFIELD) |
428 | 1722 { |
1723 case StaticGray: return intern ("static-gray"); | |
1724 case GrayScale: return intern ("gray-scale"); | |
1725 case StaticColor: return intern ("static-color"); | |
1726 case PseudoColor: return intern ("pseudo-color"); | |
1727 case TrueColor: return intern ("true-color"); | |
1728 case DirectColor: return intern ("direct-color"); | |
1729 default: | |
563 | 1730 invalid_state ("display has an unknown visual class", Qunbound); |
428 | 1731 return Qnil; /* suppress compiler warning */ |
1732 } | |
1733 } | |
1734 | |
1735 DEFUN ("x-display-visual-depth", Fx_display_visual_depth, 0, 1, 0, /* | |
1736 Return the bitplane depth of the visual the X display DEVICE is using. | |
1737 */ | |
1738 (device)) | |
1739 { | |
1740 return make_int (DEVICE_X_DEPTH (decode_x_device (device))); | |
1741 } | |
1742 | |
1743 static Lisp_Object | |
1744 x_device_system_metrics (struct device *d, | |
1745 enum device_metrics m) | |
1746 { | |
1747 Display *dpy = DEVICE_X_DISPLAY (d); | |
1748 | |
1749 switch (m) | |
1750 { | |
1751 case DM_size_device: | |
1752 return Fcons (make_int (DisplayWidth (dpy, DefaultScreen (dpy))), | |
1753 make_int (DisplayHeight (dpy, DefaultScreen (dpy)))); | |
1754 case DM_size_device_mm: | |
1755 return Fcons (make_int (DisplayWidthMM (dpy, DefaultScreen (dpy))), | |
1756 make_int (DisplayHeightMM (dpy, DefaultScreen (dpy)))); | |
1757 case DM_num_bit_planes: | |
1758 return make_int (DisplayPlanes (dpy, DefaultScreen (dpy))); | |
1759 case DM_num_color_cells: | |
1760 return make_int (DisplayCells (dpy, DefaultScreen (dpy))); | |
1942 | 1761 case DM_num_screens: |
1762 return make_int (ScreenCount (dpy)); | |
1763 case DM_backing_store: | |
1764 switch (DoesBackingStore (DefaultScreenOfDisplay (dpy))) | |
1765 { | |
1766 case Always: | |
1767 return intern ("always"); | |
1768 case WhenMapped: | |
1769 return intern ("when-mapped"); | |
1770 default: | |
1771 return intern ("not-useful"); | |
1772 } | |
1773 case DM_save_under: | |
1774 return (DoesSaveUnders (DefaultScreenOfDisplay (dpy)) == True) | |
1775 ? Qt : Qnil; | |
428 | 1776 default: /* No such device metric property for X devices */ |
1777 return Qunbound; | |
1778 } | |
1779 } | |
1780 | |
1781 DEFUN ("x-server-vendor", Fx_server_vendor, 0, 1, 0, /* | |
1782 Return the vendor ID string of the X server DEVICE is on. | |
1783 Return the empty string if the vendor ID string cannot be determined. | |
1784 */ | |
1785 (device)) | |
1786 { | |
1787 Display *dpy = get_x_display (device); | |
2367 | 1788 Extbyte *vendor = ServerVendor (dpy); |
428 | 1789 |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1790 return build_extstring (vendor ? vendor : "", Qx_hpc_encoding); |
428 | 1791 } |
1792 | |
1793 DEFUN ("x-server-version", Fx_server_version, 0, 1, 0, /* | |
1794 Return the version numbers of the X server DEVICE is on. | |
1795 The returned value is a list of three integers: the major and minor | |
1796 version numbers of the X Protocol in use, and the vendor-specific release | |
1797 number. See also `x-server-vendor'. | |
1798 */ | |
1799 (device)) | |
1800 { | |
1801 Display *dpy = get_x_display (device); | |
1802 | |
1803 return list3 (make_int (ProtocolVersion (dpy)), | |
1804 make_int (ProtocolRevision (dpy)), | |
1805 make_int (VendorRelease (dpy))); | |
1806 } | |
1807 | |
1808 DEFUN ("x-valid-keysym-name-p", Fx_valid_keysym_name_p, 1, 1, 0, /* | |
1809 Return true if KEYSYM names a keysym that the X library knows about. | |
1810 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in | |
1811 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. | |
1812 */ | |
1813 (keysym)) | |
1814 { | |
2367 | 1815 const Extbyte *keysym_ext; |
428 | 1816 |
1817 CHECK_STRING (keysym); | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
1818 keysym_ext = LISP_STRING_TO_EXTERNAL (keysym, Qctext); |
428 | 1819 |
1820 return XStringToKeysym (keysym_ext) ? Qt : Qnil; | |
1821 } | |
1822 | |
1823 DEFUN ("x-keysym-hash-table", Fx_keysym_hash_table, 0, 1, 0, /* | |
440 | 1824 Return a hash table containing a key for all keysyms on DEVICE. |
1825 DEVICE must be an X11 display device. See `x-keysym-on-keyboard-p'. | |
428 | 1826 */ |
1827 (device)) | |
1828 { | |
1829 struct device *d = decode_device (device); | |
1830 if (!DEVICE_X_P (d)) | |
563 | 1831 gui_error ("Not an X device", device); |
428 | 1832 |
1833 return DEVICE_X_DATA (d)->x_keysym_map_hash_table; | |
1834 } | |
1835 | |
1836 DEFUN ("x-keysym-on-keyboard-sans-modifiers-p", Fx_keysym_on_keyboard_sans_modifiers_p, | |
1837 1, 2, 0, /* | |
1838 Return true if KEYSYM names a key on the keyboard of DEVICE. | |
1839 More precisely, return true if pressing a physical key | |
1840 on the keyboard of DEVICE without any modifier keys generates KEYSYM. | |
1841 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in | |
1842 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. | |
1843 The keysym name can be provided in two forms: | |
1844 - if keysym is a string, it must be the name as known to X windows. | |
1845 - if keysym is a symbol, it must be the name as known to XEmacs. | |
1846 The two names differ in capitalization and underscoring. | |
1847 */ | |
1848 (keysym, device)) | |
1849 { | |
1850 struct device *d = decode_device (device); | |
1851 if (!DEVICE_X_P (d)) | |
563 | 1852 gui_error ("Not an X device", device); |
428 | 1853 |
1854 return (EQ (Qsans_modifiers, | |
1855 Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ? | |
1856 Qt : Qnil); | |
1857 } | |
1858 | |
1859 | |
1860 DEFUN ("x-keysym-on-keyboard-p", Fx_keysym_on_keyboard_p, 1, 2, 0, /* | |
1861 Return true if KEYSYM names a key on the keyboard of DEVICE. | |
1862 More precisely, return true if some keystroke (possibly including modifiers) | |
1863 on the keyboard of DEVICE keys generates KEYSYM. | |
1864 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in | |
1865 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. | |
1866 The keysym name can be provided in two forms: | |
1867 - if keysym is a string, it must be the name as known to X windows. | |
1868 - if keysym is a symbol, it must be the name as known to XEmacs. | |
1869 The two names differ in capitalization and underscoring. | |
2828 | 1870 |
1871 This function is not entirely trustworthy, in that Xlib compose processing | |
1872 can produce keysyms that XEmacs will not have seen when it examined the | |
1873 keysyms available on startup. So pressing `dead-diaeresis' and then 'a' may | |
1874 pass `adiaeresis' to XEmacs, or (in some implementations) even `U00E4', | |
1875 where `(x-keysym-on-keyboard-p 'adiaeresis)' and `(x-keysym-on-keyboard-p | |
1876 'U00E4)' would both have returned nil. Subsequent to XEmacs seeing a keysym | |
1877 it was previously unaware of, the predicate will take note of it, though. | |
428 | 1878 */ |
1879 (keysym, device)) | |
1880 { | |
1881 struct device *d = decode_device (device); | |
1882 if (!DEVICE_X_P (d)) | |
563 | 1883 gui_error ("Not an X device", device); |
428 | 1884 |
1885 return (NILP (Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ? | |
1886 Qnil : Qt); | |
1887 } | |
1888 | |
1889 | |
1890 /************************************************************************/ | |
1891 /* grabs and ungrabs */ | |
1892 /************************************************************************/ | |
1893 | |
1894 DEFUN ("x-grab-pointer", Fx_grab_pointer, 0, 3, 0, /* | |
1895 Grab the pointer and restrict it to its current window. | |
1896 If optional DEVICE argument is nil, the default device will be used. | |
1897 If optional CURSOR argument is non-nil, change the pointer shape to that | |
1898 until `x-ungrab-pointer' is called (it should be an object returned by the | |
1899 `make-cursor-glyph' function). | |
1900 If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all | |
1901 keyboard events during the grab. | |
1902 Returns t if the grab is successful, nil otherwise. | |
1903 */ | |
1904 (device, cursor, ignore_keyboard)) | |
1905 { | |
1906 Window w; | |
1907 int pointer_mode, result; | |
1908 struct device *d = decode_x_device (device); | |
1909 | |
1910 if (!NILP (cursor)) | |
1911 { | |
1912 CHECK_POINTER_GLYPH (cursor); | |
1913 cursor = glyph_image_instance (cursor, device, ERROR_ME, 0); | |
1914 } | |
1915 | |
1916 if (!NILP (ignore_keyboard)) | |
1917 pointer_mode = GrabModeSync; | |
1918 else | |
1919 pointer_mode = GrabModeAsync; | |
1920 | |
1921 w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d))); | |
1922 | |
1923 /* #### Possibly this needs to gcpro the cursor somehow, but it doesn't | |
1924 seem to cause a problem if XFreeCursor is called on a cursor in use | |
1925 in a grab; I suppose the X server counts the grab as a reference | |
1926 and doesn't free it until it exits? */ | |
1927 result = XGrabPointer (DEVICE_X_DISPLAY (d), w, | |
1928 False, | |
1929 ButtonMotionMask | | |
1930 ButtonPressMask | | |
1931 ButtonReleaseMask | | |
1932 PointerMotionHintMask, | |
1933 GrabModeAsync, /* Keep pointer events flowing */ | |
1934 pointer_mode, /* Stall keyboard events */ | |
1935 w, /* Stay in this window */ | |
1936 (NILP (cursor) ? 0 | |
1937 : XIMAGE_INSTANCE_X_CURSOR (cursor)), | |
1938 CurrentTime); | |
1939 return (result == GrabSuccess) ? Qt : Qnil; | |
1940 } | |
1941 | |
1942 DEFUN ("x-ungrab-pointer", Fx_ungrab_pointer, 0, 1, 0, /* | |
1943 Release a pointer grab made with `x-grab-pointer'. | |
1944 If optional first arg DEVICE is nil the default device is used. | |
1945 If it is t the pointer will be released on all X devices. | |
1946 */ | |
1947 (device)) | |
1948 { | |
1949 if (!EQ (device, Qt)) | |
1950 { | |
1951 Display *dpy = get_x_display (device); | |
1952 XUngrabPointer (dpy, CurrentTime); | |
1953 } | |
1954 else | |
1955 { | |
1956 Lisp_Object devcons, concons; | |
1957 | |
1958 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
1959 { | |
1960 struct device *d = XDEVICE (XCAR (devcons)); | |
1961 | |
1962 if (DEVICE_X_P (d)) | |
1963 XUngrabPointer (DEVICE_X_DISPLAY (d), CurrentTime); | |
1964 } | |
1965 } | |
1966 | |
1967 return Qnil; | |
1968 } | |
1969 | |
1970 DEFUN ("x-grab-keyboard", Fx_grab_keyboard, 0, 1, 0, /* | |
1971 Grab the keyboard on the given device (defaulting to the selected one). | |
1972 So long as the keyboard is grabbed, all keyboard events will be delivered | |
1973 to emacs -- it is not possible for other X clients to eavesdrop on them. | |
1974 Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect). | |
1975 Returns t if the grab is successful, nil otherwise. | |
1976 */ | |
1977 (device)) | |
1978 { | |
1979 struct device *d = decode_x_device (device); | |
1980 Window w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d))); | |
1981 Display *dpy = DEVICE_X_DISPLAY (d); | |
1982 Status status; | |
1983 XSync (dpy, False); | |
1984 status = XGrabKeyboard (dpy, w, True, | |
1985 /* I don't really understand sync-vs-async | |
1986 grabs, but this is what xterm does. */ | |
1987 GrabModeAsync, GrabModeAsync, | |
1988 /* Use the timestamp of the last user action | |
1989 read by emacs proper; xterm uses CurrentTime | |
1990 but there's a comment that says "wrong"... | |
1991 (Despite the name this is the time of the | |
1992 last key or mouse event.) */ | |
1993 DEVICE_X_MOUSE_TIMESTAMP (d)); | |
1994 if (status == GrabSuccess) | |
1995 { | |
1996 /* The XUngrabKeyboard should generate a FocusIn back to this | |
1997 window but it doesn't unless we explicitly set focus to the | |
1998 window first (which should already have it. The net result | |
1999 is that without this call when x-ungrab-keyboard is called | |
2000 the selected frame ends up not having focus. */ | |
2001 XSetInputFocus (dpy, w, RevertToParent, DEVICE_X_MOUSE_TIMESTAMP (d)); | |
2002 return Qt; | |
2003 } | |
2004 else | |
2005 return Qnil; | |
2006 } | |
2007 | |
2008 DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, 0, 1, 0, /* | |
2009 Release a keyboard grab made with `x-grab-keyboard'. | |
2010 */ | |
2011 (device)) | |
2012 { | |
2013 Display *dpy = get_x_display (device); | |
2014 XUngrabKeyboard (dpy, CurrentTime); | |
2015 return Qnil; | |
2016 } | |
2017 | |
2018 DEFUN ("x-get-font-path", Fx_get_font_path, 0, 1, 0, /* | |
2019 Get the X Server's font path. | |
2020 | |
2021 See also `x-set-font-path'. | |
2022 */ | |
2023 (device)) | |
2024 { | |
2025 Display *dpy = get_x_display (device); | |
2026 int ndirs_return; | |
2367 | 2027 const Extbyte **directories = |
2028 (const Extbyte **) XGetFontPath (dpy, &ndirs_return); | |
428 | 2029 Lisp_Object font_path = Qnil; |
2030 | |
2031 if (!directories) | |
563 | 2032 gui_error ("Can't get X font path", device); |
428 | 2033 |
2034 while (ndirs_return--) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2035 font_path = Fcons (build_extstring (directories[ndirs_return], |
440 | 2036 Qfile_name), |
2037 font_path); | |
428 | 2038 |
4548
b0d2ace4aed1
Call XFreeFontPath appropriately in #'x-get-font-path.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4528
diff
changeset
|
2039 XFreeFontPath ((char **)directories); |
b0d2ace4aed1
Call XFreeFontPath appropriately in #'x-get-font-path.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4528
diff
changeset
|
2040 |
428 | 2041 return font_path; |
2042 } | |
2043 | |
2044 DEFUN ("x-set-font-path", Fx_set_font_path, 1, 2, 0, /* | |
2045 Set the X Server's font path to FONT-PATH. | |
2046 | |
2047 There is only one font path per server, not one per client. Use this | |
2048 sparingly. It uncaches all of the X server's font information. | |
2049 | |
2050 Font directories should end in the path separator and should contain | |
2051 a file called fonts.dir usually created with the program mkfontdir. | |
2052 | |
2053 Setting the FONT-PATH to nil tells the X server to use the default | |
2054 font path. | |
2055 | |
2056 See also `x-get-font-path'. | |
2057 */ | |
2058 (font_path, device)) | |
2059 { | |
2060 Display *dpy = get_x_display (device); | |
2367 | 2061 Extbyte **directories; |
428 | 2062 int i=0,ndirs=0; |
2063 | |
2367 | 2064 { |
2065 EXTERNAL_LIST_LOOP_2 (path_entry, font_path) | |
2066 { | |
2067 CHECK_STRING (path_entry); | |
2068 ndirs++; | |
2069 } | |
2070 } | |
428 | 2071 |
2367 | 2072 directories = alloca_array (Extbyte *, ndirs); |
428 | 2073 |
2367 | 2074 { |
2075 EXTERNAL_LIST_LOOP_2 (path_entry, font_path) | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
2076 LISP_PATHNAME_CONVERT_OUT (path_entry, directories[i++]); |
2367 | 2077 } |
428 | 2078 |
2079 expect_x_error (dpy); | |
2367 | 2080 XSetFontPath (dpy, directories, ndirs); |
428 | 2081 signal_if_x_error (dpy, 1/*resumable_p*/); |
2082 | |
2083 return Qnil; | |
2084 } | |
2085 | |
2086 | |
2087 /************************************************************************/ | |
2088 /* initialization */ | |
2089 /************************************************************************/ | |
2090 | |
2091 void | |
2092 syms_of_device_x (void) | |
2093 { | |
3092 | 2094 #ifdef NEW_GC |
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4790
diff
changeset
|
2095 INIT_LISP_OBJECT (x_device); |
3092 | 2096 #endif /* NEW_GC */ |
2097 | |
428 | 2098 DEFSUBR (Fx_debug_mode); |
2099 DEFSUBR (Fx_get_resource); | |
2100 DEFSUBR (Fx_get_resource_prefix); | |
2101 DEFSUBR (Fx_put_resource); | |
2102 | |
2103 DEFSUBR (Fdefault_x_device); | |
2104 DEFSUBR (Fx_display_visual_class); | |
2105 DEFSUBR (Fx_display_visual_depth); | |
2106 DEFSUBR (Fx_server_vendor); | |
2107 DEFSUBR (Fx_server_version); | |
2108 DEFSUBR (Fx_valid_keysym_name_p); | |
2109 DEFSUBR (Fx_keysym_hash_table); | |
2110 DEFSUBR (Fx_keysym_on_keyboard_p); | |
2111 DEFSUBR (Fx_keysym_on_keyboard_sans_modifiers_p); | |
2112 | |
2113 DEFSUBR (Fx_grab_pointer); | |
2114 DEFSUBR (Fx_ungrab_pointer); | |
2115 DEFSUBR (Fx_grab_keyboard); | |
2116 DEFSUBR (Fx_ungrab_keyboard); | |
2117 | |
2118 DEFSUBR (Fx_get_font_path); | |
2119 DEFSUBR (Fx_set_font_path); | |
2120 | |
563 | 2121 DEFSYMBOL (Qx_error); |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
2122 DEFSYMBOL (Qmake_device_early_x_entry_point); |
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
2123 DEFSYMBOL (Qmake_device_late_x_entry_point); |
771 | 2124 |
2125 #ifdef MULE | |
2126 DEFSYMBOL (Qget_coding_system_from_locale); | |
2127 #endif | |
428 | 2128 } |
2129 | |
2130 void | |
2131 reinit_console_type_create_device_x (void) | |
2132 { | |
2133 /* Initialize variables to speed up X resource interactions */ | |
2367 | 2134 const Ascbyte *valid_resource_chars = |
428 | 2135 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"; |
2136 while (*valid_resource_chars) | |
2137 valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1; | |
2138 | |
771 | 2139 name_Extbyte_dynarr = Dynarr_new (Extbyte); |
2140 class_Extbyte_dynarr = Dynarr_new (Extbyte); | |
428 | 2141 } |
2142 | |
2143 void | |
2144 console_type_create_device_x (void) | |
2145 { | |
2146 reinit_console_type_create_device_x (); | |
2147 CONSOLE_HAS_METHOD (x, init_device); | |
2148 CONSOLE_HAS_METHOD (x, finish_init_device); | |
2149 CONSOLE_HAS_METHOD (x, mark_device); | |
2150 CONSOLE_HAS_METHOD (x, delete_device); | |
2151 CONSOLE_HAS_METHOD (x, device_system_metrics); | |
2152 } | |
2153 | |
2154 void | |
2155 reinit_vars_of_device_x (void) | |
2156 { | |
2157 error_expected = 0; | |
2158 error_occurred = 0; | |
2159 | |
2160 in_resource_setting = 0; | |
2161 } | |
2162 | |
2163 void | |
2164 vars_of_device_x (void) | |
2165 { | |
2166 DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class /* | |
2167 The X application class of the XEmacs process. | |
2168 This controls, among other things, the name of the `app-defaults' file | |
2169 that XEmacs will use. For changes to this variable to take effect, they | |
2170 must be made before the connection to the X server is initialized, that is, | |
2171 this variable may only be changed before emacs is dumped, or by setting it | |
2172 in the file lisp/term/x-win.el. | |
2173 | |
2681 | 2174 If this variable is nil on startup, the application uses `XEmacs'. Versions |
2175 previous to 21.5.21 examined the resource database and used `XEmacs' if any | |
2176 resources beginning with that string existed, and `Emacs' otherwise, for | |
2828 | 2177 greater backward compatibility. However, this has always tended to conflict |
2681 | 2178 with GNU Emacs, so this behavior is deprecated--in the short term, you can |
2179 restore it in a post-21.5.21 XEmacs by setting the | |
2180 USE_EMACS_AS_DEFAULT_APPLICATION_CLASS environment variable to some value, | |
2181 but in the medium and long term, you should migrate your X resources. | |
428 | 2182 */ ); |
2183 Vx_emacs_application_class = Qnil; | |
2184 | |
2185 DEFVAR_LISP ("x-initial-argv-list", &Vx_initial_argv_list /* | |
2186 You don't want to know. | |
2187 This is used during startup to communicate the remaining arguments in | |
2188 `command-line-args-left' to the C code, which passes the args to | |
2189 the X initialization code, which removes some args, and then the | |
2190 args are placed back into `x-initial-arg-list' and thence into | |
2191 `command-line-args-left'. Perhaps `command-line-args-left' should | |
2192 just reside in C. | |
2193 */ ); | |
2194 Vx_initial_argv_list = Qnil; | |
2195 | |
2196 DEFVAR_LISP ("x-app-defaults-directory", &Vx_app_defaults_directory /* | |
2197 Used by the Lisp code to communicate to the low level X initialization | |
2198 where the localized init files are. | |
2199 */ ); | |
2200 Vx_app_defaults_directory = Qnil; | |
2201 | |
2202 Fprovide (Qx); | |
2203 } |