Add changes to lisp/url/ChangeLog omitted from 2011-04-02T23:41:03Z!cyd@stupidchicken...
[bpt/emacs.git] / src / xfont.c
index 67cb6e5..3e0fcd2 100644 (file)
@@ -1,6 +1,6 @@
 /* xfont.c -- X core font driver.
 /* xfont.c -- X core font driver.
-   Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
-   Copyright (C) 2006, 2007, 2008
+   Copyright (C) 2006-2011 Free Software Foundation, Inc.
+   Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
      National Institute of Advanced Industrial Science and Technology (AIST)
      Registration Number H13PRO009
 
      National Institute of Advanced Industrial Science and Technology (AIST)
      Registration Number H13PRO009
 
@@ -21,7 +21,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include <config.h>
 #include <stdio.h>
 
 #include <config.h>
 #include <stdio.h>
-#include <stdlib.h>
+#include <setjmp.h>
 #include <X11/Xlib.h>
 
 #include "lisp.h"
 #include <X11/Xlib.h>
 
 #include "lisp.h"
@@ -46,18 +46,15 @@ struct xfont_info
 };
 
 /* Prototypes of support functions.  */
 };
 
 /* Prototypes of support functions.  */
-extern void x_clear_errors P_ ((Display *));
+extern void x_clear_errors (Display *);
 
 
-static XCharStruct *xfont_get_pcm P_ ((XFontStruct *, XChar2b *));
-static void xfont_find_ccl_program P_ ((struct font *));
+static XCharStruct *xfont_get_pcm (XFontStruct *, XChar2b *);
 
 /* Get metrics of character CHAR2B in XFONT.  Value is null if CHAR2B
    is not contained in the font.  */
 
 static XCharStruct *
 
 /* Get metrics of character CHAR2B in XFONT.  Value is null if CHAR2B
    is not contained in the font.  */
 
 static XCharStruct *
-xfont_get_pcm (xfont, char2b)
-     XFontStruct *xfont;
-     XChar2b *char2b;
+xfont_get_pcm (XFontStruct *xfont, XChar2b *char2b)
 {
   /* The result metric information.  */
   XCharStruct *pcm = NULL;
 {
   /* The result metric information.  */
   XCharStruct *pcm = NULL;
@@ -119,55 +116,19 @@ xfont_get_pcm (xfont, char2b)
          ? NULL : pcm);
 }
 
          ? NULL : pcm);
 }
 
-/* Find a CCL program for a font specified by FONTP, and set the member
- `encoder' of the structure.  */
-
-static void
-xfont_find_ccl_program (font)
-     struct font *font;
-{
-  Lisp_Object list, elt;
-
-  elt = Qnil;
-  for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCDR (list))
-    {
-      elt = XCAR (list);
-      if (CONSP (elt)
-         && STRINGP (XCAR (elt))
-         && ((fast_string_match_ignore_case (XCAR (elt),
-                                             font->props[FONT_NAME_INDEX])
-              >= 0)
-             || (fast_string_match_ignore_case (XCAR (elt),
-                                                font->props[FONT_FULLNAME_INDEX])
-                 >= 0)))
-       break;
-    }
-
-  if (! NILP (list))
-    {
-      struct ccl_program *ccl
-       = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
-
-      if (setup_ccl_program (ccl, XCDR (elt)) < 0)
-       xfree (ccl);
-      else
-       font->font_encoder = ccl;
-    }
-}
-
-static Lisp_Object xfont_get_cache P_ ((FRAME_PTR));
-static Lisp_Object xfont_list P_ ((Lisp_Object, Lisp_Object));
-static Lisp_Object xfont_match P_ ((Lisp_Object, Lisp_Object));
-static Lisp_Object xfont_list_family P_ ((Lisp_Object));
-static Lisp_Object xfont_open P_ ((FRAME_PTR, Lisp_Object, int));
-static void xfont_close P_ ((FRAME_PTR, struct font *));
-static int xfont_prepare_face P_ ((FRAME_PTR, struct face *));
-static int xfont_has_char P_ ((Lisp_Object, int));
-static unsigned xfont_encode_char P_ ((struct font *, int));
-static int xfont_text_extents P_ ((struct font *, unsigned *, int,
-                                  struct font_metrics *));
-static int xfont_draw P_ ((struct glyph_string *, int, int, int, int, int));
-static int xfont_check P_ ((FRAME_PTR, struct font *));
+static Lisp_Object xfont_get_cache (FRAME_PTR);
+static Lisp_Object xfont_list (Lisp_Object, Lisp_Object);
+static Lisp_Object xfont_match (Lisp_Object, Lisp_Object);
+static Lisp_Object xfont_list_family (Lisp_Object);
+static Lisp_Object xfont_open (FRAME_PTR, Lisp_Object, int);
+static void xfont_close (FRAME_PTR, struct font *);
+static int xfont_prepare_face (FRAME_PTR, struct face *);
+static int xfont_has_char (Lisp_Object, int);
+static unsigned xfont_encode_char (struct font *, int);
+static int xfont_text_extents (struct font *, unsigned *, int,
+                               struct font_metrics *);
+static int xfont_draw (struct glyph_string *, int, int, int, int, int);
+static int xfont_check (FRAME_PTR, struct font *);
 
 struct font_driver xfont_driver =
   {
 
 struct font_driver xfont_driver =
   {
@@ -187,40 +148,220 @@ struct font_driver xfont_driver =
     xfont_text_extents,
     xfont_draw,
     NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
     xfont_text_extents,
     xfont_draw,
     NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
-    xfont_check
+    xfont_check,
+    NULL, /* get_variation_glyphs */
+    NULL, /* filter_properties */
   };
 
   };
 
