Fix the MS-Windows build broken by SAFE_ALLOCA changes.

[gnu-emacs] / src / font.c

diff --git a/src/font.c b/src/font.c
index db55549be8c114eb39d3501fd5785d50643b96bc..46fc51bd5ad19e923d48ffeb81832b7677424f65 100644 (file)
--- a/src/font.c
+++ b/src/font.c
@@ -1,6 +1,6 @@
 /* font.c -- "Font" primitives.
 
 /* font.c -- "Font" primitives.
 

-Copyright (C) 2006-2013 Free Software Foundation, Inc.
+Copyright (C) 2006-2014 Free Software Foundation, Inc.

 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
   National Institute of Advanced Industrial Science and Technology (AIST)
   Registration Number H13PRO009
 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
   National Institute of Advanced Industrial Science and Technology (AIST)
   Registration Number H13PRO009


@@ -41,6 +41,10 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include TERM_HEADER
 #endif /* HAVE_WINDOW_SYSTEM */
 
 #include TERM_HEADER
 #endif /* HAVE_WINDOW_SYSTEM */
 

+#ifndef MAX
+# define MAX(a, b) ((a) > (b) ? (a) : (b))
+#endif
+

 Lisp_Object Qopentype;
 
 /* Important character set strings.  */
 Lisp_Object Qopentype;
 
 /* Important character set strings.  */


@@ -207,6 +211,9 @@ font_make_object (int size, Lisp_Object entity, int pixelsize)
     = (struct font *) allocate_pseudovector (size, FONT_OBJECT_MAX, PVEC_FONT);
   int i;
 
     = (struct font *) allocate_pseudovector (size, FONT_OBJECT_MAX, PVEC_FONT);
   int i;
 

+  /* GC can happen before the driver is set up,
+     so avoid dangling pointer here (Bug#17771).  */
+  font->driver = NULL;

   XSETFONT (font_object, font);
 
   if (! NILP (entity))
   XSETFONT (font_object, font);
 
   if (! NILP (entity))


@@ -222,7 +229,35 @@ font_make_object (int size, Lisp_Object entity, int pixelsize)
   return font_object;
 }
 
   return font_object;
 }
 

-\f
+#if defined (HAVE_XFT) || defined (HAVE_FREETYPE) || defined (HAVE_NS)
+
+static int font_unparse_fcname (Lisp_Object, int, char *, int);
+
+/* Like above, but also set `type', `name' and `fullname' properties
+   of font-object.  */
+
+Lisp_Object
+font_build_object (int vectorsize, Lisp_Object type,
+                  Lisp_Object entity, double pixelsize)
+{
+  int len;
+  char name[256];
+  Lisp_Object font_object = font_make_object (vectorsize, entity, pixelsize);
+
+  ASET (font_object, FONT_TYPE_INDEX, type);
+  len = font_unparse_xlfd (entity, pixelsize, name, sizeof name);
+  if (len > 0)
+    ASET (font_object, FONT_NAME_INDEX, make_string (name, len));
+  len = font_unparse_fcname (entity, pixelsize, name, sizeof name);
+  if (len > 0)
+    ASET (font_object, FONT_FULLNAME_INDEX, make_string (name, len));
+  else
+    ASET (font_object, FONT_FULLNAME_INDEX,
+         AREF (font_object, FONT_NAME_INDEX));
+  return font_object;
+}
+
+#endif /* HAVE_XFT || HAVE_FREETYPE || HAVE_NS */

 
 static int font_pixel_size (struct frame *f, Lisp_Object);
 static Lisp_Object font_open_entity (struct frame *, Lisp_Object, int);
 
 static int font_pixel_size (struct frame *f, Lisp_Object);
 static Lisp_Object font_open_entity (struct frame *, Lisp_Object, int);


@@ -279,10 +314,8 @@ font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
 
   if (SYMBOLP (tem))
     return tem;
 
   if (SYMBOLP (tem))
     return tem;

-  if (len == nchars || len != nbytes)
-    tem = make_unibyte_string (str, len);
-  else
-    tem = make_multibyte_string (str, nchars, len);
+  tem = make_specified_string (str, nchars, len,
+                              len != nchars && len == nbytes);

   return Fintern (tem, obarray);
 }
 
   return Fintern (tem, obarray);
 }
 


