comparison src/font.c @ 103889:82ad563e96ed

(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.

103888:0cebb3e8f85d

  /* The following code is copied from the function intern (in
     lread.c), and modified to suite our purpose.  */
  obarray = Vobarray;
  if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
    obarray = check_obarray (obarray);
  parse_str_as_multibyte (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.  */
    tem = oblookup (obarray, str, len, len);
  else

  return score;
}


/* The comparison function for qsort.  */

static int
font_compare (d1, d2)
     const void *d1, *d2;
{
  return (*(unsigned *) d1 - *(unsigned *) d2);
}


/* The structure for elements being sorted by qsort.  */
struct font_sort_data
{
  unsigned score;
  Lisp_Object entity;
};


/* Sort font-entities in vector VEC 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.

   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.  */

static Lisp_Object
font_sort_entities (vec, prefer, frame, best_only)
     Lisp_Object vec, prefer, frame;
     int best_only;
{
  Lisp_Object prefer_prop[FONT_SPEC_MAX];
  int len, i;
  struct font_sort_data *data;
  unsigned best_score;
  Lisp_Object best_entity, driver_type;
  int driver_order;
  struct frame *f = XFRAME (frame);
  struct font_driver_list *list;
  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;
  best_score = 0xFFFFFFFF;
  best_entity = Qnil;
  for (i = 0; i < len; i++)
    {
      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)
	{
	  best_score = data[i].score;
	  best_entity = data[i].entity;
	  if (best_score == 0)
	    break;
	}
    }
  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);
  return vec;
}



static Lisp_Object scratch_font_spec, scratch_font_prefer;

Lisp_Object
font_delete_unmatched (list, spec, size)
     Lisp_Object list, spec;
     int size;
{
  Lisp_Object entity, val;
  enum font_property_index prop;

  for (val = Qnil; CONSP (list); list = XCDR (list))
    {
      entity = XCAR (list);
      for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
	if (INTEGERP (AREF (spec, prop))
	    && ((XINT (AREF (spec, prop)) >> 8)
		!= (XINT (AREF (entity, prop)) >> 8)))
	  prop = FONT_SPEC_MAX;

		   AREF (entity, FONT_AVGWIDTH_INDEX)))
	prop = FONT_SPEC_MAX;
      if (prop < FONT_SPEC_MAX)
	val = Fcons (entity, val);
    }
  return Fnreverse (val);
}


/* Return a vector of font-entities matching with SPEC on FRAME.  */

Lisp_Object
font_list_entities (frame, spec)
     Lisp_Object frame, spec;
{
  FRAME_PTR f = XFRAME (frame);
  struct font_driver_list *driver_list = f->font_driver_list;
  Lisp_Object ftype, val;
  Lisp_Object *vec;
  int size;
  int need_filtering = 0;
  int i;

  font_assert (FONT_SPEC_P (spec));

	/* Skip FONT_SPACING_INDEX  */
	i++;
    }
  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)))
      {

	else
	  {
	    Lisp_Object copy;

	    val = driver_list->driver->list (frame, scratch_font_spec);
	    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)
	  val = font_delete_unmatched (val, spec, size);
	if (! NILP (val))
	  vec[i++] = val;
      }

  val = (i > 0 ? Fvconcat (i, vec) : null_vector);
  FONT_ADD_LOG ("list", spec, val);
  return (val);
}


/* Return a font entity matching with SPEC on FRAME.  ATTRS, if non
   nil, is an array of face's attributes, which specifies preferred

	}
    }
}


/* Selecte a font from ENTITIES that supports C and matches best with
   ATTRS and PIXEL_SIZE.  */

