--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/objects-x.c	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,832 @@
+/* X-specific Lisp objects.
+   Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1995 Board of Trustees, University of Illinois.
+   Copyright (C) 1995 Tinker Systems.
+   Copyright (C) 1995, 1996 Ben Wing.
+   Copyright (C) 1995 Sun Microsystems, Inc.
+
+This file is part of XEmacs.
+
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+/* Authors: Jamie Zawinski, Chuck Thompson, Ben Wing */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-x.h"
+#include "objects-x.h"
+
+#include "buffer.h"
+#include "device.h"
+#include "insdel.h"
+
+int handle_nonfull_spec_fonts;
+
+
+/************************************************************************/
+/*                          color instances                             */
+/************************************************************************/
+
+/* Replacement for XAllocColor() that tries to return the nearest
+   available color if the colormap is full.  From FSF Emacs. */
+
+int
+allocate_nearest_color (Display *display, Colormap screen_colormap,
+		        XColor *color_def)
+{
+  int status;
+
+  status = XAllocColor (display, screen_colormap, color_def);
+  if (!status)
+    {
+      /* 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.  */
+
+      XColor *cells;
+      int no_cells;
+      int nearest;
+      long nearest_delta, trial_delta;
+      int x;
+
+      no_cells = XDisplayCells (display, XDefaultScreen (display));
+      cells = (XColor *) alloca (sizeof (XColor) * no_cells);
+
+      for (x = 0; x < no_cells; x++)
+	cells[x].pixel = x;
+
+      XQueryColors (display, screen_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))));
+	  if (trial_delta < nearest_delta)
+	    {
+	      nearest = x;
+	      nearest_delta = trial_delta;
+	    }
+	}
+      color_def->red = cells[nearest].red;
+      color_def->green = cells[nearest].green;
+      color_def->blue = cells[nearest].blue;
+      status = XAllocColor (display, screen_colormap, color_def);
+    }
+
+  return status;
+}
+
+int
+x_parse_nearest_color (struct device *d, XColor *color, Bufbyte *name,
+		       Bytecount len, Error_behavior errb)
+{
+  Display *dpy;
+  Screen *xs;
+  Colormap cmap;
+  int result;
+  
+  dpy = DEVICE_X_DISPLAY (d);
+  xs = DefaultScreenOfDisplay (dpy);
+  cmap = DefaultColormapOfScreen (xs);
+  
+  memset (color, 0, sizeof (*color));
+  {
+    CONST Extbyte *extname;
+    Extcount extnamelen;
+
+    GET_CHARPTR_EXT_BINARY_DATA_ALLOCA (name, len, extname, extnamelen);
+    result = XParseColor (dpy, cmap, (char *) extname, color);
+  }
+  if (!result)
+    {
+      maybe_signal_simple_error ("unrecognized color", make_string (name, len),
+				 Qcolor, errb);
+      return 0;
+    }
+  result = allocate_nearest_color (dpy, cmap, color);
+  if (!result)
+    {
+      maybe_signal_simple_error ("couldn't allocate color",
+				 make_string (name, len), Qcolor, errb);
+      return 0;
+    }
+
+  return 1;
+}
+
+static int
+x_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name,
+			     Lisp_Object device, Error_behavior errb)
+{
+  XColor color;
+  int result;
+
+  result = x_parse_nearest_color (XDEVICE (device), &color,
+				  string_data (XSTRING (name)),
+				  string_length (XSTRING (name)),
+				  errb);
+
+  if (!result)
+    return 0;
+
+  /* Don't allocate the data until we're sure that we will succeed,
+     or the finalize method may get fucked. */
+  c->data = malloc_type (struct x_color_instance_data);
+  COLOR_INSTANCE_X_COLOR (c) = color;
+  return 1;
+}
+
+static void
+x_print_color_instance (struct Lisp_Color_Instance *c,
+			Lisp_Object printcharfun,
+			int escapeflag)
+{
+  char buf[100];
+  XColor color = COLOR_INSTANCE_X_COLOR (c);
+  sprintf (buf, " %ld=(%X,%X,%X)",
+	   color.pixel, color.red, color.green, color.blue);
+  write_c_string (buf, printcharfun);
+}
+
+static void
+x_finalize_color_instance (struct Lisp_Color_Instance *c)
+{
+  if (c->data)
+    {
+      if (DEVICE_LIVE_P (XDEVICE (c->device)))
+	{
+	  Display *dpy = DEVICE_X_DISPLAY (XDEVICE (c->device));
+  
+	  XFreeColors (dpy,
+		       DefaultColormapOfScreen (DefaultScreenOfDisplay (dpy)),
+		       &COLOR_INSTANCE_X_COLOR (c).pixel, 1, 0);
+	}
+      xfree (c->data);
+      c->data = 0;
+    }
+}
+
+/* Color instances are equal if they resolve to the same color on the
+   screen (have the same RGB values).  I imagine that
+   "same RGV values" == "same cell in the colormap."  Arguably we should
+   be comparing their names instead. */
+
+static int
+x_color_instance_equal (struct Lisp_Color_Instance *c1,
+			struct Lisp_Color_Instance *c2,
+			int depth)
+{
+  XColor color1 = COLOR_INSTANCE_X_COLOR (c1);
+  XColor color2 = COLOR_INSTANCE_X_COLOR (c2);
+  return ((color1.red == color2.red) &&
+	  (color1.green == color2.green) &&
+	  (color1.blue == color2.blue));
+}
+
+static unsigned long
+x_color_instance_hash (struct Lisp_Color_Instance *c, int depth)
+{
+  XColor color = COLOR_INSTANCE_X_COLOR (c);
+  return HASH3 (color.red, color.green, color.blue);
+}
+
+static Lisp_Object
+x_color_instance_rgb_components (struct Lisp_Color_Instance *c)
+{
+  XColor color = COLOR_INSTANCE_X_COLOR (c);
+  return (list3 (make_int (color.red), 
+		 make_int (color.green),
+		 make_int (color.blue)));
+}
+
+static int
+x_valid_color_name_p (struct device *d, Lisp_Object color)
+{
+  XColor c;
+  Display *dpy = DEVICE_X_DISPLAY (d);
+  CONST char *extname;
+  
+  GET_C_STRING_CTEXT_DATA_ALLOCA (color, extname);
+
+  return XParseColor (dpy,
+		      DefaultColormapOfScreen (DefaultScreenOfDisplay (dpy)),
+		      extname, &c);
+}
+
+
+/************************************************************************/
+/*                           font instances                             */
+/************************************************************************/
+
+static int
+x_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name,
+			    Lisp_Object device, Error_behavior errb)
+{
+  Display *dpy;
+  XFontStruct *xf;
+  CONST char *extname;
+  
+  dpy = DEVICE_X_DISPLAY (XDEVICE (device));
+  GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, extname);
+  xf = XLoadQueryFont (dpy, extname);
+  
+  if (!xf)
+    {
+      maybe_signal_simple_error ("couldn't load font", f->name,
+				 Qfont, errb);
+      return 0;
+    }
+  
+  if (!xf->max_bounds.width)
+    {
+      /* yes, this has been known to happen. */
+      XFreeFont (dpy, xf);
+      maybe_signal_simple_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. */
+  f->data = malloc_type (struct x_font_instance_data);
+  FONT_INSTANCE_X_TRUENAME (f) = Qnil;
+  FONT_INSTANCE_X_FONT (f) = xf;
+  f->ascent = xf->ascent;
+  f->descent = xf->descent;
+  f->height = xf->ascent + xf->descent;
+  {
+    unsigned int def_char = xf->default_char;
+    int byte1, byte2;
+
+  once_more:
+    byte1 = def_char >> 8;
+    byte2 = def_char & 0xFF;
+
+    if (xf->per_char)
+      {
+	/* Old versions of the R5 font server have garbage (>63k) as
+	   def_char. 'n' might not be a valid character. */
+	if (byte1 < xf->min_byte1 || byte1 > xf->max_byte1 ||
+	    byte2 < xf->min_char_or_byte2 || byte2 > 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;
+      }
+    else
+      f->width = xf->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)
+      {
+	if (def_char == 'n')
+	  f->width = xf->max_bounds.width;
+	else
+	  {
+	    def_char = 'n';
+	    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 ||
+		       (handle_nonfull_spec_fonts &&
+			!xf->all_chars_exist));
+
+  return 1;
+}
+
+static void
+x_mark_font_instance (struct Lisp_Font_Instance *f,
+		       void (*markobj) (Lisp_Object))
+{
+  ((markobj) (FONT_INSTANCE_X_TRUENAME (f)));
+}
+
+static void
+x_print_font_instance (struct Lisp_Font_Instance *f,
+		       Lisp_Object printcharfun,
+		       int escapeflag)
+{
+  char buf[200];
+  sprintf (buf, " 0x%lx", (unsigned long) FONT_INSTANCE_X_FONT (f)->fid);
+  write_c_string (buf, printcharfun);
+}
+
+static void
+x_finalize_font_instance (struct Lisp_Font_Instance *f)
+{
+  
+  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));
+	}
+      xfree (f->data);
+      f->data = 0;
+    }
+}
+
+/* Determining the truename of a font is hard.  (Big surprise.)
+
+   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.
+
+   One might think that the first font returned by XListFonts would be the one
+   that XOpenFont would pick.  Apparently this is the case on some servers,
+   but not on others.  It would seem not to be specified.
+
+   The MIT R5 server sometimes appears to be picking the lexicographically
+   smallest font which matches the name (thus picking "adobe" fonts before
+   "bitstream" fonts even if the bitstream fonts are earlier in the path, and
+   also picking 100dpi adobe fonts over 75dpi adobe fonts even though the
+   75dpi are in the path earlier) but sometimes appears to be doing something
+   else entirely (for example, removing the bitsream fonts from the path will
+   cause the 75dpi adobe fonts to be used instead of the100dpi, even though
+   their relative positions in the path (and their names!) have not changed).
+
+   The documentation for XSetFontPath() seems to indicate that the order of
+   entries in the font path means something, but it's pretty noncommital about
+   it, and the spirit of the law is apparently not being obeyed...
+
+   All the fonts I've seen have a property named `FONT' which contains the
+   truename of the font.  However, there are two problems with using this: the
+   first is that the X Protocol Document is quite explicit that all properties
+   are optional, so we can't depend on it being there.  The second is that
+   it's concievable that this alleged truename isn't actually accessible as a
+   font, due to some difference of opinion between the font designers and
+   whoever installed the font on the system.
+
+   So, our first attempt is to look for a FONT property, and then verify that
+   the name there is a valid name by running XListFonts on it.  There's still
+   the potential that this could be true but we could still be being lied to,
+   but that seems pretty remote.
+
+     Late breaking news: I've gotten reports that SunOS 4.1.3U1
+     with OpenWound 3.0 has a font whose truename is really
+     "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1"
+     but whose FONT property contains "Courier".
+
+     So we disbelieve the FONT property unless it begins with a dash and
+     is more than 30 characters long.  X Windows: The defacto substandard.
+     X Windows: Complex nonsolutions to simple nonproblems.  X Windows:
+     Live the nightmare.
+
+   If the FONT property doesn't exist, then we try and construct an XLFD name
+   out of the other font properties (FOUNDRY, FAMILY_NAME, WEIGHT_NAME, etc).
+   This is necessary at least for some versions of OpenWound.  But who knows
+   what the future will bring.
+
+   If that doesn't work, then we use XListFonts and either take the first font
+   (which I think is the most sensible thing) or we find the lexicographically
+   least, depending on whether the preprocessor constant `XOPENFONT_SORTS' is
+   defined.  This sucks because the two behaviors are a property of the server
+   being used, not the architecture on which emacs has been compiled.  Also,
+   as I described above, sorting isn't ALWAYS what the server does.  Really it
+   does something seemingly random.  There is no reliable way to win if the
+   FONT property isn't present.
+
+   Another possibility which I haven't bothered to implement would be to map
+   over all of the matching fonts and find the first one that has the same
+   character metrics as the font we already have loaded.  Even if this didn't
+   return exactly the same font, it would at least return one whose characters
+   were the same sizes, which would probably be good enough.
+
+   More late-breaking news: on RS/6000 AIX 3.2.4, the expression
+        XLoadQueryFont (dpy, "-*-Fixed-Medium-R-*-*-*-130-75-75-*-*-ISO8859-1")
+   actually returns the font
+        -Misc-Fixed-Medium-R-Normal--13-120-75-75-C-80-ISO8859-1
+   which is crazy, because that font doesn't even match that pattern!  It is
+   also not included in the output produced by `xlsfonts' with that pattern.
+
+   So this is yet another example of XListFonts() and XOpenFont() using
+   completely different algorithms.  This, however, is a goofier example of
+   this bug, because in this case, it's not just the search order that is 
+   different -- the sets don't even intersect.
+
+   If anyone has any better ideas how to do this, or any insights on what it is
+   that the various servers are actually doing, please let me know!  -- jwz. */
+
+static int
+valid_x_font_name_p (Display *dpy, char *name)
+{
+  /* Maybe this should be implemented by callign XLoadFont and trapping
+     the error.  That would be a lot of work, and wasteful as hell, but
+     might be more correct.
+   */
+  int nnames = 0;
+  char **names = 0;
+  if (! name)
+    return 0;
+  names = XListFonts (dpy, name, 1, &nnames);
+  if (names)
+    XFreeFontNames (names);
+  return (nnames != 0);
+}
+
+static char *
+truename_via_FONT_prop (Display *dpy, XFontStruct *font)
+{
+  unsigned long value = 0;
+  char *result = 0;
+  if (XGetFontProperty (font, XA_FONT, &value))
+    result = XGetAtomName (dpy, value);
+  /* result is now 0, or the string value of the FONT property. */
+  if (result)
+    {
+      /* Verify that result is an XLFD name (roughly...) */
+      if (result [0] != '-' || strlen (result) < (unsigned int) 30)
+	{
+	  XFree (result);
+	  result = 0;
+	}
+    }
+  return result;	/* this must be freed by caller if non-0 */
+}
+
+static char *
+truename_via_random_props (Display *dpy, XFontStruct *font)
+{
+  struct device *d = get_device_from_display (dpy);
+  unsigned long value = 0;
+  char *foundry, *family, *weight, *slant, *setwidth, *add_style;
+  unsigned long pixel, point, res_x, res_y;
+  char *spacing;
+  unsigned long avg_width;
+  char *registry, *encoding;
+  char composed_name [2048];
+  int ok = 0;
+  char *result;
+
+#define get_string(atom,var)				\
+  if (XGetFontProperty (font, (atom), &value))		\
+    var = XGetAtomName (dpy, value);			\
+  else	{						\
+    var = 0;						\
+    goto FAIL; }
+#define get_number(atom,var)				\
+  if (!XGetFontProperty (font, (atom), &var) ||		\
+      var > 999)					\
+    goto FAIL;
+
+  foundry = family = weight = slant = setwidth = 0;
+  add_style = spacing = registry = encoding = 0;
+
+  get_string (DEVICE_XATOM_FOUNDRY (d), foundry);
+  get_string (DEVICE_XATOM_FAMILY_NAME (d), family);
+  get_string (DEVICE_XATOM_WEIGHT_NAME (d), weight);
+  get_string (DEVICE_XATOM_SLANT (d), slant);
+  get_string (DEVICE_XATOM_SETWIDTH_NAME (d), setwidth);
+  get_string (DEVICE_XATOM_ADD_STYLE_NAME (d), add_style);
+  get_number (DEVICE_XATOM_PIXEL_SIZE (d), pixel);
+  get_number (DEVICE_XATOM_POINT_SIZE (d), point);
+  get_number (DEVICE_XATOM_RESOLUTION_X (d), res_x);
+  get_number (DEVICE_XATOM_RESOLUTION_Y (d), res_y);
+  get_string (DEVICE_XATOM_SPACING (d), spacing);
+  get_number (DEVICE_XATOM_AVERAGE_WIDTH (d), avg_width);
+  get_string (DEVICE_XATOM_CHARSET_REGISTRY (d), registry);
+  get_string (DEVICE_XATOM_CHARSET_ENCODING (d), encoding);
+#undef get_number
+#undef get_string
+
+  sprintf (composed_name,
+	   "-%s-%s-%s-%s-%s-%s-%ld-%ld-%ld-%ld-%s-%ld-%s-%s",
+	   foundry, family, weight, slant, setwidth, add_style, pixel,
+	   point, res_x, res_y, spacing, avg_width, registry, encoding);
+  ok = 1;
+
+ FAIL:
+  if (ok)
+    {
+      int L = strlen (composed_name) + 1;
+      result = xmalloc (L);
+      strncpy (result, composed_name, L);
+    }
+  else
+    result = 0;
+
+  if (foundry) XFree (foundry);
+  if (family) XFree (family);
+  if (weight) XFree (weight);
+  if (slant) XFree (slant);
+  if (setwidth) XFree (setwidth);
+  if (add_style) XFree (add_style);
+  if (spacing) XFree (spacing);
+  if (registry) XFree (registry);
+  if (encoding) XFree (encoding);
+
+  return result;
+}
+
+/* Unbounded, for sufficiently small values of infinity... */
+#define MAX_FONT_COUNT 5000
+
+static char *
+truename_via_XListFonts (Display *dpy, char *font_name)
+{
+  char *result = 0;
+  char **names;
+  int count = 0;
+
+#ifndef XOPENFONT_SORTS
+  /* In a sensible world, the first font returned by XListFonts()
+     would be the font that XOpenFont() would use.  */
+  names = XListFonts (dpy, font_name, 1, &count);
+  if (count) result = names [0];
+#else
+  /* But the world I live in is much more perverse. */
+  names = XListFonts (dpy, font_name, MAX_FONT_COUNT, &count);
+  while (count--)
+    /* If names[count] is lexicographically less than result, use it.
+       (#### Should we be comparing case-insensitively?) */
+    if (result == 0 || (strcmp (result, names [count]) < 0))
+      result = names [count];
+#endif
+
+  if (result)
+    result = xstrdup (result);
+  if (names)
+    XFreeFontNames (names);
+
+  return result;	/* this must be freed by caller if non-0 */
+}
+
+static Lisp_Object
+x_font_truename (Display *dpy, char *name, XFontStruct *font)
+{
+  char *truename_FONT = 0;
+  char *truename_random = 0;
+  char *truename = 0;
+  
+  /* The search order is:
+     - if FONT property exists, and is a valid name, return it.
+     - if the other props exist, and add up to a valid name, return it.
+     - if we find a matching name with XListFonts, return it.
+     - if FONT property exists, return it regardless.
+     - if other props exist, return the resultant name regardless.
+     - else return 0.
+   */
+
+  truename = truename_FONT = truename_via_FONT_prop (dpy, font);
+  if (truename && !valid_x_font_name_p (dpy, truename))
+    truename = 0;
+  if (!truename)
+    truename = truename_random = truename_via_random_props (dpy, font);
+  if (truename && !valid_x_font_name_p (dpy, truename))
+    truename = 0;
+  if (!truename && name)
+    truename = truename_via_XListFonts (dpy, name);
+
+  if (!truename)
+    {
+      /* Gag - we weren't able to find a seemingly-valid truename.
+	 Well, maybe we're on one of those braindead systems where
+	 XListFonts() and XLoadFont() are in violent disagreement.
+	 If we were able to compute a truename, try using that even
+	 if evidence suggests that it's not a valid name - because
+	 maybe it is, really, and that's better than nothing.
+	 X Windows: You'll envy the dead.
+       */
+      if (truename_FONT)
+	truename = truename_FONT;
+      else if (truename_random)
+	truename = truename_random;
+    }
+
+  /* One or both of these are not being used - free them. */
+  if (truename_FONT && truename_FONT != truename)
+    XFree (truename_FONT);
+  if (truename_random && truename_random != truename)
+    XFree (truename_random);
+
+  if (truename)
+    {
+      Lisp_Object result = build_string (truename);
+      xfree (truename);
+      return result;
+    }
+  else
+    return Qnil;
+}
+
+static Lisp_Object
+x_font_instance_truename (struct Lisp_Font_Instance *f, Error_behavior errb)
+{
+  struct device *d = XDEVICE (f->device);
+
+  if (NILP (FONT_INSTANCE_X_TRUENAME (f)))
+    {
+      Display *dpy = DEVICE_X_DISPLAY (d);
+      char *name =
+	(char *) string_data (XSTRING (f->name));
+      {
+	FONT_INSTANCE_X_TRUENAME (f) =
+	  x_font_truename (dpy, name, FONT_INSTANCE_X_FONT (f));
+      }
+      if (NILP (FONT_INSTANCE_X_TRUENAME (f)))
+	{
+	  Lisp_Object font_instance = Qnil;
+	  XSETFONT_INSTANCE (font_instance, f);
+
+	  maybe_signal_simple_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 (FONT_INSTANCE_X_TRUENAME (f));
+}
+
+static Lisp_Object
+x_font_instance_properties (struct Lisp_Font_Instance *f)
+{
+  struct device *d = XDEVICE (f->device);
+  int i;
+  Lisp_Object result = Qnil;
+  XFontProp *props;
+  Display *dpy;
+  
+  dpy = DEVICE_X_DISPLAY (d);
+  props = FONT_INSTANCE_X_FONT (f)->properties;
+  for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--)
+    {
+      char *name_str = 0;
+      char *val_str = 0;
+      Lisp_Object name, value;
+      Atom atom = props [i].name;
+      name_str = XGetAtomName (dpy, atom);
+      name = (name_str ? intern (name_str) : Qnil);
+      if (name_str &&
+	  (atom == XA_FONT ||
+	   atom == DEVICE_XATOM_FOUNDRY (d) ||
+	   atom == DEVICE_XATOM_FAMILY_NAME (d) ||
+	   atom == DEVICE_XATOM_WEIGHT_NAME (d) ||
+	   atom == DEVICE_XATOM_SLANT (d) ||
+	   atom == DEVICE_XATOM_SETWIDTH_NAME (d) ||
+	   atom == DEVICE_XATOM_ADD_STYLE_NAME (d) ||
+	   atom == DEVICE_XATOM_SPACING (d) ||
+	   atom == DEVICE_XATOM_CHARSET_REGISTRY (d) ||
+	   atom == DEVICE_XATOM_CHARSET_ENCODING (d) ||
+	   !strcmp (name_str, "CHARSET_COLLECTIONS") ||
+	   !strcmp (name_str, "FONTNAME_REGISTRY") ||
+	   !strcmp (name_str, "CLASSIFICATION") ||
+	   !strcmp (name_str, "COPYRIGHT") ||
+	   !strcmp (name_str, "DEVICE_FONT_NAME") ||
+	   !strcmp (name_str, "FULL_NAME") ||
+	   !strcmp (name_str, "MONOSPACED") ||
+	   !strcmp (name_str, "QUALITY") ||
+	   !strcmp (name_str, "RELATIVE_SET") ||
+	   !strcmp (name_str, "RELATIVE_WEIGHT") ||
+	   !strcmp (name_str, "STYLE")))
+	{
+	  val_str = XGetAtomName (dpy, props [i].card32);
+	  value = (val_str ? build_string (val_str) : Qnil);
+	}
+      else
+	value = make_int (props [i].card32);
+      if (name_str) XFree (name_str);
+      result = Fcons (Fcons (name, value), result);
+    }
+  return result;
+}
+
+static Lisp_Object
+x_list_fonts (Lisp_Object pattern, Lisp_Object device)
+{
+  char **names;
+  int count = 0;
+  Lisp_Object result = Qnil;
+  CONST char *patternext;
+
+  GET_C_STRING_BINARY_DATA_ALLOCA (pattern, patternext);
+  
+  names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)),
+		      patternext, MAX_FONT_COUNT, &count);
+  while (count--)
+    result = Fcons (build_ext_string (names [count], FORMAT_BINARY), result);
+  if (names)
+    XFreeFontNames (names);
+  return result;
+}
+
+
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+
+void
+syms_of_objects_x (void)
+{
+}
+
+void
+console_type_create_objects_x (void)
+{
+  /* object methods */
+
+  CONSOLE_HAS_METHOD (x, initialize_color_instance);
+  CONSOLE_HAS_METHOD (x, print_color_instance);
+  CONSOLE_HAS_METHOD (x, finalize_color_instance);
+  CONSOLE_HAS_METHOD (x, color_instance_equal);
+  CONSOLE_HAS_METHOD (x, color_instance_hash);
+  CONSOLE_HAS_METHOD (x, color_instance_rgb_components);
+  CONSOLE_HAS_METHOD (x, valid_color_name_p);
+
+  CONSOLE_HAS_METHOD (x, initialize_font_instance);
+  CONSOLE_HAS_METHOD (x, mark_font_instance);
+  CONSOLE_HAS_METHOD (x, print_font_instance);
+  CONSOLE_HAS_METHOD (x, finalize_font_instance);
+  CONSOLE_HAS_METHOD (x, font_instance_truename);
+  CONSOLE_HAS_METHOD (x, font_instance_properties);
+  CONSOLE_HAS_METHOD (x, list_fonts);
+}
+
+void
+vars_of_objects_x (void)
+{
+  DEFVAR_BOOL ("x-handle-non-fully-specified-fonts",&handle_nonfull_spec_fonts /*
+If this is true then fonts which do not have all characters specified
+will be considered to be proportional width even if they are actually
+fixed-width.  If this is not done then characters which are supposed to
+have 0 width may appear to actually have some width.
+
+Note:  While setting this to t guarantees correct output in all
+circumstances, it also causes a noticeable performance hit when using
+fixed-width fonts.  Since most people don't use characters which could
+cause problems this is set to nil by default.
+*/ );
+  handle_nonfull_spec_fonts = 0;
+}
+
+
+void
+Xatoms_of_objects_x (struct device *d)
+{
+#define ATOM(x) XInternAtom (DEVICE_X_DISPLAY (d), (x), False)
+
+  DEVICE_XATOM_FOUNDRY (d) = ATOM ("FOUNDRY");
+  DEVICE_XATOM_FAMILY_NAME (d) = ATOM ("FAMILY_NAME");
+  DEVICE_XATOM_WEIGHT_NAME (d) = ATOM ("WEIGHT_NAME");
+  DEVICE_XATOM_SLANT (d) = ATOM ("SLANT");
+  DEVICE_XATOM_SETWIDTH_NAME (d) = ATOM ("SETWIDTH_NAME");
+  DEVICE_XATOM_ADD_STYLE_NAME (d) = ATOM ("ADD_STYLE_NAME");
+  DEVICE_XATOM_PIXEL_SIZE (d) = ATOM ("PIXEL_SIZE");
+  DEVICE_XATOM_POINT_SIZE (d) = ATOM ("POINT_SIZE");
+  DEVICE_XATOM_RESOLUTION_X (d) = ATOM ("RESOLUTION_X");
+  DEVICE_XATOM_RESOLUTION_Y (d) = ATOM ("RESOLUTION_Y");
+  DEVICE_XATOM_SPACING (d) = ATOM ("SPACING");
+  DEVICE_XATOM_AVERAGE_WIDTH (d) = ATOM ("AVERAGE_WIDTH");
+  DEVICE_XATOM_CHARSET_REGISTRY (d) = ATOM ("CHARSET_REGISTRY");
+  DEVICE_XATOM_CHARSET_ENCODING (d) = ATOM ("CHARSET_ENCODING");
+}