Mercurial > emacs

changeset 91135:49dbc35e3f99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* font.c [HAVE_M17N_FLT]: Include <m17n-flt.h>. (font_charset_alist): Moved from xfont.c and renamed. (font_registry_charsets): Likewise. (font_prop_validate_otf): New function. (font_property_table): Register it for QCotf. (DEVICE_DELTA, adjust_anchor, REPLACEMENT_CHARACTER) (font_drive_otf): Deleted. (font_prepare_composition): New arg F. Adjusted for the change of lispy gstring. (font_find_for_lface): New arg C. (font_load_for_face): Adjusted for the change of font_find_for_lface. (Ffont_make_gstring): Adjusted for the change of lispy gstring. (Ffont_fill_gstring): Likewise. (Ffont_shape_text): New function. (Fopen_font): If the font size is not given, use 12-pixel. (Ffont_at): New arg STRING. (syms_of_font): Initalize font_charset_alist. Declare Ffont_shape_text as a Lisp function. Call syms_of_XXfont conditionally.
author Kenichi Handa <handa@m17n.org>
date Sat, 01 Dec 2007 02:38:23 +0000
parents d8c3402ee3fa
children d54684fee154
files src/font.c
diffstat 1 files changed, 356 insertions(+), 351 deletions(-) [+]
line wrap: on
line diff
--- a/src/font.c	Sat Dec 01 02:37:59 2007 +0000
+++ b/src/font.c	Sat Dec 01 02:38:23 2007 +0000
@@ -25,6 +25,9 @@
 #include <stdio.h>
 #include <stdlib.h>
 #include <ctype.h>
+#ifdef HAVE_M17N_FLT
+#include <m17n-flt.h>
+#endif
 
 #include "lisp.h"
 #include "buffer.h"
@@ -109,6 +112,24 @@
 /* Symbols representing values of font spacing property.  */
 Lisp_Object Qc, Qm, Qp, Qd;
 
+/* Alist of font registry symbol and the corresponding charsets
+   information.  The information is retrieved from
+   Vfont_encoding_alist on demand.
+
+   Eash element has the form:
+	(REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
+   or
+	(REGISTRY . nil)
+
+   In the former form, ENCODING-CHARSET-ID is an ID of a charset that
+   encodes a character code to a glyph code of a font, and
+   REPERTORY-CHARSET-ID is an ID of a charset that tells if a
+   character is supported by a font.
+
+   The latter form means that the information for REGISTRY couldn't be
+   retrieved.  */
+static Lisp_Object font_charset_alist;
+
 /* List of all font drivers.  Each font-backend (XXXfont.c) calls
    register_font_driver in syms_of_XXXfont to register its font-driver
    here.  */
@@ -251,6 +272,69 @@
     }
 }
 
+extern Lisp_Object find_font_encoding P_ ((Lisp_Object));
+
+/* Return encoding charset and repertory charset for REGISTRY in
+   ENCODING and REPERTORY correspondingly.  If correct information for
+   REGISTRY is available, return 0.  Otherwise return -1.  */
+
+int
+font_registry_charsets (registry, encoding, repertory)
+     Lisp_Object registry;
+     struct charset **encoding, **repertory;
+{
+  Lisp_Object val;
+  int encoding_id, repertory_id;
+
+  val = assq_no_quit (registry, font_charset_alist);
+  if (! NILP (val))
+    {
+      val = XCDR (val);
+      if (NILP (val))
+	return -1;
+      encoding_id = XINT (XCAR (val));
+      repertory_id = XINT (XCDR (val));
+    }
+  else
+    {
+      val = find_font_encoding (SYMBOL_NAME (registry));
+      if (SYMBOLP (val) && CHARSETP (val))
+	{
+	  encoding_id = repertory_id = XINT (CHARSET_SYMBOL_ID (val));
+	}
+      else if (CONSP (val))
+	{
+	  if (! CHARSETP (XCAR (val)))
+	    goto invalid_entry;
+	  encoding_id = XINT (CHARSET_SYMBOL_ID (XCAR (val)));
+	  if (NILP (XCDR (val)))
+	    repertory_id = -1;
+	  else
+	    {
+	      if (! CHARSETP (XCDR (val)))
+		goto invalid_entry;
+	      repertory_id = XINT (CHARSET_SYMBOL_ID (XCDR (val)));
+	    }
+	}      
+      else
+	goto invalid_entry;
+      val = Fcons (make_number (encoding_id), make_number (repertory_id));
+      font_charset_alist
+	= nconc2 (font_charset_alist, Fcons (Fcons (registry, val), Qnil));
+    }
+
+  if (encoding)
+    *encoding = CHARSET_FROM_ID (encoding_id);
+  if (repertory)
+    *repertory = repertory_id >= 0 ? CHARSET_FROM_ID (repertory_id) : NULL;
+  return 0;
+
+ invalid_entry:
+  font_charset_alist
+    = nconc2 (font_charset_alist, Fcons (Fcons (registry, Qnil), Qnil));
+  return -1;
+}
+
 
 /* Font property value validaters.  See the comment of
    font_property_table for the meaning of the arguments.  */
