comparison src/font.c @ 90541:b7130e76c2f9

Include window.h. (font_lispy_object): New function. (font_prepare_composition): Check LGLYPH_FORM (g) to detect the end of valid glyph. (font_close_object): Fix getting (struct font *). (font_at): New function. (Ffont_get): If FONT is a font-object, get entity from it. (Ffont_make_gstring): Initialize elements of glyphs with nil. (Ffont_fill_gstring): Use macro LGSTRING_XXX and LGLYPH_XXX. Fix range check. (Ffont_at): New function. (syms_of_font): Defsubr Sfont_at.

90540:a4c3599e9f9b

#include <ctype.h>

#include "lisp.h"
#include "buffer.h"
#include "frame.h"
#include "dispextern.h"
#include "charset.h"
#include "character.h"
#include "composite.h"
#include "fontset.h"

	ASET (spec, FONT_REGISTRY_INDEX,
	      intern_downcase ((char *) SDATA (registry), SBYTES (registry)));
    }
}


/* OTF handler */

#ifdef HAVE_LIBOTF
#include <otf.h>

/* glyph-string handler */

/* GSTRING is a vector of this form:
	[ [FONT-OBJECT LBEARING RBEARING WIDTH ASCENT DESCENT] GLYPH ... ]
   and GLYPH is a vector of this form:
	[ FROM-IDX TO-IDX C CODE [ [X-OFF Y-OFF WIDTH WADJUST] | nil] ]
   where
	FROM-IDX and TO-IDX are used internally and should not be touched.
	C is a character of the glyph.
	CODE is a glyph-code of C in FONT-OBJECT.
	X-OFF and Y-OFF are offests to the base position for the glyph.

  cmp->descent = font->descent;

  for (i = 0; i < len; i++)
    {
      Lisp_Object g = LGSTRING_GLYPH (gstring, i);
      unsigned code = XINT (LGLYPH_CODE (g));
      struct font_metrics metrics;

      font->driver->text_extents (font, &code, 1, &metrics);
      LGLYPH_SET_WIDTH (g, make_number (metrics.width));
      metrics.lbearing += LGLYPH_XOFF (g);
      metrics.rbearing += LGLYPH_XOFF (g);
      metrics.ascent += LGLYPH_YOFF (g);

void
font_close_object (f, font_object)
     FRAME_PTR f;
     Lisp_Object font_object;
{
  struct font *font;
  Lisp_Object objlist = AREF (font->entity, FONT_OBJLIST_INDEX);
  Lisp_Object tail, prev = Qnil;

  for (prev = Qnil, tail = objlist; CONSP (tail);
       prev = tail, tail = XCDR (tail))
    if (EQ (font_object, XCAR (tail)))
      {
	struct Lisp_Save_Value *p = XSAVE_VALUE (font_object);

	xassert (p->integer > 0);
	p->integer--;
	if (p->integer == 0)
	  {
	    if (font->driver->close)
	      font->driver->close (f, p->pointer);
	    p->pointer = NULL;
	    if (NILP (prev))
	      ASET (font->entity, FONT_OBJLIST_INDEX, XCDR (objlist));
	    else
	      XSETCDR (prev, XCDR (objlist));
	  }
	break;
      }
}

int
font_has_char (f, font, c)
     FRAME_PTR f;

      free (f->font_driver_list);
      f->font_driver_list = next;
    }
}


/* Lisp API */

DEFUN ("fontp", Ffontp, Sfontp, 1, 1, 0,
       doc: /* Return t if object is a font-spec or font-entity.  */)

     (font, prop)
     Lisp_Object font, prop;
{
  enum font_property_index idx;

  CHECK_FONT (font);
  idx = get_font_prop_index (prop, 0);
  if (idx < FONT_EXTRA_INDEX)
    return AREF (font, idx);
  if (FONT_ENTITY_P (font))
    return Qnil;

  gstring = Fmake_vector (make_number (len), Qnil);
  g = Fmake_vector (make_number (6), Qnil);
  ASET (g, 0, font_object);
  ASET (gstring, 0, g);
  for (i = 1; i < len; i++)
    ASET (gstring, i, Fmake_vector (make_number (8), make_number (0)));
  return gstring;
}

DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0,
       doc: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.

  unsigned code;
  struct font *font;

  CHECK_VECTOR (gstring);
  if (NILP (font_object))
    font_object = Faref (Faref (gstring, make_number (0)), make_number (0));
  CHECK_FONT_GET_OBJECT (font_object, font);

  if (STRINGP (object))
    {
      const unsigned char *p;

      CHECK_NATNUM (start);
      CHECK_NATNUM (end);
      if (XINT (start) > XINT (end)
	  || XINT (end) > ASIZE (object)
	  || XINT (end) - XINT (start) >= XINT (Flength (gstring)))
	args_out_of_range (start, end);

      len = XINT (end) - XINT (start);
      p = SDATA (object) + string_char_to_byte (object, XINT (start));
      for (i = 0; i < len; i++)

	  c = STRING_CHAR_ADVANCE (p);
	  code = font->driver->encode_char (font, c);
	  if (code > MOST_POSITIVE_FIXNUM)
	    error ("Glyph code 0x%X is too large", code);
	  ASET (g, 0, make_number (i));
	  ASET (g, 1, make_number (i + 1));
	  LGLYPH_SET_CHAR (g, make_number (c));
	  LGLYPH_SET_CODE (g, make_number (code));
	}
    }
  else

      int pos, pos_byte;

      if (! NILP (object))
	Fset_buffer (object);
      validate_region (&start, &end);
      if (XINT (end) - XINT (start) > len)
	args_out_of_range (start, end);
      len = XINT (end) - XINT (start);
      pos = XINT (start);
      pos_byte = CHAR_TO_BYTE (pos);
      for (i = 0; i < len; i++)

	  FETCH_CHAR_ADVANCE (c, pos, pos_byte);
	  code = font->driver->encode_char (font, c);
	  if (code > MOST_POSITIVE_FIXNUM)
	    error ("Glyph code 0x%X is too large", code);
	  ASET (g, 0, make_number (i));
	  ASET (g, 1, make_number (i + 1));
	  LGLYPH_SET_CHAR (g, make_number (c));
	  LGLYPH_SET_CODE (g, make_number (code));
	}
    }
  return Qnil;
}

    CHECK_FONT_SPEC (font);

  return (font_match_p (spec, font) ? Qt : Qnil);
}

#if 0
DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
       doc: /*  Draw STRING by FONT-OBJECT on the top left corner of the current frame.
The value is a number of glyphs drawn.
Type C-l to recover what previously shown.  */)

  defsubr (&Sopen_font);
  defsubr (&Sclose_font);
  defsubr (&Squery_font);
  defsubr (&Sget_font_glyphs);
  defsubr (&Sfont_match_p);
#if 0
  defsubr (&Sdraw_string);
#endif
#endif	/* FONT_DEBUG */

90541:b7130e76c2f9

#include <ctype.h>

#include "lisp.h"
#include "buffer.h"
#include "frame.h"
#include "window.h"
#include "dispextern.h"
#include "charset.h"
#include "character.h"
#include "composite.h"
#include "fontset.h"

	ASET (spec, FONT_REGISTRY_INDEX,
	      intern_downcase ((char *) SDATA (registry), SBYTES (registry)));
    }
}

static Lisp_Object
font_lispy_object (font)
     struct font *font;
{
  Lisp_Object objlist = AREF (font->entity, FONT_OBJLIST_INDEX);

  for (; ! NILP (objlist); objlist = XCDR (objlist))
    {
      struct Lisp_Save_Value *p = XSAVE_VALUE (XCAR (objlist));

      if (font == (struct font *) p->pointer)
	break;
    }
  xassert (! NILP (objlist));
  return XCAR (objlist);
}


/* OTF handler */

#ifdef HAVE_LIBOTF
#include <otf.h>

/* glyph-string handler */

