(font_vconcat_entity_vectors): New function.

(struct font_sort_data): New member font_driver_preference.
(font_compare): Check font_driver_preference.
(font_sort_entities): The format of the first argument changed.
(font_delete_unmatched): Likewise.
(font_list_entities): The return type changed.
(font_select_entity): The format of the second argument changed.
(font_find_for_lface): Adjusted for the above changes.  Don't
suppress the checking of C even if the repertory supports it.
(Flist_fonts): Adjusted for the above changes.

1 files changed, 166 insertions, 98 deletions

diff --git a/src/font.c b/src/font.c
index 203acc7b54..d2cd1febe9 100644
--- a/src/font.c
+++ b/src/font.c
@@ -273,7 +273,7 @@ font_intern_prop (str, len, force_symbol)
   obarray = Vobarray;
   if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
     obarray = check_obarray (obarray);
-  parse_str_as_multibyte (str, len, &nchars, &nbytes);
+  parse_str_as_multibyte ((unsigned char *) str, len, &nchars, &nbytes);
   if (len == nchars || len != nbytes)
     /* CONTENTS contains no multibyte sequences or contains an invalid
        multibyte sequence.  We'll make a unibyte string.  */
@@ -2280,13 +2280,19 @@ font_score (entity, spec_prop)
 }
 
 
-/* The comparison function for qsort.  */
+/* Concatenate all elements of LIST into one vector.  LIST is a list
+   of font-entity vectors.  */
 
-static int
-font_compare (d1, d2)
-     const void *d1, *d2;
+static Lisp_Object
+font_vconcat_entity_vectors (Lisp_Object list)
 {
-  return (*(unsigned *) d1 - *(unsigned *) d2);
+  int nargs = XINT (Flength (list));
+  Lisp_Object *args = alloca (sizeof (Lisp_Object) * nargs);
+  int i;
+
+  for (i = 0; i < nargs; i++, list = XCDR (list))
+    args[i] = XCAR (list);
+  return Fvconcat (nargs, args);
 }
 
 
@@ -2294,82 +2300,136 @@ font_compare (d1, d2)
 struct font_sort_data
 {
   unsigned score;
+  int font_driver_preference;
   Lisp_Object entity;
 };
 
 
-/* Sort font-entities in vector VEC by closeness to font-spec PREFER.
+/* The comparison function for qsort.  */
+
+static int
+font_compare (d1, d2)
+     const void *d1, *d2;
+{
+  const struct font_sort_data *data1 = d1;
+  const struct font_sort_data *data2 = d2;
+
+  if (data1->score < data2->score)
+    return -1;
+  else if (data1->score > data2->score)
+    return 1;
+  return (data1->font_driver_preference - data2->font_driver_preference);
+}
+
+
+/* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
    If PREFER specifies a point-size, calculate the corresponding
    pixel-size from QCdpi property of PREFER or from the Y-resolution
    of FRAME before sorting.
 
    If BEST-ONLY is nonzero, return the best matching entity (that
    supports the character BEST-ONLY if BEST-ONLY is positive, or any
-   if BEST-ONLY is negative).  Otherwise, return the sorted VEC.
+   if BEST-ONLY is negative).  Otherwise, return the sorted result as
+   a single vector of font-entities.
 
-   This function does no optimization for the case that the length of
-   VEC is 1.  The caller should avoid calling this in such a case.  */
+   This function does no optimization for the case that the total
+   number of elements is 1.  The caller should avoid calling this in
+   such a case.  */
 
 static Lisp_Object