@@ -329,6 +413,41 @@
   return Qerror;
 }
 
+static Lisp_Object
+font_prop_validate_otf (prop, val)
+     Lisp_Object prop, val;
+{
+  Lisp_Object tail, tmp;
+  int i;
+
+  /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
+     GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
+     GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil  */
+  if (! CONSP (val))
+    return Qerror;
+  if (! SYMBOLP (XCAR (val)))
+    return Qerror;
+  tail = XCDR (val);
+  if (NILP (tail))
+    return val;
+  if (! CONSP (tail) || ! SYMBOLP (XCAR (val)))
+    return Qerror;
+  for (i = 0; i < 2; i++)
+    {
+      tail = XCDR (tail);
+      if (NILP (tail))
+	return val;
+      if (! CONSP (tail))
+	return Qerror;
+      for (tmp = XCAR (tail); CONSP (tmp); tmp = XCDR (tmp))
+	if (! SYMBOLP (XCAR (tmp)))
+	  return Qerror;
+      if (! NILP (tmp))
+	return Qerror;
+    }
+  return val;
+}
+
 /* Structure of known font property keys and validater of the
    values.  */
 struct
@@ -354,7 +473,7 @@
     { &QCdpi, font_prop_validate_non_neg },
     { &QCspacing, font_prop_validate_spacing },
     { &QCscalable, NULL },
-    { &QCotf, font_prop_validate_symbol },
+    { &QCotf, font_prop_validate_otf },
     { &QCantialias, font_prop_validate_symbol }
   };
 
@@ -1662,31 +1781,6 @@
     error ("OTF spec too long");
 }
 
-#define DEVICE_DELTA(table, size)				\
-  (((size) >= (table).StartSize && (size) <= (table).EndSize)	\
-   ? (table).DeltaValue[(size) - (table).StartSize]		\
-   : 0)
-
-void
-adjust_anchor (struct font *font, OTF_Anchor *anchor,
-	       unsigned code, int size, int *x, int *y)
-{
-  if (anchor->AnchorFormat == 2 && font->driver->anchor_point)
-    {
-      int x0, y0;
-
-      if (font->driver->anchor_point (font, code, anchor->f.f1.AnchorPoint,
-				      &x0, &y0) >= 0)
-	*x = x0, *y = y0;
-    }
-  else if (anchor->AnchorFormat == 3)
-    {
-      if (anchor->f.f2.XDeviceTable.offset)
-	*x += DEVICE_DELTA (anchor->f.f2.XDeviceTable, size);
-      if (anchor->f.f2.YDeviceTable.offset)
-	*y += DEVICE_DELTA (anchor->f.f2.YDeviceTable, size);
-    }
-}
 
 Lisp_Object
 font_otf_DeviceTable (device_table)
@@ -1743,244 +1837,6 @@
   return val;
 }
 
