emacs: src/font.c comparison

comparison src/font.c @ 97822:f44734c99365

(QCf): New variable. (check_gstring): Use LGSTRING_GLYPH_LEN, not LGSTRING_LENGTH. (font_prepare_composition): Delete this function. (font_range): Type and arguments changed. (Ffont_make_gstring, Ffont_fill_gstring): Delete them. (font_fill_lglyph_metrics): New function. (Ffont_shape_text): Renamed to Ffont_shape_gstring and arguments changed. (syms_of_font): DEFSYM QCf. Delete defsubr for Sfont_make_gstring, Sfont_fill_gstring, Sfont_shape_text. Defsubr Sfont_shape_gstring.

author	Kenichi Handa <handa@m17n.org>
date	Fri, 29 Aug 2008 07:54:44 +0000
parents	ec399baa25dd
children	fa1023e4960c

comparison

equal deleted inserted replaced

-:9d12856db185
+:f44734c99365
 #ifdef HAVE_NS
 #define DEFAULT_ENCODING Qiso10646_1
 #else
 #define DEFAULT_ENCODING Qiso8859_1
 #endif
+/* Unicode category `Cf'.  */
+static Lisp_Object QCf;
 /* Special vector of zero length.  This is repeatedly used by (struct
 font_driver *)->list when a specified font is not found. */
 static Lisp_Object null_vector;
 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
-for (i = 0; i < LGSTRING_LENGTH (gstring); i++)
+for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
 {
 val = LGSTRING_GLYPH (gstring, i);
 CHECK_VECTOR (val);
 if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
 	goto err;
 }
 return val;
 }
 #endif	/* HAVE_LIBOTF */
 #endif	/* 0 */
-/* G-string (glyph string) handler */
-/* G-string is a vector of the form [HEADER GLYPH ...].
-See the docstring of `font-make-gstring' for more detail.  */
-struct font *
-font_prepare_composition (cmp, f)
-struct composition *cmp;
-FRAME_PTR f;
-{
-Lisp_Object gstring
-= AREF (XHASH_TABLE (composition_hash_table)->key_and_value,
-	    cmp->hash_index * 2);
-cmp->font = XFONT_OBJECT (LGSTRING_FONT (gstring));
-cmp->glyph_len = LGSTRING_LENGTH (gstring);
-cmp->pixel_width = LGSTRING_WIDTH (gstring);
-cmp->lbearing = LGSTRING_LBEARING (gstring);
-cmp->rbearing = LGSTRING_RBEARING (gstring);
-cmp->ascent = LGSTRING_ASCENT (gstring);
-cmp->descent = LGSTRING_DESCENT (gstring);
-cmp->width = cmp->pixel_width / FRAME_COLUMN_WIDTH (f);
-if (cmp->width == 0)
-cmp->width = 1;
-return cmp->font;
-}
 /* Font sorting */
 static unsigned font_score P_ ((Lisp_Object, Lisp_Object *));
 foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
 if (! NILP (foundry[0]))
 foundry[1] = null_vector;
 else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
 {
-foundry[0] = font_intern_prop (SDATA (attrs[LFACE_FOUNDRY_INDEX]),
+val = attrs[LFACE_FOUNDRY_INDEX];
-				     SBYTES (attrs[LFACE_FOUNDRY_INDEX]), 1);
+foundry[0] = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
 foundry[1] = Qnil;
 foundry[2] = null_vector;
 }
 else
 foundry[0] = Qnil, foundry[1] = null_vector;
 adstyle[0] = Qnil, adstyle[1] = null_vector;
 val = AREF (work, FONT_FAMILY_INDEX);
 if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
-val = font_intern_prop (SDATA (attrs[LFACE_FAMILY_INDEX]),
+{
-			    SBYTES (attrs[LFACE_FAMILY_INDEX]), 1);
+val = attrs[LFACE_FAMILY_INDEX];
+val = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
+}
 if (NILP (val))
 {
 family = alloca ((sizeof family[0]) * 2);
 family[0] = Qnil;
 family[1] = null_vector;	/* terminator.  */
 XSETFONT (font_object, face->font);
 return font_object;
 }