-font_sort_entities (vec, prefer, frame, best_only)
-     Lisp_Object vec, prefer, frame;
+font_sort_entities (list, prefer, frame, best_only)
+     Lisp_Object list, prefer, frame;
      int best_only;
 {
   Lisp_Object prefer_prop[FONT_SPEC_MAX];
-  int len, i;
+  int len, maxlen, i;
   struct font_sort_data *data;
   unsigned best_score;
-  Lisp_Object best_entity, driver_type;
-  int driver_order;
+  Lisp_Object best_entity;
   struct frame *f = XFRAME (frame);
-  struct font_driver_list *list;
+  Lisp_Object tail, vec;
   USE_SAFE_ALLOCA;
 
-  len = ASIZE (vec);
   for (i = FONT_WEIGHT_INDEX; i <= FONT_AVGWIDTH_INDEX; i++)
     prefer_prop[i] = AREF (prefer, i);
   if (FLOATP (prefer_prop[FONT_SIZE_INDEX]))
     prefer_prop[FONT_SIZE_INDEX]
       = make_number (font_pixel_size (XFRAME (frame), prefer));
 
-  /* Scoring and sorting.  */
-  SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * len);
-  /* We are sure that the length of VEC > 1.  */
-  driver_type = AREF (AREF (vec, 0), FONT_TYPE_INDEX);
-  for (driver_order = 0, list = f->font_driver_list; list;
-       driver_order++, list = list->next)
-    if (EQ (driver_type, list->driver->type))
-      break;
+  if (NILP (XCDR (list)))
+    {
+      /* What we have to take care of is this single vector.  */
+      vec = XCAR (list);
+      maxlen = ASIZE (vec);
+    }
+  else if (best_only)
+    {
+      /* We don't have to perform sort, so there's no need of creating
+	 a single vector.  But, we must find the length of the longest
+	 vector.  */
+      maxlen = 0;
+      for (tail = list; CONSP (tail); tail = XCDR (tail))
+	if (maxlen < ASIZE (XCAR (tail)))
+	  maxlen = ASIZE (XCAR (tail));
+    }
+  else
+    {
+      /* We have to create a single vector to sort it.  */
+      vec = font_vconcat_entity_vectors (list);
+      maxlen = ASIZE (vec);
+    }
+
+  SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * maxlen);
   best_score = 0xFFFFFFFF;
   best_entity = Qnil;
-  for (i = 0; i < len; i++)
+
+  for (tail = list; CONSP (tail); tail = XCDR (tail))
     {
-      if (!EQ (driver_type, AREF (AREF (vec, i), FONT_TYPE_INDEX)))
-	for (driver_order = 0, list = f->font_driver_list; list;
-	     driver_order++, list = list->next)
-	  if (EQ (driver_type, list->driver->type))
-	    break;
-      data[i].entity = AREF (vec, i);
-      data[i].score
-	= (best_only <= 0 || font_has_char (f, data[i].entity, best_only) > 0
-	   ? font_score (data[i].entity, prefer_prop) | driver_order
-	   : 0xFFFFFFFF);
-      if (best_only && best_score > data[i].score)
+      int font_driver_preference = 0;
+      Lisp_Object current_font_driver;
+      
+      if (best_only)
+	vec = XCAR (tail);
+      len = ASIZE (vec);
+
+      /* We are sure that the length of VEC > 0.  */
+      current_font_driver = AREF (AREF (vec, 0), FONT_TYPE_INDEX);
+      /* Score the elements.  */
+      for (i = 0; i < len; i++)
 	{
-	  best_score = data[i].score;
-	  best_entity = data[i].entity;
-	  if (best_score == 0)
-	    break;
+	  data[i].entity = AREF (vec, i);
+	  data[i].score
+	    = ((best_only <= 0 || font_has_char (f, data[i].entity, best_only)
+		> 0)
+	       ? font_score (data[i].entity, prefer_prop)
+	       : 0xFFFFFFFF);
+	  if (best_only && best_score > data[i].score)
+	    {
+	      best_score = data[i].score;
+	      best_entity = data[i].entity;
+	      if (best_score == 0)
+		break;
+	    }
+	  if (! EQ (current_font_driver, AREF (AREF (vec, i), FONT_TYPE_INDEX)))
+	    {
+	      current_font_driver = AREF (AREF (vec, i), FONT_TYPE_INDEX);
+	      font_driver_preference++;
+	    }
+	  data[i].font_driver_preference = font_driver_preference;
 	}
+
+      /* Sort if necessary.  */
+      if (! best_only)
+	{
+	  qsort (data, len, sizeof *data, font_compare);
+	  for (i = 0; i < len; i++)
+	    ASET (vec, i, data[i].entity);
+	  break;
+	}
+      else
+	vec = best_entity;
     }
