misc changes
[bpt/emacs.git] / src / font.c
index b49664b..bb9629c 100644 (file)
@@ -207,6 +207,9 @@ font_make_object (int size, Lisp_Object entity, int pixelsize)
     = (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))
@@ -274,15 +277,8 @@ font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
   /* This code is similar to intern function from lread.c.  */
   obarray = check_obarray (Vobarray);
   parse_str_as_multibyte ((unsigned char *) str, len, &nchars, &nbytes);
-  tem = oblookup (obarray, str,
-                 (len == nchars || len != nbytes) ? len : nchars, len);
-
-  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);
 }
 
@@ -662,10 +658,6 @@ static const struct
     { &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.  */
 
@@ -674,7 +666,7 @@ get_font_prop_index (Lisp_Object key)
 {
   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;
@@ -2753,22 +2745,21 @@ font_list_entities (struct frame *f, Lisp_Object spec)
          val = XCDR (val);
        else
          {
-           Lisp_Object copy;
-
            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);
-       if (ASIZE (val) > 0)
+       if (VECTORP (val) && ASIZE (val) > 0)
          list = Fcons (val, list);
       }
 
@@ -2804,18 +2795,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);
-       Lisp_Object copy;
 
        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);
-           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;
@@ -3338,7 +3333,6 @@ font_done_for_face (struct frame *f, struct face *face)
 {
   if (face->font->driver->done_face)
     face->font->driver->done_face (f, face);
-  face->extra = NULL;
 }
 
 
@@ -4932,8 +4926,7 @@ If the named font is not yet loaded, return nil.  */)
 #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)
@@ -5063,6 +5056,8 @@ font_deferred_log (const char *action, Lisp_Object arg, Lisp_Object result)
 void
 syms_of_font (void)
 {
+#include "font.x"
+
   sort_shift_bits[FONT_TYPE_INDEX] = 0;
   sort_shift_bits[FONT_SLANT_INDEX] = 2;
   sort_shift_bits[FONT_WEIGHT_INDEX] = 9;
@@ -5123,41 +5118,6 @@ syms_of_font (void)
 #endif /* HAVE_LIBOTF */
 #endif /* 0 */
 
-  defsubr (&Sfontp);
-  defsubr (&Sfont_spec);
-  defsubr (&Sfont_get);
-#ifdef HAVE_WINDOW_SYSTEM
-  defsubr (&Sfont_face_attributes);
-#endif
-  defsubr (&Sfont_put);
-  defsubr (&Slist_fonts);
-  defsubr (&Sfont_family_list);
-  defsubr (&Sfind_font);
-  defsubr (&Sfont_xlfd_name);
-  defsubr (&Sclear_font_cache);
-  defsubr (&Sfont_shape_gstring);
-  defsubr (&Sfont_variation_glyphs);
-#if 0
-  defsubr (&Sfont_drive_otf);
-  defsubr (&Sfont_otf_alternates);
-#endif /* 0 */
-
-#ifdef FONT_DEBUG
-  defsubr (&Sopen_font);
-  defsubr (&Sclose_font);
-  defsubr (&Squery_font);
-  defsubr (&Sfont_get_glyphs);
-  defsubr (&Sfont_match_p);
-  defsubr (&Sfont_at);
-#if 0
-  defsubr (&Sdraw_string);
-#endif
-  defsubr (&Sframe_font_cache);
-#endif /* FONT_DEBUG */
-#ifdef HAVE_WINDOW_SYSTEM
-  defsubr (&Sfont_info);
-#endif
-
   DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist,
               doc: /*
 Alist of fontname patterns vs the corresponding encoding and repertory info.
@@ -5191,19 +5151,19 @@ Each element has the form:
     [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
   Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
-  XSYMBOL (intern_c_string ("font-weight-table"))->constant = 1;
+  SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("font-weight-table")), 1);
 
   DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table,
               doc: /*  Vector of font slant symbols vs the corresponding numeric values.
 See `font-weight-table' for the format of the vector. */);
   Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
-  XSYMBOL (intern_c_string ("font-slant-table"))->constant = 1;
+  SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("font-slant-table")), 1);
 
   DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table,
               doc: /*  Alist of font width symbols vs the corresponding numeric values.
 See `font-weight-table' for the format of the vector. */);
   Vfont_width_table = BUILD_STYLE_TABLE (width_table);
-  XSYMBOL (intern_c_string ("font-width-table"))->constant = 1;
+  SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("font-width-table")), 1);
 
   staticpro (&font_style_table);
   font_style_table = make_uninit_vector (3);