More warning suppressions
[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                         int sz = snprintf(path, sizeof(path),
593                                           "%s%s/Emacs", data_dir, locale);
594                         assert(sz >= 0 && (size_t)sz < sizeof(path));
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                         int sz = snprintf(path, sizeof(path), 
609                                           "%sapp-defaults/%s/Emacs",
610                                           data_dir, locale);
611                         assert(sz >= 0 && (size_t)sz < sizeof(path));
612                         if (!access(path, R_OK)) {
613                                 XrmCombineFileDatabase(path, &db, False);
614                         }
615                 }
616         }
617         return;
618 }
619 #else  /* !LWLIB_MENUBARS_MOTIF && !HAVE_XIM && !USE_XFONTSET */
620 static inline void
621 read_locale_specific_resources(Display *SXE_UNUSED(dpy))
622 {
623         return;
624 }
625 #endif  /* LWLIB_MENUBARS_MOTIF || HAVE_XIM || USE_XFONTSET */
626
627 static void x_init_device(struct device *d, Lisp_Object props)
628 {
629         Lisp_Object display;
630         Lisp_Object device;
631         Display *dpy;
632         Widget app_shell;
633         int argc;
634         Extbyte **argv;
635         char *app_class;
636         char *app_name;
637         char *disp_name;
638         Visual *visual = NULL;
639         int depth = 8;          /* shut up the compiler */
640         Colormap cmap;
641         int screen;
642         /* */
643         int best_visual_found = 0;
644
645         /* is that still needed? -hrop */
646         check_for_3d_shebang();
647
648         XSETDEVICE(device, d);
649         display = DEVICE_CONNECTION(d);
650
651         allocate_x_device_struct(d);
652
653         make_argc_argv(Vx_initial_argv_list, &argc, &argv);
654
655         LISP_STRING_TO_EXTERNAL(display, disp_name, Qctext);
656
657         /*
658          * Break apart the old XtOpenDisplay call into XOpenDisplay and
659          * XtDisplayInitialize so we can figure out whether there
660          * are any SXEmacs resources in the resource database before
661          * we initialize Xt.  This is so we can automagically support
662          * both `Emacs' and `SXEmacs' application classes.
663          */
664         slow_down_interrupts();
665         device_being_initialized = d;
666         dpy = DEVICE_X_DISPLAY(d) = XOpenDisplay(disp_name);
667         device_being_initialized = NULL;
668         speed_up_interrupts();
669
670         if (dpy == NULL) {
671                 suppress_early_error_handler_backtrace = 1;
672                 signal_simple_error("X server not responding\n", display);
673         }
674
675         if (STRINGP(Vx_emacs_application_class) &&
676             XSTRING_LENGTH(Vx_emacs_application_class) > 0) {
677                 LISP_STRING_TO_EXTERNAL(Vx_emacs_application_class, app_class,
678                                         Qctext);
679         } else {
680                 app_class = (NILP(Vx_emacs_application_class) &&
681                              have_sxemacs_resources_in_xrdb(dpy))
682                 ? "SXEmacs"
683                 : "Emacs";
684                 /* need to update Vx_emacs_application_class: */
685                 Vx_emacs_application_class = build_string(app_class);
686         }
687
688         slow_down_interrupts();
689         XtDisplayInitialize(Xt_app_con, dpy, compute_x_app_name(argc, argv),
690                             app_class, emacs_options,
691                             XtNumber(emacs_options), &argc, (char **)argv);
692         speed_up_interrupts();
693
694         screen = DefaultScreen(dpy);
695         if (NILP(Vdefault_x_device))
696                 Vdefault_x_device = device;
697
698 #if defined MULE
699         read_locale_specific_resources(dpy);
700 #endif
701
702         if (NILP(DEVICE_NAME(d)))
703                 DEVICE_NAME(d) = display;
704
705         /* We're going to modify the string in-place, so be a nice SXEmacs */
706         DEVICE_NAME(d) = Fcopy_sequence(DEVICE_NAME(d));
707         /* colons and periods can't appear in individual elements of resource
708            strings */
709
710         XtGetApplicationNameAndClass(
711                 dpy, (String*)&app_name, (String*)&app_class);
712         /* search for a matching visual if requested by the user, or setup the
713            display default */
714         {
715                 int resource_name_length = max(sizeof(".emacsVisual"),
716                                                sizeof(".privateColormap"));
717                 char buf1[strlen(app_name) + resource_name_length];
718                 char buf2[strlen(app_class) + resource_name_length];
719                 char *type;
720                 XrmValue value;
721
722                 int sz = snprintf(buf1, sizeof(buf1), "%s.emacsVisual", app_name);
723                 assert(sz >= 0 && (size_t)sz < sizeof(buf1));
724                 sz = snprintf(buf2, sizeof(buf2), "%s.EmacsVisual", app_class);
725                 assert(sz >= 0 && (size_t)sz < sizeof(buf2));
726
727                 if (XrmGetResource(XtDatabase(dpy), buf1, buf2, &type, &value)
728                     == True) {
729                         int cnt = 0;
730                         int vis_class = PseudoColor;
731                         XVisualInfo vinfo;
732                         char *str = (char *)value.addr;
733
734 #define CHECK_VIS_CLASS(visual_class)                                   \
735         else if (memcmp(str, #visual_class, sizeof(#visual_class) - 1) == 0) \
736                 cnt = sizeof (#visual_class) - 1, vis_class = visual_class
737
738                         if (1) ;
739                         CHECK_VIS_CLASS(StaticGray);
740                         CHECK_VIS_CLASS(StaticColor);
741                         CHECK_VIS_CLASS(TrueColor);
742                         CHECK_VIS_CLASS(GrayScale);
743                         CHECK_VIS_CLASS(PseudoColor);
744                         CHECK_VIS_CLASS(DirectColor);
745
746                         if (cnt) {
747                                 depth = atoi(str + cnt);
748                                 if (depth == 0) {
749                                         stderr_out(
750                                                 "Invalid Depth specification "
751                                                 "in %s... ignoring...\n", str);
752                                 } else {
753                                         if (XMatchVisualInfo
754                                             (dpy, screen, depth, vis_class,
755                                              &vinfo)) {
756                                                 visual = vinfo.visual;
757                                         } else {
758                                                 stderr_out(
759                                                         "Can't match the "
760                                                         "requested visual %s..."
761                                                         " using defaults\n",
762                                                         str);
763                                         }
764                                 }
765                         } else {
766                                 stderr_out("Invalid Visual specification "
767                                            "in %s... ignoring.\n", str);
768                         }
769                 }
770                 if (visual == NULL) {
771                         /*
772                            visual = DefaultVisual(dpy, screen);
773                            depth = DefaultDepth(dpy, screen);
774                          */
775                         visual = x_try_best_visual(dpy, screen);
776                         depth = x_get_visual_depth(dpy, visual);
777                         best_visual_found =
778                                 (visual != DefaultVisual(dpy, screen));
779                 }
780
781                 /* If we've got the same visual as the default and it's
782                    PseudoColor, check to see if the user specified that we need
783                    a private colormap */
784                 if (visual == DefaultVisual(dpy, screen)) {
785                         sz = snprintf(buf1, sizeof(buf1), "%s.privateColormap", app_name);
786                         assert(sz >= 0 && (size_t)sz < sizeof(buf1));
787                         sz = snprintf(buf2, sizeof(buf2), "%s.PrivateColormap", app_class);
788                         assert(sz >= 0 && (size_t)sz < sizeof(buf2));
789
790                         if ((visual->class == PseudoColor) &&
791                             (XrmGetResource
792                              (XtDatabase(dpy), buf1, buf2, &type,
793                               &value) == True)) {
794                                 cmap =
795                                     XCopyColormapAndFree(dpy,
796                                                          DefaultColormap(dpy,
797                                                                          screen));
798                         } else {
799                                 cmap = DefaultColormap(dpy, screen);
800                         }
801                 } else {
802                         if (best_visual_found) {
803                                 cmap =
804                                     XCreateColormap(dpy,
805                                                     RootWindow(dpy, screen),
806                                                     visual, AllocNone);
807                         } else {
808                                 /* We have to create a matching colormap
809                                    anyway...
810                                    #### think about using standard colormaps
811                                    (need the Xmu libs?) */
812                                 cmap =
813                                     XCreateColormap(dpy,
814                                                     RootWindow(dpy, screen),
815                                                     visual, AllocNone);
816                                 XInstallColormap(dpy, cmap);
817                         }
818                 }
819         }
820
821         DEVICE_X_VISUAL(d) = visual;
822         DEVICE_X_COLORMAP(d) = cmap;
823         DEVICE_X_DEPTH(d) = depth;
824         validify_resource_component((char *)XSTRING_DATA(DEVICE_NAME(d)),
825                                     XSTRING_LENGTH(DEVICE_NAME(d)));
826
827         {
828                 /* inevitable warnings coming up */
829                 Arg al[3];
830                 XtSetArg(al[0], XtNvisual, visual);
831                 XtSetArg(al[1], XtNdepth, depth);
832                 XtSetArg(al[2], XtNcolormap, cmap);
833
834                 app_shell = XtAppCreateShell(NULL, app_class,
835                                              applicationShellWidgetClass,
836                                              dpy, al, countof(al));
837         }
838
839         DEVICE_XT_APP_SHELL(d) = app_shell;
840
841 #ifdef HAVE_XIM
842         XIM_init_device(d);
843 #endif                          /* HAVE_XIM */
844
845         /* Realize the app_shell so that its window exists for GC creation purposes,
846            and set it to the size of the root window for child placement purposes */
847         {
848                 /* inevitable warnings coming up */
849                 Arg al[5];
850                 XtSetArg(al[0], XtNmappedWhenManaged, False);
851                 XtSetArg(al[1], XtNx, 0);
852                 XtSetArg(al[2], XtNy, 0);
853                 XtSetArg(al[3], XtNwidth,
854                          WidthOfScreen(ScreenOfDisplay(dpy, screen)));
855                 XtSetArg(al[4], XtNheight,
856                          HeightOfScreen(ScreenOfDisplay(dpy, screen)));
857                 XtSetValues(app_shell, al, countof(al));
858                 XtRealizeWidget(app_shell);
859         }
860
861 #ifdef HAVE_WMCOMMAND
862         {
863                 int new_argc;
864                 Extbyte **new_argv;
865                 make_argc_argv(Vcommand_line_args, &new_argc, &new_argv);
866                 XSetCommand(XtDisplay(app_shell), XtWindow(app_shell),
867                             (char **)new_argv, new_argc);
868                 free_argc_argv(new_argv);
869         }
870 #endif                          /* HAVE_WMCOMMAND */
871
872         Vx_initial_argv_list = make_arg_list(argc, argv);
873         free_argc_argv(argv);
874
875         DEVICE_X_WM_COMMAND_FRAME(d) = Qnil;
876
877         sanity_check_geometry_resource(dpy);
878
879         /* In event-Xt.c */
880         x_init_modifier_mapping(d);
881
882         DEVICE_INFD(d) = DEVICE_OUTFD(d) = ConnectionNumber(dpy);
883         init_baud_rate(d);
884         init_one_device(d);
885
886         DEVICE_X_GC_CACHE(d) = make_gc_cache(dpy, XtWindow(app_shell));
887         DEVICE_X_GRAY_PIXMAP(d) = None;
888         Xatoms_of_device_x(d);
889         Xatoms_of_select_x(d);
890         Xatoms_of_objects_x(d);
891         x_init_device_class(d);
892
893         /* Run the elisp side of the X device initialization. */
894         call0(Qinit_pre_x_win);
895 }
896
897 static void x_finish_init_device(struct device *d, Lisp_Object props)
898 {
899         call0(Qinit_post_x_win);
900 }
901
902 static void x_mark_device(struct device *d)
903 {
904         mark_object(DEVICE_X_WM_COMMAND_FRAME(d));
905         mark_object(DEVICE_X_DATA(d)->x_keysym_map_hash_table);
906 }
907 \f
908 /************************************************************************/
909 /*                       closing an X connection                        */
910 /************************************************************************/
911
912 static void free_x_device_struct(struct device *d)
913 {
914         xfree(d->device_data);
915 }
916
917 static void x_delete_device(struct device *d)
918 {
919         Lisp_Object device;
920         Display *display;
921 #ifdef FREE_CHECKING
922         extern void (*__free_hook) (void *);
923         int checking_free;
924 #endif
925
926         XSETDEVICE(device, d);
927         display = DEVICE_X_DISPLAY(d);
928
929         if (display) {
930 #ifdef FREE_CHECKING
931                 checking_free = (__free_hook != 0);
932
933                 /* Disable strict free checking, to avoid bug in X library */
934                 if (checking_free)
935                         disable_strict_free_check();
936 #endif
937
938                 free_gc_cache(DEVICE_X_GC_CACHE(d));
939                 if (DEVICE_X_DATA(d)->x_modifier_keymap)
940                         XFreeModifiermap(DEVICE_X_DATA(d)->x_modifier_keymap);
941                 if (DEVICE_X_DATA(d)->x_keysym_map)
942                         XFree((char *)DEVICE_X_DATA(d)->x_keysym_map);
943
944                 if (DEVICE_XT_APP_SHELL(d)) {
945                         XtDestroyWidget(DEVICE_XT_APP_SHELL(d));
946                         DEVICE_XT_APP_SHELL(d) = NULL;
947                 }
948
949                 XtCloseDisplay(display);
950                 DEVICE_X_DISPLAY(d) = 0;
951 #ifdef FREE_CHECKING
952                 if (checking_free)
953                         enable_strict_free_check();
954 #endif
955         }
956
957         if (EQ(device, Vdefault_x_device)) {
958                 Lisp_Object devcons, concons;
959                 /* #### handle deleting last X device */
960                 Vdefault_x_device = Qnil;
961                 DEVICE_LOOP_NO_BREAK(devcons, concons) {
962                         if (DEVICE_X_P(XDEVICE(XCAR(devcons))) &&
963                             !EQ(device, XCAR(devcons))) {
964                                 Vdefault_x_device = XCAR(devcons);
965                                 goto double_break;
966                         }
967                 }
968         }
969       double_break:
970         free_x_device_struct(d);
971 }
972 \f
973 /************************************************************************/
974 /*                              handle X errors                         */
975 /************************************************************************/
976
977 const char *x_event_name(int event_type)
978 {
979         static const char *events[] = {
980                 "0: ERROR!",
981                 "1: REPLY",
982                 "KeyPress",
983                 "KeyRelease",
984                 "ButtonPress",
985                 "ButtonRelease",
986                 "MotionNotify",
987                 "EnterNotify",
988                 "LeaveNotify",
989                 "FocusIn",
990                 "FocusOut",
991                 "KeymapNotify",
992                 "Expose",
993                 "GraphicsExpose",
994                 "NoExpose",
995                 "VisibilityNotify",
996                 "CreateNotify",
997                 "DestroyNotify",
998                 "UnmapNotify",
999                 "MapNotify",
1000                 "MapRequest",
1001                 "ReparentNotify",
1002                 "ConfigureNotify",
1003                 "ConfigureRequest",
1004                 "GravityNotify",
1005                 "ResizeRequest",
1006                 "CirculateNotify",
1007                 "CirculateRequest",
1008                 "PropertyNotify",
1009                 "SelectionClear",
1010                 "SelectionRequest",
1011                 "SelectionNotify",
1012                 "ColormapNotify",
1013                 "ClientMessage",
1014                 "MappingNotify",
1015                 "LASTEvent"
1016         };
1017
1018         if (event_type < 0 || event_type >= countof(events))
1019                 return NULL;
1020         return events[event_type];
1021 }
1022
1023 /* Handling errors.
1024
1025    If an X error occurs which we are not expecting, we have no alternative
1026    but to print it to stderr.  It would be nice to stuff it into a pop-up
1027    buffer, or to print it in the minibuffer, but that's not possible, because
1028    one is not allowed to do any I/O on the display connection from an error
1029    handler. The guts of Xlib expect these functions to either return or exit.
1030
1031    However, there are occasions when we might expect an error to reasonably
1032    occur.  The interface to this is as follows:
1033
1034    Before calling some X routine which may error, call
1035         expect_x_error (dpy);
1036
1037    Just after calling the X routine, call either:
1038
1039         x_error_occurred_p (dpy);
1040
1041    to ask whether an error happened (and was ignored), or:
1042
1043         signal_if_x_error (dpy, resumable_p);
1044
1045    which will call Fsignal() with args appropriate to the X error, if there
1046    was one.  (Resumable_p is whether the debugger should be allowed to
1047    continue from the call to signal.)
1048
1049    You must call one of these two routines immediately after calling the X
1050    routine; think of them as bookends like BLOCK_INPUT and UNBLOCK_INPUT.
1051  */
1052
1053 static int error_expected;
1054 static int error_occurred;
1055 static XErrorEvent last_error;
1056
1057 /* OVERKILL! */
1058
1059 #ifdef EXTERNAL_WIDGET
1060 static Lisp_Object x_error_handler_do_enqueue(Lisp_Object frame)
1061 {
1062         enqueue_magic_eval_event(io_error_delete_frame, frame);
1063         return Qt;
1064 }
1065
1066 static Lisp_Object x_error_handler_error(Lisp_Object data, Lisp_Object dummy)
1067 {
1068         return Qnil;
1069 }
1070 #endif                          /* EXTERNAL_WIDGET */
1071
1072 int x_error_handler(Display * disp, XErrorEvent * event)
1073 {
1074         if (error_expected) {
1075                 error_expected = 0;
1076                 error_occurred = 1;
1077                 last_error = *event;
1078         } else {
1079 #ifdef EXTERNAL_WIDGET
1080                 struct frame *f;
1081                 struct device *d = get_device_from_display(disp);
1082
1083                 if ((event->error_code == BadWindow ||
1084                      event->error_code == BadDrawable)
1085                     && ((f = x_any_window_to_frame(d, event->resourceid)) != 0)) {
1086                         Lisp_Object frame;
1087
1088                         /* one of the windows comprising one of our frames has died.
1089                            This occurs particularly with ExternalShell frames when the
1090                            client that owns the ExternalShell's window dies.
1091
1092                            We cannot do any I/O on the display connection so we need
1093                            to enqueue an eval event so that the deletion happens
1094                            later.
1095
1096                            Furthermore, we need to trap any errors (out-of-memory) that
1097                            may occur when Fenqueue_eval_event is called.
1098                          */
1099
1100                         if (f->being_deleted)
1101                                 return 0;
1102                         XSETFRAME(frame, f);
1103                         if (!NILP
1104                             (condition_case_1
1105                              (Qerror, x_error_handler_do_enqueue, frame,
1106                               x_error_handler_error, Qnil))) {
1107                                 f->being_deleted = 1;
1108                                 f->visible = 0;
1109                         }
1110                         return 0;
1111                 }
1112 #endif                          /* EXTERNAL_WIDGET */
1113
1114 #if 0
1115                 /* This ends up calling X, which isn't allowed in an X error handler
1116                  */
1117                 stderr_out("\n%s: ", (STRINGP(Vinvocation_name)
1118                                       ? (char *)XSTRING_DATA(Vinvocation_name)
1119                                       : "sxemacs"));
1120 #endif
1121                 XmuPrintDefaultErrorMessage(disp, event, stderr);
1122         }
1123         return 0;
1124 }
1125
1126 void expect_x_error(Display * dpy)
1127 {
1128         assert(!error_expected);
1129         XSync(dpy, 0);          /* handle pending errors before setting flag */
1130         error_expected = 1;
1131         error_occurred = 0;
1132 }
1133
1134 int x_error_occurred_p(Display * dpy)
1135 {
1136         int val;
1137         XSync(dpy, 0);          /* handle pending errors before setting flag */
1138         val = error_occurred;
1139         error_expected = 0;
1140         error_occurred = 0;
1141         return val;
1142 }
1143
1144 int signal_if_x_error(Display * dpy, int resumable_p)
1145 {
1146         char buf[1024];
1147         Lisp_Object data;
1148         int sz;
1149
1150         if (!x_error_occurred_p(dpy))
1151                 return 0;
1152         data = Qnil;
1153         sz = snprintf(buf, sizeof(buf), "0x%X", (unsigned int)last_error.resourceid);
1154         assert(sz >= 0 && (size_t)sz < sizeof(buf));
1155         data = Fcons(build_string(buf), data);
1156         {
1157                 char num[32];
1158                 sz = snprintf(num, sizeof(num), "%d", last_error.request_code);
1159                 assert(sz >= 0 && (size_t)sz < sizeof(num));
1160                 XGetErrorDatabaseText(last_error.display, "XRequest", num, "",
1161                                       buf, sizeof(buf));
1162                 if (!*buf) {
1163                         sz = snprintf(buf, sizeof(buf), "Request-%d", last_error.request_code);
1164                         assert(sz >=0 && (size_t)sz < sizeof(buf));
1165                 }
1166                 data = Fcons(build_string(buf), data);
1167         }
1168         XGetErrorText(last_error.display, last_error.error_code, buf,
1169                       sizeof(buf));
1170         data = Fcons(build_string(buf), data);
1171         Fsignal(Qx_error, data);
1172         if (!resumable_p) {
1173                 while(1)
1174                         Fsignal(Qx_error, data);
1175         } 
1176         return 1;
1177 }
1178
1179 int x_IO_error_handler(Display * disp)
1180 {
1181         /* This function can GC */
1182         Lisp_Object dev;
1183         struct device *d = get_device_from_display_1(disp);
1184
1185         if (!d)
1186                 d = device_being_initialized;
1187
1188         assert(d != NULL);
1189         XSETDEVICE(dev, d);
1190
1191         if (NILP(find_nonminibuffer_frame_not_on_device(dev))) {
1192                 /* We're going down. */
1193                 stderr_out
1194                     ("\n%s: Fatal I/O Error %d (%s) on display connection \"%s\"\n",
1195                      (STRINGP(Vinvocation_name) ?
1196                       (char *)XSTRING_DATA(Vinvocation_name) : "sxemacs"),
1197                      errno, strerror(errno), DisplayString(disp));
1198                 stderr_out
1199                     ("  after %lu requests (%lu known processed) with %d events remaining.\n",
1200                      NextRequest(disp) - 1, LastKnownRequestProcessed(disp),
1201                      QLength(disp));
1202                 /* assert (!_Xdebug); */
1203         } else {
1204                 warn_when_safe
1205                     (Qx, Qcritical,
1206                      "I/O Error %d (%s) on display connection\n"
1207                      "  \"%s\" after after %lu requests (%lu known processed)\n"
1208                      "  with %d events remaining.\n"
1209                      "  Throwing to top level.\n",
1210                      errno, strerror(errno), DisplayString(disp),
1211                      NextRequest(disp) - 1, LastKnownRequestProcessed(disp),
1212                      QLength(disp));
1213         }
1214
1215         /* According to X specs, we should not return from this function, or
1216            Xlib might just decide to exit().  So we mark the offending
1217            console for deletion and throw to top level.  */
1218         if (d) {
1219           enqueue_magic_eval_event(io_error_delete_device, dev);
1220           DEVICE_X_BEING_DELETED(d) = 1;
1221         }
1222         Fthrow(Qtop_level, Qnil);
1223
1224         return 0;               /* not reached */
1225 }
1226
1227 DEFUN("x-debug-mode", Fx_debug_mode, 1, 2, 0,   /*
1228 With a true arg, make the connection to the X server synchronous.
1229 With false, make it asynchronous.  Synchronous connections are much slower,
1230 but are useful for debugging. (If you get X errors, make the connection
1231 synchronous, and use a debugger to set a breakpoint on `x_error_handler'.
1232 Your backtrace of the C stack will now be useful.  In asynchronous mode,
1233 the stack above `x_error_handler' isn't helpful because of buffering.)
1234 If DEVICE is not specified, the selected device is assumed.
1235
1236 Calling this function is the same as calling the C function `XSynchronize',
1237 or starting the program with the `-sync' command line argument.
1238 */
1239       (arg, device))
1240 {
1241         struct device *d = decode_x_device(device);
1242
1243         XSynchronize(DEVICE_X_DISPLAY(d), !NILP(arg));
1244
1245         if (!NILP(arg))
1246                 message("X connection is synchronous");
1247         else
1248                 message("X connection is asynchronous");
1249
1250         return arg;
1251 }
1252 \f
1253 /************************************************************************/
1254 /*                             X resources                              */
1255 /************************************************************************/
1256
1257 #if 0                           /* bah humbug.  The whole "widget == resource" stuff is such
1258                                    a crock of shit that I'm just going to ignore it all. */
1259
1260 /* If widget is NULL, we are retrieving device or global face data. */
1261
1262 static void
1263 construct_name_list(Display * display, Widget widget, char *fake_name,
1264                     char *fake_class, char *name, char *class)
1265 {
1266         char *stack[100][2];
1267         Widget this;
1268         int count = 0;
1269         char *name_tail, *class_tail;
1270
1271         if (widget) {
1272                 for (this = widget; this; this = XtParent(this)) {
1273                         stack[count][0] = this->core.name;
1274                         stack[count][1] = XtClass(this)->core_class.class_name;
1275                         count++;
1276                 }
1277                 count--;
1278         } else if (fake_name && fake_class) {
1279                 stack[count][0] = fake_name;
1280                 stack[count][1] = fake_class;
1281                 count++;
1282         }
1283
1284         /* The root widget is an application shell; resource lookups use the
1285            specified application name and application class in preference to
1286            the name/class of that widget (which is argv[0] / "ApplicationShell").
1287            Generally the app name and class will be argv[0] / "Emacs" but
1288            the former can be set via the -name command-line option, and the
1289            latter can be set by changing `x-emacs-application-class' in
1290            lisp/term/x-win.el.
1291          */
1292         XtGetApplicationNameAndClass(display,
1293                                      &stack[count][0], &stack[count][1]);
1294
1295         name[0] = 0;
1296         class[0] = 0;
1297
1298         name_tail = name;
1299         class_tail = class;
1300         for (; count >= 0; count--) {
1301                 strcat(name_tail, stack[count][0]);
1302                 for (; *name_tail; name_tail++)
1303                         if (*name_tail == '.')
1304                                 *name_tail = '_';
1305                 strcat(name_tail, ".");
1306                 name_tail++;
1307
1308                 strcat(class_tail, stack[count][1]);
1309                 for (; *class_tail; class_tail++)
1310                         if (*class_tail == '.')
1311                                 *class_tail = '_';
1312                 strcat(class_tail, ".");
1313                 class_tail++;
1314         }
1315 }
1316
1317 #endif                          /* 0 */
1318
1319 /* strcasecmp() is not sufficiently portable or standard,
1320    and it's easier just to write our own. */
1321 static int ascii_strcasecmp(const char *s1, const char *s2)
1322 {
1323         while (1) {
1324                 char c1 = *s1++;
1325                 char c2 = *s2++;
1326                 if (c1 >= 'A' && c1 <= 'Z')
1327                         c1 += 'a' - 'A';
1328                 if (c2 >= 'A' && c2 <= 'Z')
1329                         c2 += 'a' - 'A';
1330                 if (c1 != c2)
1331                         return c1 - c2;
1332                 if (c1 == '\0')
1333                         return 0;
1334         }
1335 }
1336
1337 static char_dynarr *name_char_dynarr;
1338 static char_dynarr *class_char_dynarr;
1339
1340 /* Given a locale and device specification from x-get-resource or
1341 x-get-resource-prefix, return the resource prefix and display to
1342 fetch the resource on. */
1343
1344 static void
1345 x_get_resource_prefix(Lisp_Object locale, Lisp_Object device,
1346                       Display ** display_out, char_dynarr * name,
1347                       char_dynarr * class)
1348 {
1349         if (NILP(locale))
1350                 locale = Qglobal;
1351         if (NILP(Fvalid_specifier_locale_p(locale)))
1352                 signal_simple_error("Invalid locale", locale);
1353         if (WINDOWP(locale))
1354                 /* #### I can't come up with any coherent way of naming windows.
1355                    By relative position?  That seems tricky because windows
1356                    can change position, be split, etc.  By order of creation?
1357                    That seems less than useful. */
1358                 signal_simple_error("Windows currently can't be resourced",
1359                                     locale);
1360
1361         if (!NILP(device) && !DEVICEP(device))
1362                 CHECK_DEVICE(device);
1363         if (DEVICEP(device) && !DEVICE_X_P(XDEVICE(device)))
1364                 device = Qnil;
1365         if (NILP(device)) {
1366                 device = DFW_DEVICE(locale);
1367                 if (DEVICEP(device) && !DEVICE_X_P(XDEVICE(device)))
1368                         device = Qnil;
1369                 if (NILP(device))
1370                         device = Vdefault_x_device;
1371                 if (NILP(device)) {
1372                         *display_out = 0;
1373                         return;
1374                 }
1375         }
1376
1377         *display_out = DEVICE_X_DISPLAY(XDEVICE(device));
1378
1379         {
1380                 char *appname, *appclass;
1381                 int name_len, class_len;
1382                 XtGetApplicationNameAndClass(*display_out, &appname, &appclass);
1383                 name_len = strlen(appname);
1384                 class_len = strlen(appclass);
1385                 Dynarr_add_many(name, appname, name_len);
1386                 Dynarr_add_many(class, appclass, class_len);
1387                 validify_resource_component(Dynarr_atp(name, 0), name_len);
1388                 validify_resource_component(Dynarr_atp(class, 0), class_len);
1389         }
1390
1391         if (EQ(locale, Qglobal))
1392                 return;
1393         if (BUFFERP(locale)) {
1394                 Dynarr_add_literal_string(name, ".buffer.");
1395                 /* we know buffer is live; otherwise we got an error above. */
1396                 Dynarr_add_validified_lisp_string(name, Fbuffer_name(locale));
1397                 Dynarr_add_literal_string(class,
1398                                           ".EmacsLocaleType.EmacsBuffer");
1399         } else if (FRAMEP(locale)) {
1400                 Dynarr_add_literal_string(name, ".frame.");
1401                 /* we know frame is live; otherwise we got an error above. */
1402                 Dynarr_add_validified_lisp_string(name, Fframe_name(locale));
1403                 Dynarr_add_literal_string(class, ".EmacsLocaleType.EmacsFrame");
1404         } else {
1405                 assert(DEVICEP(locale));
1406                 Dynarr_add_literal_string(name, ".device.");
1407                 /* we know device is live; otherwise we got an error above. */
1408                 Dynarr_add_validified_lisp_string(name, Fdevice_name(locale));
1409                 Dynarr_add_literal_string(class,
1410                                           ".EmacsLocaleType.EmacsDevice");
1411         }
1412         return;
1413 }
1414
1415 DEFUN("x-get-resource", Fx_get_resource, 3, 6, 0,       /*
1416 Retrieve an X resource from the resource manager.
1417
1418 The first arg is the name of the resource to retrieve, such as "font".
1419 The second arg is the class of the resource to retrieve, such as "Font".
1420 The third arg must be one of the symbols 'string, 'integer, 'natnum, or
1421 'boolean, specifying the type of object that the database is searched for.
1422 The fourth arg is the locale to search for the resources on, and can
1423 currently be a buffer, a frame, a device, or 'global.  If omitted, it
1424 defaults to 'global.
1425 The fifth arg is the device to search for the resources on. (The resource
1426 database for a particular device is constructed by combining non-device-
1427 specific resources such as any command-line resources specified and any
1428 app-defaults files found [or the fallback resources supplied by SXEmacs,
1429 if no app-defaults file is found] with device-specific resources such as
1430 those supplied using xrdb.) If omitted, it defaults to the device of
1431 LOCALE, if a device can be derived (i.e. if LOCALE is a frame or device),
1432 and otherwise defaults to the value of `default-x-device'.
1433 The sixth arg NOERROR, if non-nil, means do not signal an error if a
1434 bogus resource specification was retrieved (e.g. if a non-integer was
1435 given when an integer was requested).  In this case, a warning is issued
1436 instead, unless NOERROR is t, in which case no warning is issued.
1437
1438 The resource names passed to this function are looked up relative to the
1439 locale.
1440
1441 If you want to search for a subresource, you just need to specify the
1442 resource levels in NAME and CLASS.  For example, NAME could be
1443 "modeline.attributeFont", and CLASS "Face.AttributeFont".
1444
1445 Specifically,
1446
1447 1) If LOCALE is a buffer, a call
1448
1449 (x-get-resource "foreground" "Foreground" 'string SOME-BUFFER)
1450
1451 is an interface to a C call something like
1452
1453 XrmGetResource (db, "sxemacs.buffer.BUFFER-NAME.foreground",
1454 "Emacs.EmacsLocaleType.EmacsBuffer.Foreground",
1455 "String");
1456
1457 2) If LOCALE is a frame, a call
1458
1459 (x-get-resource "foreground" "Foreground" 'string SOME-FRAME)
1460
1461 is an interface to a C call something like
1462
1463 XrmGetResource (db, "sxemacs.frame.FRAME-NAME.foreground",
1464 "Emacs.EmacsLocaleType.EmacsFrame.Foreground",
1465 "String");
1466
1467 3) If LOCALE is a device, a call
1468
1469 (x-get-resource "foreground" "Foreground" 'string SOME-DEVICE)
1470
1471 is an interface to a C call something like
1472
1473 XrmGetResource (db, "sxemacs.device.DEVICE-NAME.foreground",
1474 "Emacs.EmacsLocaleType.EmacsDevice.Foreground",
1475 "String");
1476
1477 4) If LOCALE is 'global, a call
1478
1479 (x-get-resource "foreground" "Foreground" 'string 'global)
1480
1481 is an interface to a C call something like
1482
1483 XrmGetResource (db, "sxemacs.foreground",
1484 "Emacs.Foreground",
1485 "String");
1486
1487 Note that for 'global, no prefix is added other than that of the
1488 application itself; thus, you can use this locale to retrieve
1489 arbitrary application resources, if you really want to.
1490
1491 The returned value of this function is nil if the queried resource is not
1492 found.  If the third arg is `string', a string is returned, and if it is
1493 `integer', an integer is returned.  If the third arg is `boolean', then the
1494 returned value is the list (t) for true, (nil) for false, and is nil to
1495 mean ``unspecified''.
1496 */
1497       (name, class, type, locale, device, noerror))
1498 {
1499         char *name_string, *class_string;
1500         char *raw_result;
1501         XrmDatabase db;
1502         Display *display;
1503         Error_behavior errb = decode_error_behavior_flag(noerror);
1504
1505         CHECK_STRING(name);
1506         CHECK_STRING(class);
1507         CHECK_SYMBOL(type);
1508
1509         Dynarr_reset(name_char_dynarr);
1510         Dynarr_reset(class_char_dynarr);
1511
1512         x_get_resource_prefix(locale, device, &display,
1513                               name_char_dynarr, class_char_dynarr);
1514         if (!display)
1515                 return Qnil;
1516
1517         db = XtDatabase(display);
1518
1519         Dynarr_add(name_char_dynarr, '.');
1520         Dynarr_add_lisp_string(name_char_dynarr, name);
1521         Dynarr_add(class_char_dynarr, '.');
1522         Dynarr_add_lisp_string(class_char_dynarr, class);
1523         Dynarr_add(name_char_dynarr, '\0');
1524         Dynarr_add(class_char_dynarr, '\0');
1525
1526         name_string = Dynarr_atp(name_char_dynarr, 0);
1527         class_string = Dynarr_atp(class_char_dynarr, 0);
1528
1529         {
1530                 XrmValue xrm_value;
1531                 XrmName namelist[100];
1532                 XrmClass classlist[100];
1533                 XrmName *namerest = namelist;
1534                 XrmClass *classrest = classlist;
1535                 XrmRepresentation xrm_type;
1536                 XrmRepresentation string_quark;
1537                 int result;
1538                 XrmStringToNameList(name_string, namelist);
1539                 XrmStringToClassList(class_string, classlist);
1540                 string_quark = XrmStringToQuark("String");
1541
1542                 /* ensure that they have the same length */
1543                 while (namerest[0] && classrest[0])
1544                         namerest++, classrest++;
1545                 if (namerest[0] || classrest[0])
1546                         signal_simple_error_2
1547                             ("class list and name list must be the same length",
1548                              name, class);
1549                 result =
1550                     XrmQGetResource(db, namelist, classlist, &xrm_type,
1551                                     &xrm_value);
1552
1553                 if (result != True || xrm_type != string_quark)
1554                         return Qnil;
1555                 raw_result = (char *)xrm_value.addr;
1556         }
1557
1558         if (EQ(type, Qstring))
1559                 return build_string(raw_result);
1560         else if (EQ(type, Qboolean)) {
1561                 if (!ascii_strcasecmp(raw_result, "off") ||
1562                     !ascii_strcasecmp(raw_result, "false") ||
1563                     !ascii_strcasecmp(raw_result, "no"))
1564                         return Fcons(Qnil, Qnil);
1565                 if (!ascii_strcasecmp(raw_result, "on") ||
1566                     !ascii_strcasecmp(raw_result, "true") ||
1567                     !ascii_strcasecmp(raw_result, "yes"))
1568                         return Fcons(Qt, Qnil);
1569                 return maybe_continuable_error
1570                     (Qresource, errb,
1571                      "can't convert %s: %s to a Boolean", name_string,
1572                      raw_result);
1573         } else if (EQ(type, Qinteger) || EQ(type, Qnatnum)) {
1574                 int i;
1575                 char c;
1576                 if (1 != sscanf(raw_result, "%d%c", &i, &c))
1577                         return maybe_continuable_error
1578                             (Qresource, errb,
1579                              "can't convert %s: %s to an integer", name_string,
1580                              raw_result);
1581                 else if (EQ(type, Qnatnum) && i < 0)
1582                         return maybe_continuable_error
1583                             (Qresource, errb,
1584                              "invalid numerical value %d for resource %s", i,
1585                              name_string);
1586                 else
1587                         return make_int(i);
1588         } else {
1589                 return maybe_signal_continuable_error
1590                     (Qwrong_type_argument,
1591                      list2(build_translated_string
1592                            ("should be string, integer, natnum or boolean"),
1593                            type), Qresource, errb);
1594         }
1595 }
1596
1597 DEFUN("x-get-resource-prefix", Fx_get_resource_prefix, 1, 2, 0, /*
1598 Return the resource prefix for LOCALE on DEVICE.
1599 The resource prefix is the strings used to prefix resources if
1600 the LOCALE and DEVICE arguments were passed to `x-get-resource'.
1601 The returned value is a cons of a name prefix and a class prefix.
1602 For example, if LOCALE is a frame, the returned value might be
1603 \("sxemacs.frame.FRAME-NAME" . "Emacs.EmacsLocaleType.EmacsFrame").
1604 If no valid X device for resourcing can be obtained, this function
1605 returns nil. (In such a case, `x-get-resource' would always return nil.)
1606 */
1607       (locale, device))
1608 {
1609         Display *display;
1610
1611         Dynarr_reset(name_char_dynarr);
1612         Dynarr_reset(class_char_dynarr);
1613
1614         x_get_resource_prefix(locale, device, &display,
1615                               name_char_dynarr, class_char_dynarr);
1616         if (!display)
1617                 return Qnil;
1618
1619         return Fcons(make_string((Bufbyte *) Dynarr_atp(name_char_dynarr, 0),
1620                                  Dynarr_length(name_char_dynarr)),
1621                      make_string((Bufbyte *) Dynarr_atp(class_char_dynarr, 0),
1622                                  Dynarr_length(class_char_dynarr)));
1623 }
1624
1625 DEFUN("x-put-resource", Fx_put_resource, 1, 2, 0,       /*
1626 Add a resource to the resource database for DEVICE.
1627 RESOURCE-LINE specifies the resource to add and should be a
1628 standard resource specification.
1629 */
1630       (resource_line, device))
1631 {
1632         struct device *d = decode_device(device);
1633         char *str, *colon_pos;
1634
1635         CHECK_STRING(resource_line);
1636         str = (char *)XSTRING_DATA(resource_line);
1637         if (!(colon_pos = strchr(str, ':')) || strchr(str, '\n'))
1638               invalid:
1639                 signal_simple_error("Invalid resource line", resource_line);
1640         if (strspn(str,
1641                    /* Only the following chars are allowed before the colon */
1642                    " \t.*?abcdefghijklmnopqrstuvwxyz"
1643                    "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-")
1644             != (size_t) (colon_pos - str))
1645                 goto invalid;
1646
1647         if (DEVICE_X_P(d)) {
1648                 XrmDatabase db = XtDatabase(DEVICE_X_DISPLAY(d));
1649                 XrmPutLineResource(&db, str);
1650         }
1651
1652         return Qnil;
1653 }
1654 \f
1655 /************************************************************************/
1656 /*                   display information functions                      */
1657 /************************************************************************/
1658
1659 DEFUN("default-x-device", Fdefault_x_device, 0, 0, 0,   /*
1660 Return the default X device for resourcing.
1661 This is the first-created X device that still exists.
1662 */
1663       ())
1664 {
1665         return Vdefault_x_device;
1666 }
1667
1668 DEFUN("x-display-visual-class", Fx_display_visual_class, 0, 1, 0,       /*
1669 Return the visual class of the X display DEVICE is using.
1670 This can be altered from the default at startup using the XResource "EmacsVisual".
1671 The returned value will be one of the symbols `static-gray', `gray-scale',
1672 `static-color', `pseudo-color', `true-color', or `direct-color'.
1673 */
1674       (device))
1675 {
1676         Visual *vis = DEVICE_X_VISUAL(decode_x_device(device));
1677         switch (vis->class) {
1678         case StaticGray:
1679                 return intern("static-gray");
1680         case GrayScale:
1681                 return intern("gray-scale");
1682         case StaticColor:
1683                 return intern("static-color");
1684         case PseudoColor:
1685                 return intern("pseudo-color");
1686         case TrueColor:
1687                 return intern("true-color");
1688         case DirectColor:
1689                 return intern("direct-color");
1690         default:
1691                 error("display has an unknown visual class");
1692                 return Qnil;    /* suppress compiler warning */
1693         }
1694 }
1695
1696 DEFUN("x-display-visual-depth", Fx_display_visual_depth, 0, 1, 0,       /*
1697 Return the bitplane depth of the visual the X display DEVICE is using.
1698 */
1699       (device))
1700 {
1701         return make_int(DEVICE_X_DEPTH(decode_x_device(device)));
1702 }
1703
1704 static Lisp_Object
1705 x_device_system_metrics(struct device *d, enum device_metrics m)
1706 {
1707         Display *dpy = DEVICE_X_DISPLAY(d);
1708
1709         switch ((unsigned int)m) {
1710         case DM_size_device:
1711                 return Fcons(make_int(DisplayWidth(dpy, DefaultScreen(dpy))),
1712                              make_int(DisplayHeight(dpy, DefaultScreen(dpy))));
1713         case DM_size_device_mm:
1714                 return Fcons(make_int(DisplayWidthMM(dpy, DefaultScreen(dpy))),
1715                              make_int(DisplayHeightMM
1716                                       (dpy, DefaultScreen(dpy))));
1717         case DM_num_bit_planes:
1718                 return make_int(DisplayPlanes(dpy, DefaultScreen(dpy)));
1719         case DM_num_color_cells:
1720                 return make_int(DisplayCells(dpy, DefaultScreen(dpy)));
1721
1722         default:
1723                 /* No such device metric property for X devices  */
1724                 return Qunbound;
1725         }
1726 }
1727
1728 DEFUN("x-server-vendor", Fx_server_vendor, 0, 1, 0,     /*
1729 Return the vendor ID string of the X server DEVICE is on.
1730 Return the empty string if the vendor ID string cannot be determined.
1731 */
1732       (device))
1733 {
1734         Display *dpy = get_x_display(device);
1735         char *vendor = ServerVendor(dpy);
1736
1737         return build_string(vendor ? vendor : "");
1738 }
1739
1740 DEFUN("x-server-version", Fx_server_version, 0, 1, 0,   /*
1741 Return the version numbers of the X server DEVICE is on.
1742 The returned value is a list of three integers: the major and minor
1743 version numbers of the X Protocol in use, and the vendor-specific release
1744 number.  See also `x-server-vendor'.
1745 */
1746       (device))
1747 {
1748         Display *dpy = get_x_display(device);
1749
1750         return list3(make_int(ProtocolVersion(dpy)),
1751                      make_int(ProtocolRevision(dpy)),
1752                      make_int(VendorRelease(dpy)));
1753 }
1754
1755 DEFUN("x-valid-keysym-name-p", Fx_valid_keysym_name_p, 1, 1, 0, /*
1756 Return true if KEYSYM names a keysym that the X library knows about.
1757 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1758 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1759 */
1760       (keysym))
1761 {
1762         const char *keysym_ext;
1763
1764         CHECK_STRING(keysym);
1765         LISP_STRING_TO_EXTERNAL(keysym, keysym_ext, Qctext);
1766
1767         return XStringToKeysym(keysym_ext) ? Qt : Qnil;
1768 }
1769
1770 DEFUN("x-keysym-hash-table", Fx_keysym_hash_table, 0, 1, 0,     /*
1771 Return a hash table containing a key for all keysyms on DEVICE.
1772 DEVICE must be an X11 display device.  See `x-keysym-on-keyboard-p'.
1773 */
1774       (device))
1775 {
1776         struct device *d = decode_device(device);
1777         if (!DEVICE_X_P(d))
1778                 signal_simple_error("Not an X device", device);
1779
1780         return DEVICE_X_DATA(d)->x_keysym_map_hash_table;
1781 }
1782
1783 DEFUN("x-keysym-on-keyboard-sans-modifiers-p", Fx_keysym_on_keyboard_sans_modifiers_p, 1, 2, 0, /*
1784 Return true if KEYSYM names a key on the keyboard of DEVICE.
1785 More precisely, return true if pressing a physical key
1786 on the keyboard of DEVICE without any modifier keys generates KEYSYM.
1787 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1788 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1789 The keysym name can be provided in two forms:
1790 - if keysym is a string, it must be the name as known to X windows.
1791 - if keysym is a symbol, it must be the name as known to SXEmacs.
1792 The two names differ in capitalization and underscoring.
1793 */
1794       (keysym, device))
1795 {
1796         struct device *d = decode_device(device);
1797         if (!DEVICE_X_P(d))
1798                 signal_simple_error("Not an X device", device);
1799
1800         return (EQ(Qsans_modifiers,
1801                    Fgethash(keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE(d), Qnil)) ?
1802                 Qt : Qnil);
1803 }
1804
1805 DEFUN("x-keysym-on-keyboard-p", Fx_keysym_on_keyboard_p, 1, 2, 0,       /*
1806 Return true if KEYSYM names a key on the keyboard of DEVICE.
1807 More precisely, return true if some keystroke (possibly including modifiers)
1808 on the keyboard of DEVICE keys generates KEYSYM.
1809 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1810 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1811 The keysym name can be provided in two forms:
1812 - if keysym is a string, it must be the name as known to X windows.
1813 - if keysym is a symbol, it must be the name as known to SXEmacs.
1814 The two names differ in capitalization and underscoring.
1815 */
1816       (keysym, device))
1817 {
1818         struct device *d = decode_device(device);
1819         if (!DEVICE_X_P(d))
1820                 signal_simple_error("Not an X device", device);
1821
1822         return (NILP(Fgethash(keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE(d), Qnil))
1823                 ? Qnil : Qt);
1824 }
1825 \f
1826 /************************************************************************/
1827 /*                          grabs and ungrabs                           */
1828 /************************************************************************/
1829
1830 DEFUN("x-grab-pointer", Fx_grab_pointer, 0, 3, 0,       /*
1831 Grab the pointer and restrict it to its current window.
1832 If optional DEVICE argument is nil, the default device will be used.
1833 If optional CURSOR argument is non-nil, change the pointer shape to that
1834 until `x-ungrab-pointer' is called (it should be an object returned by the
1835 `make-cursor-glyph' function).
1836 If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all
1837 keyboard events during the grab.
1838 Returns t if the grab is successful, nil otherwise.
1839 */
1840       (device, cursor, ignore_keyboard))
1841 {
1842         Window w;
1843         int pointer_mode, result;
1844         struct device *d = decode_x_device(device);
1845
1846         if (!NILP(cursor)) {
1847                 CHECK_POINTER_GLYPH(cursor);
1848                 cursor = glyph_image_instance(cursor, device, ERROR_ME, 0);
1849         }
1850
1851         if (!NILP(ignore_keyboard))
1852                 pointer_mode = GrabModeSync;
1853         else
1854                 pointer_mode = GrabModeAsync;
1855
1856         w = XtWindow(FRAME_X_TEXT_WIDGET(device_selected_frame(d)));
1857
1858         /* #### Possibly this needs to gcpro the cursor somehow, but it doesn't
1859            seem to cause a problem if XFreeCursor is called on a cursor in use
1860            in a grab; I suppose the X server counts the grab as a reference
1861            and doesn't free it until it exits? */
1862         result = XGrabPointer(DEVICE_X_DISPLAY(d), w, False, ButtonMotionMask | ButtonPressMask | ButtonReleaseMask | PointerMotionHintMask, GrabModeAsync,     /* Keep pointer events flowing */
1863                               pointer_mode,     /* Stall keyboard events */
1864                               w,        /* Stay in this window */
1865                               (NILP(cursor) ? 0
1866                                : XIMAGE_INSTANCE_X_CURSOR(cursor)),
1867                               CurrentTime);
1868         return (result == GrabSuccess) ? Qt : Qnil;
1869 }
1870
1871 DEFUN("x-ungrab-pointer", Fx_ungrab_pointer, 0, 1, 0,   /*
1872 Release a pointer grab made with `x-grab-pointer'.
1873 If optional first arg DEVICE is nil the default device is used.
1874 If it is t the pointer will be released on all X devices.
1875 */
1876       (device))
1877 {
1878         if (!EQ(device, Qt)) {
1879                 Display *dpy = get_x_display(device);
1880                 XUngrabPointer(dpy, CurrentTime);
1881         } else {
1882                 Lisp_Object devcons, concons;
1883
1884                 DEVICE_LOOP_NO_BREAK(devcons, concons) {
1885                         struct device *d = XDEVICE(XCAR(devcons));
1886
1887                         if (DEVICE_X_P(d))
1888                                 XUngrabPointer(DEVICE_X_DISPLAY(d),
1889                                                CurrentTime);
1890                 }
1891         }
1892
1893         return Qnil;
1894 }
1895
1896 DEFUN("x-grab-keyboard", Fx_grab_keyboard, 0, 1, 0,     /*
1897 Grab the keyboard on the given device (defaulting to the selected one).
1898 So long as the keyboard is grabbed, all keyboard events will be delivered
1899 to emacs -- it is not possible for other X clients to eavesdrop on them.
1900 Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect).
1901 Returns t if the grab is successful, nil otherwise.
1902 */
1903       (device))
1904 {
1905         struct device *d = decode_x_device(device);
1906         Window w = XtWindow(FRAME_X_TEXT_WIDGET(device_selected_frame(d)));
1907         Display *dpy = DEVICE_X_DISPLAY(d);
1908         Status status;
1909         XSync(dpy, False);
1910         status = XGrabKeyboard(dpy, w, True,
1911                                /* I don't really understand sync-vs-async
1912                                   grabs, but this is what xterm does. */
1913                                GrabModeAsync, GrabModeAsync,
1914                                /* Use the timestamp of the last user action
1915                                   read by emacs proper; xterm uses CurrentTime
1916                                   but there's a comment that says "wrong"...
1917                                   (Despite the name this is the time of the
1918                                   last key or mouse event.) */
1919                                DEVICE_X_MOUSE_TIMESTAMP(d));
1920         if (status == GrabSuccess) {
1921                 /* The XUngrabKeyboard should generate a FocusIn back to this
1922                    window but it doesn't unless we explicitly set focus to the
1923                    window first (which should already have it.  The net result
1924                    is that without this call when x-ungrab-keyboard is called
1925                    the selected frame ends up not having focus. */
1926                 XSetInputFocus(dpy, w, RevertToParent,
1927                                DEVICE_X_MOUSE_TIMESTAMP(d));
1928                 return Qt;
1929         } else
1930                 return Qnil;
1931 }
1932
1933 DEFUN("x-ungrab-keyboard", Fx_ungrab_keyboard, 0, 1, 0, /*
1934 Release a keyboard grab made with `x-grab-keyboard'.
1935 */
1936       (device))
1937 {
1938         Display *dpy = get_x_display(device);
1939         XUngrabKeyboard(dpy, CurrentTime);
1940         return Qnil;
1941 }
1942
1943 DEFUN("x-get-font-path", Fx_get_font_path, 0, 1, 0,     /*
1944 Get the X Server's font path.
1945
1946 See also `x-set-font-path'.
1947 */
1948       (device))
1949 {
1950         Display *dpy = get_x_display(device);
1951         int ndirs_return;
1952         const char **directories =
1953             (const char **)XGetFontPath(dpy, &ndirs_return);
1954         Lisp_Object font_path = Qnil;
1955
1956         if (!directories)
1957                 signal_simple_error("Can't get X font path", device);
1958
1959         while (ndirs_return--)
1960                 font_path = Fcons(build_ext_string(directories[ndirs_return],
1961                                                    Qfile_name), font_path);
1962
1963         return font_path;
1964 }
1965
1966 DEFUN("x-set-font-path", Fx_set_font_path, 1, 2, 0,     /*
1967 Set the X Server's font path to FONT-PATH.
1968
1969 There is only one font path per server, not one per client.  Use this
1970 sparingly.  It uncaches all of the X server's font information.
1971
1972 Font directories should end in the path separator and should contain
1973 a file called fonts.dir usually created with the program mkfontdir.
1974
1975 Setting the FONT-PATH to nil tells the X server to use the default
1976 font path.
1977
1978 See also `x-get-font-path'.
1979 */
1980       (font_path, device))
1981 {
1982         Display *dpy = get_x_display(device);
1983         Lisp_Object path_entry;
1984         int i = 0, ndirs = 0;
1985
1986         EXTERNAL_LIST_LOOP(path_entry, font_path) {
1987                 CHECK_STRING(XCAR(path_entry));
1988                 ndirs++;
1989         }
1990
1991         {
1992                 char *directories[ndirs];
1993
1994                 EXTERNAL_LIST_LOOP(path_entry, font_path) {
1995                         LISP_STRING_TO_EXTERNAL(XCAR(path_entry),
1996                                                 directories[i++],
1997                                                 Qfile_name);
1998                 }
1999
2000                 expect_x_error(dpy);
2001                 XSetFontPath(dpy, (char **)directories, ndirs);
2002                 signal_if_x_error(dpy, 1 /*resumable_p */ );
2003         }
2004         return Qnil;
2005 }
2006 \f
2007 /************************************************************************/
2008 /*                            initialization                            */
2009 /************************************************************************/
2010
2011 void syms_of_device_x(void)
2012 {
2013         DEFSUBR(Fx_debug_mode);
2014         DEFSUBR(Fx_get_resource);
2015         DEFSUBR(Fx_get_resource_prefix);
2016         DEFSUBR(Fx_put_resource);
2017
2018         DEFSUBR(Fdefault_x_device);
2019         DEFSUBR(Fx_display_visual_class);
2020         DEFSUBR(Fx_display_visual_depth);
2021         DEFSUBR(Fx_server_vendor);
2022         DEFSUBR(Fx_server_version);
2023         DEFSUBR(Fx_valid_keysym_name_p);
2024         DEFSUBR(Fx_keysym_hash_table);
2025         DEFSUBR(Fx_keysym_on_keyboard_p);
2026         DEFSUBR(Fx_keysym_on_keyboard_sans_modifiers_p);
2027
2028         DEFSUBR(Fx_grab_pointer);
2029         DEFSUBR(Fx_ungrab_pointer);
2030         DEFSUBR(Fx_grab_keyboard);
2031         DEFSUBR(Fx_ungrab_keyboard);
2032
2033         DEFSUBR(Fx_get_font_path);
2034         DEFSUBR(Fx_set_font_path);
2035
2036         defsymbol(&Qx_error, "x-error");
2037         defsymbol(&Qinit_pre_x_win, "init-pre-x-win");
2038         defsymbol(&Qinit_post_x_win, "init-post-x-win");
2039 }
2040
2041 void reinit_console_type_create_device_x(void)
2042 {
2043         /* Initialize variables to speed up X resource interactions */
2044         const char *valid_resource_chars =
2045             "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_";
2046         while (*valid_resource_chars)
2047                 valid_resource_char_p[(unsigned int)(*valid_resource_chars++)] =
2048                     1;
2049
2050         name_char_dynarr = Dynarr_new(char);
2051         class_char_dynarr = Dynarr_new(char);
2052 }
2053
2054 void console_type_create_device_x(void)
2055 {
2056         reinit_console_type_create_device_x();
2057         CONSOLE_HAS_METHOD(x, init_device);
2058         CONSOLE_HAS_METHOD(x, finish_init_device);
2059         CONSOLE_HAS_METHOD(x, mark_device);
2060         CONSOLE_HAS_METHOD(x, delete_device);
2061         CONSOLE_HAS_METHOD(x, device_system_metrics);
2062 }
2063
2064 void reinit_vars_of_device_x(void)
2065 {
2066         error_expected = 0;
2067         error_occurred = 0;
2068
2069         in_resource_setting = 0;
2070 }
2071
2072 void vars_of_device_x(void)
2073 {
2074         reinit_vars_of_device_x();
2075
2076         DEFVAR_LISP("x-emacs-application-class", &Vx_emacs_application_class    /*
2077 The X application class of the SXEmacs process.
2078 This controls, among other things, the name of the `app-defaults' file
2079 that SXEmacs will use.  For changes to this variable to take effect, they
2080 must be made before the connection to the X server is initialized, that is,
2081 this variable may only be changed before emacs is dumped, or by setting it
2082 in the file lisp/term/x-win.el.
2083
2084 If this variable is nil before the connection to the X server is first
2085 initialized (which it is by default), the X resource database will be
2086 consulted and the value will be set according to whether any resources
2087 are found for the application class `SXEmacs'.  If the user has set any
2088 resources for the SXEmacs application class, the SXEmacs process will use
2089 the application class `SXEmacs'.  Otherwise, the SXEmacs process will use
2090 the application class `Emacs' which is backwards compatible to previous
2091 SXEmacs versions but may conflict with resources intended for GNU Emacs.
2092                                                                                  */ );
2093         Vx_emacs_application_class = Qnil;
2094
2095         DEFVAR_LISP("x-initial-argv-list", &Vx_initial_argv_list        /*
2096 You don't want to know.
2097 This is used during startup to communicate the remaining arguments in
2098 `command-line-args-left' to the C code, which passes the args to
2099 the X initialization code, which removes some args, and then the
2100 args are placed back into `x-initial-arg-list' and thence into
2101 `command-line-args-left'.  Perhaps `command-line-args-left' should
2102 just reside in C.
2103                                                                          */ );
2104         Vx_initial_argv_list = Qnil;
2105
2106 #if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET))
2107         DEFVAR_LISP("x-app-defaults-directory", &Vx_app_defaults_directory      /*
2108 Used by the Lisp code to communicate to the low level X initialization
2109 where the localized init files are.
2110                                                                                  */ );
2111         Vx_app_defaults_directory = Qnil;
2112 #endif
2113
2114         Fprovide(Qx);
2115
2116         staticpro(&Vdefault_x_device);
2117         Vdefault_x_device = Qnil;
2118 }