]> code.delx.au - gnu-emacs/blobdiff - src/font.c
Improve indexing in Emacs manual (Bug#20105)
[gnu-emacs] / src / font.c
index 8027de81609080c8ea7936523359db5dd46bdbb3..f07fbe3bb115c460775c420b47b6511527733efa 100644 (file)
@@ -1,6 +1,6 @@
 /* font.c -- "Font" primitives.
 
-Copyright (C) 2006-2014 Free Software Foundation, Inc.
+Copyright (C) 2006-2015 Free Software Foundation, Inc.
 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
   National Institute of Advanced Industrial Science and Technology (AIST)
   Registration Number H13PRO009
@@ -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))
@@ -1721,7 +1724,7 @@ font_parse_name (char *name, ptrdiff_t namelen, Lisp_Object font)
 void
 font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Object font_spec)
 {
-  int len;
+  ptrdiff_t len;
   char *p0, *p1;
 
   if (! NILP (family)
@@ -2515,7 +2518,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
-   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 *);
@@ -2585,18 +2588,21 @@ static void
 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);
-      /* 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)))
        {
-         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)))
@@ -2750,22 +2756,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);
       }
 
@@ -2801,18 +2806,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;
@@ -4842,6 +4851,21 @@ Type C-l to recover what previously shown.  */)
 }
 #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
@@ -5134,6 +5158,7 @@ syms_of_font (void)
 #if 0
   defsubr (&Sdraw_string);
 #endif
+  defsubr (&Sframe_font_cache);
 #endif /* FONT_DEBUG */
 #ifdef HAVE_WINDOW_SYSTEM
   defsubr (&Sfont_info);