Mercurial > emacs

--- a/src/composite.c	Fri Aug 29 07:53:11 2008 +0000
+++ b/src/composite.c	Fri Aug 29 07:53:27 2008 +0000
@@ -28,6 +28,10 @@
 #include "buffer.h"
 #include "character.h"
 #include "intervals.h"
+#include "window.h"
+#include "frame.h"
+#include "dispextern.h"
+#include "font.h"

 /* Emacs uses special text property `composition' to support character
    composition.  A sequence of characters that have the same (i.e. eq)
@@ -151,6 +155,7 @@
 Lisp_Object Qauto_composed;
 Lisp_Object Vauto_composition_function;
 Lisp_Object Qauto_composition_function;
+Lisp_Object Vcomposition_function_table;

 EXFUN (Fremove_list_of_text_properties, 4);

@@ -317,10 +322,6 @@
 		 : ((INTEGERP (components) || STRINGP (components))
 		    ? COMPOSITION_WITH_ALTCHARS
 		    : COMPOSITION_WITH_RULE_ALTCHARS));
-  if (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS
-      && VECTORP (components)
-      && ! INTEGERP (AREF (components, 0)))
-    cmp->method = COMPOSITION_WITH_GLYPH_STRING;
   cmp->hash_index = hash_index;
   glyph_len = (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS
 	       ? (XVECTOR (key)->size + 1) / 2
@@ -329,13 +330,7 @@
   cmp->offsets = (short *) xmalloc (sizeof (short) * glyph_len * 2);
   cmp->font = NULL;

-  /* Calculate the width of overall glyphs of the composition.  */
-  if (cmp->method == COMPOSITION_WITH_GLYPH_STRING)
-    {
-      cmp->width = 1;		/* Should be fixed later.  */
-      cmp->glyph_len--;
-    }
-  else if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
+  if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
     {
       /* Relative composition.  */
       cmp->width = 0;
@@ -645,6 +640,705 @@
   Fput_text_property  (make_number (start), make_number (end),
 		       Qcomposition, prop, string);
 }
