diff src/objects-x.c @ 5118:e0db3c197671 ben-lisp-object

merge up to latest default branch, doesn't compile yet
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 21:18:49 -0600
parents a23ac8f90a49
children a6c778975d7d 304aebb79cd3
line wrap: on
line diff
--- a/src/objects-x.c	Sat Dec 26 00:20:27 2009 -0600
+++ b/src/objects-x.c	Sat Dec 26 21:18:49 2009 -0600
@@ -37,193 +37,23 @@
 
 #include "console-x-impl.h"
 #include "objects-x-impl.h"
+#include "elhash.h"
+
+#ifdef USE_XFT
+#include "font-mgr.h"
+#endif
 
 int x_handle_non_fully_specified_fonts;
 
+#ifdef DEBUG_XEMACS 
+Fixnum debug_x_objects;
+#endif /* DEBUG_XEMACS */
+
 
 /************************************************************************/
 /*                          color instances                             */
 /************************************************************************/
 
-/* Replacement for XAllocColor() that tries to return the nearest
-   available color if the colormap is full.  Original was from FSFmacs,
-   but rewritten by Jareth Hein <jareth@camelot-soft.com> 97/11/25
-   Modified by Lee Kindness <lkindness@csl.co.uk> 31/08/99 to handle previous
-   total failure which was due to a read/write colorcell being the nearest
-   match - tries the next nearest...
-
-   Return value is 1 for normal success, 2 for nearest color success,
-   3 for Non-deallocable success. */
-int
-allocate_nearest_color (Display *display, Colormap colormap, Visual *visual,
-		        XColor *color_def)
-{
-  int status;
-
-  if (visual->X_CLASSFIELD == DirectColor || visual->X_CLASSFIELD == TrueColor)
-    {
-      if (XAllocColor (display, colormap, color_def) != 0)
-	{
-	  status = 1;
-	}
-      else
-	{
-	  /* We're dealing with a TrueColor/DirectColor visual, so play games
-	     with the RGB values in the XColor struct. */
-	  /* #### JH: I'm not sure how a call to XAllocColor can fail in a
-	     TrueColor or DirectColor visual, so I will just reformat the
-	     request to match the requirements of the visual, and re-issue
-	     the request.  If this fails for anybody, I wanna know about it
-	     so I can come up with a better plan */
-
-	  unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
-	  junk = visual->red_mask;
-	  rshift = 0;
-	  while ((junk & 0x1) == 0) {
-	    junk = junk >> 1;
-	    rshift ++;
-	  }
-	  rbits = 0;
-	  while (junk != 0) {
-	    junk = junk >> 1;
-	    rbits++;
-	  }
-	  junk = visual->green_mask;
-	  gshift = 0;
-	  while ((junk & 0x1) == 0) {
-	    junk = junk >> 1;
-	    gshift ++;
-	  }
-	  gbits = 0;
-	  while (junk != 0) {
-	    junk = junk >> 1;
-	    gbits++;
-	  }
-	  junk = visual->blue_mask;
-	  bshift = 0;
-	  while ((junk & 0x1) == 0) {
-	    junk = junk >> 1;
-	    bshift ++;
-	  }
-	  bbits = 0;
-	  while (junk != 0) {
-	    junk = junk >> 1;
-	    bbits++;
- 	  }
-
-	  color_def->red = color_def->red >> (16 - rbits);
-	  color_def->green = color_def->green >> (16 - gbits);
-	  color_def->blue = color_def->blue >> (16 - bbits);
-	  if (XAllocColor (display, colormap, color_def) != 0)
-	    status = 1;
-	  else
-  	    {
-  	      int rd, gr, bl;
-	      /* #### JH: I'm punting here, knowing that doing this will at
-		 least draw the color correctly.  However, unless we convert
-		 all of the functions that allocate colors (graphics
-		 libraries, etc) to use this function doing this is very
-		 likely to cause problems later... */
-
-	      if (rbits > 8)
-		rd = color_def->red << (rbits - 8);
-	      else
-		rd = color_def->red >> (8 - rbits);
-	      if (gbits > 8)
-		gr = color_def->green << (gbits - 8);
-	      else
-		gr = color_def->green >> (8 - gbits);
-	      if (bbits > 8)
-		bl = color_def->blue << (bbits - 8);
-	      else
-		bl = color_def->blue >> (8 - bbits);
-	      color_def->pixel = (rd << rshift) | (gr << gshift) | (bl <<
-								    bshift);
-	      status = 3;
-	    }
-	}
-    }
-  else
-    {
-      XColor *cells = NULL;
-      /* JH: I can't believe there's no way to go backwards from a
-	 colormap ID and get its visual and number of entries, but X
-	 apparently isn't built that way... */
-      int no_cells = visual->map_entries;
-      status = 0;
-
-      if (XAllocColor (display, colormap, color_def) != 0)
-	status = 1;
-      else while( status != 2 )
-	{
-	  /* If we got to this point, the colormap is full, so we're
-	     going to try and get the next closest color.  The algorithm used
-	     is a least-squares matching, which is what X uses for closest
-	     color matching with StaticColor visuals. */
-	  int nearest;
-	  long nearest_delta, trial_delta;
-	  int x;
-
-	  if( cells == NULL )
-	    {
-	      cells = alloca_array (XColor, no_cells);
-	      for (x = 0; x < no_cells; x++)
-		cells[x].pixel = x;
-
-	      /* read the current colormap */
-	      XQueryColors (display, colormap, cells, no_cells);
-	    }
-
-	  nearest = 0;
-	  /* I'm assuming CSE so I'm not going to condense this. */
-	  nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8))
-			    * ((color_def->red >> 8) - (cells[0].red >> 8)))
-			   +
-			   (((color_def->green >> 8) - (cells[0].green >> 8))
-			    * ((color_def->green >> 8) - (cells[0].green >>
-							  8)))
-			   +
-			   (((color_def->blue >> 8) - (cells[0].blue >> 8))
-			    * ((color_def->blue >> 8) - (cells[0].blue >>
-							 8))));
-	  for (x = 1; x < no_cells; x++)
-	    {
-	      trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8))
-			      * ((color_def->red >> 8) - (cells[x].red >> 8)))
-			     +
-			     (((color_def->green >> 8) - (cells[x].green >> 8))
-			      * ((color_def->green >> 8) - (cells[x].green >>
-							    8)))
-			     +
-			     (((color_def->blue >> 8) - (cells[x].blue >> 8))
-			      * ((color_def->blue >> 8) - (cells[x].blue >>
-							   8))));
-
-	      /* less? Ignore cells marked as previously failing */
-	      if( (trial_delta < nearest_delta) &&
-		  (cells[x].pixel != ULONG_MAX) )
-		{
-		  nearest = x;
-		  nearest_delta = trial_delta;
-		}
-	    }
-	  color_def->red = cells[nearest].red;
-	  color_def->green = cells[nearest].green;
-	  color_def->blue = cells[nearest].blue;
-	  if (XAllocColor (display, colormap, color_def) != 0)
-	    status = 2;
-	  else
-	    /* LSK: Either the colour map has changed since
-	     * we read it, or the colour is allocated
-	     * read/write... Mark this cmap entry so it's
-	     * ignored in the next iteration.
-	     */
-	    cells[nearest].pixel = ULONG_MAX;
-	}
-    }
-  return status;
-}
-
 static int
 x_parse_nearest_color (struct device *d, XColor *color, Lisp_Object name,
 		       Error_Behavior errb)
