=== modified file 'src/alloc.c'
--- src/alloc.c	2013-12-01 22:33:13 +0000
+++ src/alloc.c	2013-12-05 06:10:49 +0000
@@ -2877,7 +2877,12 @@
   if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT)
       && ((vector->header.size & PSEUDOVECTOR_SIZE_MASK)
 	  == FONT_OBJECT_MAX))
-    ((struct font *) vector)->driver->close ((struct font *) vector);
+    {
+      if (((struct font *) vector)->debug)
+	fprintf (stderr, "GC%ld: free interesting font %p\n",
+		 gcs_done, vector);
+      ((struct font *) vector)->driver->close ((struct font *) vector);
+    }
 }
 
 /* Reclaim space used by unmarked vectors.  */
@@ -5733,6 +5738,14 @@
   if (size & PSEUDOVECTOR_FLAG)
     size &= PSEUDOVECTOR_SIZE_MASK;
 
+  if (FONT_OBJECT_P (make_lisp_ptr (ptr, Lisp_Vectorlike)))
+    {
+      struct font *f = (struct font *) ptr;
+      if (f->debug)
+	fprintf (stderr, "GC%ld: mark interesting font %p\n",
+		 gcs_done, f);
+    }
+
   /* Note that this size is not the memory-footprint size, but only
      the number of Lisp_Object fields that we should trace.
      The distinction is used e.g. by Lisp_Process which places extra

=== modified file 'src/font.c'
--- src/font.c	2013-12-04 13:08:30 +0000
+++ src/font.c	2013-12-05 06:00:56 +0000
@@ -188,6 +188,7 @@
   int i;
 
   XSETFONT (font_object, font);
+  font->debug = 0;
 
   if (! NILP (entity))
     {
@@ -196,6 +197,7 @@
       if (! NILP (AREF (entity, FONT_EXTRA_INDEX)))
 	font->props[FONT_EXTRA_INDEX]
 	  = Fcopy_alist (AREF (entity, FONT_EXTRA_INDEX));
+      font->props[FONT_ENTITY_INDEX] = entity;
     }
   if (size > 0)
     font->props[FONT_SIZE_INDEX] = make_number (pixelsize);
@@ -4189,7 +4191,7 @@
 the consecutive wildcards are folded into one.  */)
   (Lisp_Object font, Lisp_Object fold_wildcards)
 {
-  char name[256];
+  char name[256 + 32];
   int namelen, pixel_size = 0;
 
   CHECK_FONT (font);
@@ -4202,7 +4204,11 @@
 	  && SDATA (font_name)[0] == '-')
 	{
 	  if (NILP (fold_wildcards))
-	    return font_name;
+	    {
+	      XFONT_OBJECT (font)->debug = 1;
+	      return make_formatted_string
+		(name, "%s (%p)", SSDATA (font_name), XFONT_OBJECT (font));
+	    }
 	  strcpy (name, SSDATA (font_name));
 	  namelen = SBYTES (font_name);
 	  goto done;

=== modified file 'src/font.h'
--- src/font.h	2013-12-04 13:35:41 +0000
+++ src/font.h	2013-12-05 05:59:31 +0000
@@ -285,6 +285,8 @@
 
   /* Beyond here, there should be no more Lisp_Object components.  */
 
+  int debug;
+
   /* Minimum and maximum glyph widths, in pixels.  Some font backends,
      such as xft, lack the information to easily compute minimum and
      maximum widths over all characters; in that case, these values