-extern Lisp_Object QCname;
-
 static Lisp_Object
 static Lisp_Object
-xfont_get_cache (f)
-     FRAME_PTR f;
+xfont_get_cache (FRAME_PTR f)
 {
   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
 
   return (dpyinfo->name_list_element);
 }
 
 {
   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
 
   return (dpyinfo->name_list_element);
 }
 
-extern Lisp_Object Vface_alternative_font_registry_alist;
-
 static int
 compare_font_names (const void *name1, const void *name2)
 {
 static int
 compare_font_names (const void *name1, const void *name2)
 {
-  return xstrcasecmp (*(const unsigned char **) name1,
-                     *(const unsigned char **) name2);
+  return xstrcasecmp (*(const char **) name1,
+                     *(const char **) name2);
+}
+
+/* Decode XLFD as iso-8859-1 into OUTPUT, and return the byte length
+   of the decoding result.  LEN is the byte length of XLFD, or -1 if
+   XLFD is NULL terminated.  The caller must assure that OUTPUT is at
+   least twice (plus 1) as large as XLFD.  */
+
+static int
+xfont_decode_coding_xlfd (char *xlfd, int len, char *output)
+{
+  char *p0 = xlfd, *p1 = output;
+  int c;
+
+  while (*p0)
+    {
+      c = *(unsigned char *) p0++;
+      p1 += CHAR_STRING (c, (unsigned char *) p1);
+      if (--len == 0)
+       break;
+    }
+  *p1 = 0;
+  return (p1 - output);
 }
 
 }
 
-static Lisp_Object xfont_list_pattern P_ ((Lisp_Object, Display *, char *));
+/* Encode XLFD from UTF-8 to iso-8859-1 destructively, and return the
+   resulting byte length.  If XLFD contains unencodable character,
+   return -1.  */
+
+static int
+xfont_encode_coding_xlfd (char *xlfd)
+{
+  const unsigned char *p0 = (unsigned char *) xlfd;
+  unsigned char *p1 = (unsigned char *) xlfd;
+  int len = 0;
+
+  while (*p0)
+    {
+      int c = STRING_CHAR_ADVANCE (p0);
+
+      if (c >= 0x100)
+       return -1;
+      *p1++ = c;
+      len++;
+    }
+  *p1 = 0;
+  return len;
+}
+
+/* Check if CHARS (cons or vector) is supported by XFONT whose
+   encoding charset is ENCODING (XFONT is NULL) or by a font whose
+   registry corresponds to ENCODING and REPERTORY.
+   Return 1 if supported, return 0 otherwise.  */
+
+static int
+xfont_chars_supported (Lisp_Object chars, XFontStruct *xfont,
+                      struct charset *encoding, struct charset *repertory)
+{
+  struct charset *charset = repertory ? repertory : encoding;
+
+  if (CONSP (chars))
+    {
+      for (; CONSP (chars); chars = XCDR (chars))
+       {
+         int c = XINT (XCAR (chars));
+         unsigned code = ENCODE_CHAR (charset, c);
+         XChar2b char2b;
+
+         if (code == CHARSET_INVALID_CODE (charset))
+           break;
+         if (! xfont)
+           continue;
+         if (code >= 0x10000)
+           break;
+         char2b.byte1 = code >> 8;
+         char2b.byte2 = code & 0xFF;
+         if (! xfont_get_pcm (xfont, &char2b))
+           break;
+       }
+      return (NILP (chars));
+    }
+  else if (VECTORP (chars))
+    {
+      int i;
+
+      for (i = ASIZE (chars) - 1; i >= 0; i--)
+       {
+         int c = XINT (AREF (chars, i));
+         unsigned code = ENCODE_CHAR (charset, c);
+         XChar2b char2b;
+
+         if (code == CHARSET_INVALID_CODE (charset))
+           continue;
+         if (! xfont)
+           break;
+         if (code >= 0x10000)
+           continue;
+         char2b.byte1 = code >> 8;
+         char2b.byte2 = code & 0xFF;
+         if (xfont_get_pcm (xfont, &char2b))
+           break;
+       }
+      return (i >= 0);
+    }
+  return 0;
+}
+
+/* A hash table recoding which font supports which scritps.  Each key
+   is a vector of characteristic font propertis FOUNDRY to WIDTH and
+   ADDSTYLE, and each value is a list of script symbols.
+
+   We assume that fonts that have the same value in the above
+   properties supports the same set of characters on all displays.  */
+
+static Lisp_Object xfont_scripts_cache;
+
+/* Re-usable vector to store characteristic font properites.   */
+static Lisp_Object xfont_scratch_props;
+
+/* Return a list of scripts supported by the font of FONTNAME whose
+   characteristic properties are in PROPS and whose encoding charset
+   is ENCODING.  A caller must call BLOCK_INPUT in advance.  */
 
 static Lisp_Object
 
 static Lisp_Object
