* alloc.c: Do not define struct catchtag.
[bpt/emacs.git] / src / composite.c
index 95f700c..a654b5e 100644 (file)
@@ -1,7 +1,7 @@
 /* Composite sequence support.
    Copyright (C) 2001, 2002, 2003, 2004, 2005,
-                 2006, 2007, 2008 Free Software Foundation, Inc.
-   Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+                 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+   Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
      National Institute of Advanced Industrial Science and Technology (AIST)
      Registration Number H14PRO021
    Copyright (C) 2003, 2006
@@ -24,14 +24,18 @@ You should have received a copy of the GNU General Public License
 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include <config.h>
+#include <setjmp.h>
 #include "lisp.h"
 #include "buffer.h"
 #include "character.h"
+#include "coding.h"
 #include "intervals.h"
 #include "window.h"
 #include "frame.h"
 #include "dispextern.h"
 #include "font.h"
+#include "termhooks.h"
+
 
 /* Emacs uses special text property `composition' to support character
    composition.  A sequence of characters that have the same (i.e. eq)
@@ -157,6 +161,10 @@ Lisp_Object Vauto_composition_function;
 Lisp_Object Qauto_composition_function;
 Lisp_Object Vcomposition_function_table;
 
+/* Maxinum number of characters to lookback to check
+   auto-composition.  */
+#define MAX_AUTO_COMPOSITION_LOOKBACK 3
+
 EXFUN (Fremove_list_of_text_properties, 4);
 
 /* Temporary variable used in macros COMPOSITION_XXX.  */
@@ -687,7 +695,7 @@ composition_gstring_put_cache (gstring, len)
          break;
       len = i;
     }
-      
+
   copy = Fmake_vector (make_number (len + 2), Qnil);
   LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
   for (i = 0; i < len; i++)
@@ -723,7 +731,8 @@ composition_gstring_p (gstring)
   if (! VECTORP (header) || ASIZE (header) < 2)
     return 0;
   if (! NILP (LGSTRING_FONT (gstring))
-      && ! FONT_OBJECT_P (LGSTRING_FONT (gstring)))
+      && (! FONT_OBJECT_P (LGSTRING_FONT (gstring))
+         && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring))))
     return 0;
   for (i = 1; i < ASIZE (LGSTRING_HEADER (gstring)); i++)
     if (! NATNUMP (AREF (LGSTRING_HEADER (gstring), i)))
@@ -753,10 +762,19 @@ composition_gstring_width (gstring, from, to, metrics)
   if (metrics)
     {
       Lisp_Object font_object = LGSTRING_FONT (gstring);
-      struct font *font = XFONT_OBJECT (font_object);
 
-      metrics->ascent = font->ascent;
-      metrics->descent = font->descent;
+      if (FONT_OBJECT_P (font_object))
+       {
+         struct font *font = XFONT_OBJECT (font_object);
+
+         metrics->ascent = font->ascent;
+         metrics->descent = font->descent;
+       }
+      else
+       {
+         metrics->ascent = 1;
+         metrics->descent = 0;
+       }
       metrics->width = metrics->lbearing = metrics->rbearing = 0;
     }
   for (glyph = &LGSTRING_GLYPH (gstring, from); from < to; from++, glyph++)
@@ -779,7 +797,7 @@ composition_gstring_width (gstring, from, to, metrics)
          x = LGLYPH_ASCENT (*glyph) - LGLYPH_YOFF (*glyph);
          if (metrics->ascent < x)
            metrics->ascent = x;
-         x = LGLYPH_DESCENT (*glyph) - LGLYPH_YOFF (*glyph);
+         x = LGLYPH_DESCENT (*glyph) + LGLYPH_YOFF (*glyph);
          if (metrics->descent < x)
            metrics->descent = x;
        }
@@ -810,11 +828,10 @@ fill_gstring_header (header, start, end, font_object, string)
   else
     {
       CHECK_STRING (string);
-      if (! STRING_MULTIBYTE (current_buffer->enable_multibyte_characters))
+      if (! STRING_MULTIBYTE (string))
        error ("Attempt to shape unibyte text");
-      CHECK_NATNUM (start);
+      /* FROM and TO are checked by the caller.  */
       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);
