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