-#define REPLACEMENT_CHARACTER 0xFFFD
-
-/* Drive FONT's OpenType FEATURES.  See the comment of (sturct
-   font_driver).drive_otf.  */
-
-int
-font_drive_otf (font, otf_features, gstring_in, from, to, gstring_out, idx,
-	       alternate_subst)
-     struct font *font;
-     Lisp_Object otf_features;
-     Lisp_Object gstring_in;
-     int from, to;
-     Lisp_Object gstring_out;
-     int idx, alternate_subst;
-{
-  Lisp_Object val;
-  int len;
-  int i;
-  OTF *otf;
-  OTF_GlyphString otf_gstring;
-  OTF_Glyph *g;
-  char *script, *langsys = NULL, *gsub_features = NULL, *gpos_features = NULL;
-  int need_cmap;
-
-  val = XCAR (otf_features);
-  script = SDATA (SYMBOL_NAME (val));
-  otf_features = XCDR (otf_features);
-  val = XCAR (otf_features);
-  langsys = NILP (val) ? NULL : SDATA (SYMBOL_NAME (val));
-  otf_features = XCDR (otf_features);
-  val = XCAR (otf_features);
-  if (! NILP (val))
-    {
-      gsub_features = alloca (XINT (Flength (val)) * 6);
-      generate_otf_features (val, &script, &langsys, gsub_features);
-    }
-  otf_features = XCDR (otf_features);
-  val = XCAR (otf_features);
-  if (! NILP (val))
-    {
-      gpos_features = alloca (XINT (Flength (val)) * 6);
-      generate_otf_features (val, &script, &langsys, gpos_features);
-    }
-
-  otf = otf_open (font->entity, font->file_name);
-  if (! otf)
-    return 0;
-  if (OTF_get_table (otf, "head") < 0)
-    return 0;
-  if (OTF_get_table (otf, "cmap") < 0)
-    return 0;
-  if ((! gsub_features || OTF_check_table (otf, "GSUB") < 0)
-      && (! gpos_features || OTF_check_table (otf, "GPOS") < 0))
-    return 0;
-
-  len = to - from;
-  otf_gstring.size = otf_gstring.used = len;
-  otf_gstring.glyphs = (OTF_Glyph *) malloc (sizeof (OTF_Glyph) * len);
-  memset (otf_gstring.glyphs, 0, sizeof (OTF_Glyph) * len);
-  for (i = 0, need_cmap = 0; i < len; i++)
-    {
-      Lisp_Object g = LGSTRING_GLYPH (gstring_in, from + i);
-
-      otf_gstring.glyphs[i].c = XINT (LGLYPH_CHAR (g));
-      if (otf_gstring.glyphs[i].c == REPLACEMENT_CHARACTER)
-	otf_gstring.glyphs[i].c = 0;
-      if (NILP (LGLYPH_CODE (g)))
-	{
-	  otf_gstring.glyphs[i].glyph_id = 0;
-	  need_cmap = 1;
-	}
-      else
-	otf_gstring.glyphs[i].glyph_id = XINT (LGLYPH_CODE (g));
-    }
-  if (need_cmap)
-    OTF_drive_cmap (otf, &otf_gstring);
-  OTF_drive_gdef (otf, &otf_gstring);
-
-  if (gsub_features)
-    {
-      if ((alternate_subst
-	   ? OTF_drive_gsub_alternate (otf, &otf_gstring, script, langsys,
-				       gsub_features)
-	   : OTF_drive_gsub (otf, &otf_gstring, script, langsys,
-			     gsub_features)) < 0)
-	{
-	  free (otf_gstring.glyphs);
-	  return 0;
-	}
-      if (ASIZE (gstring_out) < idx + otf_gstring.used)
-	{
-	  free (otf_gstring.glyphs);
-	  return -1;
-	}
-      for (i = 0, g = otf_gstring.glyphs; i < otf_gstring.used;)
-	{
-	  int i0 = g->f.index.from, i1 = g->f.index.to;
-	  Lisp_Object glyph = LGSTRING_GLYPH (gstring_in, from + i0);
-	  Lisp_Object min_idx = AREF (glyph, 0);
-	  Lisp_Object max_idx = AREF (glyph, 1);
-
-	  if (i0 < i1)
-	    {
-	      int min_idx_i = XINT (min_idx), max_idx_i = XINT (max_idx);
-
-	      for (i0++; i0 <= i1; i0++)
-		{
-		  glyph = LGSTRING_GLYPH (gstring_in, from + i0);
-		  if (min_idx_i > XINT (AREF (glyph, 0)))
-		    min_idx_i = XINT (AREF (glyph, 0));
-		  if (max_idx_i < XINT (AREF (glyph, 1)))
-		    max_idx_i = XINT (AREF (glyph, 1));
-		}
-	      min_idx = make_number (min_idx_i);
-	      max_idx = make_number (max_idx_i);
-	      i0 = g->f.index.from;
-	    }
-	  for (; i < otf_gstring.used && g->f.index.from == i0; i++, g++)
-	    {
-	      glyph = LGSTRING_GLYPH (gstring_out, idx + i);
-	      ASET (glyph, 0, min_idx);
-	      ASET (glyph, 1, max_idx);
-	      if (g->c > 0)
-		LGLYPH_SET_CHAR (glyph, make_number (g->c));
-	      else
-		LGLYPH_SET_CHAR (glyph, make_number (REPLACEMENT_CHARACTER));
-	      LGLYPH_SET_CODE (glyph, make_number (g->glyph_id));
-	    }
-	}
-    }
-
-  if (gpos_features)
-    {
-      Lisp_Object glyph;
-      int u = otf->head->unitsPerEm;
-      int size = font->pixel_size;
-      Lisp_Object base = Qnil, mark = Qnil;
-
-      if (OTF_drive_gpos (otf, &otf_gstring, script, langsys,
-			  gpos_features) < 0)
-	{
-	  free (otf_gstring.glyphs);
-	  return 0;
-	}
-      for (i = 0, g = otf_gstring.glyphs; i < otf_gstring.used; i++, g++)
-	{
-	  Lisp_Object prev;
-	  int xoff = 0, yoff = 0, width_adjust = 0;
-
-	  if (! g->glyph_id)
-	    continue;
-
-	  switch (g->positioning_type)
-	    {
-	    case 0:
-	      break;
-	    case 1: case 2:
-	      {
-		int format = g->f.f1.format;
-
-		if (format & OTF_XPlacement)
-		  xoff = g->f.f1.value->XPlacement * size / u;
-		if (format & OTF_XPlaDevice)
-		  xoff += DEVICE_DELTA (g->f.f1.value->XPlaDevice, size);
-		if (format & OTF_YPlacement)
-		  yoff = - (g->f.f1.value->YPlacement * size / u);
-		if (format & OTF_YPlaDevice)
-		  yoff -= DEVICE_DELTA (g->f.f1.value->YPlaDevice, size);
-		if (format & OTF_XAdvance)
-		  width_adjust += g->f.f1.value->XAdvance * size / u;
-		if (format & OTF_XAdvDevice)
-		  width_adjust += DEVICE_DELTA (g->f.f1.value->XAdvDevice, size);
-	      }
-	      break;
-	    case 3:
-	      /* Not yet supported.  */
-	      break;
-	    case 4: case 5:
-	      if (NILP (base))
-		break;
-	      prev = base;
-	      goto label_adjust_anchor;
-	    default:		/* i.e. case 6 */
-	      if (NILP (mark))
-		break;
-	      prev = mark;
-
-	    label_adjust_anchor:
-	      {
-		int base_x, base_y, mark_x, mark_y, width;
-		unsigned code;
-
-		base_x = g->f.f4.base_anchor->XCoordinate * size / u;
-		base_y = g->f.f4.base_anchor->YCoordinate * size / u;
-		mark_x = g->f.f4.mark_anchor->XCoordinate * size / u;
-		mark_y = g->f.f4.mark_anchor->YCoordinate * size / u;
-
-		code = XINT (LGLYPH_CODE (prev));
-		if (g->f.f4.base_anchor->AnchorFormat != 1)
-		  adjust_anchor (font, g->f.f4.base_anchor,
-				 code, size, &base_x, &base_y);
-		if (g->f.f4.mark_anchor->AnchorFormat != 1)
-		  adjust_anchor (font, g->f.f4.mark_anchor,
-				 code, size, &mark_x, &mark_y);
-
-		if (NILP (LGLYPH_WIDTH (prev)))
-		  {
-		    width = font->driver->text_extents (font, &code, 1, NULL);
-		    LGLYPH_SET_WIDTH (prev, make_number (width));
-		  }
-		else
-		  width = XINT (LGLYPH_WIDTH (prev));
-		xoff = XINT (LGLYPH_XOFF (prev)) + (base_x - width) - mark_x;
-		yoff = XINT (LGLYPH_YOFF (prev)) + mark_y - base_y;
-	      }
-	    }
-	  if (xoff || yoff || width_adjust)
-	    {
-	      Lisp_Object adjustment = Fmake_vector (make_number (3), Qnil);
-
-	      ASET (adjustment, 0, make_number (xoff));
-	      ASET (adjustment, 1, make_number (yoff));
-	      ASET (adjustment, 2, make_number (width_adjust));
-	      LGLYPH_SET_ADJUSTMENT (glyph, adjustment);
-	    }
-	  if (g->GlyphClass == OTF_GlyphClass0)
-	    base = mark = glyph;
-	  else if (g->GlyphClass == OTF_GlyphClassMark)
-	    mark = glyph;
-	  else
-	    base = glyph;
-	}
-    }
-
-  free (otf_gstring.glyphs);  
-  return i;
-}
-
 #endif	/* HAVE_LIBOTF */
 
 /* G-string (glyph string) handler */