-xfont_list_pattern (frame, display, pattern)
-     Lisp_Object frame;
-     Display *display;
-     char *pattern;
+xfont_supported_scripts (Display *display, char *fontname, Lisp_Object props,
+                        struct charset *encoding)
+{
+  Lisp_Object scripts;
+
+  /* Two special cases to avoid opening rather big fonts.  */
+  if (EQ (AREF (props, 2), Qja))
+    return Fcons (intern ("kana"), Fcons (intern ("han"), Qnil));
+  if (EQ (AREF (props, 2), Qko))
+    return Fcons (intern ("hangul"), Qnil);
+  scripts = Fgethash (props, xfont_scripts_cache, Qt);
+  if (EQ (scripts, Qt))
+    {
+      XFontStruct *xfont;
+      Lisp_Object val;
+
+      scripts = Qnil;
+      xfont = XLoadQueryFont (display, fontname);
+      if (xfont)
+       {
+         if (xfont->per_char)
+           {
+             for (val = Vscript_representative_chars; CONSP (val);
+                  val = XCDR (val))
+               if (CONSP (XCAR (val)) && SYMBOLP (XCAR (XCAR (val))))
+                 {
+                   Lisp_Object script = XCAR (XCAR (val));
+                   Lisp_Object chars = XCDR (XCAR (val));
+
+                   if (xfont_chars_supported (chars, xfont, encoding, NULL))
+                     scripts = Fcons (script, scripts);
+                 }
+           }
+         XFreeFont (display, xfont);
+       }
+      if (EQ (AREF (props, 3), Qiso10646_1)
+         && NILP (Fmemq (Qlatin, scripts)))
+       scripts = Fcons (Qlatin, scripts);
+      Fputhash (Fcopy_sequence (props), scripts, xfont_scripts_cache);
+    }
+  return scripts;
+}
+
+static Lisp_Object
+xfont_list_pattern (Display *display, const char *pattern,
+                   Lisp_Object registry, Lisp_Object script)
 {
   Lisp_Object list = Qnil;
 {
   Lisp_Object list = Qnil;
+  Lisp_Object chars = Qnil;
+  struct charset *encoding, *repertory = NULL;
   int i, limit, num_fonts;
   char **names;
   int i, limit, num_fonts;
   char **names;
+  /* Large enough to decode the longest XLFD (255 bytes). */
+  char buf[512];
+
+  if (! NILP (registry)
+      && font_registry_charsets (registry, &encoding, &repertory) < 0)
+    /* Unknown REGISTRY, not supported.  */
+    return Qnil;
+  if (! NILP (script))
+    {
+      chars = assq_no_quit (script, Vscript_representative_chars);
+      if (NILP (chars))
+       /* We can't tell whether or not a font supports SCRIPT.  */
+       return Qnil;
+      chars = XCDR (chars);
+      if (repertory)
+       {
+         if (! xfont_chars_supported (chars, NULL, encoding, repertory))
+           return Qnil;
+         script = Qnil;
+       }
+    }
 
   BLOCK_INPUT;
   x_catch_errors (display);
 
   BLOCK_INPUT;
   x_catch_errors (display);
@@ -244,7 +385,11 @@ xfont_list_pattern (frame, display, pattern)
   if (num_fonts > 0)
     {
       char **indices = alloca (sizeof (char *) * num_fonts);
   if (num_fonts > 0)
     {
       char **indices = alloca (sizeof (char *) * num_fonts);
+      Lisp_Object *props = XVECTOR (xfont_scratch_props)->contents;
+      Lisp_Object scripts = Qnil;
 
 
+      for (i = 0; i < ASIZE (xfont_scratch_props); i++)
+       props[i] = Qnil;
       for (i = 0; i < num_fonts; i++)
        indices[i] = names[i];
       qsort (indices, num_fonts, sizeof (char *), compare_font_names);
       for (i = 0; i < num_fonts; i++)
        indices[i] = names[i];
       qsort (indices, num_fonts, sizeof (char *), compare_font_names);
@@ -252,43 +397,81 @@ xfont_list_pattern (frame, display, pattern)
       for (i = 0; i < num_fonts; i++)
        {
          Lisp_Object entity;
       for (i = 0; i < num_fonts; i++)
        {
          Lisp_Object entity;
-         int result;
 
          if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0)
            continue;
 
          if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0)
            continue;
-
          entity = font_make_entity ();
          entity = font_make_entity ();
+         xfont_decode_coding_xlfd (indices[i], -1, buf);
+         if (font_parse_xlfd (buf, entity) < 0)
+           continue;
          ASET (entity, FONT_TYPE_INDEX, Qx);
          ASET (entity, FONT_TYPE_INDEX, Qx);
-
-         result = font_parse_xlfd (indices[i], entity);
-         if (result < 0)
+         /* Avoid auto-scaled fonts.  */
+         if (INTEGERP (AREF (entity, FONT_DPI_INDEX))
+             && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
+             && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
+             && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0)
+           continue;
+         /* Avoid not-allowed scalable fonts.  */
+         if (NILP (Vscalable_fonts_allowed))
            {
            {
-             /* This may be an alias name.  Try to get the full XLFD name
-                from XA_FONT property of the font.  */
-             XFontStruct *font = XLoadQueryFont (display, indices[i]);
-             unsigned long value;
+             int size = 0;
 
 
-             if (! font)
+             if (INTEGERP (AREF (entity, FONT_SIZE_INDEX)))
+               size = XINT (AREF (entity, FONT_SIZE_INDEX));
+             else if (FLOATP (AREF (entity, FONT_SIZE_INDEX)))
+               size = XFLOAT_DATA (AREF (entity, FONT_SIZE_INDEX));
+             if (size == 0)
                continue;
                continue;
-             if (XGetFontProperty (font, XA_FONT, &value))
+           }
+         else if (CONSP (Vscalable_fonts_allowed))
+           {
+             Lisp_Object tail, elt;
+
+             for (tail = Vscalable_fonts_allowed; CONSP (tail);
+                  tail = XCDR (tail))
                {
                {
-                 char *name = (char *) XGetAtomName (display, (Atom) value);
-                 int len = strlen (name);
-
-                 /* If DXPC (a Differential X Protocol Compressor)
-                    Ver.3.7 is running, XGetAtomName will return null
-                    string.  We must avoid such a name.  */
-                 if (len > 0)
-                   result = font_parse_xlfd (name, entity);
-                 XFree (name);
+                 elt = XCAR (tail);
+                 if (STRINGP (elt)
+                     && fast_c_string_match_ignore_case (elt, indices[i]) >= 0)
+                   break;
                }
                }
-             XFreeFont (display, font);
+             if (! CONSP (tail))
+               continue;
            }
 
            }
 
-         if (result == 0
-             /* Avoid auto-scaled fonts.  */
-             && (XINT (AREF (entity, FONT_DPI_INDEX)) == 0
-                 || XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) > 0))
+         /* Avoid fonts of invalid registry.  */
+         if (NILP (AREF (entity, FONT_REGISTRY_INDEX)))
+           continue;
+
+         /* Update encoding and repertory if necessary.  */
+         if (! EQ (registry, AREF (entity, FONT_REGISTRY_INDEX)))
+           {
+             registry = AREF (entity, FONT_REGISTRY_INDEX);
+             if (font_registry_charsets (registry, &encoding, &repertory) < 0)
+               encoding = NULL;
+           }
+         if (! encoding)
+           /* Unknown REGISTRY, not supported.  */
+           continue;
+         if (repertory)
+           {
+             if (NILP (script)
+                 || xfont_chars_supported (chars, NULL, encoding, repertory))
+               list = Fcons (entity, list);
+             continue;
+           }
+         if (memcmp (props, &(AREF (entity, FONT_FOUNDRY_INDEX)),
+                     sizeof (Lisp_Object) * 7)
+             || ! EQ (AREF (entity, FONT_SPACING_INDEX), props[7]))
+           {
+             memcpy (props, &(AREF (entity, FONT_FOUNDRY_INDEX)),
+                     sizeof (Lisp_Object) * 7);
+             props[7] = AREF (entity, FONT_SPACING_INDEX);
+             scripts = xfont_supported_scripts (display, indices[i],
+                                                xfont_scratch_props, encoding);
+           }
+         if (NILP (script)
+             || ! NILP (Fmemq (script, scripts)))
            list = Fcons (entity, list);
        }
       XFreeFontNames (names);
            list = Fcons (entity, list);
        }
       XFreeFontNames (names);
@@ -297,27 +480,24 @@ xfont_list_pattern (frame, display, pattern)
   x_uncatch_errors ();
   UNBLOCK_INPUT;
 
   x_uncatch_errors ();
   UNBLOCK_INPUT;
 
-  font_add_log ("xfont-list", build_string (pattern), list);
+  FONT_ADD_LOG ("xfont-list", build_string (pattern), list);
   return list;
 }
 
 static Lisp_Object
   return list;
 }
 
 static Lisp_Object