static Lisp_Object
font_select_entity (frame, entities, attrs, pixel_size, c)
     Lisp_Object frame, entities, *attrs;
     int 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)
    {
      font_entity = AREF (entities, 0);
      if (c < 0
	  || (result = font_has_char (f, font_entity, c)) > 0)
	return font_entity;
      return Qnil;
    }

     Lisp_Object *attrs;
     Lisp_Object spec;
     int c;
{
  Lisp_Object work;
  Lisp_Object frame, entities, val, props[FONT_REGISTRY_INDEX + 1] ;
  Lisp_Object size, foundry[3], *family, registry[3], adstyle[3];
  int pixel_size;
  int i, j, k, l, result;

  registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
  if (NILP (registry[0]))
    {
      registry[0] = DEFAULT_ENCODING;

      struct charset *encoding, *repertory;

      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;
	}
      else if (c > encoding->max_char)
	return Qnil;
    }

  work = Fcopy_font_spec (spec);

	      ASET (work, FONT_REGISTRY_INDEX, registry[k]);
	      for (l = 0; SYMBOLP (adstyle[l]); l++)
		{
		  ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
		  entities = font_list_entities (frame, work);
		  if (ASIZE (entities) > 0)
		    {
		      val = font_select_entity (frame, entities,
						attrs, pixel_size, c);
		      if (! NILP (val))
			return val;

control the order of the returned list.  Fonts are sorted by
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;

  if (NILP (frame))
    frame = selected_frame;
  CHECK_LIVE_FRAME (frame);
  CHECK_FONT_SPEC (font_spec);

	return Qnil;
    }
  if (! NILP (prefer))
    CHECK_FONT_SPEC (prefer);

  vec = font_list_entities (frame, font_spec);
  len = ASIZE (vec);
  if (len == 0)
    return Qnil;
  if (len == 1)
    return Fcons (AREF (vec, 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++)
    {
      Lisp_Object val = Fcons (AREF (vec, i), Qnil);

      XSETCDR (tail, val);
      tail = val;
    }
  return list;
}

DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,

			   concat2 (equalstr,
				    SYMBOL_NAME (XCAR (XCDR (elt)))));
	}
      arg = val;
    }
  if (FONTP (result))
    {
      val = Ffont_xlfd_name (result, Qt);
      if (! FONT_SPEC_P (result))
	val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),

103889:82ad563e96ed

  /* The following code is copied from the function intern (in
     lread.c), and modified to suite our purpose.  */
  obarray = Vobarray;
  if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
    obarray = check_obarray (obarray);
  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.  */
    tem = oblookup (obarray, str, len, len);
  else

  return score;
}


/* Concatenate all elements of LIST into one vector.  LIST is a list
   of font-entity vectors.  */

static Lisp_Object
font_vconcat_entity_vectors (Lisp_Object list)
{
  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);
}


/* The structure for elements being sorted by qsort.  */
struct font_sort_data
{
  unsigned score;
  int font_driver_preference;
  Lisp_Object entity;
};