-  if (! best_only)
-    {
-      qsort (data, len, sizeof *data, font_compare);
-      for (i = 0; i < len; i++)
-	ASET (vec, i, data[i].entity);
-    }
-  else
-    vec = best_entity;
+
   SAFE_FREE ();
 
   FONT_ADD_LOG ("sort-by", prefer, vec);
@@ -2718,16 +2778,17 @@ font_clear_cache (f, cache, driver)
 static Lisp_Object scratch_font_spec, scratch_font_prefer;
 
 Lisp_Object
-font_delete_unmatched (list, spec, size)
-     Lisp_Object list, spec;
+font_delete_unmatched (vec, spec, size)
+     Lisp_Object vec, spec;
      int size;
 {
   Lisp_Object entity, val;
   enum font_property_index prop;
+  int i;
 
-  for (val = Qnil; CONSP (list); list = XCDR (list))
+  for (val = Qnil, i = ASIZE (vec) - 1; i >= 0; i--)
     {
-      entity = XCAR (list);
+      entity = AREF (vec, i);
       for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
 	if (INTEGERP (AREF (spec, prop))
 	    && ((XINT (AREF (spec, prop)) >> 8)
@@ -2760,11 +2821,13 @@ font_delete_unmatched (list, spec, size)
       if (prop < FONT_SPEC_MAX)
 	val = Fcons (entity, val);
     }
-  return Fnreverse (val);
+  return (Fvconcat (1, &val));
 }
 
 
-/* Return a vector of font-entities matching with SPEC on FRAME.  */
+/* Return a list of vectors of font-entities matching with SPEC on
+   FRAME.  The elements of the list are in the same of order of
+   font-drivers.  */
 
 Lisp_Object
 font_list_entities (frame, spec)
@@ -2773,7 +2836,7 @@ font_list_entities (frame, spec)
   FRAME_PTR f = XFRAME (frame);
   struct font_driver_list *driver_list = f->font_driver_list;
   Lisp_Object ftype, val;
-  Lisp_Object *vec;
+  Lisp_Object list = Qnil;
   int size;
   int need_filtering = 0;
   int i;
@@ -2802,10 +2865,6 @@ font_list_entities (frame, spec)
   ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
   ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));
 
-  vec = alloca (sizeof (Lisp_Object) * num_font_drivers);
-  if (! vec)
-    return null_vector;
-
   for (i = 0; driver_list; driver_list = driver_list->next)
     if (driver_list->on
 	&& (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
@@ -2821,19 +2880,23 @@ font_list_entities (frame, spec)
 	    Lisp_Object copy;
 
 	    val = driver_list->driver->list (frame, scratch_font_spec);
+	    if (NILP (val))
+	      val = null_vector;
+	    else
+	      val = Fvconcat (1, &val);
 	    copy = Fcopy_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) && need_filtering)
+	if (ASIZE (val) > 0 && need_filtering)
 	  val = font_delete_unmatched (val, spec, size);
-	if (! NILP (val))
-	  vec[i++] = val;
+	if (ASIZE (val) > 0)
+	  list = Fcons (val, list);
       }
 
-  val = (i > 0 ? Fvconcat (i, vec) : null_vector);
-  FONT_ADD_LOG ("list", spec, val);
-  return (val);
+  list = Fnreverse (list);
+  FONT_ADD_LOG ("list", spec, list);
+  return list;
 }
 
 
@@ -3179,8 +3242,8 @@ font_update_lface (f, attrs)
 }
 
 
-/* Selecte a font from ENTITIES that supports C and matches best with
-   ATTRS and PIXEL_SIZE.  */
+/* Selecte a font from ENTITIES (list of font-entity vectors) that
+   supports C and matches best with ATTRS and PIXEL_SIZE.  */
 
 static Lisp_Object
 font_select_entity (frame, entities, attrs, pixel_size, c)