@@ -662,10 +695,6 @@ static const struct
     { &QCotf, font_prop_validate_otf }
   };
 
     { &QCotf, font_prop_validate_otf }
   };
 

-/* Size (number of elements) of the above table.  */
-#define FONT_PROPERTY_TABLE_SIZE \
-  ((sizeof font_property_table) / (sizeof *font_property_table))
-

 /* Return an index number of font property KEY or -1 if KEY is not an
    already known property.  */
 
 /* Return an index number of font property KEY or -1 if KEY is not an
    already known property.  */
 


@@ -674,7 +703,7 @@ get_font_prop_index (Lisp_Object key)
 {
   int i;
 
 {
   int i;
 

-  for (i = 0; i < FONT_PROPERTY_TABLE_SIZE; i++)
+  for (i = 0; i < ARRAYELTS (font_property_table); i++)

     if (EQ (key, *font_property_table[i].key))
       return i;
   return -1;
     if (EQ (key, *font_property_table[i].key))
       return i;
   return -1;


@@ -1274,6 +1303,9 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
 
   val = AREF (font, FONT_SIZE_INDEX);
   eassert (NUMBERP (val) || NILP (val));
 
   val = AREF (font, FONT_SIZE_INDEX);
   eassert (NUMBERP (val) || NILP (val));

+  char font_size_index_buf[sizeof "-*"
+                          + MAX (INT_STRLEN_BOUND (EMACS_INT),
+                                 1 + DBL_MAX_10_EXP + 1)];

   if (INTEGERP (val))
     {
       EMACS_INT v = XINT (val);
   if (INTEGERP (val))
     {
       EMACS_INT v = XINT (val);


@@ -1281,8 +1313,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
        v = pixel_size;
       if (v > 0)
        {
        v = pixel_size;
       if (v > 0)
        {

-         f[XLFD_PIXEL_INDEX] = p =
-           alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT));
+         f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;

          sprintf (p, "%"pI"d-*", v);
        }
       else
          sprintf (p, "%"pI"d-*", v);
        }
       else


@@ -1291,21 +1322,22 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
   else if (FLOATP (val))
     {
       double v = XFLOAT_DATA (val) * 10;
   else if (FLOATP (val))
     {
       double v = XFLOAT_DATA (val) * 10;

-      f[XLFD_PIXEL_INDEX] = p = alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP + 1);
+      f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;

       sprintf (p, "*-%.0f", v);
     }
   else
     f[XLFD_PIXEL_INDEX] = "*-*";
 
       sprintf (p, "*-%.0f", v);
     }
   else
     f[XLFD_PIXEL_INDEX] = "*-*";
 

+  char dpi_index_buf[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT)];

   if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
     {
       EMACS_INT v = XINT (AREF (font, FONT_DPI_INDEX));
   if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
     {
       EMACS_INT v = XINT (AREF (font, FONT_DPI_INDEX));

-      f[XLFD_RESX_INDEX] = p =
-       alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT));
+      f[XLFD_RESX_INDEX] = p = dpi_index_buf;

       sprintf (p, "%"pI"d-%"pI"d", v, v);
     }
   else
     f[XLFD_RESX_INDEX] = "*-*";
       sprintf (p, "%"pI"d-%"pI"d", v, v);
     }
   else
     f[XLFD_RESX_INDEX] = "*-*";

+

   if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
     {
       EMACS_INT spacing = XINT (AREF (font, FONT_SPACING_INDEX));
   if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
     {
       EMACS_INT spacing = XINT (AREF (font, FONT_SPACING_INDEX));


@@ -1317,13 +1349,16 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
     }
   else
     f[XLFD_SPACING_INDEX] = "*";
     }
   else
     f[XLFD_SPACING_INDEX] = "*";