-/* Check how many characters after POS (at most to LIMIT) can be
+#ifdef HAVE_WINDOW_SYSTEM
-displayed by the same font.  FACE is the face selected for the
-character as POS on frame F.  STRING, if not nil, is the string to
+/* Check how many characters after POS (at most to *LIMIT) can be
-check instead of the current buffer.
+displayed by the same font on the window W.  FACE, if non-NULL, is
+the face selected for the character at POS.  If STRING is not nil,
-The return value is the position of the character that is displayed
+it is the string to check instead of the current buffer.  In that
-by the differnt font than that of the character as POS.  */
+case, FACE must be not NULL.
-EMACS_INT
+The return value is the font-object for the character at POS.
-font_range (pos, limit, face, f, string)
+*LIMIT is set to the position where that font can't be used.
-EMACS_INT pos, limit;
+It is assured that the current buffer (or STRING) is multibyte.  */
+Lisp_Object
+font_range (pos, limit, w, face, string)
+EMACS_INT pos, *limit;
+struct window *w;
 struct face *face;
-FRAME_PTR f;
 Lisp_Object string;
 {
-int multibyte;
+EMACS_INT pos_byte, ignore, start, start_byte;
-EMACS_INT pos_byte;
 int c;
-struct font *font;
+Lisp_Object font_object = Qnil;
-int first = 1;
 if (NILP (string))
 {
-multibyte = ! NILP (current_buffer->enable_multibyte_characters);
 pos_byte = CHAR_TO_BYTE (pos);
+if (! face)
+	{
+	  int face_id;
+	  face_id = face_at_buffer_position (w, pos, 0, 0, &ignore, *limit, 0);
+	  face = FACE_FROM_ID (XFRAME (w->frame), face_id);
+	}
 }
 else
 {
-multibyte = STRING_MULTIBYTE (string);
+font_assert (face);
 pos_byte = string_char_to_byte (string, pos);
 }
-if (! multibyte)
+start = pos, start_byte = pos_byte;
-/* All unibyte character are displayed by the same font.  */
+while (pos < *limit)
-return limit;
+{
+Lisp_Object category;
-while (pos < limit)
-{
-int face_id;
 if (NILP (string))
 	FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte);
 else
 	FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
-face_id = FACE_FOR_CHAR (f, face, c, pos, string);
+if (NILP (font_object))
-face = FACE_FROM_ID (f, face_id);
+	{
-if (first)
+	  font_object = font_for_char (face, c, pos - 1, string);
-	{
+	  if (NILP (font_object))
-	  font = face->font;
+	    return Qnil;
-	  first = 0;
 	  continue;
 	}
-else if (font != face->font)
-	{
+category = CHAR_TABLE_REF (Vunicode_category_table, c);
-	  pos--;
+if (! EQ (category, QCf)
-	  break;
+	  && font_encode_char (font_object, c) == FONT_INVALID_CODE)
-	}
+	{
-}
+	  Lisp_Object f = font_for_char (face, c, pos - 1, string);
-return pos;
+	  EMACS_INT i, i_byte;
-}
+	  if (NILP (f))
+	    {
+	      *limit = pos - 1;
+	      return font_object;
+	    }
+	  i = start, i_byte = start_byte;
+	  while (i < pos - 1)
+	    {
+	      if (NILP (string))
+		FETCH_CHAR_ADVANCE_NO_CHECK (c, i, i_byte);
+	      else
+		FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, i, i_byte);
+	      category = CHAR_TABLE_REF (Vunicode_category_table, c);
+	      if (! EQ (category, QCf)
+		  && font_encode_char (f, c) == FONT_INVALID_CODE)
+		{
+		  *limit = pos - 1;
+		  return font_object;
+		}
+	    }
+	  font_object = f;
+	}
+}
+return font_object;
+}
+#endif
 /* Lisp API */
 DEFUN ("fontp", Ffontp, Sfontp, 1, 2, 0,
 }
 return Qnil;
 }
