comparison src/font.c @ 95403:26df7325a6ff

(font_style_to_value, font_score): Delete casting of the args to xstcasecmp. (register_font_driver): Increment num_font_drivers only when registering the driver globally. (Ffont_info): Moved from fontset.c. Handle a font object too. (syms_of_font): Defsubr Sfont_info.

95402:6f0d3ea7dbbe

  int len = ASIZE (table);
  int i, j;

  if (SYMBOLP (val))
    {
      char *s;
      Lisp_Object args[2], elt;

      /* At first try exact match.  */
      for (i = 0; i < len; i++)
	for (j = 1; j < ASIZE (AREF (table, i)); j++)
	  if (EQ (val, AREF (AREF (table, i), j)))
	    return ((XINT (AREF (AREF (table, i), 0)) << 8)
		    | (i << 4) | (j - 1));
      /* Try also with case-folding match.  */
      s = (char *) SDATA (SYMBOL_NAME (val));
      for (i = 0; i < len; i++)
	for (j = 1; j < ASIZE (AREF (table, i)); j++)
	  {
	    elt = AREF (AREF (table, i), j);
	    if (xstrcasecmp (s, (char *) SDATA (SYMBOL_NAME (elt))) == 0)
	      return ((XINT (AREF (AREF (table, i), 0)) << 8)
		      | (i << 4) | (j - 1));
	  }
      if (! noerror)
	return -1;

	&& ! NILP (spec_prop[i]) && ! EQ (AREF (entity, i), spec_prop[i]))
      {
	Lisp_Object entity_str = SYMBOL_NAME (AREF (entity, i));
	Lisp_Object spec_str = SYMBOL_NAME (spec_prop[i]);

	if (xstrcasecmp ((char *) SDATA (spec_str),
                         (char *) SDATA (entity_str)))
	  {
	    if (i == FONT_FAMILY_INDEX && CONSP (alternate_families))
	      {
		int j;

		for (j = 1; CONSP (alternate_families);
		     j++, alternate_families = XCDR (alternate_families))
		  {
		    spec_str = XCAR (alternate_families);
		    if (xstrcasecmp ((char *) SDATA (spec_str),
                                     (char *) SDATA (entity_str)) == 0)
		      break;

		  }
		if (j > 3)
		  j = 3;
		score |= j << sort_shift_bits[i];
	      }

    prev->next = list;
  else if (f)
    f->font_driver_list = list;
  else
    font_driver_list = list;
  num_font_drivers++;
}


/* Free font-driver list on frame F.  It doesn't free font-drivers
   themselves.  */

}
#endif

#endif	/* FONT_DEBUG */


#define BUILD_STYLE_TABLE(TBL) \
  build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))

static Lisp_Object

  defsubr (&Sfont_at);
#if 0
  defsubr (&Sdraw_string);
#endif
#endif	/* FONT_DEBUG */

  DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
	       doc: /*
Alist of fontname patterns vs the corresponding encoding and repertory info.
Each element looks like (REGEXP . (ENCODING . REPERTORY)),

95403:26df7325a6ff

  int len = ASIZE (table);
  int i, j;

  if (SYMBOLP (val))
    {
      unsigned char *s;
      Lisp_Object args[2], elt;

      /* At first try exact match.  */
      for (i = 0; i < len; i++)
	for (j = 1; j < ASIZE (AREF (table, i)); j++)
	  if (EQ (val, AREF (AREF (table, i), j)))
	    return ((XINT (AREF (AREF (table, i), 0)) << 8)
		    | (i << 4) | (j - 1));
      /* Try also with case-folding match.  */
      s = SDATA (SYMBOL_NAME (val));
      for (i = 0; i < len; i++)
	for (j = 1; j < ASIZE (AREF (table, i)); j++)
	  {
	    elt = AREF (AREF (table, i), j);
	    if (xstrcasecmp (s, SDATA (SYMBOL_NAME (elt))) == 0)
	      return ((XINT (AREF (AREF (table, i), 0)) << 8)
		      | (i << 4) | (j - 1));
	  }
      if (! noerror)
	return -1;

	&& ! NILP (spec_prop[i]) && ! EQ (AREF (entity, i), spec_prop[i]))
      {
	Lisp_Object entity_str = SYMBOL_NAME (AREF (entity, i));
	Lisp_Object spec_str = SYMBOL_NAME (spec_prop[i]);

	if (xstrcasecmp (SDATA (spec_str), SDATA (entity_str)))
	  {
	    if (i == FONT_FAMILY_INDEX && CONSP (alternate_families))
	      {
		int j;

		for (j = 1; CONSP (alternate_families);
		     j++, alternate_families = XCDR (alternate_families))
		  {
		    spec_str = XCAR (alternate_families);
		    if (xstrcasecmp (SDATA (spec_str), SDATA (entity_str)) == 0)
		      break;
		  }
		if (j > 3)
		  j = 3;
		score |= j << sort_shift_bits[i];
	      }

    prev->next = list;
  else if (f)
    f->font_driver_list = list;
  else
    font_driver_list = list;
  if (! f)
    num_font_drivers++;
}


/* Free font-driver list on frame F.  It doesn't free font-drivers
   themselves.  */

}
#endif