@@ -875,7 +892,7 @@ fill_gstring_body (gstring)
       LGLYPH_SET_FROM (g, i);
       LGLYPH_SET_TO (g, i);
       LGLYPH_SET_CHAR (g, c);
-      if (! NILP (font_object))
+      if (FONT_OBJECT_P (font_object))
        {
          font_fill_lglyph_metrics (g, font_object);
        }
@@ -896,10 +913,9 @@ fill_gstring_body (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).
+   which is an element of composition-function-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.  */
@@ -917,44 +933,56 @@ autocmp_chars (cft_element, charpos, bytepos, limit, win, face, string)
   Lisp_Object pos = make_number (charpos);
   EMACS_INT pt = PT, pt_byte = PT_BYTE;
   int lookback;
-  
+
   record_unwind_save_match_data ();
   for (lookback = -1; 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;
+      EMACS_INT len, to;
 
       if (! VECTORP (elt) || ASIZE (elt) != 3)
        continue;
       if (lookback < 0)
-       lookback = XFASTINT (AREF (elt, 1));
+       {
+         lookback = XFASTINT (AREF (elt, 1));
+         if (limit > charpos + MAX_COMPOSITION_COMPONENTS)
+           limit = charpos + MAX_COMPOSITION_COMPONENTS;
+       }
       else if (lookback != XFASTINT (AREF (elt, 1)))
        break;
       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)))))
+      if (NILP (re))
+       len = 1;
+      else if ((len = fast_looking_at (re, charpos, bytepos, limit, -1, string))
+              > 0)
        {
-         to = (NILP (re) ? charpos + 1 : XINT (Fmatch_end (make_number (0))));
+         if (NILP (string))
+           len = BYTE_TO_CHAR (bytepos + len) - charpos;
+         else
+           len = string_byte_to_char (string, bytepos + len) - charpos;
+       }
+      if (len > 0)
+       {
+         limit = to = charpos + len;
 #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 (! FONT_OBJECT_P (font_object)
+                 || (! NILP (re)
+                     && to < limit
+                     && (fast_looking_at (re, charpos, bytepos, to, -1, string) <= 0)))
                {
                  if (NILP (string))
                    TEMP_SET_PT_BOTH (pt, pt_byte);
                  return unbind_to (count, Qnil);
                }
            }
+         else
 #endif /* not HAVE_WINDOW_SYSTEM */
+           font_object = win->frame;
          gstring = Fcomposition_get_gstring (pos, make_number (to),
                                              font_object, string);
          if (NILP (LGSTRING_ID (gstring)))
@@ -1008,6 +1036,8 @@ composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string)
       cmp_it->stop_pos = endpos = start;
       cmp_it->ch = -1;
     }
+  if (NILP (string) && PT > charpos && PT < endpos)
+    cmp_it->stop_pos = PT;
   if (NILP (current_buffer->enable_multibyte_characters)
       || ! FUNCTIONP (Vauto_composition_function))
     return;
@@ -1027,7 +1057,10 @@ composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string)
       else
        FETCH_CHAR_ADVANCE (c, charpos, bytepos);
       if (c == '\n')
-       break;
+       {
+         cmp_it->ch = -2;
+         break;
+       }
       val = CHAR_TABLE_REF (Vcomposition_function_table, c);
       if (! NILP (val))
        {
@@ -1050,11 +1083,10 @@ composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string)
        }
     }
   cmp_it->stop_pos = charpos;
-  cmp_it->ch = -2;
 }
 
 /* Check if the character at CHARPOS (and BYTEPOS) is composed
-   (possibly with the following charaters) on window W.  ENDPOS limits
+   (possibly with the following characters) 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
@@ -1253,6 +1285,8 @@ find_automatic_composition (pos, limit, start, end, gstring, string)
      Lisp_Object *gstring, string;
 {
   EMACS_INT head, tail, stop;
+  /* Limit to check a composition after POS.  */
+  EMACS_INT fore_check_limit;
   struct position_record orig, cur, check, prev;
   Lisp_Object check_val, val, elt;
   int check_lookback;
