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