#endif	/* FONT_DEBUG */

DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
       doc: /* Return information about a font named NAME on frame FRAME.
If FRAME is omitted or nil, use the selected frame.
The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
  HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
where
  OPENED-NAME is the name used for opening the font,
  FULL-NAME is the full name of the font,
  SIZE is the maximum bound width of the font,
  HEIGHT is the height of the font,
  BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
  RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
    how to compose characters.
If the named font is not yet loaded, return nil.  */)
     (name, frame)
     Lisp_Object name, frame;
{
  FRAME_PTR f;
  struct font *font;
  Lisp_Object info;
  Lisp_Object font_object;

  (*check_window_system_func) ();

  if (! FONTP (name))
    CHECK_STRING (name);
  if (NILP (frame))
    frame = selected_frame;
  CHECK_LIVE_FRAME (frame);
  f = XFRAME (frame);

  if (STRINGP (name))
    {
      int fontset = fs_query_fontset (name, 0);

      if (fontset >= 0)
	name = fontset_ascii (fontset);
      font_object = font_open_by_name (f, (char *) SDATA (name));
    }
  else if (FONT_OBJECT_P (name))
    font_object = name;
  else if (FONT_ENTITY_P (name))
    font_object = font_open_entity (f, name, 0);
  else
    {
      struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
      Lisp_Object entity = font_matching_entity (f, face->lface, name);

      font_object = ! NILP (entity) ? font_open_entity (f, entity, 0) : Qnil;
    }
  if (NILP (font_object))
    return Qnil;
  font = XFONT_OBJECT (font_object);

  info = Fmake_vector (make_number (7), Qnil);
  XVECTOR (info)->contents[0] = AREF (font_object, FONT_NAME_INDEX);
  XVECTOR (info)->contents[1] = AREF (font_object, FONT_NAME_INDEX);
  XVECTOR (info)->contents[2] = make_number (font->pixel_size);
  XVECTOR (info)->contents[3] = make_number (font->height);
  XVECTOR (info)->contents[4] = make_number (font->baseline_offset);
  XVECTOR (info)->contents[5] = make_number (font->relative_compose);
  XVECTOR (info)->contents[6] = make_number (font->default_ascent);

#if 0
  /* As font_object is still in FONT_OBJLIST of the entity, we can't
     close it now.  Perhaps, we should manage font-objects
     by `reference-count'.  */
  font_close_object (f, font_object);
#endif
  return info;
}


#define BUILD_STYLE_TABLE(TBL) \
  build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))

static Lisp_Object

  defsubr (&Sfont_at);
#if 0
  defsubr (&Sdraw_string);
#endif
#endif	/* FONT_DEBUG */
  defsubr (&Sfont_info);

  DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
	       doc: /*
Alist of fontname patterns vs the corresponding encoding and repertory info.
Each element looks like (REGEXP . (ENCODING . REPERTORY)),