/* GSTRING is a vector of this form:
	[ [FONT-OBJECT LBEARING RBEARING WIDTH ASCENT DESCENT] GLYPH ... ]
   and GLYPH is a vector of this form:
	[ FROM-IDX TO-IDX C CODE WIDTH [ [X-OFF Y-OFF WADJUST] | nil] ]
   where
	FROM-IDX and TO-IDX are used internally and should not be touched.
	C is a character of the glyph.
	CODE is a glyph-code of C in FONT-OBJECT.
	X-OFF and Y-OFF are offests to the base position for the glyph.

  cmp->descent = font->descent;

  for (i = 0; i < len; i++)
    {
      Lisp_Object g = LGSTRING_GLYPH (gstring, i);
      unsigned code;
      struct font_metrics metrics;

      if (NILP (LGLYPH_FROM (g)))
	break;
      code = XINT (LGLYPH_CODE (g));
      font->driver->text_extents (font, &code, 1, &metrics);
      LGLYPH_SET_WIDTH (g, make_number (metrics.width));
      metrics.lbearing += LGLYPH_XOFF (g);
      metrics.rbearing += LGLYPH_XOFF (g);
      metrics.ascent += LGLYPH_YOFF (g);

void
font_close_object (f, font_object)
     FRAME_PTR f;
     Lisp_Object font_object;
{
  struct font *font = XSAVE_VALUE (font_object)->pointer;
  Lisp_Object objlist;
  Lisp_Object tail, prev = Qnil;

  XSAVE_VALUE (font_object)->integer--;
  xassert (XSAVE_VALUE (font_object)->integer >= 0);
  if (XSAVE_VALUE (font_object)->integer > 0)
    return;

  objlist = AREF (font->entity, FONT_OBJLIST_INDEX);
  for (prev = Qnil, tail = objlist; CONSP (tail);
       prev = tail, tail = XCDR (tail))
    if (EQ (font_object, XCAR (tail)))
      {
	if (font->driver->close)
	  font->driver->close (f, font);
	XSAVE_VALUE (font_object)->pointer = NULL;
	if (NILP (prev))
	  ASET (font->entity, FONT_OBJLIST_INDEX, XCDR (objlist));
	else
	  XSETCDR (prev, XCDR (objlist));
	return;
      }
  abort ();
}

int
font_has_char (f, font, c)
     FRAME_PTR f;

      free (f->font_driver_list);
      f->font_driver_list = next;
    }
}

Lisp_Object
font_at (c, pos, face, w, object)
     int c;
     EMACS_INT pos;
     struct face *face;
     struct window *w;
     Lisp_Object object;
{
  FRAME_PTR f;
  int face_id;
  int dummy;

  f = XFRAME (w->frame);
  if (! face)
    {
      if (STRINGP (object))
	face_id = face_at_string_position (w, object, pos, 0, -1, -1, &dummy,
					   DEFAULT_FACE_ID, 0);
      else
	face_id = face_at_buffer_position (w, pos, -1, -1, &dummy,
					   pos + 100, 0);
      face = FACE_FROM_ID (f, face_id);
    }
  face_id = FACE_FOR_CHAR (f, face, c, pos, object);
  face = FACE_FROM_ID (f, face_id);
  if (! face->font_info)
    return Qnil;
  return font_lispy_object ((struct font *) face->font_info);
}


/* Lisp API */

DEFUN ("fontp", Ffontp, Sfontp, 1, 1, 0,
       doc: /* Return t if object is a font-spec or font-entity.  */)

     (font, prop)
     Lisp_Object font, prop;
{
  enum font_property_index idx;

  if (FONT_OBJECT_P (font))
    font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity;
  else
    CHECK_FONT (font);
  idx = get_font_prop_index (prop, 0);
  if (idx < FONT_EXTRA_INDEX)
    return AREF (font, idx);
  if (FONT_ENTITY_P (font))
    return Qnil;

  gstring = Fmake_vector (make_number (len), Qnil);
  g = Fmake_vector (make_number (6), Qnil);
  ASET (g, 0, font_object);
  ASET (gstring, 0, g);
  for (i = 1; i < len; i++)
    ASET (gstring, i, Fmake_vector (make_number (8), Qnil));
  return gstring;
}

DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0,
       doc: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.

  unsigned code;
  struct font *font;

  CHECK_VECTOR (gstring);
  if (NILP (font_object))
    font_object = LGSTRING_FONT (gstring);
  CHECK_FONT_GET_OBJECT (font_object, font);

  if (STRINGP (object))
    {
      const unsigned char *p;

      CHECK_NATNUM (start);
      CHECK_NATNUM (end);
      if (XINT (start) > XINT (end)
	  || XINT (end) > ASIZE (object)
	  || XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
	args_out_of_range (start, end);

      len = XINT (end) - XINT (start);
      p = SDATA (object) + string_char_to_byte (object, XINT (start));
      for (i = 0; i < len; i++)

	  c = STRING_CHAR_ADVANCE (p);
	  code = font->driver->encode_char (font, c);
	  if (code > MOST_POSITIVE_FIXNUM)
	    error ("Glyph code 0x%X is too large", code);
	  LGLYPH_SET_FROM (g, make_number (i));
	  LGLYPH_SET_TO (g, make_number (i + 1));
	  LGLYPH_SET_CHAR (g, make_number (c));
	  LGLYPH_SET_CODE (g, make_number (code));
	}
    }
  else

      int pos, pos_byte;

      if (! NILP (object))
	Fset_buffer (object);
      validate_region (&start, &end);
      if (XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
	args_out_of_range (start, end);
      len = XINT (end) - XINT (start);
      pos = XINT (start);
      pos_byte = CHAR_TO_BYTE (pos);
      for (i = 0; i < len; i++)

	  FETCH_CHAR_ADVANCE (c, pos, pos_byte);
	  code = font->driver->encode_char (font, c);
	  if (code > MOST_POSITIVE_FIXNUM)
	    error ("Glyph code 0x%X is too large", code);
	  LGLYPH_SET_FROM (g, make_number (i));
	  LGLYPH_SET_TO (g, make_number (i + 1));
	  LGLYPH_SET_CHAR (g, make_number (c));
	  LGLYPH_SET_CODE (g, make_number (code));
	}
    }
  for (i = LGSTRING_LENGTH (gstring) - 1; i >= len; i--)
    {
      Lisp_Object g = LGSTRING_GLYPH (gstring, i);

      LGLYPH_SET_FROM (g, Qnil);
    }
  return Qnil;
}

    CHECK_FONT_SPEC (font);

  return (font_match_p (spec, font) ? Qt : Qnil);
}

DEFUN ("font-at", Ffont_at, Sfont_at, 1, 2, 0,
       doc: /* Return a font-object for displaying a character at POSISTION.
Optional second arg WINDOW, if non-nil, is a window displaying
the current buffer.  It defaults to the currently selected window.  */)
     (position, window)
     Lisp_Object position, window;
{
  struct window *w;
  EMACS_INT pos, pos_byte;
  int c;

  CHECK_NUMBER_COERCE_MARKER (position);
  pos = XINT (position);
  if (pos < BEGV || pos >= ZV)
    args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
  pos_byte = CHAR_TO_BYTE (pos);
  c = FETCH_CHAR (pos_byte);
  if (NILP (window))
    window = selected_window;
  CHECK_LIVE_WINDOW (window);
  w = XWINDOW (selected_window);

  return font_at (c, pos, NULL, w, Qnil);
}

#if 0
DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
       doc: /*  Draw STRING by FONT-OBJECT on the top left corner of the current frame.
The value is a number of glyphs drawn.
Type C-l to recover what previously shown.  */)

  defsubr (&Sopen_font);
  defsubr (&Sclose_font);
  defsubr (&Squery_font);
  defsubr (&Sget_font_glyphs);
  defsubr (&Sfont_match_p);
  defsubr (&Sfont_at);
#if 0
  defsubr (&Sdraw_string);
#endif
#endif	/* FONT_DEBUG */