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