/* 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 result as
   a single vector of font-entities.

   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 (list, prefer, frame, best_only)
     Lisp_Object list, prefer, frame;
     int best_only;
{
  Lisp_Object prefer_prop[FONT_SPEC_MAX];
  int len, maxlen, i;
  struct font_sort_data *data;
  unsigned best_score;
  Lisp_Object best_entity;
  struct frame *f = XFRAME (frame);
  Lisp_Object tail, vec;
  USE_SAFE_ALLOCA;

  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));

  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 (tail = list; CONSP (tail); tail = XCDR (tail))
    {
      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++)
	{
	  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;
    }

  SAFE_FREE ();

  FONT_ADD_LOG ("sort-by", prefer, vec);
  return vec;
}



static Lisp_Object scratch_font_spec, scratch_font_prefer;

Lisp_Object
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, i = ASIZE (vec) - 1; i >= 0; i--)
    {
      entity = AREF (vec, i);
      for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
	if (INTEGERP (AREF (spec, prop))
	    && ((XINT (AREF (spec, prop)) >> 8)
		!= (XINT (AREF (entity, prop)) >> 8)))
	  prop = FONT_SPEC_MAX;

		   AREF (entity, FONT_AVGWIDTH_INDEX)))
	prop = FONT_SPEC_MAX;
      if (prop < FONT_SPEC_MAX)
	val = Fcons (entity, val);
    }
  return (Fvconcat (1, &val));
}


/* 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)
     Lisp_Object frame, spec;
{
  FRAME_PTR f = XFRAME (frame);
  struct font_driver_list *driver_list = f->font_driver_list;
  Lisp_Object ftype, val;
  Lisp_Object list = Qnil;
  int size;
  int need_filtering = 0;
  int i;

  font_assert (FONT_SPEC_P (spec));

	/* Skip FONT_SPACING_INDEX  */
	i++;
    }
  ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
  ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));

  for (i = 0; driver_list; driver_list = driver_list->next)
    if (driver_list->on
	&& (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
      {

	else
	  {
	    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 (ASIZE (val) > 0 && need_filtering)
	  val = font_delete_unmatched (val, spec, size);
	if (ASIZE (val) > 0)
	  list = Fcons (val, list);
      }

  list = Fnreverse (list);
  FONT_ADD_LOG ("list", spec, list);
  return list;
}


/* Return a font entity matching with SPEC on FRAME.  ATTRS, if non
   nil, is an array of face's attributes, which specifies preferred

	}
    }
}


/* 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)
     Lisp_Object frame, entities, *attrs;
     int pixel_size, c;
{
  Lisp_Object font_entity;
  Lisp_Object prefer;
  int result, i;
  FRAME_PTR f = XFRAME (frame);

  if (NILP (XCDR (entities))
      && ASIZE (XCAR (entities)) == 1)
    {
      font_entity = AREF (XCAR (entities), 0);
      if (c < 0
	  || (result = font_has_char (f, font_entity, c)) > 0)
	return font_entity;
      return Qnil;
    }

     Lisp_Object *attrs;
     Lisp_Object spec;
     int c;
{
  Lisp_Object work;
  Lisp_Object frame, entities, val;
  Lisp_Object size, foundry[3], *family, registry[3], adstyle[3];
  int pixel_size;
  int i, j, k, l;

  registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
  if (NILP (registry[0]))
    {
      registry[0] = DEFAULT_ENCODING;

      struct charset *encoding, *repertory;

      if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
				  &encoding, &repertory) < 0)
	return Qnil;
      if (repertory
	  && ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
	return Qnil;
      else if (c > encoding->max_char)
	return Qnil;
    }

  work = Fcopy_font_spec (spec);

	      ASET (work, FONT_REGISTRY_INDEX, registry[k]);
	      for (l = 0; SYMBOLP (adstyle[l]); l++)
		{
		  ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
		  entities = font_list_entities (frame, work);
		  if (! NILP (entities))
		    {
		      val = font_select_entity (frame, entities,
						attrs, pixel_size, c);
		      if (! NILP (val))
			return val;

control the order of the returned list.  Fonts are sorted by
how close they are to PREFER.  */)
     (font_spec, frame, num, prefer)
     Lisp_Object font_spec, frame, num, prefer;
{
  Lisp_Object vec, list;
  int n = 0;

  if (NILP (frame))
    frame = selected_frame;
  CHECK_LIVE_FRAME (frame);
  CHECK_FONT_SPEC (font_spec);

	return Qnil;
    }
  if (! NILP (prefer))
    CHECK_FONT_SPEC (prefer);

  list = font_list_entities (frame, font_spec);
  if (NILP (list))
    return Qnil;
  if (NILP (XCDR (list))
      && ASIZE (XCAR (list)) == 1)
    return Fcons (AREF (XCAR (list), 0), Qnil);

  if (! NILP (prefer))
    vec = font_sort_entities (list, prefer, frame, 0);
  else
    vec = font_vconcat_entity_vectors (list);
  if (n == 0 || n >= ASIZE (vec))
    {
      Lisp_Object args[2];

      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;
}

DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,

			   concat2 (equalstr,
				    SYMBOL_NAME (XCAR (XCDR (elt)))));
	}
      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);
      if (! FONT_SPEC_P (result))
	val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),