+
+
+static Lisp_Object autocmp_chars P_ ((Lisp_Object, EMACS_INT, EMACS_INT,
+				      EMACS_INT, struct window *,
+				      struct face *, Lisp_Object));
+
+
+/* Lisp glyph-string handlers */
+
+/* Hash table for automatic composition.  The key is a header of a
+   lgstring (Lispy glyph-string), and the value is a body of a
+   lgstring.  */
+
+static Lisp_Object gstring_hash_table;
+
+static Lisp_Object gstring_lookup_cache P_ ((Lisp_Object));
+
+static Lisp_Object
+gstring_lookup_cache (header)
+     Lisp_Object header;
+{
+  struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
+  int i = hash_lookup (h, header, NULL);
+
+  return (i >= 0 ? HASH_VALUE (h, i) : Qnil);
+}
+
+Lisp_Object
+composition_gstring_put_cache (gstring, len)
+     Lisp_Object gstring;
+     int len;
+{
+  struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
+  unsigned hash;
+  Lisp_Object header, copy;
+  int i;
+
+  header = LGSTRING_HEADER (gstring);
+  hash = h->hashfn (h, header);
+  if (len < 0)
+    {
+      len = LGSTRING_GLYPH_LEN (gstring);
+      for (i = 0; i < len; i++)
+	if (NILP (LGSTRING_GLYPH (gstring, i)))
+	  break;
+      len = i;
+    }
+
+  copy = Fmake_vector (make_number (len + 2), Qnil);
+  LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
+  for (i = 0; i < len; i++)
+    LGSTRING_SET_GLYPH (copy, i, Fcopy_sequence (LGSTRING_GLYPH (gstring, i)));
+  i = hash_put (h, LGSTRING_HEADER (copy), copy, hash);
+  LGSTRING_SET_ID (copy, make_number (i));
+  return copy;
+}
+
+Lisp_Object
+composition_gstring_from_id (id)
+     int id;
+{
+  struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
+
+  return HASH_VALUE (h, id);
+}
+
+static Lisp_Object fill_gstring_header P_ ((Lisp_Object, Lisp_Object,
+					    Lisp_Object, Lisp_Object,
+					    Lisp_Object));
+
+int
+composition_gstring_p (gstring)
+     Lisp_Object gstring;
+{
+  Lisp_Object header;
+  int i;
+
+  if (! VECTORP (gstring) || ASIZE (gstring) < 2)
+    return 0;
+  header = LGSTRING_HEADER (gstring);
+  if (! VECTORP (header) || ASIZE (header) < 2)
+    return 0;
+  if (! NILP (LGSTRING_FONT (gstring))
+      && ! FONT_OBJECT_P (LGSTRING_FONT (gstring)))
+    return 0;
+  for (i = 1; i < ASIZE (LGSTRING_HEADER (gstring)); i++)
+    if (! NATNUMP (AREF (LGSTRING_HEADER (gstring), i)))
+      return 0;
+  if (! NILP (LGSTRING_ID (gstring)) && ! NATNUMP (LGSTRING_ID (gstring)))
+    return 0;
+  for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
+    {
+      Lisp_Object glyph = LGSTRING_GLYPH (gstring, i);
+      if (NILP (glyph))
+	break;
+      if (! VECTORP (glyph) || ASIZE (glyph) != LGLYPH_SIZE)
+	return 0;
+    }
+  return 1;
+}
+
+int
+composition_gstring_width (gstring, from, to, metrics)
+     Lisp_Object gstring;
+     int from, to;
+     struct font_metrics *metrics;
+{
+  Lisp_Object *glyph;
+  int width = 0;
+
+  if (metrics)
+    {
+      Lisp_Object font_object = LGSTRING_FONT (gstring);
+      struct font *font = XFONT_OBJECT (font_object);
+
+      metrics->ascent = font->ascent;
+      metrics->descent = font->descent;
+      metrics->width = metrics->lbearing = metrics->rbearing = 0;
+    }
+  for (glyph = &LGSTRING_GLYPH (gstring, from); from < to; from++, glyph++)
+    {
+      int x;
+
+      if (NILP (LGLYPH_ADJUSTMENT (*glyph)))
+	width += LGLYPH_WIDTH (*glyph);
+      else
+	width += LGLYPH_WADJUST (*glyph);
+      if (metrics)
+	{
+	  x = metrics->width + LGLYPH_LBEARING (*glyph) + LGLYPH_XOFF (*glyph);
+	  if (metrics->lbearing > x)
+	    metrics->lbearing = x;
+	  x = metrics->width + LGLYPH_RBEARING (*glyph) + LGLYPH_XOFF (*glyph);
+	  if (metrics->rbearing < x)
+	    metrics->rbearing = x;
+	  metrics->width = width;
+	  x = LGLYPH_ASCENT (*glyph) - LGLYPH_YOFF (*glyph);
+	  if (metrics->ascent < x)
+	    metrics->ascent = x;
+	  x = LGLYPH_DESCENT (*glyph) - LGLYPH_YOFF (*glyph);
+	  if (metrics->descent < x)
+	    metrics->descent = x;
+	}
+    }
+  return width;
+}
+
+
+static Lisp_Object gstring_work;
+static Lisp_Object gstring_work_headers;
+
+static Lisp_Object
+fill_gstring_header (header, start, end, font_object, string)
+     Lisp_Object header, start, end, font_object, string;
+{
+  EMACS_INT from, to, from_byte;
+  EMACS_INT len, i;
+
+  if (NILP (string))
+    {
+      if (NILP (current_buffer->enable_multibyte_characters))
+	error ("Attempt to shape unibyte text");
+      validate_region (&start, &end);
+      from = XFASTINT (start);
+      to = XFASTINT (end);
+      from_byte = CHAR_TO_BYTE (from);
+    }
+  else
+    {
+      CHECK_STRING (string);
+      if (! STRING_MULTIBYTE (current_buffer->enable_multibyte_characters))
+	error ("Attempt to shape unibyte text");
+      CHECK_NATNUM (start);
+      from = XINT (start);
+      CHECK_NATNUM (end);
+      to = XINT (end);
+      if (from < 0 || from > to || to > SCHARS (string))
+	args_out_of_range_3 (string, start, end);
+      from_byte = string_char_to_byte (string, from);
+    }
+
+  len = to - from;
+  if (len == 0)
+    error ("Attempt to shape zero-length text");
+  if (VECTORP (header))
+    {
+      if (ASIZE (header) != len + 1)
+	args_out_of_range (header, make_number (len + 1));
+    }
+  else
+    {
+      if (len <= 8)
+	header = AREF (gstring_work_headers, len - 1);
+      else
+	header = Fmake_vector (make_number (len + 1), Qnil);
+    }
+
+  ASET (header, 0, font_object);
+  for (i = 0; i < len; i++)
+    {
+      int c;
+
+      if (NILP (string))
+	FETCH_CHAR_ADVANCE_NO_CHECK (c, from, from_byte);
+      else
+	FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, from, from_byte);
+      ASET (header, i + 1, make_number (c));
+    }
+  return header;
+}
+
+extern void font_fill_lglyph_metrics P_ ((Lisp_Object, Lisp_Object));
+
+static void
+fill_gstring_body (gstring)
+     Lisp_Object gstring;
+{
+  Lisp_Object font_object = LGSTRING_FONT (gstring);
+  Lisp_Object header = AREF (gstring, 0);
+  EMACS_INT len = LGSTRING_CHAR_LEN (gstring);
+  EMACS_INT i;
+
+  for (i = 0; i < len; i++)
+    {
+      Lisp_Object g = LGSTRING_GLYPH (gstring, i);
+      int c = XINT (AREF (header, i + 1));
+
+      if (NILP (g))
+	{
+	  g = LGLYPH_NEW ();
+	  LGSTRING_SET_GLYPH (gstring, i, g);
+	}
+      LGLYPH_SET_FROM (g, i);
+      LGLYPH_SET_TO (g, i);
+      LGLYPH_SET_CHAR (g, c);
+      if (! NILP (font_object))
+	{
+	  font_fill_lglyph_metrics (g, font_object);
+	}
+      else
+	{
+	  int width = XFASTINT (CHAR_TABLE_REF (Vchar_width_table, c));
+
+	  LGLYPH_SET_CODE (g, c);
+	  LGLYPH_SET_LBEARING (g, 0);
+	  LGLYPH_SET_RBEARING (g, width);
+	  LGLYPH_SET_WIDTH (g, width);
+	  LGLYPH_SET_ASCENT (g, 1);
+	  LGLYPH_SET_DESCENT (g, 0);
+	}
+      LGLYPH_SET_ADJUSTMENT (g, Qnil);
+    }
+  if (i < LGSTRING_GLYPH_LEN (gstring))
+    LGSTRING_SET_GLYPH (gstring, i, Qnil);
+}
+
+EXFUN (Fre_search_forward, 4);
+
+/* Try to compose the characters at CHARPOS according to CFT_ELEMENT
+   which is an element of composition-fucntion-table (which see).
+   LIMIT limits the characters to compose.  STRING, if not nil, is a
+   target string.  WIN is a window where the characters are being
+   displayed.  */
+
+static Lisp_Object
+autocmp_chars (cft_element, charpos, bytepos, limit, win, face, string)
+     Lisp_Object cft_element;
+     EMACS_INT charpos, bytepos, limit;
+     struct window *win;
+     struct face *face;
+     Lisp_Object string;
+{
+  int count = SPECPDL_INDEX ();
+  FRAME_PTR f = XFRAME (win->frame);
+  Lisp_Object pos = make_number (charpos);
+  EMACS_INT pt = PT, pt_byte = PT_BYTE;
+
+  record_unwind_save_match_data ();
+  for (; CONSP (cft_element); cft_element = XCDR (cft_element))
+    {
+      Lisp_Object elt = XCAR (cft_element);
+      Lisp_Object re;
+      Lisp_Object font_object = Qnil, gstring;
+      EMACS_INT to;
+
+      if (! VECTORP (elt) || ASIZE (elt) != 3)
+	continue;
+      re = AREF (elt, 0);
+      if (NILP (string))
+	TEMP_SET_PT_BOTH (charpos, bytepos);
+      if (NILP (re)
+	  || (STRINGP (re)
+	      && (STRINGP (string)
+		  ? EQ (Fstring_match (re, string, pos), pos)
+		  : (! NILP (Fre_search_forward (re, make_number (limit), Qt, Qnil))
+		     && EQ (Fmatch_beginning (make_number (0)), pos)))))
+	{
+	  to = (NILP (re) ? charpos + 1 : XINT (Fmatch_end (make_number (0))));
+#ifdef HAVE_WINDOW_SYSTEM
+	  if (FRAME_WINDOW_P (f))
+	    {
+	      font_object = font_range (charpos, &to, win, face, string);
+	      if (! FONT_OBJECT_P (font_object))
+		{
+		  if (NILP (string))
+		    TEMP_SET_PT_BOTH (pt, pt_byte);
+		  return unbind_to (count, Qnil);
+		}
+	    }
+#endif	/* not HAVE_WINDOW_SYSTEM */
+	  gstring = Fcomposition_get_gstring (pos, make_number (to),
+					      font_object, string);
+	  if (NILP (LGSTRING_ID (gstring)))
+	    {
+	      Lisp_Object args[6];
+
+	      args[0] = Vauto_composition_function;
+	      args[1] = AREF (elt, 2);
+	      args[2] = pos;
+	      args[3] = make_number (to);
+	      args[4] = font_object;
+	      args[5] = string;
+	      gstring = safe_call (6, args);
+	    }
+	  if (NILP (string))
+	    TEMP_SET_PT_BOTH (pt, pt_byte);
+	  return unbind_to (count, gstring);
+	}
+    }
+  if (NILP (string))
+    TEMP_SET_PT_BOTH (pt, pt_byte);
+  return unbind_to (count, Qnil);
+}
+
+
+/* Update cmp_it->stop_pos to the next position after CHARPOS (and
+   BYTEPOS) where character composition may happen.  If BYTEPOS is
+   negative, compoute it.  If it is a static composition, set
+   cmp_it->ch to -1.  Otherwise, set cmp_it->ch to the character that
+   triggers a automatic composition.  */
+
+void
+composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string)
+     struct composition_it *cmp_it;
+     EMACS_INT charpos, bytepos, endpos;
+     Lisp_Object string;
+{
+  EMACS_INT start, end, c;
+  Lisp_Object prop, val;
+
+  cmp_it->stop_pos = endpos;
+  if (find_composition (charpos, endpos, &start, &end, &prop, string)
+      && COMPOSITION_VALID_P (start, end, prop))
+    {
+      cmp_it->stop_pos = endpos = start;
+      cmp_it->ch = -1;
+    }
+  if (NILP (current_buffer->enable_multibyte_characters)
+      || ! FUNCTIONP (Vauto_composition_function))
+    return;
+  if (bytepos < 0)
+    {
+      if (STRINGP (string))
+	bytepos = string_char_to_byte (string, charpos);
+      else
+	bytepos = CHAR_TO_BYTE (charpos);
+    }
+
+  start = charpos;
+  while (charpos < endpos)
+    {
+      if (STRINGP (string))
+	FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
+      else
+	FETCH_CHAR_ADVANCE (c, charpos, bytepos);
+      val = CHAR_TABLE_REF (Vcomposition_function_table, c);
+      if (! NILP (val))
+	{
+	  Lisp_Object elt;
+
+	  for (; CONSP (val); val = XCDR (val))
+	    {
+	      elt = XCAR (val);
+	      if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1))
+		  && charpos - 1 - XFASTINT (AREF (elt, 1)) >= start)
+		break;
+	    }
+	  if (CONSP (val))
+	    {
+	      cmp_it->stop_pos = charpos - 1 - XFASTINT (AREF (elt, 1));
+	      cmp_it->ch = c;
+	      break;
+	    }
+	}
+    }
+}
+
+/* Check if the character at CHARPOS (and BYTEPOS) is composed
+   (possibly with the following charaters) on window W.  ENDPOS limits
+   characters to be composed.  FACE, in non-NULL, is a base face of
+   the character.  If STRING is not nil, it is a string containing the
+   character to check, and CHARPOS and BYTEPOS are indices in the
+   string.  In that case, FACE must not be NULL.
+
+   If the character is composed, setup members of CMP_IT (id, nglyphs,
+   and from), and return 1.  Otherwise, update CMP_IT->stop_pos, and
+   return 0.  */
+
+int
+composition_reseat_it (cmp_it, charpos, bytepos, endpos, w, face, string)
+     struct composition_it *cmp_it;
+     EMACS_INT charpos, bytepos, endpos;
+     struct window *w;
+     struct face *face;
+     Lisp_Object string;
+{
+  if (cmp_it->ch < 0)
+    {
+      /* We are looking at a static composition.  */
+      EMACS_INT start, end;
+      Lisp_Object prop;
+
+      find_composition (charpos, -1, &start, &end, &prop, string);
+      cmp_it->id = get_composition_id (charpos, bytepos, end - start,
+				       prop, string);
+      if (cmp_it->id < 0)
+	goto no_composition;
+      cmp_it->nchars = end - start;
+      cmp_it->nglyphs = composition_table[cmp_it->id]->glyph_len;
+    }
+  else
+    {
+      Lisp_Object val;
+      int i;
+
+      val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
+      if (NILP (val))
+	goto no_composition;
+      val = autocmp_chars (val, charpos, bytepos, endpos, w, face, string);
+      if (! composition_gstring_p (val))
+	goto no_composition;
+      if (NILP (LGSTRING_ID (val)))
+	val = composition_gstring_put_cache (val, -1);
+      cmp_it->id = XINT (LGSTRING_ID (val));
+      for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++)
+	if (NILP (LGSTRING_GLYPH (val, i)))
+	  break;
+      cmp_it->nglyphs = i;
+    }
+  cmp_it->from = 0;
+  return 1;
+
+ no_composition:
+  charpos++;
+  if (STRINGP (string))
+    bytepos += MULTIBYTE_LENGTH_NO_CHECK (SDATA (string) + bytepos);
+  else
+    INC_POS (bytepos);
+  composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
+  return 0;
+}
+
+int
+composition_update_it (cmp_it, charpos, bytepos, string)
+     struct composition_it *cmp_it;
+     EMACS_INT charpos, bytepos;
+     Lisp_Object string;
+{
+  int i, c;
+
+  if (cmp_it->ch < 0)
+    {
+      struct composition *cmp = composition_table[cmp_it->id];
+
+      cmp_it->to = cmp_it->nglyphs;
+      if (cmp_it->nglyphs == 0)
+	c = -1;
+      else
+	{
+	  for (i = 0; i < cmp->glyph_len; i++)
+	    if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t')
+	      break;
+	  if (c == '\t')
+	    c = ' ';
+	}
+      cmp_it->width = cmp->width;
+    }
+  else
+    {
+      Lisp_Object gstring = composition_gstring_from_id (cmp_it->id);
+
+      if (cmp_it->nglyphs == 0)
+	{
+	  c = -1;
+	  cmp_it->nchars = LGSTRING_CHAR_LEN (gstring);
+	  cmp_it->width = 0;
+	}
+      else
+	{
+	  Lisp_Object glyph = LGSTRING_GLYPH (gstring, cmp_it->from);
+	  int from = LGLYPH_FROM (glyph);
+
+	  c = LGSTRING_CHAR (gstring, from);
+	  cmp_it->nchars = LGLYPH_TO (glyph) - from + 1;
+	  cmp_it->width = (LGLYPH_WIDTH (glyph) > 0
+			   ? CHAR_WIDTH (LGLYPH_CHAR (glyph)) : 0);
+	  for (cmp_it->to = cmp_it->from + 1; cmp_it->to < cmp_it->nglyphs;
+	       cmp_it->to++)
+	    {
+	      glyph = LGSTRING_GLYPH (gstring, cmp_it->to);
+	      if (LGLYPH_FROM (glyph) != from)
+		break;
+	      if (LGLYPH_WIDTH (glyph) > 0)
+		cmp_it->width += CHAR_WIDTH (LGLYPH_CHAR (glyph));
+	    }
+	}
+    }
+
+  charpos += cmp_it->nchars;
+  if (STRINGP (string))
+    cmp_it->nbytes = string_char_to_byte (string, charpos) - bytepos;
+  else
+    cmp_it->nbytes = CHAR_TO_BYTE (charpos) - bytepos;
+  return c;
+}
+
+
+int
+composition_adjust_point (last_pt)
+     EMACS_INT last_pt;
+{
+  /* Now check the automatic composition. */
+  EMACS_INT charpos, bytepos, startpos, beg, end, pos;
+  Lisp_Object val, cat;
+  EMACS_INT limit;
+  int c;
+
+  if (PT == BEGV || PT == ZV)
+    return PT;
+
+  if (get_property_and_range (PT, Qcomposition, &val, &beg, &end, Qnil)
+      && COMPOSITION_VALID_P (beg, end, val)
+      && beg < PT /* && end > PT   <- It's always the case.  */
+      && (last_pt <= beg || last_pt >= end))
+    return (PT < last_pt ? beg : end);
+
+  if (NILP (current_buffer->enable_multibyte_characters)
+      || ! FUNCTIONP (Vauto_composition_function))
+    return PT;
+
+  c = FETCH_MULTIBYTE_CHAR (PT_BYTE);
+  cat = CHAR_TABLE_REF (Vunicode_category_table, c);
+  if (SYMBOLP (cat)
+      && ((c = SDATA (SYMBOL_NAME (cat))[0]) == 'C' || c == 'Z'))
+    /* A control character is never composed.  */
+    return PT;
+
+  charpos = PT;
+  bytepos = PT_BYTE;
+  limit = (last_pt < PT ? last_pt : BEGV);
+  do {
+    DEC_BOTH (charpos, bytepos);
+    c = FETCH_MULTIBYTE_CHAR (bytepos);
+    cat = CHAR_TABLE_REF (Vunicode_category_table, c);
+    if (SYMBOLP (cat)
+	&& ((c = SDATA (SYMBOL_NAME (cat))[0]) == 'C' || c == 'Z'))
+      {
+	INC_BOTH (charpos, bytepos);
+	break;
+      }
+  } while (charpos > limit);
+
+
+  limit = (last_pt < PT ? ZV : last_pt);
+  if (limit > PT + 3)
+    limit = PT + 3;
+  startpos = charpos;
+  while (charpos < limit)
+    {
+      c = FETCH_MULTIBYTE_CHAR (bytepos);
+      if (charpos > PT)
+	{
+	  int ch;
+
+	  cat = CHAR_TABLE_REF (Vunicode_category_table, c);
+	  if (SYMBOLP (cat)
+	      && ((ch = SDATA (SYMBOL_NAME (cat))[0]) == 'C' || ch == 'Z'))
+	    return PT;
+	}
+      val = CHAR_TABLE_REF (Vcomposition_function_table, c);
+      if (! CONSP (val))
+	{
+	  INC_BOTH (charpos, bytepos);
+	  continue;
+	}
+      for (; CONSP (val); val = XCDR (val))
+	{
+	  Lisp_Object elt = XCAR (val);
+
+	  if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1))
+	      && (pos = charpos - XFASTINT (AREF (elt, 1))) < PT
+	      && pos >= startpos)
+	    {
+	      Lisp_Object gstring;
+	      EMACS_INT pos_byte;
+
+	      if (XFASTINT (AREF (elt, 1)) == 0)
+		pos_byte = bytepos;
+	      else
+		pos_byte = CHAR_TO_BYTE (pos);
+	      gstring = autocmp_chars (val, pos, pos_byte, Z,
+				       XWINDOW (selected_window), NULL, Qnil);
+	      if (composition_gstring_p (gstring))
+		{
+		  if (pos + LGSTRING_CHAR_LEN (gstring) > PT)
+		    {
+		      int i;
+
+		      for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
+			{
+			  Lisp_Object glyph = LGSTRING_GLYPH (gstring, i);
+
+			  if (NILP (glyph))
+			    break;
+			  if (pos + LGLYPH_FROM (glyph) == PT)
+			    return PT;
+			  if (pos + LGLYPH_TO (glyph) + 1 > PT)
+			    return (PT < last_pt
+				    ? pos + LGLYPH_FROM (glyph)
+				    : pos + LGLYPH_TO (glyph) + 1);
+			}
+		      return PT;
+		    }
+		  charpos = startpos = pos + LGSTRING_CHAR_LEN (gstring);
+		  bytepos = CHAR_TO_BYTE (charpos);
+		  break;
+		}
+	    }
+	}
+      if (! CONSP (val))
+	INC_BOTH (charpos, bytepos);
+    }
+  return PT;
+}
+
+DEFUN ("composition-get-gstring", Fcomposition_get_gstring,
+       Scomposition_get_gstring, 4, 4, 0,
+       doc: /* Return a glyph-string for characters between FROM and TO.
+If the glhph string is for graphic display, FONT-OBJECT must be
+a font-object to use for those characters.
+Otherwise (for terminal display), FONT-OBJECT must be nil.
+
+If the optional 4th argument STRING is not nil, it is a string
+containing the target characters between indices FROM and TO.
+
+A glhph-string is a vector containing information about how to display
+specific character sequence.  The format is:
+   [HEADER ID GLYPH ...]
+
+HEADER is a vector of this form:
+    [FONT-OBJECT CHAR ...]
+where
+    FONT-OBJECT is a font-object for all glyphs in the glyph-string,
+    or nil if not yet decided.
+    CHARs are characters to be composed by GLYPHs.
+
+ID is an identification number of the glyph-string.  It may be nil if
+not yet shaped.
+
+GLYPH is a vector whose elements has this form:
+    [ 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 thru DESCENT are the metrics (in pixels) of the glyph.
+    X-OFF and Y-OFF are offests to the base position for the glyph.
+    WADJUST is the adjustment to the normal width of the glyph.
+
+If GLYPH is nil, the remaining elements of the glhph-string vector
+must be ignore.  */)
+     (from, to, font_object, string)
+     Lisp_Object font_object, from, to, string;
+{
+  Lisp_Object gstring, header;
+
+  if (! NILP (font_object))
+    CHECK_FONT_OBJECT (font_object);
+  header = fill_gstring_header (Qnil, from, to, font_object, string);
+  gstring = gstring_lookup_cache (header);
+  if (! NILP (gstring))
+    return gstring;
+  LGSTRING_SET_HEADER (gstring_work, header);
+  LGSTRING_SET_ID (gstring_work, Qnil);
+  fill_gstring_body (gstring_work);
+  return gstring_work;
+}
+

 /* Emacs Lisp APIs.  */