-xfont_list (frame, spec)
-     Lisp_Object frame, spec;
+xfont_list (Lisp_Object frame, Lisp_Object spec)
 {
   FRAME_PTR f = XFRAME (frame);
   Display *display = FRAME_X_DISPLAY_INFO (f)->display;
 {
   FRAME_PTR f = XFRAME (frame);
   Display *display = FRAME_X_DISPLAY_INFO (f)->display;
-  Lisp_Object registry, list, val, extra;
+  Lisp_Object registry, list, val, extra, script;
   int len;
   int len;
-  char name[256];
-  
+  /* Large enough to contain the longest XLFD (255 bytes) in UTF-8.  */
+  char name[512];
+
   extra = AREF (spec, FONT_EXTRA_INDEX);
   if (CONSP (extra))
     {
       val = assq_no_quit (QCotf, extra);
   extra = AREF (spec, FONT_EXTRA_INDEX);
   if (CONSP (extra))
     {
       val = assq_no_quit (QCotf, extra);
-      if (! NILP (val))
-       return Qnil;
-      val = assq_no_quit (QCscript, extra);
       if (! NILP (val))
        return Qnil;
       val = assq_no_quit (QClang, extra);
       if (! NILP (val))
        return Qnil;
       val = assq_no_quit (QClang, extra);
@@ -326,11 +506,13 @@ xfont_list (frame, spec)
     }
 
   registry = AREF (spec, FONT_REGISTRY_INDEX);
     }
 
   registry = AREF (spec, FONT_REGISTRY_INDEX);
-  len = font_unparse_xlfd (spec, 0, name, 256);
-  ASET (spec, FONT_REGISTRY_INDEX, registry);
-  if (len < 0)
+  len = font_unparse_xlfd (spec, 0, name, 512);
+  if (len < 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
     return Qnil;
     return Qnil;
-  list = xfont_list_pattern (frame, display, name);
+
+  val = assq_no_quit (QCscript, extra);
+  script = CDR (val);
+  list = xfont_list_pattern (display, name, registry, script);
   if (NILP (list) && NILP (registry))
     {
       /* Try iso10646-1 */
   if (NILP (list) && NILP (registry))
     {
       /* Try iso10646-1 */
@@ -339,7 +521,7 @@ xfont_list (frame, spec)
       if (r - name + 10 < 256) /* 10 == strlen (iso10646-1) */
        {
          strcpy (r, "iso10646-1");
       if (r - name + 10 < 256) /* 10 == strlen (iso10646-1) */
        {
          strcpy (r, "iso10646-1");
-         list = xfont_list_pattern (frame, display, name);
+         list = xfont_list_pattern (display, name, Qiso10646_1, script);
        }
     }
   if (NILP (list) && ! NILP (registry))
        }
     }
   if (NILP (list) && ! NILP (registry))
@@ -358,8 +540,8 @@ xfont_list (frame, spec)
            if (STRINGP (XCAR (alter))
                && ((r - name) + SBYTES (XCAR (alter))) < 256)
              {
            if (STRINGP (XCAR (alter))
                && ((r - name) + SBYTES (XCAR (alter))) < 256)
              {
-               strcpy (r, (char *) SDATA (XCAR (alter)));
-               list = xfont_list_pattern (frame, display, name);
+               strcpy (r, SSDATA (XCAR (alter)));
+               list = xfont_list_pattern (display, name, registry, script);
                if (! NILP (list))
                  break;
              }
                if (! NILP (list))
                  break;
              }
@@ -369,21 +551,25 @@ xfont_list (frame, spec)
     {
       /* Try alias.  */
       val = assq_no_quit (QCname, AREF (spec, FONT_EXTRA_INDEX));
     {
       /* Try alias.  */
       val = assq_no_quit (QCname, AREF (spec, FONT_EXTRA_INDEX));
-      if (CONSP (val) && STRINGP (XCDR (val)))
-       list = xfont_list_pattern (frame, display, (char *) SDATA (XCDR (val)));
+      if (CONSP (val) && STRINGP (XCDR (val)) && SBYTES (XCDR (val)) < 512)
+       {
+         memcpy (name, SDATA (XCDR (val)), SBYTES (XCDR (val)) + 1);
+         if (xfont_encode_coding_xlfd (name) < 0)
+           return Qnil;
+         list = xfont_list_pattern (display, name, registry, script);
+       }
     }
 
   return list;
 }
 
 static Lisp_Object
     }
 
   return list;
 }
 
 static Lisp_Object
-xfont_match (frame, spec)
-     Lisp_Object frame, spec;
+xfont_match (Lisp_Object frame, Lisp_Object spec)
 {
   FRAME_PTR f = XFRAME (frame);
   Display *display = FRAME_X_DISPLAY_INFO (f)->display;
   Lisp_Object extra, val, entity;
 {
   FRAME_PTR f = XFRAME (frame);
   Display *display = FRAME_X_DISPLAY_INFO (f)->display;
   Lisp_Object extra, val, entity;
-  char buf[256], *name;
+  char name[512];
   XFontStruct *xfont;
   unsigned long value;
 
   XFontStruct *xfont;
   unsigned long value;
 
@@ -391,12 +577,15 @@ xfont_match (frame, spec)
   val = assq_no_quit (QCname, extra);
   if (! CONSP (val) || ! STRINGP (XCDR (val)))
     {
   val = assq_no_quit (QCname, extra);
   if (! CONSP (val) || ! STRINGP (XCDR (val)))
     {
-      if (font_unparse_xlfd (spec, 0, buf, 256) < 0)
+      if (font_unparse_xlfd (spec, 0, name, 512) < 0)
        return Qnil;
        return Qnil;
-      name = buf;
     }
     }
+  else if (SBYTES (XCDR (val)) < 512)
+    memcpy (name, SDATA (XCDR (val)), SBYTES (XCDR (val)) + 1);
   else
   else
-    name = (char *) SDATA (XCDR (val));
+    return Qnil;
+  if (xfont_encode_coding_xlfd (name) < 0)
+    return Qnil;
 
   BLOCK_INPUT;
   entity = Qnil;
 
   BLOCK_INPUT;
   entity = Qnil;
@@ -406,9 +595,10 @@ xfont_match (frame, spec)
       if (XGetFontProperty (xfont, XA_FONT, &value))
        {
          int len;
       if (XGetFontProperty (xfont, XA_FONT, &value))
        {
          int len;
+         char *s;
 
 
-         name = (char *) XGetAtomName (display, (Atom) value);
-         len = strlen (name);
+         s = (char *) XGetAtomName (display, (Atom) value);
+         len = strlen (s);
 
          /* If DXPC (a Differential X Protocol Compressor)
             Ver.3.7 is running, XGetAtomName will return null
 
          /* If DXPC (a Differential X Protocol Compressor)
             Ver.3.7 is running, XGetAtomName will return null
@@ -417,29 +607,29 @@ xfont_match (frame, spec)
            {
              entity = font_make_entity ();
              ASET (entity, FONT_TYPE_INDEX, Qx);
            {
              entity = font_make_entity ();
              ASET (entity, FONT_TYPE_INDEX, Qx);
+             xfont_decode_coding_xlfd (s, -1, name);
              if (font_parse_xlfd (name, entity) < 0)
                entity = Qnil;
            }
              if (font_parse_xlfd (name, entity) < 0)
                entity = Qnil;
            }
-         XFree (name);
+         XFree (s);
        }
       XFreeFont (display, xfont);
     }
   UNBLOCK_INPUT;
 
        }
       XFreeFont (display, xfont);
     }
   UNBLOCK_INPUT;
 
-  font_add_log ("xfont-match", spec, entity);
+  FONT_ADD_LOG ("xfont-match", spec, entity);
   return entity;
 }
 
 static Lisp_Object
   return entity;
 }
 
 static Lisp_Object
-xfont_list_family (frame)
-     Lisp_Object frame;
+xfont_list_family (Lisp_Object frame)
 {
   FRAME_PTR f = XFRAME (frame);
   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
   char **names;
   int num_fonts, i;
   Lisp_Object list;
 {
   FRAME_PTR f = XFRAME (frame);
   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
   char **names;
   int num_fonts, i;
   Lisp_Object list;
-  char *last_family;
+  char *last_family IF_LINT (= 0);
   int last_len;
 
   BLOCK_INPUT;
   int last_len;
 
   BLOCK_INPUT;
@@ -457,8 +647,9 @@ xfont_list_family (frame)
   list = Qnil;
   for (i = 0, last_len = 0; i < num_fonts; i++)
     {
   list = Qnil;
   for (i = 0, last_len = 0; i < num_fonts; i++)
     {
-      char *p0 = names[i], *p1;
+      char *p0 = names[i], *p1, buf[512];
       Lisp_Object family;
       Lisp_Object family;
+      int decoded_len;
 
       p0++;                    /* skip the leading '-' */
       while (*p0 && *p0 != '-') p0++; /* skip foundry */
 
       p0++;                    /* skip the leading '-' */
       while (*p0 && *p0 != '-') p0++; /* skip foundry */
@@ -469,11 +660,13 @@ xfont_list_family (frame)
       if (! *p1 || p1 == p0)
        continue;
       if (last_len == p1 - p0
       if (! *p1 || p1 == p0)
        continue;
       if (last_len == p1 - p0
-         && bcmp (last_family, p0, last_len) == 0)
+         && memcmp (last_family, p0, last_len) == 0)
        continue;
       last_len = p1 - p0;
       last_family = p0;
        continue;
       last_len = p1 - p0;
       last_family = p0;
-      family = font_intern_prop (p0, last_len, 1);
+
+      decoded_len = xfont_decode_coding_xlfd (p0, last_len, buf);
+      family = font_intern_prop (p0, decoded_len, 1);
       if (NILP (assq_no_quit (family, list)))
        list = Fcons (family, list);
     }
       if (NILP (assq_no_quit (family, list)))
        list = Fcons (family, list);
     }
@@ -485,17 +678,12 @@ xfont_list_family (frame)
   return list;
 }
 
   return list;
 }
 
-extern Lisp_Object QCavgwidth;
-
 static Lisp_Object
 static Lisp_Object
-xfont_open (f, entity, pixel_size)
-     FRAME_PTR f;
-     Lisp_Object entity;
-     int pixel_size;
+xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
 {
   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
   Display *display = dpyinfo->display;
 {
   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
   Display *display = dpyinfo->display;
-  char name[256];
+  char name[512];
   int len;
   unsigned long value;
   Lisp_Object registry;
   int len;
   unsigned long value;
   Lisp_Object registry;
@@ -503,14 +691,13 @@ xfont_open (f, entity, pixel_size)
   Lisp_Object font_object, fullname;
   struct font *font;
   XFontStruct *xfont;
   Lisp_Object font_object, fullname;
   struct font *font;
   XFontStruct *xfont;
-  int i;
 
   /* At first, check if we know how to encode characters for this
      font.  */
   registry = AREF (entity, FONT_REGISTRY_INDEX);
   if (font_registry_charsets (registry, &encoding, &repertory) < 0)
     {
 
   /* At first, check if we know how to encode characters for this
      font.  */
   registry = AREF (entity, FONT_REGISTRY_INDEX);
   if (font_registry_charsets (registry, &encoding, &repertory) < 0)
     {
-      font_add_log ("  x:unknown registry", registry, Qnil);
+      FONT_ADD_LOG ("  x:unknown registry", registry, Qnil);
       return Qnil;
     }
 
       return Qnil;
     }
 
@@ -523,10 +710,10 @@ xfont_open (f, entity, pixel_size)
       else
        pixel_size = 14;
     }
       else
        pixel_size = 14;
     }
-  len = font_unparse_xlfd (entity, pixel_size, name, 256);
-  if (len <= 0)
+  len = font_unparse_xlfd (entity, pixel_size, name, 512);
+  if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
     {
     {
-      font_add_log ("  x:unparse failed", entity, Qnil);
+      FONT_ADD_LOG ("  x:unparse failed", entity, Qnil);
       return Qnil;
     }
 
       return Qnil;
     }
 
@@ -554,10 +741,10 @@ xfont_open (f, entity, pixel_size)
 
       temp = Fcopy_font_spec (entity);
       ASET (temp, FONT_DPI_INDEX, Qnil);
 
       temp = Fcopy_font_spec (entity);
       ASET (temp, FONT_DPI_INDEX, Qnil);
-      len = font_unparse_xlfd (temp, pixel_size, name, 256);
-      if (len <= 0)
+      len = font_unparse_xlfd (temp, pixel_size, name, 512);
+      if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
        {
        {
-         font_add_log ("  x:unparse failed", temp, Qnil);
+         FONT_ADD_LOG ("  x:unparse failed", temp, Qnil);
          return Qnil;
        }
       xfont = XLoadQueryFont (display, name);
          return Qnil;
        }
       xfont = XLoadQueryFont (display, name);
@@ -576,7 +763,7 @@ xfont_open (f, entity, pixel_size)
       char *p0, *p;
       int dashes = 0;
 
       char *p0, *p;
       int dashes = 0;
 
-      p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);;
+      p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);
       /* Count the number of dashes in the "full name".
         If it is too few, this isn't really the font's full name,
         so don't use it.
       /* Count the number of dashes in the "full name".
         If it is too few, this isn't really the font's full name,
         so don't use it.
@@ -590,7 +777,10 @@ xfont_open (f, entity, pixel_size)
        }
 
       if (dashes >= 13)
        }
 
       if (dashes >= 13)
-       fullname = Fdowncase (make_unibyte_string (p0, p - p0));
+       {
+         len = xfont_decode_coding_xlfd (p0, -1, name);
+         fullname = Fdowncase (make_string (name, len));
+       }
       XFree (p0);
     }
   x_uncatch_errors ();
       XFree (p0);
     }
   x_uncatch_errors ();
@@ -598,7 +788,7 @@ xfont_open (f, entity, pixel_size)
 
   if (! xfont)
     {
 
   if (! xfont)
     {
-      font_add_log ("  x:open failed", build_string (name), Qnil);
+      FONT_ADD_LOG ("  x:open failed", build_string (name), Qnil);
       return Qnil;
     }
 
       return Qnil;
     }
 
@@ -606,11 +796,17 @@ xfont_open (f, entity, pixel_size)
                                  entity, pixel_size);
   ASET (font_object, FONT_TYPE_INDEX, Qx);
   if (STRINGP (fullname))
                                  entity, pixel_size);
   ASET (font_object, FONT_TYPE_INDEX, Qx);
   if (STRINGP (fullname))
-    font_parse_xlfd ((char *) SDATA (fullname), font_object);
-  if (STRINGP (fullname))
-    ASET (font_object, FONT_NAME_INDEX, fullname);
+    {
+      font_parse_xlfd (SSDATA (fullname), font_object);
+      ASET (font_object, FONT_NAME_INDEX, fullname);
+    }
   else
   else
-    ASET (font_object, FONT_NAME_INDEX, make_unibyte_string (name, len));
+    {
+      char buf[512];
+
+      len = xfont_decode_coding_xlfd (name, -1, buf);
+      ASET (font_object, FONT_NAME_INDEX, make_string (buf, len));
+    }
   ASET (font_object, FONT_FULLNAME_INDEX, fullname);
   ASET (font_object, FONT_FILE_INDEX, Qnil);
   ASET (font_object, FONT_FORMAT_INDEX, Qx);
   ASET (font_object, FONT_FULLNAME_INDEX, fullname);
   ASET (font_object, FONT_FILE_INDEX, Qnil);
   ASET (font_object, FONT_FORMAT_INDEX, Qx);
@@ -645,7 +841,7 @@ xfont_open (f, entity, pixel_size)
 
       val = Ffont_get (font_object, QCavgwidth);
       if (INTEGERP (val))
 
       val = Ffont_get (font_object, QCavgwidth);
       if (INTEGERP (val))
-       font->average_width = XINT (val);
+       font->average_width = XINT (val) / 10;
       if (font->average_width < 0)
        font->average_width = - font->average_width;
       if (font->average_width == 0
       if (font->average_width < 0)
        font->average_width = - font->average_width;
       if (font->average_width == 0
@@ -695,9 +891,7 @@ xfont_open (f, entity, pixel_size)
 }
 
 static void
 }
 
 static void
-xfont_close (f, font)
-     FRAME_PTR f;
-     struct font *font;
+xfont_close (FRAME_PTR f, struct font *font)
 {
   BLOCK_INPUT;
   XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont);
 {
   BLOCK_INPUT;
   XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont);
@@ -705,9 +899,7 @@ xfont_close (f, font)
 }
 
 static int
 }
 
 static int
-xfont_prepare_face (f, face)
-     FRAME_PTR f;
-     struct face *face;
+xfont_prepare_face (FRAME_PTR f, struct face *face)
 {
   BLOCK_INPUT;
   XSetFont (FRAME_X_DISPLAY (f), face->gc,
 {
   BLOCK_INPUT;
   XSetFont (FRAME_X_DISPLAY (f), face->gc,
@@ -718,24 +910,36 @@ xfont_prepare_face (f, face)
 }
 
 static int
 }
 
 static int
-xfont_has_char (entity, c)
-     Lisp_Object entity;
-     int c;
+xfont_has_char (Lisp_Object font, int c)
 {
 {
-  Lisp_Object registry = AREF (entity, FONT_REGISTRY_INDEX);
-  struct charset *repertory;
+  Lisp_Object registry = AREF (font, FONT_REGISTRY_INDEX);
+  struct charset *encoding;
+  struct charset *repertory = NULL;
 
 
-  if (font_registry_charsets (registry, NULL, &repertory) < 0)
-    return -1;
+  if (EQ (registry, Qiso10646_1))
+    {
+      encoding = CHARSET_FROM_ID (charset_unicode);
+      /* We use a font of `ja' and `ko' adstyle only for a character
+        in JISX0208 and KSC5601 charsets respectively.  */
+      if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qja)
+         && charset_jisx0208 >= 0)
+       repertory = CHARSET_FROM_ID (charset_jisx0208);
+      else if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qko)
+              && charset_ksc5601 >= 0)
+       repertory = CHARSET_FROM_ID (charset_ksc5601);
+    }
+  else if (font_registry_charsets (registry, &encoding, &repertory) < 0)
+    /* Unknown REGISTRY, not usable.  */
+    return 0;
+  if (ASCII_CHAR_P (c) && encoding->ascii_compatible_p)
+    return 1;
   if (! repertory)
     return -1;
   return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
 }
 
 static unsigned
   if (! repertory)
     return -1;
   return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
 }
 
 static unsigned
