X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Fdevice-x.c;h=540e407c6aa098e52bfdd59a38f08356ed044480;hp=0ffbd653bf1686b12e8f2576005ec8cadea942f0;hb=414b512c0774e67ba8e160b605447d862d3be166;hpb=cb9f6f4eadc44f1becb32cbbd1db26449e347755

diff --git a/src/device-x.c b/src/device-x.c
index 0ffbd65..540e407 100644
--- a/src/device-x.c
+++ b/src/device-x.c
@@ -21,6 +21,8 @@ Boston, MA 02111-1307, USA.  */
 
 /* Synched up with: Not in FSF. */
 
+/* 7-8-00 !!#### This file needs definite Mule review. */
+
 /* Original authors: Jamie Zawinski and the FSF */
 /* Rewritten by Ben Wing and Chuck Thompson. */
 
@@ -50,6 +52,10 @@ Boston, MA 02111-1307, USA.  */
 #include "sysfile.h"
 #include "systime.h"
 
+#if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D)
+#include "sysdll.h"
+#endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */
+
 #ifdef HAVE_OFFIX_DND
 #include "offix.h"
 #endif
@@ -135,7 +141,7 @@ get_device_from_display (Display *dpy)
        (STRINGP (Vinvocation_name) ?
 	(char *) XSTRING_DATA (Vinvocation_name) : FALLBACK_RESOURCE_NAME),
        DisplayString (dpy) ? DisplayString (dpy) : "???");
-    abort();
+    ABORT();
   }
 
 #undef FALLBACK_RESOURCE_NAME
@@ -162,6 +168,8 @@ get_x_display (Lisp_Object device)
 /*		      initializing an X connection			*/
 /************************************************************************/
 