@@ -771,10 +1465,12 @@
 void
 syms_of_composite ()
 {
+  int i;
+
   Qcomposition = intern ("composition");
   staticpro (&Qcomposition);

-  /* Make a hash table for composition.  */
+  /* Make a hash table for static composition.  */
   {
     Lisp_Object args[6];
     extern Lisp_Object QCsize;
@@ -794,6 +1490,28 @@
     staticpro (&composition_hash_table);
   }

+  /* Make a hash table for glyph-string.  */
+  {
+    Lisp_Object args[6];
+    extern Lisp_Object QCsize;
+
+    args[0] = QCtest;
+    args[1] = Qequal;
+    args[2] = QCweakness;
+    args[3] = Qnil;
+    args[4] = QCsize;
+    args[5] = make_number (311);
+    gstring_hash_table = Fmake_hash_table (6, args);
+    staticpro (&gstring_hash_table);
+  }
+
+  staticpro (&gstring_work_headers);
+  gstring_work_headers = Fmake_vector (make_number (8), Qnil);
+  for (i = 0; i < 8; i++)
+    ASET (gstring_work_headers, i, Fmake_vector (make_number (i + 2), Qnil));
+  staticpro (&gstring_work);
+  gstring_work = Fmake_vector (make_number (10), Qnil);
+
   /* Text property `composition' should be nonsticky by default.  */
   Vtext_property_default_nonsticky
     = Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky);