+
+  char avgwidth_index_buf[INT_BUFSIZE_BOUND (EMACS_INT)];

   if (INTEGERP (AREF (font,  FONT_AVGWIDTH_INDEX)))
     {
   if (INTEGERP (AREF (font,  FONT_AVGWIDTH_INDEX)))
     {

-      f[XLFD_AVGWIDTH_INDEX] = p = alloca (INT_BUFSIZE_BOUND (EMACS_INT));
+      f[XLFD_AVGWIDTH_INDEX] = p = avgwidth_index_buf;

       sprintf (p, "%"pI"d", XINT (AREF (font, FONT_AVGWIDTH_INDEX)));
     }
   else
     f[XLFD_AVGWIDTH_INDEX] = "*";
       sprintf (p, "%"pI"d", XINT (AREF (font, FONT_AVGWIDTH_INDEX)));
     }
   else
     f[XLFD_AVGWIDTH_INDEX] = "*";

+

   len = snprintf (name, nbytes, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
                  f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX],
                  f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX],
   len = snprintf (name, nbytes, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
                  f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX],
                  f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX],


@@ -1576,11 +1611,14 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font)
   return 0;
 }
 
   return 0;
 }
 

+#if defined HAVE_XFT || defined HAVE_FREETYPE || defined HAVE_NS
+

 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
    NAME (NBYTES length), and return the name length.  If
 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
    NAME (NBYTES length), and return the name length.  If

-   FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.  */
+   FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.
+   Return a negative value on error.  */

 
 

-int
+static int

 font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes)
 {
   Lisp_Object family, foundry;
 font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes)
 {
   Lisp_Object family, foundry;


@@ -1701,6 +1739,8 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes)
   return (p - name);
 }
 
   return (p - name);
 }
 

+#endif
+

 /* Parse NAME (null terminated) and store information in FONT
    (font-spec or font-entity).  If NAME is successfully parsed, return
    0.  Otherwise return -1.  */
 /* Parse NAME (null terminated) and store information in FONT
    (font-spec or font-entity).  If NAME is successfully parsed, return
    0.  Otherwise return -1.  */


@@ -2128,10 +2168,14 @@ font_score (Lisp_Object entity, Lisp_Object *spec_prop)
         lowest bit is set if the DPI is different.  */
       EMACS_INT diff;
       EMACS_INT pixel_size = XINT (spec_prop[FONT_SIZE_INDEX]);
         lowest bit is set if the DPI is different.  */
       EMACS_INT diff;
       EMACS_INT pixel_size = XINT (spec_prop[FONT_SIZE_INDEX]);

+      EMACS_INT entity_size = XINT (AREF (entity, FONT_SIZE_INDEX));

 
       if (CONSP (Vface_font_rescale_alist))
        pixel_size *= font_rescale_ratio (entity);
 
       if (CONSP (Vface_font_rescale_alist))
        pixel_size *= font_rescale_ratio (entity);

-      diff = eabs (pixel_size - XINT (AREF (entity, FONT_SIZE_INDEX))) << 1;
+      if (pixel_size * 2 < entity_size || entity_size * 2 < pixel_size)
+       /* This size is wrong by more than a factor 2: reject it!  */
+       return 0xFFFFFFFF;
+      diff = eabs (pixel_size - entity_size) << 1;

       if (! NILP (spec_prop[FONT_DPI_INDEX])
          && ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX)))
        diff |= 1;
       if (! NILP (spec_prop[FONT_DPI_INDEX])
          && ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX)))
        diff |= 1;


@@ -2151,13 +2195,17 @@ font_score (Lisp_Object entity, Lisp_Object *spec_prop)
 static Lisp_Object
 font_vconcat_entity_vectors (Lisp_Object list)
 {
 static Lisp_Object
 font_vconcat_entity_vectors (Lisp_Object list)
 {

-  int nargs = XINT (Flength (list));
-  Lisp_Object *args = alloca (word_size * nargs);
-  int i;
+  EMACS_INT nargs = XFASTINT (Flength (list));
+  Lisp_Object *args;
+  USE_SAFE_ALLOCA;
+  SAFE_ALLOCA_LISP (args, nargs);
+  ptrdiff_t i;

 
   for (i = 0; i < nargs; i++, list = XCDR (list))
     args[i] = XCAR (list);
 
   for (i = 0; i < nargs; i++, list = XCDR (list))
     args[i] = XCAR (list);

-  return Fvconcat (nargs, args);
+  Lisp_Object result = Fvconcat (nargs, args);
+  SAFE_FREE ();
+  return result;

 }
 
 
 }
 
 