@@ -1279,19 +1313,14 @@ find_automatic_composition (pos, limit, start, end, gstring, string)
       orig.p = SDATA (string) + orig.pos_byte;
     }
   if (limit < pos)
-    {
-      head = max (head, limit);
-      tail = min (tail, pos + 3);
-    }
+    fore_check_limit = min (tail, pos + MAX_AUTO_COMPOSITION_LOOKBACK);
   else
-    {
-      tail = min (tail, limit + 3);
-    }
+    fore_check_limit = min (tail, limit + MAX_AUTO_COMPOSITION_LOOKBACK);
   cur = orig;
 
  retry:
   check_val = Qnil;
-  /* At first, check if POS is compoable.  */
+  /* At first, check if POS is composable.  */
   c = STRING_CHAR (cur.p, 0);
   if (! CHAR_COMPOSABLE_P (c))
     {
@@ -1306,9 +1335,18 @@ find_automatic_composition (pos, limit, start, end, gstring, string)
       if (! NILP (val))
        check_val = val, check = cur;
       else
-       while (cur.pos + 1 < tail)
+       while (cur.pos + 1 < fore_check_limit)
          {
+           EMACS_INT b, e;
+
            FORWARD_CHAR (cur, stop);
+           if (get_property_and_range (cur.pos, Qcomposition, &val, &b, &e,
+                                       Qnil)
+               && COMPOSITION_VALID_P (b, e, val))
+             {
+               fore_check_limit = cur.pos;
+               break;
+             }
            c = STRING_CHAR (cur.p, 0);
            if (! CHAR_COMPOSABLE_P (c))
              break;
@@ -1324,7 +1362,12 @@ find_automatic_composition (pos, limit, start, end, gstring, string)
      for compositions.  */
   while (cur.pos > head)
     {
+      EMACS_INT b, e;
+
       BACKWARD_CHAR (cur, stop);
+      if (get_property_and_range (cur.pos, Qcomposition, &val, &b, &e, Qnil)
+         && COMPOSITION_VALID_P (b, e, val))
+       break;
       c = STRING_CHAR (cur.p, 0);
       if (! CHAR_COMPOSABLE_P (c))
        break;
@@ -1334,7 +1377,7 @@ find_automatic_composition (pos, limit, start, end, gstring, string)
     }
   prev = cur;
   /* Now search forward.  */
- search_forward:  
+ search_forward:
   *gstring = Qnil;
   if (! NILP (check_val) || limit >= orig.pos)
     {
@@ -1342,7 +1385,7 @@ find_automatic_composition (pos, limit, start, end, gstring, string)
        cur = orig;
       else
        cur = check;
-      while (cur.pos < tail)
+      while (cur.pos < fore_check_limit)
        {
          int need_adjustment = 0;
 
@@ -1400,7 +1443,7 @@ find_automatic_composition (pos, limit, start, end, gstring, string)
       cur = prev;
       BACKWARD_CHAR (cur, stop);
       orig = cur;
-      tail = orig.pos;
+      fore_check_limit = orig.pos;
       goto retry;
     }
   return 0;
@@ -1419,10 +1462,13 @@ composition_adjust_point (last_pt)
 
   /* At first check the static composition. */
   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);
+      && COMPOSITION_VALID_P (beg, end, val))
+    {
+      if (beg < PT /* && end > PT   <- It's always the case.  */
+         && (last_pt <= beg || last_pt >= end))
+       return (PT < last_pt ? beg : end);
+      return PT;
+    }
 
   if (NILP (current_buffer->enable_multibyte_characters)
       || ! FUNCTIONP (Vauto_composition_function))
@@ -1451,28 +1497,29 @@ composition_adjust_point (last_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
+If the glyph 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.
+Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
+frame, or nil for the selected frame's terminal device.
 
 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:
+A glyph-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.
+    or the terminal coding system of the specified terminal.
     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:
+GLYPH is a vector whose elements have this form:
     [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
       [ [X-OFF Y-OFF WADJUST] | nil] ]
 where
@@ -1480,24 +1527,41 @@ where
     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.
+    X-OFF and Y-OFF are offsets 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.  */)
+If GLYPH is nil, the remaining elements of the glyph-string vector
+should be ignored.  */)
      (from, to, font_object, string)
      Lisp_Object font_object, from, to, string;
 {
   Lisp_Object gstring, header;
+  EMACS_INT frompos, topos;
+
+  CHECK_NATNUM (from);
+  CHECK_NATNUM (to);
+  if (XINT (to) > XINT (from) + MAX_COMPOSITION_COMPONENTS)
+    to = make_number (XINT (from) + MAX_COMPOSITION_COMPONENTS);
+  if (! FONT_OBJECT_P (font_object))
+    {
+      struct coding_system *coding;
+      struct terminal *terminal = get_terminal (font_object, 1);
+
+      coding = ((TERMINAL_TERMINAL_CODING (terminal)->common_flags
+                & CODING_REQUIRE_ENCODING_MASK)
+               ? TERMINAL_TERMINAL_CODING (terminal) : &safe_terminal_coding);
+      font_object = CODING_ID_NAME (coding->id);
+    }
 
-  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;
-  if (LGSTRING_GLYPH_LEN (gstring_work) < to - from)
-    gstring_work = Fmake_vector (make_number (to - from + 2), Qnil);
+
+  frompos = XINT (from);
+  topos = XINT (to);
+  if (LGSTRING_GLYPH_LEN (gstring_work) < topos - frompos)
+    gstring_work = Fmake_vector (make_number (topos - frompos + 2), Qnil);
   LGSTRING_SET_HEADER (gstring_work, header);
   LGSTRING_SET_ID (gstring_work, Qnil);
   fill_gstring_body (gstring_work);
@@ -1513,7 +1577,7 @@ DEFUN ("compose-region-internal", Fcompose_region_internal,
 
 Compose text in the region between START and END.
 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
-for the composition.  See `compose-region' for more detail.  */)
+for the composition.  See `compose-region' for more details.  */)
      (start, end, components, modification_func)
      Lisp_Object start, end, components, modification_func;
 {
@@ -1534,7 +1598,7 @@ DEFUN ("compose-string-internal", Fcompose_string_internal,
 
 Compose text between indices START and END of STRING.
 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
-for the composition.  See `compose-string' for more detail.  */)
+for the composition.  See `compose-string' for more details.  */)
      (string, start, end, components, modification_func)
      Lisp_Object string, start, end, components, modification_func;
 {
@@ -1556,7 +1620,7 @@ DEFUN ("find-composition-internal", Ffind_composition_internal,
        doc: /* Internal use only.
 
 Return information about composition at or nearest to position POS.
-See `find-composition' for more detail.  */)
+See `find-composition' for more details.  */)
      (pos, limit, string, detail_p)
      Lisp_Object pos, limit, string, detail_p;
 {
@@ -1699,8 +1763,8 @@ syms_of_composite ()
   DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function,
               doc: /* Function to adjust composition of buffer text.
 
-The function is called with three arguments FROM, TO, and OBJECT.
-FROM and TO specify the range of text of which composition should be
+This function is called with three arguments: FROM, TO, and OBJECT.
+FROM and TO specify the range of text whose composition should be
 adjusted.  OBJECT, if non-nil, is a string that contains the text.
 
 This function is called after a text with `composition' property is
@@ -1718,7 +1782,7 @@ The default value is the function `compose-chars-after'.  */);
 
   DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function,
               doc: /* Function to call to compose characters automatically.
-The function is called from the display routine with four arguments,
+This function is called from the display routine with four arguments:
 FROM, TO, WINDOW, and STRING.
 
 If STRING is nil, the function must compose characters in the region
@@ -1730,7 +1794,7 @@ string.  */);
   Vauto_composition_function = Qnil;
 
   DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table,
-              doc: /* Char-able of functions for automatic character composition.
+              doc: /* Char-table 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.
@@ -1738,25 +1802,25 @@ 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
+PATTERN is a regular expression 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.
+PREV-CHARS is a non-negative integer (less than 4) specifying how many
+characters before C to check the matching with PATTERN.  If it is 0,
+PATTERN must match C and the following characters.  If it is 1,
+PATTERN must match 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
+composition of the characters that match 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
+function must return a new glyph-string with the same header as
 GSTRING, or modify GSTRING itself and return it.
 
 See also the documentation of `auto-composition-mode'.  */);