comparison src/device-x.c @ 428:3ecd8885ac67 r21-2-22

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