@@ -2515,7 +2563,7 @@ font_match_p (Lisp_Object spec, Lisp_Object font)
 
    where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
    is a number frames sharing this cache, and FONT-CACHE-DATA is a
 
    where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
    is a number frames sharing this cache, and FONT-CACHE-DATA is a

-   cons (FONT-SPEC FONT-ENTITY ...).  */
+   cons (FONT-SPEC . [FONT-ENTITY ...]).  */

 
 static void font_prepare_cache (struct frame *, struct font_driver *);
 static void font_finish_cache (struct frame *, struct font_driver *);
 
 static void font_prepare_cache (struct frame *, struct font_driver *);
 static void font_finish_cache (struct frame *, struct font_driver *);


@@ -2585,18 +2633,21 @@ static void
 font_clear_cache (struct frame *f, Lisp_Object cache, struct font_driver *driver)
 {
   Lisp_Object tail, elt;
 font_clear_cache (struct frame *f, Lisp_Object cache, struct font_driver *driver)
 {
   Lisp_Object tail, elt;

-  Lisp_Object tail2, entity;
+  Lisp_Object entity;
+  ptrdiff_t i;

 
   /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
   for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
     {
       elt = XCAR (tail);
 
   /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
   for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
     {
       elt = XCAR (tail);

-      /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
+      /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */

       if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
        {
       if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
        {

-         for (tail2 = XCDR (elt); CONSP (tail2); tail2 = XCDR (tail2))
+         elt = XCDR (elt);
+         eassert (VECTORP (elt));
+         for (i = 0; i < ASIZE (elt); i++)

            {
            {

-             entity = XCAR (tail2);
+             entity = AREF (elt, i);

 
              if (FONT_ENTITY_P (entity)
                  && EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
 
              if (FONT_ENTITY_P (entity)
                  && EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))


@@ -2750,22 +2801,21 @@ font_list_entities (struct frame *f, Lisp_Object spec)
          val = XCDR (val);
        else
          {
          val = XCDR (val);
        else
          {

-           Lisp_Object copy;
-

            val = driver_list->driver->list (f, scratch_font_spec);
            val = driver_list->driver->list (f, scratch_font_spec);

-           if (NILP (val))
-             val = zero_vector;
-           else
-             val = Fvconcat (1, &val);
-           copy = copy_font_spec (scratch_font_spec);
-           ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
-           XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
+           if (!NILP (val))
+             {
+               Lisp_Object copy = copy_font_spec (scratch_font_spec);
+
+               val = Fvconcat (1, &val);
+               ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
+               XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
+             }

          }
          }

-       if (ASIZE (val) > 0
+       if (VECTORP (val) && ASIZE (val) > 0

            && (need_filtering
                || ! NILP (Vface_ignored_fonts)))
          val = font_delete_unmatched (val, need_filtering ? spec : Qnil, size);
            && (need_filtering
                || ! NILP (Vface_ignored_fonts)))
          val = font_delete_unmatched (val, need_filtering ? spec : Qnil, size);

-       if (ASIZE (val) > 0)
+       if (VECTORP (val) && ASIZE (val) > 0)

          list = Fcons (val, list);
       }
 
          list = Fcons (val, list);
       }
 


@@ -2801,18 +2851,22 @@ font_matching_entity (struct frame *f, Lisp_Object *attrs, Lisp_Object spec)
        && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
       {
        Lisp_Object cache = font_get_cache (f, driver_list->driver);
        && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
       {
        Lisp_Object cache = font_get_cache (f, driver_list->driver);

-       Lisp_Object copy;

 
        ASET (work, FONT_TYPE_INDEX, driver_list->driver->type);
        entity = assoc_no_quit (work, XCDR (cache));
        if (CONSP (entity))
 
        ASET (work, FONT_TYPE_INDEX, driver_list->driver->type);
        entity = assoc_no_quit (work, XCDR (cache));
        if (CONSP (entity))

-         entity = XCDR (entity);
+         entity = AREF (XCDR (entity), 0);

        else
          {
            entity = driver_list->driver->match (f, work);
        else
          {
            entity = driver_list->driver->match (f, work);

-           copy = copy_font_spec (work);
-           ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
-           XSETCDR (cache, Fcons (Fcons (copy, entity), XCDR (cache)));
+           if (!NILP (entity))
+             {
+               Lisp_Object copy = copy_font_spec (work);
+               Lisp_Object match = Fvector (1, &entity);
+
+               ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
+               XSETCDR (cache, Fcons (Fcons (copy, match), XCDR (cache)));
+             }

          }
        if (! NILP (entity))
          break;
          }
        if (! NILP (entity))
          break;


@@ -3179,9 +3233,10 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int
       val = attrs[LFACE_FAMILY_INDEX];
       val = font_intern_prop (SSDATA (val), SBYTES (val), 1);
     }
       val = attrs[LFACE_FAMILY_INDEX];
       val = font_intern_prop (SSDATA (val), SBYTES (val), 1);
     }

+  Lisp_Object familybuf[3];

   if (NILP (val))
     {
   if (NILP (val))
     {

-      family = alloca ((sizeof family[0]) * 2);
+      family = familybuf;

       family[0] = Qnil;
       family[1] = zero_vector; /* terminator.  */
     }
       family[0] = Qnil;
       family[1] = zero_vector; /* terminator.  */
     }


@@ -3202,7 +3257,7 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int
        }
       else
        {
        }
       else
        {

-         family = alloca ((sizeof family[0]) * 3);
+         family = familybuf;

          i = 0;
          family[i++] = val;
          if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
          i = 0;
          family[i++] = val;
          if (NILP (AREF (spec, FONT_FAMILY_INDEX)))


@@ -3335,7 +3390,6 @@ font_done_for_face (struct frame *f, struct face *face)
 {
   if (face->font->driver->done_face)
     face->font->driver->done_face (f, face);
 {
   if (face->font->driver->done_face)
     face->font->driver->done_face (f, face);

-  face->extra = NULL;

 }
 
 
 }
 
 


@@ -3490,8 +3544,9 @@ font_update_drivers (struct frame *f, Lisp_Object new_drivers)
       struct font_driver_list **list_table, **next;
       Lisp_Object tail;
       int i;
       struct font_driver_list **list_table, **next;
       Lisp_Object tail;
       int i;

+      USE_SAFE_ALLOCA;

 
 

-      list_table = alloca (sizeof list_table[0] * (num_font_drivers + 1));
+      SAFE_NALLOCA (list_table, 1, num_font_drivers + 1);

       for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
        {
          for (list = f->font_driver_list; list; list = list->next)
       for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
        {
          for (list = f->font_driver_list; list; list = list->next)


@@ -3512,6 +3567,7 @@ font_update_drivers (struct frame *f, Lisp_Object new_drivers)
          next = &(*next)->next;
        }
       *next = NULL;
          next = &(*next)->next;
        }
       *next = NULL;

+      SAFE_FREE ();

 
       if (! f->font_driver_list->on)
        { /* None of the drivers is enabled: enable them all.
 
       if (! f->font_driver_list->on)
        { /* None of the drivers is enabled: enable them all.


@@ -3537,53 +3593,40 @@ font_update_drivers (struct frame *f, Lisp_Object new_drivers)
   return active_drivers;
 }
 
   return active_drivers;
 }
 

-int
-font_put_frame_data (struct frame *f, struct font_driver *driver, void *data)
+#if defined (HAVE_XFT) || defined (HAVE_FREETYPE)
+
+static void
+fset_font_data (struct frame *f, Lisp_Object val)

 {
 {

-  struct font_data_list *list, *prev;
+  f->font_data = val;
+}

 
 

-  for (prev = NULL, list = f->font_data_list; list;
-       prev = list, list = list->next)
-    if (list->driver == driver)
-      break;
-  if (! data)
-    {
-      if (list)
-       {
-         if (prev)
-           prev->next = list->next;
-         else
-           f->font_data_list = list->next;
-         xfree (list);
-       }
-      return 0;
-    }
+void
+font_put_frame_data (struct frame *f, Lisp_Object driver, void *data)
+{
+  Lisp_Object val = assq_no_quit (driver, f->font_data);

 
 

-  if (! list)
+  if (!data)
+    fset_font_data (f, Fdelq (val, f->font_data));
+  else

     {
     {

-      list = xmalloc (sizeof *list);
-      list->driver = driver;
-      list->next = f->font_data_list;
-      f->font_data_list = list;
+      if (NILP (val))
+       fset_font_data (f, Fcons (Fcons (driver, make_save_ptr (data)),
+                                 f->font_data));
+      else
+       XSETCDR (val, make_save_ptr (data));

     }
     }

-  list->data = data;
-  return 0;

 }
 
 }
 

-

 void *
 void *

-font_get_frame_data (struct frame *f, struct font_driver *driver)
+font_get_frame_data (struct frame *f, Lisp_Object driver)

 {
 {

-  struct font_data_list *list;
-
-  for (list = f->font_data_list; list; list = list->next)
-    if (list->driver == driver)
-      break;
-  if (! list)
-    return NULL;
-  return list->data;
+  Lisp_Object val = assq_no_quit (driver, f->font_data);
+
+  return NILP (val) ? NULL : XSAVE_POINTER (XCDR (val), 0);

 }
 
 }
 

+#endif /* HAVE_XFT || HAVE_FREETYPE */

 
 /* Sets attributes on a font.  Any properties that appear in ALIST and
    BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
 
 /* Sets attributes on a font.  Any properties that appear in ALIST and
    BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.


@@ -4429,7 +4472,7 @@ where
   LANGSYS is a symbol specifying a langsys tag of OpenType,
   GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
 
   LANGSYS is a symbol specifying a langsys tag of OpenType,
   GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
 

-If LANGYS is nil, the default langsys is selected.
+If LANGSYS is nil, the default langsys is selected.

 
 The features are applied in the order they appear in the list.  The
 symbol `*' means to apply all available features not present in this
 
 The features are applied in the order they appear in the list.  The
 symbol `*' means to apply all available features not present in this


@@ -4785,7 +4828,7 @@ character at index specified by POSITION.  */)
   if (NILP (string))
     {
       if (XBUFFER (w->contents) != current_buffer)
   if (NILP (string))
     {
       if (XBUFFER (w->contents) != current_buffer)

-       error ("Specified window is not displaying the current buffer.");
+       error ("Specified window is not displaying the current buffer");

       CHECK_NUMBER_COERCE_MARKER (position);
       if (! (BEGV <= XINT (position) && XINT (position) < ZV))
        args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
       CHECK_NUMBER_COERCE_MARKER (position);
       if (! (BEGV <= XINT (position) && XINT (position) < ZV))
        args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));


@@ -4842,6 +4885,21 @@ Type C-l to recover what previously shown.  */)
 }
 #endif
 
 }
 #endif
 

+DEFUN ("frame-font-cache", Fframe_font_cache, Sframe_font_cache, 0, 1, 0,
+       doc: /* Return FRAME's font cache.  Mainly used for debugging.
+If FRAME is omitted or nil, use the selected frame.  */)
+  (Lisp_Object frame)
+{
+#ifdef HAVE_WINDOW_SYSTEM
+  struct frame *f = decode_live_frame (frame);
+
+  if (FRAME_WINDOW_P (f))
+    return FRAME_DISPLAY_INFO (f)->name_list_element;
+  else
+#endif
+    return Qnil;
+}
+

 #endif /* FONT_DEBUG */
 
 #ifdef HAVE_WINDOW_SYSTEM
 #endif /* FONT_DEBUG */
 
 #ifdef HAVE_WINDOW_SYSTEM


@@ -4914,8 +4972,7 @@ If the named font is not yet loaded, return nil.  */)
 #endif
 
 \f
 #endif
 
 \f

-#define BUILD_STYLE_TABLE(TBL) \
-  build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
+#define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))

 
 static Lisp_Object
 build_style_table (const struct table_entry *entry, int nelement)
 
 static Lisp_Object
 build_style_table (const struct table_entry *entry, int nelement)


@@ -5134,6 +5191,7 @@ syms_of_font (void)
 #if 0
   defsubr (&Sdraw_string);
 #endif
 #if 0
   defsubr (&Sdraw_string);
 #endif

+  defsubr (&Sframe_font_cache);

 #endif /* FONT_DEBUG */
 #ifdef HAVE_WINDOW_SYSTEM
   defsubr (&Sfont_info);
 #endif /* FONT_DEBUG */
 #ifdef HAVE_WINDOW_SYSTEM
   defsubr (&Sfont_info);