+static struct device *device_being_initialized = NULL;
+
 static void
 allocate_x_device_struct (struct device *d)
 {
@@ -242,11 +250,11 @@ x_init_device_class (struct device *d)
  * Finally, if all else fails, return `xemacs', as it is more
  * appropriate (X11R5 returns `main').
  */
-static char *
-compute_x_app_name (int argc, char **argv)
+static Extbyte *
+compute_x_app_name (int argc, Extbyte **argv)
 {
   int i;
-  char *ptr;
+  Extbyte *ptr;
 
   for (i = 1; i < argc - 1; i++)
     if (!strncmp(argv[i], "-name", max (2, strlen (argv[1]))))
@@ -317,6 +325,136 @@ Dynarr_add_validified_lisp_string (char_dynarr *cda, Lisp_Object str)
   validify_resource_component (Dynarr_atp (cda, Dynarr_length (cda) - len), len);
 }
 
+#if 0
+/* compare visual info for qsorting */
+static int
+x_comp_visual_info (const void *elem1, const void *elem2)
+{
+  XVisualInfo *left, *right;
+
+  left = (XVisualInfo *)elem1;
+  right = (XVisualInfo *)elem2;
+
+  if ( left == NULL )
+    return -1;
+  if ( right == NULL )
+    return 1;
+
+  if ( left->depth > right->depth ) {
+    return 1;
+  }
+  else if ( left->depth == right->depth ) {
+    if ( left->colormap_size > right->colormap_size )
+      return 1;
+    if ( left->class > right->class )
+      return 1;
+    else if ( left->class < right->class )
+      return -1;
+    else
+      return 0;
+  }
+  else {
+    return -1;
+  }
+
+}
+#endif /* if 0 */
+
+#define XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN
+static Visual *
+x_try_best_visual_class (Screen *screen, int scrnum, int visual_class)
+{
+  Display *dpy = DisplayOfScreen (screen);
+  XVisualInfo vi_in;
+  XVisualInfo *vi_out = NULL;
+  int out_count;
+
+  vi_in.class = visual_class;
+  vi_in.screen = scrnum;
+  vi_out = XGetVisualInfo (dpy, (VisualClassMask | VisualScreenMask),
+			   &vi_in, &out_count);
+  if ( vi_out )
+    {
+      int i, best;
+      Visual *visual;
+      for (i = 0, best = 0; i < out_count; i++)
+	/* It's better if it's deeper, or if it's the same depth with
+	   more cells (does that ever happen?  Well, it could...)
+	   NOTE: don't allow pseudo color to get larger than 8! */
+	if (((vi_out [i].depth > vi_out [best].depth) ||
+	     ((vi_out [i].depth == vi_out [best].depth) &&
+	      (vi_out [i].colormap_size > vi_out [best].colormap_size)))
+#ifdef XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN
+	    /* For now, the image library doesn't like PseudoColor visuals
+	       of depths other than 1 or 8.  Depths greater than 8 only occur
+	       on machines which have TrueColor anyway, so probably we'll end
+	       up using that (it is the one that `Best' would pick) but if a
+	       PseudoColor visual is explicitly specified, pick the 8 bit one.
+	    */
+	    && (visual_class != PseudoColor ||
+		vi_out [i].depth == 1 ||
+		vi_out [i].depth == 8)
+#endif
+
+	    /* SGI has 30-bit deep visuals.  Ignore them.
+                (We only have 24-bit data anyway.)
+              */
+	    && (vi_out [i].depth <= 24)
+	    )
+	  best = i;
+      visual = vi_out[best].visual;
+      XFree ((char *) vi_out);
+      return visual;
+    }
+  else
+    return 0;
+}
+
+static int
+x_get_visual_depth (Display *dpy, Visual *visual)
+{
+  XVisualInfo vi_in;
+  XVisualInfo *vi_out;
+  int out_count, d;
+
+  vi_in.visualid = XVisualIDFromVisual (visual);
+  vi_out = XGetVisualInfo (dpy, /*VisualScreenMask|*/VisualIDMask,
+			   &vi_in, &out_count);
+  if (! vi_out) ABORT ();
+  d = vi_out [0].depth;
+  XFree ((char *) vi_out);
+  return d;
+}
+
+static Visual *
+x_try_best_visual (Display *dpy, int scrnum)
+{
+  Visual *visual = NULL;
+  Screen *screen = ScreenOfDisplay (dpy, scrnum);
+  if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor))
+      && x_get_visual_depth (dpy, visual) >= 16 )
+    return visual;
+  if ((visual = x_try_best_visual_class (screen, scrnum, PseudoColor)))
+    return visual;
+  if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor)))
+    return visual;
+#ifdef DIRECTCOLOR_WORKS
+  if ((visual = x_try_best_visual_class (screen, scrnum, DirectColor)))
+    return visual;
+#endif
+
+  visual = DefaultVisualOfScreen (screen);
+  if ( x_get_visual_depth (dpy, visual) >= 8 )
+    return visual;
+
+  if ((visual = x_try_best_visual_class (screen, scrnum, StaticGray)))
+    return visual;
+  if ((visual = x_try_best_visual_class (screen, scrnum, GrayScale)))
+    return visual;
+  return DefaultVisualOfScreen (screen);
+}
+
+
 static void
 x_init_device (struct device *d, Lisp_Object props)
 {
@@ -325,14 +463,88 @@ x_init_device (struct device *d, Lisp_Object props)
   Display *dpy;
   Widget app_shell;
   int argc;
-  char **argv;
-  CONST char *app_class;
-  CONST char *app_name;
-  CONST char *disp_name;
+  Extbyte **argv;
+  const char *app_class;
+  const char *app_name;
+  const char *disp_name;
   Visual *visual = NULL;
   int depth = 8;		/* shut up the compiler */
   Colormap cmap;
   int screen;
+  /* */
+  int best_visual_found = 0;
+
+#if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D)
+  /*
+   * In order to avoid the lossage with flat Athena widgets dynamically
+   * linking to one of the ThreeD variants, using the dynamic symbol helpers
+   * to look for symbols that shouldn't be there and refusing to run if they
+   * are seems a less toxic idea than having XEmacs crash when we try and
+   * use a subclass of a widget that has changed size.
+   *
+   * It's ugly, I know, and not going to work everywhere. It seems better to
+   * do our damnedest to try and tell the user what to expect rather than
+   * simply blow up though.
+   *
+   * All the ThreeD variants I have access to define the following function
+   * symbols in the shared library. The flat Xaw library does not define them:
+   *
+   * Xaw3dComputeBottomShadowRGB
+   * Xaw3dComputeTopShadowRGB
+   *
+   * So far only Linux has shown this problem. This seems to be portable to
+   * all the distributions (certainly all the ones I checked - Debian and
+   * Redhat)
+   *
+   * This will only work, sadly, with dlopen() -- the other dynamic linkers
+   * are simply not capable of doing what is needed. :/
+   */
+
+  {
+    /* Get a dll handle to the main process. */
+    dll_handle xaw_dll_handle = dll_open (NULL);
+
+    /* Did that fail?  If so, continue without error.
+     * We could die here but, well, that's unfriendly and all -- plus I feel
+     * better about some crashing somewhere rather than preventing a perfectly
+     * good configuration working just because dll_open failed.
+     */
+    if (xaw_dll_handle != NULL)
+      {
+	/* Look for the Xaw3d function */
+	dll_func xaw_function_handle =
+	  dll_function (xaw_dll_handle, "Xaw3dComputeTopShadowRGB");
+
+	/* If we found it, warn the user in big, nasty, unfriendly letters */
+	if (xaw_function_handle != NULL)
+	  {
+	    warn_when_safe (Qdevice, Qerror, "\n"
+"It seems that XEmacs is built dynamically linked to the flat Athena widget\n"
+"library but it finds a 3D Athena variant with the same name at runtime.\n"
+"\n"
+"This WILL cause your XEmacs process to dump core at some point.\n"
+"You should not continue to use this binary without resolving this issue.\n"
+"\n"
+"This can be solved with the xaw-wrappers package under Debian\n"
+"(register XEmacs as incompatible with all 3d widget sets, see\n"
+"update-xaw-wrappers(8) and .../doc/xaw-wrappers/README.packagers).  It\n"
+"can be verified by checking the runtime path in /etc/ld.so.conf and by\n"
+"using `ldd /path/to/xemacs' under other Linux distributions.  One\n"
+"solution is to use LD_PRELOAD or LD_LIBRARY_PATH to force ld.so to\n"
+"load the flat Athena widget library instead of the aliased 3D widget\n"
+"library (see ld.so(8) for use of these environment variables).\n\n"
+			    );
+
+	  }
+
+	/* Otherwise release the handle to the library
+	 * No error catch here; I can't think of a way to recover anyhow.
+	 */
+	dll_close (xaw_dll_handle);
+      }
+  }
+#endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */
+
 
   XSETDEVICE (device, d);
   display = DEVICE_CONNECTION (d);
@@ -341,18 +553,20 @@ x_init_device (struct device *d, Lisp_Object props)
 
   make_argc_argv (Vx_initial_argv_list, &argc, &argv);
 
-  GET_C_STRING_CTEXT_DATA_ALLOCA (display, disp_name);
+  LISP_STRING_TO_EXTERNAL (display, disp_name, Qctext);
 
   /*
    * Break apart the old XtOpenDisplay call into XOpenDisplay and
    * XtDisplayInitialize so we can figure out whether there
    * are any XEmacs resources in the resource database before
-   * we intitialize Xt.  This is so we can automagically support
+   * we initialize Xt.  This is so we can automagically support
    * both `Emacs' and `XEmacs' application classes.
    */
   slow_down_interrupts ();
   /* May not be needed but XtOpenDisplay could not deal with signals here. */
+  device_being_initialized = d;
   dpy = DEVICE_X_DISPLAY (d) = XOpenDisplay (disp_name);
+  device_being_initialized = NULL;
   speed_up_interrupts ();
 
   if (dpy == 0)
@@ -363,7 +577,7 @@ x_init_device (struct device *d, Lisp_Object props)
 
   if (STRINGP (Vx_emacs_application_class) &&
       XSTRING_LENGTH (Vx_emacs_application_class) > 0)
-    GET_C_STRING_CTEXT_DATA_ALLOCA (Vx_emacs_application_class, app_class);
+    LISP_STRING_TO_EXTERNAL (Vx_emacs_application_class, app_class, Qctext);
   else
     {
       app_class = (NILP (Vx_emacs_application_class)  &&
@@ -383,7 +597,7 @@ x_init_device (struct device *d, Lisp_Object props)
      Yuck. */
   XtDisplayInitialize (Xt_app_con, dpy, compute_x_app_name (argc, argv),
                        app_class, emacs_options,
-                       XtNumber (emacs_options), &argc, argv);
+                       XtNumber (emacs_options), &argc, (char **) argv);
   speed_up_interrupts ();
 
   screen = DefaultScreen (dpy);
@@ -397,15 +611,15 @@ x_init_device (struct device *d, Lisp_Object props)
        data-directory/app-defaults/$LANG/Emacs.
        This is in addition to the standard app-defaults files, and
        does not override resources defined elsewhere */
-    CONST char *data_dir;
+    const char *data_dir;
     char *path;
     XrmDatabase db = XtDatabase (dpy); /* #### XtScreenDatabase(dpy) ? */
-    CONST char *locale = XrmLocaleOfDatabase (db);
+    const char *locale = XrmLocaleOfDatabase (db);
 
     if (STRINGP (Vx_app_defaults_directory) &&
 	XSTRING_LENGTH (Vx_app_defaults_directory) > 0)
       {
-	GET_C_STRING_FILENAME_DATA_ALLOCA(Vx_app_defaults_directory, data_dir);
+	LISP_STRING_TO_EXTERNAL (Vx_app_defaults_directory, data_dir, Qfile_name);
 	path = (char *)alloca (strlen (data_dir) + strlen (locale) + 7);
 	sprintf (path, "%s%s/Emacs", data_dir, locale);
 	if (!access (path, R_OK))
@@ -413,7 +627,7 @@ x_init_device (struct device *d, Lisp_Object props)
       }
     else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0)
       {
-	GET_C_STRING_FILENAME_DATA_ALLOCA (Vdata_directory, data_dir);
+	LISP_STRING_TO_EXTERNAL (Vdata_directory, data_dir, Qfile_name);
 	path = (char *)alloca (strlen (data_dir) + 13 + strlen (locale) + 7);
 	sprintf (path, "%sapp-defaults/%s/Emacs", data_dir, locale);
 	if (!access (path, R_OK))
@@ -434,8 +648,10 @@ x_init_device (struct device *d, Lisp_Object props)
   XtGetApplicationNameAndClass (dpy, (char **) &app_name, (char **) &app_class);
   /* search for a matching visual if requested by the user, or setup the display default */
   {
-    char *buf1 = (char *)alloca (strlen (app_name)  + 17);
-    char *buf2 = (char *)alloca (strlen (app_class) + 17);
+    int resource_name_length = max (sizeof (".emacsVisual"),
+				    sizeof (".privateColormap"));
+    char *buf1 = alloca_array (char, strlen (app_name)  + resource_name_length);
+    char *buf2 = alloca_array (char, strlen (app_class) + resource_name_length);
     char *type;
     XrmValue value;
 
@@ -443,13 +659,14 @@ x_init_device (struct device *d, Lisp_Object props)
     sprintf (buf2, "%s.EmacsVisual", app_class);
     if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
       {
-	int cnt = 0, vis_class = PseudoColor;
+	int cnt = 0;
+	int vis_class = PseudoColor;
 	XVisualInfo vinfo;
-	char *res, *str = (char*)value.addr;
+	char *str = (char*) value.addr;
 
-#define CHECK_VIS_CLASS(class)					\
- else if (strncmp (str, #class, sizeof (#class) - 1) == 0)	\
-	cnt = sizeof (#class) - 1, vis_class = class
+#define CHECK_VIS_CLASS(visual_class)					\
+ else if (memcmp (str, #visual_class, sizeof (#visual_class) - 1) == 0)	\
+	cnt = sizeof (#visual_class) - 1, vis_class = visual_class
 
 	if (1)
 	  ;
@@ -462,8 +679,7 @@ x_init_device (struct device *d, Lisp_Object props)
 
 	if (cnt)
 	  {
-	    res = str + cnt;
-	    depth = atoi (res);
+	    depth = atoi (str + cnt);
 	    if (depth == 0)
 	      {
 		stderr_out ("Invalid Depth specification in %s... ignoring...\n", str);
@@ -487,8 +703,13 @@ x_init_device (struct device *d, Lisp_Object props)
       }
     if (visual == NULL)
       {
-	visual = DefaultVisual (dpy, screen);
-	depth  = DefaultDepth  (dpy, screen);
+	/*
+	  visual = DefaultVisual(dpy, screen);
+	  depth = DefaultDepth(dpy, screen);
+	*/
+	visual = x_try_best_visual (dpy, screen);
+	depth = x_get_visual_depth (dpy, visual);
+	best_visual_found = (visual != DefaultVisual (dpy, screen));
       }
 
     /* If we've got the same visual as the default and it's PseudoColor,
@@ -509,10 +730,17 @@ x_init_device (struct device *d, Lisp_Object props)
       }
     else
       {
-	/* We have to create a matching colormap anyway...
-	   ### think about using standard colormaps (need the Xmu libs?) */
-	cmap = XCreateColormap (dpy, RootWindow(dpy, screen), visual, AllocNone);
-	XInstallColormap (dpy, cmap);
+	if ( best_visual_found )
+	  {
+	    cmap = XCreateColormap (dpy,  RootWindow (dpy, screen), visual, AllocNone);
+	  }
+	else
+	  {
+	    /* We have to create a matching colormap anyway...
+	       #### think about using standard colormaps (need the Xmu libs?) */
+	    cmap = XCreateColormap(dpy, RootWindow(dpy, screen), visual, AllocNone);
+	    XInstallColormap(dpy, cmap);
+	  }
       }
   }
 
@@ -552,15 +780,16 @@ x_init_device (struct device *d, Lisp_Object props)
     XtRealizeWidget (app_shell);
   }
 
-#ifdef HAVE_SESSION
+#ifdef HAVE_WMCOMMAND
   {
     int new_argc;
-    char **new_argv;
+    Extbyte **new_argv;
     make_argc_argv (Vcommand_line_args, &new_argc, &new_argv);
-    XSetCommand (XtDisplay (app_shell), XtWindow (app_shell), new_argv, new_argc);
+    XSetCommand (XtDisplay (app_shell), XtWindow (app_shell),
+		 (char **) new_argv, new_argc);
     free_argc_argv (new_argv);
   }
-#endif /* HAVE_SESSION */
+#endif /* HAVE_WMCOMMAND */
 
 
 #ifdef HAVE_OFFIX_DND
@@ -584,7 +813,7 @@ x_init_device (struct device *d, Lisp_Object props)
   DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow(app_shell));
   DEVICE_X_GRAY_PIXMAP (d) = None;
   Xatoms_of_device_x (d);
-  Xatoms_of_xselect (d);
+  Xatoms_of_select_x (d);
   Xatoms_of_objects_x (d);
   x_init_device_class (d);
 
@@ -599,10 +828,10 @@ x_finish_init_device (struct device *d, Lisp_Object props)
 }
 
 static void
-x_mark_device (struct device *d, void (*markobj) (Lisp_Object))
+x_mark_device (struct device *d)
 {
-  markobj (DEVICE_X_WM_COMMAND_FRAME (d));
-  markobj (DEVICE_X_DATA (d)->x_keysym_map_hash_table);
+  mark_object (DEVICE_X_WM_COMMAND_FRAME (d));
+  mark_object (DEVICE_X_DATA (d)->x_keysym_map_hash_table);
 }
 
 
@@ -683,10 +912,10 @@ x_delete_device (struct device *d)
 /*				handle X errors				*/
 /************************************************************************/
 
-CONST char *
+const char *
 x_event_name (int event_type)
 {
-  static CONST char *events[] =
+  static const char *events[] =
   {
     "0: ERROR!",
     "1: REPLY",
@@ -828,10 +1057,14 @@ x_error_handler (Display *disp, XErrorEvent *event)
       }
 #endif /* EXTERNAL_WIDGET */
 
+#if 0
+      /* This ends up calling X, which isn't allowed in an X error handler
+       */
       stderr_out ("\n%s: ",
 		  (STRINGP (Vinvocation_name)
 		   ? (char *) XSTRING_DATA (Vinvocation_name)
 		   : "xemacs"));
+#endif
       XmuPrintDefaultErrorMessage (disp, event, stderr);
     }
   return 0;
@@ -891,6 +1124,9 @@ x_IO_error_handler (Display *disp)
   Lisp_Object dev;
   struct device *d = get_device_from_display_1 (disp);
 
+  if (!d)
+    d = device_being_initialized;
+
   assert (d != NULL);
   XSETDEVICE (dev, d);
 
@@ -925,8 +1161,10 @@ x_IO_error_handler (Display *disp)
      Xlib might just decide to exit().  So we mark the offending
      console for deletion and throw to top level.  */
   if (d)
-    enqueue_magic_eval_event (io_error_delete_device, dev);
-  DEVICE_X_BEING_DELETED (d) = 1;
+    {
+      enqueue_magic_eval_event (io_error_delete_device, dev);
+      DEVICE_X_BEING_DELETED (d) = 1;
+    }
   Fthrow (Qtop_level, Qnil);
 
   return 0; /* not reached */
@@ -1029,6 +1267,22 @@ construct_name_list (Display *display, Widget widget, char *fake_name,
 
 #endif /* 0 */
 
+/* strcasecmp() is not sufficiently portable or standard,
+   and it's easier just to write our own. */
+static int
+ascii_strcasecmp (const char *s1, const char *s2)
+{
+  while (1)
+    {
+      char c1 = *s1++;
+      char c2 = *s2++;
+      if (c1 >= 'A' && c1 <= 'Z') c1 += 'a' - 'A';
+      if (c2 >= 'A' && c2 <= 'Z') c2 += 'a' - 'A';
+      if (c1 != c2) return c1 - c2;
+      if (c1 == '\0') return 0;
+    }
+}
+
 static char_dynarr *name_char_dynarr;
 static char_dynarr *class_char_dynarr;
 
@@ -1132,7 +1386,7 @@ The fifth arg is the device to search for the resources on. (The resource
 The sixth arg NOERROR, if non-nil, means do not signal an error if a
   bogus resource specification was retrieved (e.g. if a non-integer was
   given when an integer was requested).  In this case, a warning is issued
-  instead.
+  instead, unless NOERROR is t, in which case no warning is issued.
 
 The resource names passed to this function are looked up relative to the
 locale.
@@ -1191,15 +1445,15 @@ The returned value of this function is nil if the queried resource is not
 found.  If the third arg is `string', a string is returned, and if it is
 `integer', an integer is returned.  If the third arg is `boolean', then the
 returned value is the list (t) for true, (nil) for false, and is nil to
-mean ``unspecified.''
+mean ``unspecified''.
 */
-       (name, class, type, locale, device, no_error))
+       (name, class, type, locale, device, noerror))
 {
   char* name_string, *class_string;
   char *raw_result;
   XrmDatabase db;
   Display *display;
-  Error_behavior errb = decode_error_behavior_flag (no_error);
+  Error_behavior errb = decode_error_behavior_flag (noerror);
 
   CHECK_STRING (name);
   CHECK_STRING (class);
@@ -1255,13 +1509,13 @@ mean ``unspecified.''
     return build_string (raw_result);
   else if (EQ (type, Qboolean))
     {
-      if (!strcasecmp (raw_result, "off")   ||
-	  !strcasecmp (raw_result, "false") ||
-	  !strcasecmp (raw_result, "no"))
+      if (!ascii_strcasecmp (raw_result, "off")   ||
+	  !ascii_strcasecmp (raw_result, "false") ||
+	  !ascii_strcasecmp (raw_result, "no"))
 	return Fcons (Qnil, Qnil);
-      if (!strcasecmp (raw_result, "on")   ||
-	  !strcasecmp (raw_result, "true") ||
-	  !strcasecmp (raw_result, "yes"))
+      if (!ascii_strcasecmp (raw_result, "on")   ||
+	  !ascii_strcasecmp (raw_result, "true") ||
+	  !ascii_strcasecmp (raw_result, "yes"))
 	return Fcons (Qt, Qnil);
       return maybe_continuable_error
 	(Qresource, errb,
@@ -1454,17 +1708,17 @@ Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
 */
        (keysym))
 {
-  CONST char *keysym_ext;
+  const char *keysym_ext;
 
   CHECK_STRING (keysym);
-  GET_C_STRING_CTEXT_DATA_ALLOCA (keysym, keysym_ext);
+  LISP_STRING_TO_EXTERNAL (keysym, keysym_ext, Qctext);
 
   return XStringToKeysym (keysym_ext) ? Qt : Qnil;
 }
 
 DEFUN ("x-keysym-hash-table", Fx_keysym_hash_table, 0, 1, 0, /*
-Return a hash table which contains a hash key for all keysyms which
-name keys on the keyboard.  See `x-keysym-on-keyboard-p'.
+Return a hash table containing a key for all keysyms on DEVICE.
+DEVICE must be an X11 display device.  See `x-keysym-on-keyboard-p'.
 */
        (device))
 {
@@ -1606,7 +1860,7 @@ Grab the keyboard on the given device (defaulting to the selected one).
 So long as the keyboard is grabbed, all keyboard events will be delivered
 to emacs -- it is not possible for other X clients to eavesdrop on them.
 Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect).
-Returns t if the grab was successful; nil otherwise.
+Returns t if the grab is successful, nil otherwise.
 */
        (device))
 {
@@ -1649,6 +1903,70 @@ Release a keyboard grab made with `x-grab-keyboard'.
   return Qnil;
 }
 
+DEFUN ("x-get-font-path", Fx_get_font_path, 0, 1, 0, /*
+Get the X Server's font path.
+
+See also `x-set-font-path'.
+*/
+       (device))
+{
+  Display *dpy = get_x_display (device);
+  int ndirs_return;
+  const char **directories = (const char **) XGetFontPath (dpy, &ndirs_return);
+  Lisp_Object font_path = Qnil;
+
+  if (!directories)
+    signal_simple_error ("Can't get X font path", device);
+
+  while (ndirs_return--)
+      font_path = Fcons (build_ext_string (directories[ndirs_return],
+                                           Qfile_name),
+			 font_path);
+
+  return font_path;
+}
+
+DEFUN ("x-set-font-path", Fx_set_font_path, 1, 2, 0, /*
+Set the X Server's font path to FONT-PATH.
+
+There is only one font path per server, not one per client.  Use this
+sparingly.  It uncaches all of the X server's font information.
+
+Font directories should end in the path separator and should contain
+a file called fonts.dir usually created with the program mkfontdir.
+
+Setting the FONT-PATH to nil tells the X server to use the default
+font path.
+
+See also `x-get-font-path'.
+*/
+       (font_path, device))
+{
+  Display *dpy = get_x_display (device);
+  Lisp_Object path_entry;
+  const char **directories;
+  int i=0,ndirs=0;
+
+  EXTERNAL_LIST_LOOP (path_entry, font_path)
+    {
+      CHECK_STRING (XCAR (path_entry));
+      ndirs++;
+    }
+
+  directories = alloca_array (const char *, ndirs);
+
+  EXTERNAL_LIST_LOOP (path_entry, font_path)
+    {
+      LISP_STRING_TO_EXTERNAL (XCAR (path_entry), directories[i++], Qfile_name);
+    }
+
+  expect_x_error (dpy);
+  XSetFontPath (dpy, (char **) directories, ndirs);
+  signal_if_x_error (dpy, 1/*resumable_p*/);
+
+  return Qnil;
+}
+
 
 /************************************************************************/
 /*                            initialization                            */
@@ -1677,35 +1995,52 @@ syms_of_device_x (void)
   DEFSUBR (Fx_grab_keyboard);
   DEFSUBR (Fx_ungrab_keyboard);
 
+  DEFSUBR (Fx_get_font_path);
+  DEFSUBR (Fx_set_font_path);
+
   defsymbol (&Qx_error, "x-error");
   defsymbol (&Qinit_pre_x_win, "init-pre-x-win");
   defsymbol (&Qinit_post_x_win, "init-post-x-win");
 }
 
 void
+reinit_console_type_create_device_x (void)
+{
+  /* Initialize variables to speed up X resource interactions */
+  const char *valid_resource_chars =
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_";
+  while (*valid_resource_chars)
+    valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1;
+
+  name_char_dynarr  = Dynarr_new (char);
+  class_char_dynarr = Dynarr_new (char);
+}
+
+void
 console_type_create_device_x (void)
 {
+  reinit_console_type_create_device_x ();
   CONSOLE_HAS_METHOD (x, init_device);
   CONSOLE_HAS_METHOD (x, finish_init_device);
   CONSOLE_HAS_METHOD (x, mark_device);
   CONSOLE_HAS_METHOD (x, delete_device);
   CONSOLE_HAS_METHOD (x, device_system_metrics);
+}
 
-  {
-    /* Initialize variables to speed up X resource interactions */
-    CONST char *valid_resource_chars =
-      "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_";
-    while (*valid_resource_chars)
-      valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1;
-
-    name_char_dynarr  = Dynarr_new (char);
-    class_char_dynarr = Dynarr_new (char);
-  }
+void
+reinit_vars_of_device_x (void)
+{
+  error_expected = 0;
+  error_occurred = 0;
+
+  in_resource_setting = 0;
 }
 
 void
 vars_of_device_x (void)
 {
+  reinit_vars_of_device_x ();
+
   DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class /*
 The X application class of the XEmacs process.
 This controls, among other things, the name of the `app-defaults' file
@@ -1748,9 +2083,4 @@ where the localized init files are.
 
   staticpro (&Vdefault_x_device);
   Vdefault_x_device = Qnil;
-
-  error_expected = 0;
-  error_occurred = 0;
-
-  in_resource_setting = 0;
 }