@@ -246,7 +76,7 @@
 			  name, Qcolor, errb);
       return 0;
     }
-  result = allocate_nearest_color (dpy, cmap, visual, color);
+  result = x_allocate_nearest_color (dpy, cmap, visual, color);
   if (!result)
     {
       maybe_signal_error (Qgui_error, "Couldn't allocate color",
@@ -262,6 +92,9 @@
 			     Lisp_Object device, Error_Behavior errb)
 {
   XColor color;
+#ifdef USE_XFT
+  XftColor xftColor;
+#endif
   int result;
 
   result = x_parse_nearest_color (XDEVICE (device), &color, name, errb);
@@ -277,6 +110,17 @@
   else
     COLOR_INSTANCE_X_DEALLOC (c) = 1;
   COLOR_INSTANCE_X_COLOR (c) = color;
+
+#ifdef USE_XFT
+  xftColor.pixel = color.pixel;
+  xftColor.color.red = color.red;
+  xftColor.color.green = color.green;
+  xftColor.color.blue = color.blue;
+  xftColor.color.alpha = 0xffff;
+
+  COLOR_INSTANCE_X_XFTCOLOR (c) = xftColor;
+#endif
+
   return 1;
 }
 
@@ -366,95 +210,191 @@
 /*                           font instances                             */
 /************************************************************************/
 
+
 static int
 x_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object UNUSED (name),
 			    Lisp_Object device, Error_Behavior errb)
 {
   Display *dpy = DEVICE_X_DISPLAY (XDEVICE (device));
-  XFontStruct *xf;
-  const Extbyte *extname;
+  Extbyte *extname;
+  XFontStruct *fs = NULL;	/* _F_ont _S_truct */
+#ifdef USE_XFT
+  XftFont *rf = NULL;		/* _R_ender _F_ont (X Render extension) */
+#else
+#define rf (0)
+#endif
 
+#ifdef USE_XFT
+  DEBUG_XFT1 (2, "attempting to initialize font spec %s\n",
+	      XSTRING_DATA(f->name));
+  /* #### serialize (optimize) these later... */
+  /* #### This function really needs to go away.
+     The problem is that the fontconfig/Xft functions work much too hard
+     to ensure that something is returned; but that something need not be
+     at all close to what we asked for. */
+  LISP_STRING_TO_EXTERNAL (f->name, extname, Qfc_font_name_encoding);
+  rf = xft_open_font_by_name (dpy, extname);
+#endif
   LISP_STRING_TO_EXTERNAL (f->name, extname, Qx_font_name_encoding);
-  xf = XLoadQueryFont (dpy, extname);
+  /* With XFree86 4.0's fonts, XListFonts returns an entry for
+     -isas-fangsong ti-medium-r-normal--16-160-72-72-c-160-gb2312.1980-0 but
+     an XLoadQueryFont on the corresponding XLFD returns NULL.
 
-  if (!xf)
+     XListFonts is not trustworthy (of course, this is news to exactly
+     no-one used to reading XEmacs source.) */
+  fs = XLoadQueryFont (dpy, extname);
+      
+  if (!fs && !rf)
     {
-      maybe_signal_error (Qgui_error, "Couldn't load font", f->name, Qfont,
-			  errb);
+      /* #### should this refer to X and/or Xft? */
+      maybe_signal_error (Qgui_error, "Couldn't load font", f->name,
+			  Qfont, errb);
       return 0;
     }
 
-  if (!xf->max_bounds.width)
+  if (rf && fs)
+    {
+      XFreeFont (dpy, fs);
+      fs = NULL;		/* we don' need no steenkin' X font */
+    }
+
+  if (fs && !fs->max_bounds.width)
     {
       /* yes, this has been known to happen. */
-      XFreeFont (dpy, xf);
+      XFreeFont (dpy, fs);
+      fs = NULL;
       maybe_signal_error (Qgui_error, "X font is too small", f->name, Qfont,
 			  errb);
       return 0;
     }
 
-  /* Don't allocate the data until we're sure that we will succeed,
-     or the finalize method may get fucked. */
+  /* Now that we're sure that we will succeed, we can allocate data without
+     fear that the finalize method may get fucked. */
   f->data = xnew (struct x_font_instance_data);
-  FONT_INSTANCE_X_FONT (f) = xf;
-  f->ascent = xf->ascent;
-  f->descent = xf->descent;
-  f->height = xf->ascent + xf->descent;
-  {
-    /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */
-    int def_char = 'n'; /*xf->default_char;*/
-    int byte1, byte2;
 
-  once_more:
-    byte1 = def_char >> 8;
-    byte2 = def_char & 0xFF;
+#ifdef USE_XFT
+  FONT_INSTANCE_X_XFTFONT (f) = rf;
+  if (rf)
+    /* Have an Xft font, initialize font info from it. */
+    {
+      DEBUG_XFT4 (2, "pre-initial ascent %d descent %d width %d height %d\n",
+		  f->ascent, f->descent, f->width, f->height);
 
-    if (xf->per_char)
+      /* #### This shit is just plain wrong unless we have a character cell
+	 font.  It really hoses us on large repertoire Unicode fonts with
+	 "double-width" characters. */
+      f->ascent = rf->ascent;
+      f->descent = rf->descent;
       {
-	/* Old versions of the R5 font server have garbage (>63k) as
-	   def_char. 'n' might not be a valid character. */
-	if (byte1 < (int) xf->min_byte1         ||
-	    byte1 > (int) xf->max_byte1         ||
-	    byte2 < (int) xf->min_char_or_byte2 ||
-	    byte2 > (int) xf->max_char_or_byte2)
-	  f->width = 0;
-	else
-	  f->width = xf->per_char[(byte1 - xf->min_byte1) *
-				  (xf->max_char_or_byte2 -
-				   xf->min_char_or_byte2 + 1) +
-				  (byte2 - xf->min_char_or_byte2)].width;
+	/* This is an approximation that AFAIK only gets used to compute
+	   cell size for estimating window dimensions.  The test_string8
+	   is an  ASCII string whose characters should approximate the
+	   distribution of widths expected in real text.  */
+	static const FcChar8 test_string8[] = "Mmneei";
+	static const int len = sizeof (test_string8) - 1;
+	XGlyphInfo glyphinfo;
+
+	XftTextExtents8 (dpy, rf, test_string8, len, &glyphinfo);
+	/* #### maybe should be glyphinfo.xOff - glyphinfo.x? */
+	f->width = (2*glyphinfo.width + len)/(2*len);
       }
-    else
-      f->width = xf->max_bounds.width;
+      f->height = rf->height;
+      f->proportional_p = 1; 	/* we can't recognize monospaced fonts! */
+
+      /* #### This message appears wa-a-ay too often!
+	 We probably need to cache truenames or something?
+	 Even if Xft does it for us, we cons too many font instances. */
+      DEBUG_XFT4 (0,
+	"initialized metrics ascent %d descent %d width %d height %d\n",
+	f->ascent, f->descent, f->width, f->height);
+    } 
+  else
+    {
+      DEBUG_XFT1 (0, "couldn't initialize Xft font %s\n",
+		  XSTRING_DATA(f->name));
+    }
+#endif
+
+  FONT_INSTANCE_X_FONT (f) = fs;
+  if (fs)
+    /* Have to use a core font, initialize font info from it. */
+    {
+      f->ascent = fs->ascent;
+      f->descent = fs->descent;
+      f->height = fs->ascent + fs->descent;
+      {
+	/* following change suggested by Ted Phelps <phelps@dstc.edu.au> */
+	int def_char = 'n'; /*fs->default_char;*/
+	int byte1, byte2;
 
-    /* Some fonts have a default char whose width is 0.  This is no good.
-       If that's the case, first try 'n' as the default char, and if n has
-       0 width too (unlikely) then just use the max width. */
-    if (f->width == 0)
-      {
-	if (def_char == (int) xf->default_char)
-	  f->width = xf->max_bounds.width;
+      once_more:
+	byte1 = def_char >> 8;
+	byte2 = def_char & 0xFF;
+
+	if (fs->per_char)
+	  {
+	    /* Old versions of the R5 font server have garbage (>63k) as
+	       def_char. 'n' might not be a valid character. */
+	    if (byte1 < (int) fs->min_byte1         ||
+		byte1 > (int) fs->max_byte1         ||
+		byte2 < (int) fs->min_char_or_byte2 ||
+		byte2 > (int) fs->max_char_or_byte2)
+	      f->width = 0;
+	    else
+	      f->width = fs->per_char[(byte1 - fs->min_byte1) *
+				      (fs->max_char_or_byte2 -
+				       fs->min_char_or_byte2 + 1) +
+				      (byte2 - fs->min_char_or_byte2)].width;
+	  }
 	else
+	  f->width = fs->max_bounds.width;
+
+	/* Some fonts have a default char whose width is 0.  This is no good.
+	   If that's the case, first try 'n' as the default char, and if n has
+	   0 width too (unlikely) then just use the max width. */
+	if (f->width == 0)
 	  {
-	    def_char = xf->default_char;
-	    goto once_more;
+	    if (def_char == (int) fs->default_char)
+	      f->width = fs->max_bounds.width;
+	    else
+	      {
+		def_char = fs->default_char;
+		goto once_more;
+	      }
 	  }
       }
-  }
-  /* If all characters don't exist then there could potentially be
-     0-width characters lurking out there.  Not setting this flag
-     trips an optimization that would make them appear to have width
-     to redisplay.  This is bad.  So we set it if not all characters
-     have the same width or if not all characters are defined.
-     */
-  /* #### This sucks.  There is a measurable performance increase
-     when using proportional width fonts if this flag is not set.
-     Unfortunately so many of the fucking X fonts are not fully
-     defined that we could almost just get rid of this damn flag and
-     make it an assertion. */
-  f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width ||
-		       (x_handle_non_fully_specified_fonts &&
-			!xf->all_chars_exist));
+
+      /* If all characters don't exist then there could potentially be
+	 0-width characters lurking out there.  Not setting this flag
+	 trips an optimization that would make them appear to have width
+	 to redisplay.  This is bad.  So we set it if not all characters
+	 have the same width or if not all characters are defined. */
+      /* #### This sucks.  There is a measurable performance increase
+	 when using proportional width fonts if this flag is not set.
+	 Unfortunately so many of the fucking X fonts are not fully
+	 defined that we could almost just get rid of this damn flag and
+	 make it an assertion. */
+      f->proportional_p = (fs->min_bounds.width != fs->max_bounds.width ||
+			   (x_handle_non_fully_specified_fonts &&
+			    !fs->all_chars_exist));
+    }
+
+#ifdef USE_XFT
+  if (debug_xft > 0)
+    {
+      int n = 3, d = 5;
+      /* check for weirdness */
+      if (n * f->height < d * f->width)
+	stderr_out ("font %s: width:height is %d:%d, larger than %d:%d\n",
+		    XSTRING_DATA(f->name), f->width, f->height, n, d);
+      if (f->height <= 0 || f->width <= 0)
+	stderr_out ("bogus dimensions of font %s: width = %d, height = %d\n",
+		    XSTRING_DATA(f->name), f->width, f->height);
+      stderr_out ("initialized font %s\n", XSTRING_DATA(f->name));
+    }
+#else
+#undef rf
+#endif
 
   return 1;
 }