@@ -1989,55 +1845,26 @@
    See the docstring of `font-make-gstring' for more detail.  */
 
 struct font *
-font_prepare_composition (cmp)
+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);
-  struct font *font = XSAVE_VALUE (LGSTRING_FONT (gstring))->pointer;
-  int len = LGSTRING_LENGTH (gstring);
-  int i;
-
-  cmp->font = font;
-  cmp->lbearing = cmp->rbearing = cmp->pixel_width = 0;
-  cmp->ascent = font->ascent;
-  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);
-      metrics.descent += LGLYPH_YOFF (g);
-
-      if (cmp->lbearing > cmp->pixel_width + metrics.lbearing)
-	cmp->lbearing = cmp->pixel_width + metrics.lbearing;
-      if (cmp->rbearing < cmp->pixel_width + metrics.rbearing)
-	cmp->rbearing = cmp->pixel_width + metrics.rbearing;
-      if (cmp->ascent < metrics.ascent)
-	cmp->ascent = metrics.ascent;
-      if (cmp->descent < metrics.descent)
-	cmp->descent = metrics.descent;
-      cmp->pixel_width += metrics.width + LGLYPH_WADJUST (g);
-    }
-  cmp->glyph_len = i;
-  LGSTRING_SET_LBEARING (gstring, make_number (cmp->lbearing));
-  LGSTRING_SET_RBEARING (gstring, make_number (cmp->rbearing));
-  LGSTRING_SET_WIDTH (gstring, make_number (cmp->pixel_width));
-  LGSTRING_SET_ASCENT (gstring, make_number (cmp->ascent));
-  LGSTRING_SET_DESCENT (gstring, make_number (cmp->descent));
-
-  return font;
+
+  cmp->font = XSAVE_VALUE (LGSTRING_FONT (gstring))->pointer;
+  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;
 }
 
 int
@@ -2559,7 +2386,8 @@
 }
 
 
-/* Return 1 iff FONT on F has a glyph for character C.  */
+/* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
+   FONT is a font-entity and it must be opened to check.  */
 
 int
 font_has_char (f, font, c)
@@ -2658,13 +2486,15 @@
 
 
 /* Find a font entity best matching with LFACE.  If SPEC is non-nil,
-   the font must exactly match with it.  */
+   the font must exactly match with it.  C, if not negative, is a
+   character that the entity must support.  */
 
 Lisp_Object
-font_find_for_lface (f, lface, spec)
+font_find_for_lface (f, lface, spec, c)
      FRAME_PTR f;
      Lisp_Object *lface;
      Lisp_Object spec;
+     int c;
 {
   Lisp_Object frame, entities;
   int i;
@@ -2673,6 +2503,8 @@
 
   if (NILP (spec))
     {
+      if (c >= 0x100)
+	return Qnil;
       for (i = 0; i < FONT_SPEC_MAX; i++)
 	ASET (scratch_font_spec, i, Qnil);
       ASET (scratch_font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
@@ -2700,10 +2532,32 @@
     }
   else
     {
+      Lisp_Object registry = AREF (spec, FONT_REGISTRY_INDEX);
+
+      if (NILP (registry))
+	registry = Qiso8859_1;
+
+      if (c >= 0)
+	{
+	  struct charset *repertory;
+
+	  if (font_registry_charsets (registry, NULL, &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 > MAX_UNICODE_CHAR)
+	    return Qnil;
+	}
       for (i = 0; i < FONT_SPEC_MAX; i++)
 	ASET (scratch_font_spec, i, AREF (spec, i));
-      if (NILP (AREF (spec, FONT_REGISTRY_INDEX)))
-	ASET (scratch_font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
+      ASET (scratch_font_spec, FONT_REGISTRY_INDEX, registry);
       entities = font_list_entities (frame, scratch_font_spec);
     }
 
@@ -2729,12 +2583,29 @@
       font_sort_entites (entities, prefer, frame, spec);
     }
 
-  return AREF (entities, 0);
+  if (c < 0)
+    return AREF (entities, 0);
+  for (i = 0; i < ASIZE (entities); i++)
+    {
+      int result = font_has_char (f, AREF (entities, i), c);
+      Lisp_Object font_object;
+
+      if (result > 0)
+	return AREF (entities, i);
+      if (result <= 0)
+	continue;
+      font_object = font_open_for_lface (f, AREF (entities, i), lface, spec);
+      if (NILP (font_object))
+	continue;
+      result = font_has_char (f, font_object, c);
+      font_close_object (f, font_object);
+      if (result > 0)
+	return AREF (entities, i);
+    }      
+  return Qnil;
 }
 
 
-
-
 Lisp_Object
 font_open_for_lface (f, entity, lface, spec)
      FRAME_PTR f;
@@ -2770,7 +2641,7 @@
 
   if (NILP (font_object))
     {
-      Lisp_Object entity = font_find_for_lface (f, face->lface, Qnil);
+      Lisp_Object entity = font_find_for_lface (f, face->lface, Qnil, -1);
 
       if (! NILP (entity))
 	font_object = font_open_for_lface (f, entity, face->lface, Qnil);
@@ -3433,18 +3304,19 @@
 and is a vector of this form:
     [ HEADER GLYPH ... ]
 HEADER is a vector of this form:
-    [FONT-OBJECT LBEARING RBEARING WIDTH ASCENT DESCENT]
+    [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
 where
     FONT-OBJECT is a font-object for all glyphs in the g-string,
-    LBEARING thry DESCENT is the metrics (in pixels) of the whole G-string.
+    WIDTH thry DESCENT are the metrics (in pixels) of the whole G-string.
 GLYPH is a vector of this form:
-    [ FROM-IDX TO-IDX C CODE WIDTH [ [X-OFF Y-OFF WADJUST] | nil] ]
+    [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT 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.
     CODE is the glyph-code of C in FONT-OBJECT.
+    WIDTH thry DESCENT are the metrics (in pixels) of the glyph.
     X-OFF and Y-OFF are offests to the base position for the glyph.
-    WIDTH is the normal width of the glyph.
     WADJUST is the adjustment to the normal width of the glyph.  */)
      (font_object, num)
      Lisp_Object font_object, num;
@@ -3463,7 +3335,7 @@
   ASET (g, 0, font_object);
   ASET (gstring, 0, g);
   for (i = 1; i < len; i++)
-    ASET (gstring, i, Fmake_vector (make_number (8), Qnil));
+    ASET (gstring, i, Fmake_vector (make_number (10), Qnil));
   return gstring;
 }
 
@@ -3494,7 +3366,7 @@
       if (XINT (start) > XINT (end)
 	  || XINT (end) > ASIZE (object)
 	  || XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
-	args_out_of_range (start, end);
+	args_out_of_range_3 (object, start, end);
 
       len = XINT (end) - XINT (start);
       p = SDATA (object) + string_char_to_byte (object, XINT (start));
@@ -3506,10 +3378,10 @@
 	  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));
+	  LGLYPH_SET_FROM (g, i);
+	  LGLYPH_SET_TO (g, i);
+	  LGLYPH_SET_CHAR (g, c);
+	  LGLYPH_SET_CODE (g, code);
 	}
     }
   else
@@ -3532,19 +3404,123 @@
 	  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));
+	  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) - 1; i >= len; 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 shaped text.  */)
+     (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 i;
+
+  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);
+    }
+
+  CHECK_FONT_GET_OBJECT (font_object, font);
+  if (! font->driver->shape)
+    return from;
+
+  gstring = Ffont_make_gstring (font_object, make_number (end - start));
+  Ffont_fill_gstring (gstring, font_object, from, to, string);
+  n = font->driver->shape (gstring);
+  if (NILP (n))
+    return Qnil;
+  for (i = 0; i < XINT (n);)
+    {
+      Lisp_Object gstr;
       Lisp_Object g = LGSTRING_GLYPH (gstring, i);
-
-      LGLYPH_SET_FROM (g, Qnil);
+      EMACS_INT this_from = LGLYPH_FROM (g);
+      EMACS_INT this_to = LGLYPH_TO (g) + 1;
+      int j, k;
+
+      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);
+      else
+	{
+	  metrics.width = LGLYPH_WADJUST (g);
+	  metrics.lbearing += LGLYPH_XOFF (g);
+	  metrics.rbearing += LGLYPH_XOFF (g);
+	  metrics.ascent -= LGLYPH_YOFF (g);
+	  metrics.descent += LGLYPH_YOFF (g);
+	}
+      for (j = i + 1; j < XINT (n); j++)
+	{
+	  int x;
+
+	  g = LGSTRING_GLYPH (gstring, j);
+	  if (this_from != LGLYPH_FROM (g))
+	    break;
+	  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);
+	}
+
+      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++)
+	LGSTRING_SET_GLYPH (gstr, i - k, LGSTRING_GLYPH (gstring, i));
+      if (NILP (string))
+	Fcompose_region_internal (make_number (start + this_from),
+				  make_number (start + this_to),
+				  gstr, Qnil);
+      else
+	Fcompose_string_internal (string,
+				  make_number (start + this_from),
+				  make_number (start + this_to),
+				  gstr, Qnil);
     }
-  return Qnil;
+
+  return make_number (start + XINT (n));
 }
 
 DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
@@ -3687,6 +3663,8 @@
   CHECK_LIVE_FRAME (frame);
   
   isize = XINT (size);
+  if (isize == 0)
+    isize = 120;
   if (isize < 0)
     isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
 
@@ -3832,23 +3810,41 @@
   return (font_match_p (spec, font) ? Qt : Qnil);
 }
 
-DEFUN ("font-at", Ffont_at, Sfont_at, 1, 2, 0,
+DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 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;
+     (position, window, string)
+     Lisp_Object position, window, string;
 {
   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 (string))
+    {
+      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);
+    }
+  else
+    {
+      EMACS_INT len;
+      unsigned char *str;
+
+      CHECK_NUMBER (position);
+      CHECK_STRING (string);
+      pos = XINT (position);
+      if (pos < 0 || pos >= SCHARS (string))
+	args_out_of_range (string, position);
+      pos_byte = string_char_to_byte (string, pos);
+      str = SDATA (string) + pos_byte;
+      len = SBYTES (string) - pos_byte;
+      c = STRING_CHAR (str, eln);
+    }
   if (NILP (window))
     window = selected_window;
   CHECK_LIVE_WINDOW (window);
@@ -3929,6 +3925,9 @@
   staticpro (&font_family_alist);
   font_family_alist = Qnil;
 
+  staticpro (&font_charset_alist);
+  font_charset_alist = Qnil;
+
   DEFSYM (Qopentype, "opentype");
 
   DEFSYM (Qiso8859_1, "iso8859-1");
@@ -3981,6 +3980,7 @@
   defsubr (&Sinternal_set_font_style_table);
   defsubr (&Sfont_make_gstring);
   defsubr (&Sfont_fill_gstring);
+  defsubr (&Sfont_shape_text);
   defsubr (&Sfont_drive_otf);
   defsubr (&Sfont_otf_alternates);
 
@@ -3996,29 +3996,34 @@
 #endif
 #endif	/* FONT_DEBUG */
 
+#ifdef USE_FONT_BACKEND
+  if (enable_font_backend)
+    {
 #ifdef HAVE_FREETYPE
-  syms_of_ftfont ();
+      syms_of_ftfont ();
 #ifdef HAVE_X_WINDOWS
-  syms_of_xfont ();
-  syms_of_ftxfont ();
+      syms_of_xfont ();
+      syms_of_ftxfont ();
 #ifdef HAVE_XFT
-  syms_of_xftfont ();
+      syms_of_xftfont ();
 #endif  /* HAVE_XFT */
 #endif	/* HAVE_X_WINDOWS */
 #else	/* not HAVE_FREETYPE */
 #ifdef HAVE_X_WINDOWS
-  syms_of_xfont ();
+      syms_of_xfont ();
 #endif	/* HAVE_X_WINDOWS */
 #endif	/* not HAVE_FREETYPE */
 #ifdef HAVE_BDFFONT
-  syms_of_bdffont ();
+      syms_of_bdffont ();
 #endif	/* HAVE_BDFFONT */
 #ifdef WINDOWSNT
-  syms_of_w32font ();
+      syms_of_w32font ();
 #endif	/* WINDOWSNT */
 #ifdef MAC_OS
-  syms_of_atmfont ();
+      syms_of_atmfont ();
 #endif	/* MAC_OS */
+    }
+#endif	/* USE_FONT_BACKEND */
 }
 
 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846