-xfont_encode_char (font, c)
-     struct font *font;
-     int c;
+xfont_encode_char (struct font *font, int c)
 {
   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
   struct charset *charset;
 {
   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
   struct charset *charset;
@@ -758,18 +962,14 @@ xfont_encode_char (font, c)
 }
 
 static int
 }
 
 static int
-xfont_text_extents (font, code, nglyphs, metrics)
-     struct font *font;
-     unsigned *code;
-     int nglyphs;
-     struct font_metrics *metrics;
+xfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct font_metrics *metrics)
 {
   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
   int width = 0;
   int i, first, x;
 
   if (metrics)
 {
   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
   int width = 0;
   int i, first, x;
 
   if (metrics)
-    bzero (metrics, sizeof (struct font_metrics));
+    memset (metrics, 0, sizeof (struct font_metrics));
   for (i = 0, x = 0, first = 1; i < nglyphs; i++)
     {
       XChar2b char2b;
   for (i = 0, x = 0, first = 1; i < nglyphs; i++)
     {
       XChar2b char2b;
@@ -814,9 +1014,7 @@ xfont_text_extents (font, code, nglyphs, metrics)
 }
 
 static int
 }
 
 static int
-xfont_draw (s, from, to, x, y, with_background)
-     struct glyph_string *s;
-     int from, to, x, y, with_background;
+xfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_background)
 {
   XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
   int len = to - from;
 {
   XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
   int len = to - from;
@@ -891,9 +1089,7 @@ xfont_draw (s, from, to, x, y, with_background)
 }
 
 static int
 }
 
 static int
-xfont_check (f, font)
-     FRAME_PTR f;
-     struct font *font;
+xfont_check (FRAME_PTR f, struct font *font)
 {
   struct xfont_info *xfont = (struct xfont_info *) font;
 
 {
   struct xfont_info *xfont = (struct xfont_info *) font;
 
@@ -902,11 +1098,18 @@ xfont_check (f, font)
 
 \f
 void
 
 \f
 void
-syms_of_xfont ()
+syms_of_xfont (void)
 {
 {
+  staticpro (&xfont_scripts_cache);
+  { /* Here we rely on the fact that syms_of_xfont (via syms_of_font)
+       is called fairly late, when QCtest and Qequal are known to be set.  */
+    Lisp_Object args[2];
+    args[0] = QCtest;
+    args[1] = Qequal;
+    xfont_scripts_cache = Fmake_hash_table (2, args);
+  }
+  staticpro (&xfont_scratch_props);
+  xfont_scratch_props = Fmake_vector (make_number (8), Qnil);
   xfont_driver.type = Qx;
   register_font_driver (&xfont_driver, NULL);
 }
   xfont_driver.type = Qx;
   register_font_driver (&xfont_driver, NULL);
 }
-
-/* arch-tag: 23c5f366-a5ee-44b7-a3b7-90d6da7fd749
-   (do not change this comment) */