@@ -464,21 +404,43 @@
 		       Lisp_Object printcharfun,
 		       int UNUSED (escapeflag))
 {
-  write_fmt_string (printcharfun, " 0x%lx",
-		    (unsigned long) FONT_INSTANCE_X_FONT (f)->fid);
+  /* We should print information here about initial vs. final stages; we
+     can't rely on the device charset stage cache for that,
+     unfortunately. */
+  if (FONT_INSTANCE_X_FONT (f))
+      write_fmt_string (printcharfun, " font id: 0x%lx,",
+			(unsigned long) FONT_INSTANCE_X_FONT (f)->fid);
+
+#ifdef USE_XFT
+  /* #### What should we do here?  For now, print the address. */
+  if (FONT_INSTANCE_X_XFTFONT (f))
+    write_fmt_string (printcharfun, " xft font: 0x%lx",
+		      (unsigned long) FONT_INSTANCE_X_XFTFONT (f));
+#endif
 }
 
 static void
 x_finalize_font_instance (Lisp_Font_Instance *f)
 {
 
+#ifdef USE_XFT
+  DEBUG_XFT1 (0, "finalizing %s\n", (STRINGP (f->name)
+				   ? (char *) XSTRING_DATA (f->name)
+				   : "(unnamed font)"));
+#endif
+
   if (f->data)
     {
       if (DEVICE_LIVE_P (XDEVICE (f->device)))
 	{
 	  Display *dpy = DEVICE_X_DISPLAY (XDEVICE (f->device));
 
-	  XFreeFont (dpy, FONT_INSTANCE_X_FONT (f));
+	  if (FONT_INSTANCE_X_FONT (f))
+	    XFreeFont (dpy, FONT_INSTANCE_X_FONT (f));
+#ifdef USE_XFT
+	  if (FONT_INSTANCE_X_XFTFONT (f))
+	    XftFontClose (dpy, FONT_INSTANCE_X_XFTFONT (f));
+#endif
 	}
       xfree (f->data, void *);
       f->data = 0;
@@ -487,6 +449,13 @@
 
 /* Determining the truename of a font is hard.  (Big surprise.)
 
+   This is not true for fontconfig.  Each font has a (nearly) canonical
+   representation up to permutation of the order of properties.  It is
+   possible to construct a name which exactly identifies the properties of
+   the current font.  However, it is theoretically possible that there exists
+   another font with a super set of those properties that would happen to get
+   selected. -- sjt
+
    By "truename" we mean an XLFD-form name which contains no wildcards, yet
    which resolves to *exactly* the same font as the one which we already have
    the (probably wildcarded) name and `XFontStruct' of.
@@ -677,8 +646,9 @@
   return result;
 }
 
-/* Unbounded, for sufficiently small values of infinity... */
-#define MAX_FONT_COUNT 5000
+/* XListFonts doesn't allocate memory unconditionally based on this. (For
+   XFree86 in 2005, at least. */
+#define MAX_FONT_COUNT INT_MAX
 
 static Extbyte *
 truename_via_XListFonts (Display *dpy, Extbyte *font_name)
@@ -695,10 +665,12 @@
 #else
   /* But the world I live in is much more perverse. */
   names = XListFonts (dpy, font_name, MAX_FONT_COUNT, &count);
+  /* Find the lexicographic minimum of names[].
+     (#### Should we be comparing case-insensitively?) */
   while (count--)
-    /* !!#### Not Mule-friendly */
-    /* If names[count] is lexicographically less than result, use it.
-       (#### Should we be comparing case-insensitively?) */
+    /* [[ !!#### Not Mule-friendly ]]
+       Doesn't matter, XLFDs are HPC (old) or Latin1 (modern).  If they
+       aren't, who knows what they are? -- sjt */
     if (result == 0 || (strcmp (result, names [count]) < 0))
       result = names [count];
 #endif
@@ -773,29 +745,65 @@
 x_font_instance_truename (Lisp_Font_Instance *f, Error_Behavior errb)
 {
   struct device *d = XDEVICE (f->device);
+  Display *dpy = DEVICE_X_DISPLAY (d);
+  Extbyte *nameext;
+
+  /* #### restructure this so that we return a valid truename at the end,
+     and otherwise only return when we return something desperate that
+     doesn't get stored for future use. */
+
+#ifdef USE_XFT
+  /* First, try an Xft font. */
+  if (NILP (FONT_INSTANCE_TRUENAME (f)) && FONT_INSTANCE_X_XFTFONT (f))
+    {
+      /* The font is already open, we just unparse. */
+      FcChar8 *res = FcNameUnparse (FONT_INSTANCE_X_XFTFONT (f)->pattern);
+      if (! FONT_INSTANCE_X_XFTFONT (f)->pattern)
+	{
+	  maybe_signal_error (Qgui_error,
+			      "Xft font present but lacks pattern",
+			      wrap_font_instance(f), Qfont, errb);
+	}
+      if (res)
+	{
+	  FONT_INSTANCE_TRUENAME (f) = 
+	    build_ext_string ((Extbyte *) res, Qfc_font_name_encoding); 
+	  free (res);
+	  return FONT_INSTANCE_TRUENAME (f);
+	}
+      else
+	{
+	  maybe_signal_error (Qgui_error,
+			      "Couldn't unparse Xft font to truename",
+			      wrap_font_instance(f), Qfont, errb);
+	  /* used to return Qnil here */
+	}
+    }
+#endif	/* USE_XFT */
+
+  /* OK, fall back to core font. */
+  if (NILP (FONT_INSTANCE_TRUENAME (f))
+      && FONT_INSTANCE_X_FONT (f))
+    {
+      nameext = NEW_LISP_STRING_TO_EXTERNAL (f->name, Qx_font_name_encoding);
+      FONT_INSTANCE_TRUENAME (f) =
+	x_font_truename (dpy, nameext, FONT_INSTANCE_X_FONT (f));
+    }
 
   if (NILP (FONT_INSTANCE_TRUENAME (f)))
     {
-      Display *dpy = DEVICE_X_DISPLAY (d);
-      {
-	Extbyte *nameext;
+      /* Urk, no luck.  Whine about our bad luck and exit. */
+      Lisp_Object font_instance = wrap_font_instance (f);
+      
+      
+      maybe_signal_error (Qgui_error, "Couldn't determine font truename",
+			  font_instance, Qfont, errb);
+      /* Ok, just this once, return the font name as the truename.
+	 (This is only used by Fequal() right now.) */
+      return f->name;
+    }
 
-	LISP_STRING_TO_EXTERNAL (f->name, nameext, Qx_font_name_encoding);
-	FONT_INSTANCE_TRUENAME (f) =
-	  x_font_truename (dpy, nameext, FONT_INSTANCE_X_FONT (f));
-      }
-      if (NILP (FONT_INSTANCE_TRUENAME (f)))
-	{
-	  Lisp_Object font_instance = wrap_font_instance (f);
-
-
-	  maybe_signal_error (Qgui_error, "Couldn't determine font truename",
-			      font_instance, Qfont, errb);
-	  /* Ok, just this once, return the font name as the truename.
-	     (This is only used by Fequal() right now.) */
-	  return f->name;
-	}
-    }
+  /* Return what we found. */
   return FONT_INSTANCE_TRUENAME (f);
 }
 
@@ -806,8 +814,13 @@
   int i;
   Lisp_Object result = Qnil;
   Display *dpy = DEVICE_X_DISPLAY (d);
-  XFontProp *props = FONT_INSTANCE_X_FONT (f)->properties;
+  XFontProp *props = NULL;
 
+  /* #### really should hack Xft fonts, too
+     Strategy: fontconfig must have an iterator for this purpose. */
+  if (! FONT_INSTANCE_X_FONT (f)) return result;
+
+  props = FONT_INSTANCE_X_FONT (f)->properties;
   for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--)
     {
       Lisp_Object name, value;
@@ -884,110 +897,9 @@
   return result;
 }
 