@@ -3189,13 +3252,13 @@ font_select_entity (frame, entities, attrs, pixel_size, c)
 {
   Lisp_Object font_entity;
   Lisp_Object prefer;
-  Lisp_Object props[FONT_REGISTRY_INDEX + 1] ;
   int result, i;
   FRAME_PTR f = XFRAME (frame);
 
-  if (ASIZE (entities) == 1)
+  if (NILP (XCDR (entities))
+      && ASIZE (XCAR (entities)) == 1)
     {
-      font_entity = AREF (entities, 0);
+      font_entity = AREF (XCAR (entities), 0);
       if (c < 0
 	  || (result = font_has_char (f, font_entity, c)) > 0)
 	return font_entity;
@@ -3237,10 +3300,10 @@ font_find_for_lface (f, attrs, spec, c)
      int c;
 {
   Lisp_Object work;
-  Lisp_Object frame, entities, val, props[FONT_REGISTRY_INDEX + 1] ;
+  Lisp_Object frame, entities, val;
   Lisp_Object size, foundry[3], *family, registry[3], adstyle[3];
   int pixel_size;
-  int i, j, k, l, result;
+  int i, j, k, l;
 
   registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
   if (NILP (registry[0]))
@@ -3259,14 +3322,9 @@ font_find_for_lface (f, attrs, spec, c)
       if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
 				  &encoding, &repertory) < 0)
 	return Qnil;
-      if (repertory)
-	{
-	  if (ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
-	    return Qnil;
-	  /* Any font of this registry support C.  So, let's
-	     suppress the further checking.  */
-	  c = -1;
-	}
+      if (repertory
+	  && ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
+	return Qnil;
       else if (c > encoding->max_char)
 	return Qnil;
     }
@@ -3372,7 +3430,7 @@ font_find_for_lface (f, attrs, spec, c)
 		{
 		  ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
 		  entities = font_list_entities (frame, work);
-		  if (ASIZE (entities) > 0)
+		  if (! NILP (entities))
 		    {
 		      val = font_select_entity (frame, entities,
 						attrs, pixel_size, c);
@@ -4236,8 +4294,8 @@ how close they are to PREFER.  */)
      (font_spec, frame, num, prefer)
      Lisp_Object font_spec, frame, num, prefer;
 {
-  Lisp_Object vec, list, tail;
-  int n = 0, i, len;
+  Lisp_Object vec, list;
+  int n = 0;
 
   if (NILP (frame))
     frame = selected_frame;
@@ -4253,25 +4311,29 @@ how close they are to PREFER.  */)
   if (! NILP (prefer))
     CHECK_FONT_SPEC (prefer);
 
-  vec = font_list_entities (frame, font_spec);
-  len = ASIZE (vec);
-  if (len == 0)
+  list = font_list_entities (frame, font_spec);
+  if (NILP (list))
     return Qnil;
-  if (len == 1)
-    return Fcons (AREF (vec, 0), Qnil);
+  if (NILP (XCDR (list))
+      && ASIZE (XCAR (list)) == 1)
+    return Fcons (AREF (XCAR (list), 0), Qnil);
 
   if (! NILP (prefer))
-    vec = font_sort_entities (vec, prefer, frame, 0);
-
-  list = tail = Fcons (AREF (vec, 0), Qnil);
-  if (n == 0 || n > len)
-    n = len;
-  for (i = 1; i < n; i++)
+    vec = font_sort_entities (list, prefer, frame, 0);
+  else
+    vec = font_vconcat_entity_vectors (list);
+  if (n == 0 || n >= ASIZE (vec))
     {
-      Lisp_Object val = Fcons (AREF (vec, i), Qnil);
+      Lisp_Object args[2];
 
-      XSETCDR (tail, val);
-      tail = val;
+      args[0] = vec;
+      args[1] = Qnil;
+      list = Fappend (2, args);
+    }
+  else
+    {
+      for (list = Qnil, n--; n >= 0; n--)
+	list = Fcons (AREF (vec, n), list);
     }
   return list;
 }
@@ -5059,6 +5121,12 @@ font_add_log (action, arg, result)
 	}
       arg = val;
     }
+
+  if (CONSP (result)
+      && VECTORP (XCAR (result))
+      && ASIZE (XCAR (result)) > 0
+      && FONTP (AREF (XCAR (result), 0)))
+    result = font_vconcat_entity_vectors (result);
   if (FONTP (result))
     {
       val = Ffont_xlfd_name (result, Qt);