@@ -831,9 +1549,43 @@
 string.  */);
   Vauto_composition_function = Qnil;

+  DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table,
+	       doc: /* Char-able of functions for automatic character composition.
+For each character that has to be composed automatically with
+preceding and/or following characters, this char-table contains
+a function to call to compose that character.
+
+The element at index C in the table, if non-nil, is a list of
+this form: ([PATTERN PREV-CHARS FUNC] ...)
+
+PATTERN is a regular expression with which C and the surrounding
+characters must match.
+
+PREV-CHARS is a number of characters before C to check the
+matching with PATTERN.  If it is 0, PATTERN must match with C and
+the following characters.  If it is 1, PATTERN must match with a
+character before C and the following characters.
+
+If PREV-CHARS is 0, PATTERN can be nil, which means that the
+single character C should be composed.
+
+FUNC is a function to return a glyph-string representing a
+composition of the characters matching with PATTERN.  It is
+called with one argument GSTRING.
+
+GSTRING is a template of a glyph-string to return.  It is already
+filled with a proper header for the characters to compose, and
+glyphs corresponding to those characters one by one.  The
+function must return a new glyph-string of the same header as
+GSTRING, or modify GSTRING itself and return it.
+
+See also the documentation of `auto-composition-mode'.  */);
+  Vcomposition_function_table = Fmake_char_table (Qnil, Qnil);
+
   defsubr (&Scompose_region_internal);
   defsubr (&Scompose_string_internal);
   defsubr (&Sfind_composition_internal);
+  defsubr (&Scomposition_get_gstring);
 }

 /* arch-tag: 79cefaf8-ca48-4eed-97e5-d5afb290d272