-#ifdef MULE
-
-static int
-x_font_spec_matches_charset (struct device *UNUSED (d), Lisp_Object charset,
-			     const Ibyte *nonreloc, Lisp_Object reloc,
-			     Bytecount offset, Bytecount length,
-			     int stage)
-{
-  if (stage)
-    return 0;
-
-  if (UNBOUNDP (charset))
-    return 1;
-  /* Hack! Short font names don't have the registry in them,
-     so we just assume the user knows what they're doing in the
-     case of ASCII.  For other charsets, you gotta give the
-     long form; sorry buster.
-     */
-  if (EQ (charset, Vcharset_ascii))
-    {
-      const Ibyte *the_nonreloc = nonreloc;
-      int i;
-      Bytecount the_length = length;
-
-      if (!the_nonreloc)
-	the_nonreloc = XSTRING_DATA (reloc);
-      fixup_internal_substring (nonreloc, reloc, offset, &the_length);
-      the_nonreloc += offset;
-      if (!memchr (the_nonreloc, '*', the_length))
-	{
-	  for (i = 0;; i++)
-	    {
-	      const Ibyte *new_nonreloc = (const Ibyte *)
-		memchr (the_nonreloc, '-', the_length);
-	      if (!new_nonreloc)
-		break;
-	      new_nonreloc++;
-	      the_length -= new_nonreloc - the_nonreloc;
-	      the_nonreloc = new_nonreloc;
-	    }
-
-	  /* If it has less than 5 dashes, it's a short font.
-	     Of course, long fonts always have 14 dashes or so, but short
-	     fonts never have more than 1 or 2 dashes, so this is some
-	     sort of reasonable heuristic. */
-	  if (i < 5)
-	    return 1;
-	}
-    }
-
-  return (fast_string_match (XCHARSET_REGISTRY (charset),
-			     nonreloc, reloc, offset, length, 1,
-			     ERROR_ME, 0) >= 0);
-}
-
-/* find a font spec that matches font spec FONT and also matches
-   (the registry of) CHARSET. */
-static Lisp_Object
-x_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset,
-		     int stage)
-{
-  Extbyte **names;
-  int count = 0;
-  Lisp_Object result = Qnil;
-  const Extbyte *patternext;
-  int i;
-
-  if (stage)
-    return Qnil;
-
-  LISP_STRING_TO_EXTERNAL (font, patternext, Qx_font_name_encoding);
-
-  names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)),
-		      patternext, MAX_FONT_COUNT, &count);
-  /* #### This code seems awfully bogus -- mrb */
-  for (i = 0; i < count; i ++)
-    {
-      const Ibyte *intname;
-      Bytecount intlen;
-
-      TO_INTERNAL_FORMAT (C_STRING, names[i],
-			  ALLOCA, (intname, intlen),
-			  Qx_font_name_encoding);
-      if (x_font_spec_matches_charset (XDEVICE (device), charset,
-				       intname, Qnil, 0, -1, 0))
-	{
-	  result = make_string (intname, intlen);
-	  break;
-	}
-    }
-
-  if (names)
-    XFreeFontNames (names);
-
-  /* Check for a short font name. */
-  if (NILP (result)
-      && x_font_spec_matches_charset (XDEVICE (device), charset, 0,
-				      font, 0, -1, 0))
-    return font;
-
-  return result;
-}
-
-#endif /* MULE */
+/* Include the charset support, shared, for the moment, with GTK.  */
+#define THIS_IS_X
+#include "objects-xlike-inc.c"
 
 
 /************************************************************************/
@@ -1028,6 +940,13 @@
 void
 vars_of_objects_x (void)
 {
+#ifdef DEBUG_XEMACS
+  DEFVAR_INT ("debug-x-objects", &debug_x_objects /*
+If non-zero, display debug information about X objects
+*/ );
+  debug_x_objects = 0;
+#endif
+
   DEFVAR_BOOL ("x-handle-non-fully-specified-fonts",
 	       &x_handle_non_fully_specified_fonts /*
 If this is true then fonts which do not have all characters specified
@@ -1041,6 +960,10 @@
 cause problems this is set to nil by default.
 */ );
   x_handle_non_fully_specified_fonts = 0;
+
+#ifdef USE_XFT
+  Fprovide (intern ("xft-fonts"));
+#endif
 }
 
 void