-/* The following three functions are still experimental.  */
+void
-DEFUN ("font-make-gstring", Ffont_make_gstring, Sfont_make_gstring, 2, 2, 0,
+font_fill_lglyph_metrics (glyph, font_object)
-doc: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
+Lisp_Object glyph, font_object;
-FONT-OBJECT may be nil if it is not yet known.
+{
+struct font *font = XFONT_OBJECT (font_object);
-G-string is sequence of glyphs of a specific font,
+unsigned code = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
-and is a vector of this form:
+struct font_metrics metrics;
-[ HEADER GLYPH ... ]
-HEADER is a vector of this form:
+LGLYPH_SET_CODE (glyph, code);
-[FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
+font->driver->text_extents (font, &code, 1, &metrics);
-where
+LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
-FONT-OBJECT is a font-object for all glyphs in the g-string,
+LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
-WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
+LGLYPH_SET_WIDTH (glyph, metrics.width);
-GLYPH is a vector of this form:
+LGLYPH_SET_ASCENT (glyph, metrics.ascent);
-[ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
+LGLYPH_SET_DESCENT (glyph, metrics.descent);
-[ [X-OFF Y-OFF WADJUST] | nil] ]
+}
-where
-FROM-IDX and TO-IDX are used internally and should not be touched.
-C is the character of the glyph.
+DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 1, 1, 0,
-CODE is the glyph-code of C in FONT-OBJECT.
+doc: /* Shape the glyph-string GSTRING.
-WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
+Shaping means substituting glyphs and/or adjusting positions of glyphs
-X-OFF and Y-OFF are offests to the base position for the glyph.
+to get the correct visual image of character sequences set in the
-WADJUST is the adjustment to the normal width of the glyph.  */)
+header of the glyph-string.
-(font_object, num)
-Lisp_Object font_object, num;
+If the shaping was successful, the value is GSTRING itself or a newly
-{
+created glyph-string.  Otherwise, the value is nil.  */)
-Lisp_Object gstring, g;
+(gstring)
-int len;
+Lisp_Object gstring;
+{
+struct font *font;
+Lisp_Object font_object, n, glyph;
 int i;
-if (! NILP (font_object))
+if (! composition_gstring_p (gstring))
-CHECK_FONT_OBJECT (font_object);
+signal_error ("Invalid glyph-string: ", gstring);
-CHECK_NATNUM (num);
+if (! NILP (LGSTRING_ID (gstring)))
+return gstring;
-len = XINT (num) + 1;
+font_object = LGSTRING_FONT (gstring);
-gstring = Fmake_vector (make_number (len), Qnil);
+CHECK_FONT_OBJECT (font_object);
-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 (10), Qnil));
-return gstring;
-}
-DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0,
-doc: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
-START and END specify the region to extract characters.
-If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
-where to extract characters.
-FONT-OBJECT may be nil if GSTRING already contains one.  */)
-(gstring, font_object, start, end, object)
-Lisp_Object gstring, font_object, start, end, object;
-{
-int len, i, c;
-unsigned code;
-struct font *font;
-CHECK_VECTOR (gstring);
-if (NILP (font_object))
-font_object = LGSTRING_FONT (gstring);
-font = XFONT_OBJECT (font_object);
-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_3 (object, start, end);
-len = XINT (end) - XINT (start);
-p = SDATA (object) + string_char_to_byte (object, XINT (start));
-for (i = 0; i < len; i++)
-	{
-	  Lisp_Object g = LGSTRING_GLYPH (gstring, i);
-	  /* Shut up GCC warning in comparison with
-	     MOST_POSITIVE_FIXNUM below.  */
-	  EMACS_INT cod;
-	  c = STRING_CHAR_ADVANCE (p);
-	  cod = code = font->driver->encode_char (font, c);
-	  if (cod > MOST_POSITIVE_FIXNUM || code == FONT_INVALID_CODE)
-	    break;
-	  LGLYPH_SET_FROM (g, i);
-	  LGLYPH_SET_TO (g, i);
-	  LGLYPH_SET_CHAR (g, c);
-	  LGLYPH_SET_CODE (g, 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++)
-	{
-	  Lisp_Object g = LGSTRING_GLYPH (gstring, i);
-	  /* Shut up GCC warning in comparison with
-	     MOST_POSITIVE_FIXNUM below.  */
-	  EMACS_INT cod;
-	  FETCH_CHAR_ADVANCE (c, pos, pos_byte);
-	  cod = code = font->driver->encode_char (font, c);
-	  if (cod > MOST_POSITIVE_FIXNUM || code == FONT_INVALID_CODE)
-	    break;
-	  LGLYPH_SET_FROM (g, i);
-	  LGLYPH_SET_TO (g, i);
-	  LGLYPH_SET_CHAR (g, c);
-	  LGLYPH_SET_CODE (g, code);
-	}
-}
-for (; i < LGSTRING_LENGTH (gstring); i++)
-LGSTRING_SET_GLYPH (gstring, i, Qnil);
-return Qnil;
-}
-DEFUN ("font-shape-text", Ffont_shape_text, Sfont_shape_text, 3, 4, 0,
-doc: /* Shape text between FROM and TO by FONT-OBJECT.
-If optional 4th argument STRING is non-nil, it is a string to shape,
-and FROM and TO are indices to the string.
-The value is the end position of the text that can be shaped by
-FONT-OBJECT.  */)
-(from, to, font_object, string)
-Lisp_Object from, to, font_object, string;
-{
-struct font *font;
-struct font_metrics metrics;
-EMACS_INT start, end;
-Lisp_Object gstring, n;
-int len, i;
-if (! FONT_OBJECT_P (font_object))
-return Qnil;
 font = XFONT_OBJECT (font_object);
 if (! font->driver->shape)
 return Qnil;
-if (NILP (string))
-{
-validate_region (&from, &to);
-start = XFASTINT (from);
-end = XFASTINT (to);
-modify_region (current_buffer, start, end, 0);
-}
-else
-{
-CHECK_STRING (string);
-start = XINT (from);
-end = XINT (to);
-if (start < 0 || start > end || end > SCHARS (string))
-	args_out_of_range_3 (string, from, to);
-}
-len = end - start;
-gstring = Ffont_make_gstring (font_object, make_number (len));
-Ffont_fill_gstring (gstring, font_object, from, to, string);
 /* Try at most three times with larger gstring each time.  */
 for (i = 0; i < 3; i++)
 {
-Lisp_Object args[2];
 n = font->driver->shape (gstring);
 if (INTEGERP (n))
 	break;
-args[0] = gstring;
+gstring = larger_vector (gstring,
-args[1] = Fmake_vector (make_number (len), Qnil);
+			       ASIZE (gstring) + LGSTRING_GLYPH_LEN (gstring),
-gstring = Fvconcat (2, args);
+			       Qnil);
 }
-if (! INTEGERP (n) || XINT (n) == 0)
+if (i == 3 || XINT (n) == 0)
 return Qnil;
-len = XINT (n);
+glyph = LGSTRING_GLYPH (gstring, 0);
-for (i = 0; i < len;)
+for (i = 1; i < LGSTRING_GLYPH_LEN (gstring); i++)
 {
-Lisp_Object gstr;
+Lisp_Object this = LGSTRING_GLYPH (gstring, i);
-Lisp_Object g = LGSTRING_GLYPH (gstring, i);
-EMACS_INT this_from = LGLYPH_FROM (g);
+if (NILP (this))
-EMACS_INT this_to = LGLYPH_TO (g) + 1;
+	break;
-int j, k;
+if (NILP (LGLYPH_ADJUSTMENT (this)))
-int need_composition = 0;
+	glyph = this;
-metrics.lbearing = LGLYPH_LBEARING (g);
-metrics.rbearing = LGLYPH_RBEARING (g);
-metrics.ascent = LGLYPH_ASCENT (g);
-metrics.descent = LGLYPH_DESCENT (g);
-if (NILP (LGLYPH_ADJUSTMENT (g)))
-	{
-	  metrics.width = LGLYPH_WIDTH (g);
-	  if (LGLYPH_CHAR (g) == 0 || metrics.width == 0)
-	    need_composition = 1;
-	}
 else
 	{
-	  metrics.width = LGLYPH_WADJUST (g);
+	  int from = LGLYPH_FROM (glyph);
-	  metrics.lbearing += LGLYPH_XOFF (g);
+	  int to = LGLYPH_TO (glyph);
-	  metrics.rbearing += LGLYPH_XOFF (g);
-	  metrics.ascent -= LGLYPH_YOFF (g);
+	  LGLYPH_SET_FROM (this, from);
-	  metrics.descent += LGLYPH_YOFF (g);
+	  LGLYPH_SET_TO (this, to);
-	  need_composition = 1;
+	}
-	}
+}
-for (j = i + 1; j < len; j++)
+return composition_gstring_put_cache (gstring, XINT (n));
-	{
-	  int x;
-	  g = LGSTRING_GLYPH (gstring, j);
-	  if (this_from != LGLYPH_FROM (g))
-	    break;
-	  need_composition = 1;
-	  x = metrics.width + LGLYPH_LBEARING (g) + LGLYPH_XOFF (g);
-	  if (metrics.lbearing > x)
-	    metrics.lbearing = x;
-	  x = metrics.width + LGLYPH_RBEARING (g) + LGLYPH_XOFF (g);
-	  if (metrics.rbearing < x)
-	    metrics.rbearing = x;
-	  x = LGLYPH_ASCENT (g) - LGLYPH_YOFF (g);
-	  if (metrics.ascent < x)
-	    metrics.ascent = x;
-	  x = LGLYPH_DESCENT (g) - LGLYPH_YOFF (g);
-	  if (metrics.descent < x)
-	    metrics.descent = x;
-	  if (NILP (LGLYPH_ADJUSTMENT (g)))
-	    metrics.width += LGLYPH_WIDTH (g);
-	  else
-	    metrics.width += LGLYPH_WADJUST (g);
-	}
-if (need_composition)
-	{
-	  gstr = Ffont_make_gstring (font_object, make_number (j - i));
-	  LGSTRING_SET_WIDTH (gstr, metrics.width);
-	  LGSTRING_SET_LBEARING (gstr, metrics.lbearing);
-	  LGSTRING_SET_RBEARING (gstr, metrics.rbearing);
-	  LGSTRING_SET_ASCENT (gstr, metrics.ascent);
-	  LGSTRING_SET_DESCENT (gstr, metrics.descent);
-	  for (k = i; i < j; i++)
-	    {
-	      Lisp_Object g = LGSTRING_GLYPH (gstring, i);
-	      LGLYPH_SET_FROM (g, LGLYPH_FROM (g) - this_from);
-	      LGLYPH_SET_TO (g, LGLYPH_TO (g) - this_from);
-	      LGSTRING_SET_GLYPH (gstr, i - k, LGSTRING_GLYPH (gstring, i));
-	    }
-	  from = make_number (start + this_from);
-	  to = make_number (start + this_to);
-	  if (NILP (string))
-	    Fcompose_region_internal (from, to, gstr, Qnil);
-	  else
-	    Fcompose_string_internal (string, from, to, gstr, Qnil);
-	}
-else
-	i = j;
-}
-return to;
 }
 #if 0
 DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
 }
 if (EQ (Vfont_log, Qt))
 return;
 if (STRINGP (AREF (Vfont_log_deferred, 0)))
 {
-char *str = SDATA (AREF (Vfont_log_deferred, 0));
+char *str = (char *) SDATA (AREF (Vfont_log_deferred, 0));
 ASET (Vfont_log_deferred, 0, Qnil);
 font_add_log (str, AREF (Vfont_log_deferred, 1),
 		    AREF (Vfont_log_deferred, 2));
 }
 DEFSYM (Qascii_0, "ascii-0");
 DEFSYM (Qiso8859_1, "iso8859-1");
 DEFSYM (Qiso10646_1, "iso10646-1");
 DEFSYM (Qunicode_bmp, "unicode-bmp");
 DEFSYM (Qunicode_sip, "unicode-sip");
+DEFSYM (QCf, "Cf");
 DEFSYM (QCotf, ":otf");
 DEFSYM (QClang, ":lang");
 DEFSYM (QCscript, ":script");
 DEFSYM (QCantialias, ":antialias");
 defsubr (&Slist_fonts);
 defsubr (&Sfont_family_list);
 defsubr (&Sfind_font);
 defsubr (&Sfont_xlfd_name);
 defsubr (&Sclear_font_cache);
-defsubr (&Sfont_make_gstring);
+defsubr (&Sfont_shape_gstring);
-defsubr (&Sfont_fill_gstring);
-defsubr (&Sfont_shape_text);
 #if 0
 defsubr (&Sfont_drive_otf);
 defsubr (&Sfont_otf_alternates);
 #endif	/* 0 */

Mercurial > emacs

comparison src/font.c @ 97822:f44734c99365