/* 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, 2010, 2011 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
Copyright (C) 2003, 2006
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)
Lisp_Object Vcompose_chars_after_function;
Lisp_Object Qauto_composed;
+Lisp_Object Vauto_composition_mode;
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. */
}
else if (VECTORP (components) || CONSP (components))
{
- int len = XVECTOR (key)->size;
+ EMACS_UINT len = XVECTOR_SIZE (key);
/* The number of elements should be odd. */
if ((len % 2) == 0)
: COMPOSITION_WITH_RULE_ALTCHARS));
cmp->hash_index = hash_index;
glyph_len = (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS
- ? (XVECTOR (key)->size + 1) / 2
- : XVECTOR (key)->size);
+ ? (XVECTOR_SIZE (key) + 1) / 2
+ : XVECTOR_SIZE (key));
cmp->glyph_len = glyph_len;
cmp->offsets = (short *) xmalloc (sizeof (short) * glyph_len * 2);
cmp->font = NULL;
break;
len = i;
}
-
+
copy = Fmake_vector (make_number (len + 2), Qnil);
LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
for (i = 0; i < len; i++)
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)))
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++)
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;
}
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);
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);
}
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. */
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)
+ {
+ if (NILP (string))
+ len = BYTE_TO_CHAR (bytepos + len) - charpos;
+ else
+ len = string_byte_to_char (string, bytepos + len) - charpos;
+ }
+ if (len > 0)
{
- to = (NILP (re) ? charpos + 1 : XINT (Fmatch_end (make_number (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)))
{
Lisp_Object args[6];
+ /* Save point as marker before calling out to lisp. */
+ if (NILP (string))
+ {
+ Lisp_Object m = Fmake_marker ();
+ set_marker_both (m, Qnil, pt, pt_byte);
+ record_unwind_protect (restore_point_unwind, m);
+ }
+
args[0] = Vauto_composition_function;
args[1] = AREF (elt, 2);
args[2] = pos;
args[5] = string;
gstring = safe_call (6, args);
}
- if (NILP (string))
- TEMP_SET_PT_BOTH (pt, pt_byte);
+ else if (NILP (string))
+ {
+ TEMP_SET_PT_BOTH (pt, pt_byte);
+ }
return unbind_to (count, gstring);
}
}
cmp_it->id = -1;
cmp_it->ch = -2;
if (find_composition (charpos, endpos, &start, &end, &prop, string)
+ && start >= charpos
&& COMPOSITION_VALID_P (start, end, prop))
{
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))
+ || NILP (Vauto_composition_mode))
return;
if (bytepos < 0)
{
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))
{
}
}
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
struct face *face;
Lisp_Object string;
{
+ if (NILP (string) && charpos < PT && PT < endpos)
+ endpos = PT;
+
if (cmp_it->ch == -2)
{
composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
static int _work_char;
/* 1 iff the character C is composable. */
-#define CHAR_COMPOSABLE_P(C) \
- (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
- (SYMBOLP (_work_val) \
- && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
- && _work_char != 'Z'))
+#define CHAR_COMPOSABLE_P(C) \
+ ((C) == 0x200C || (C) == 0x200D \
+ || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
+ (SYMBOLP (_work_val) \
+ && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
+ && _work_char != 'Z')))
/* This is like find_composition, but find an automatic composition
instead. If found, set *GSTRING to the glyph-string representing
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;
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. */
- c = STRING_CHAR (cur.p, 0);
+ /* At first, check if POS is composable. */
+ c = STRING_CHAR (cur.p);
if (! CHAR_COMPOSABLE_P (c))
{
if (limit < 0)
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);
- c = STRING_CHAR (cur.p, 0);
+ 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);
if (! CHAR_COMPOSABLE_P (c))
break;
val = CHAR_TABLE_REF (Vcomposition_function_table, c);
for compositions. */
while (cur.pos > head)
{
+ EMACS_INT b, e;
+
BACKWARD_CHAR (cur, stop);
- c = STRING_CHAR (cur.p, 0);
+ if (get_property_and_range (cur.pos, Qcomposition, &val, &b, &e, Qnil)
+ && COMPOSITION_VALID_P (b, e, val))
+ break;
+ c = STRING_CHAR (cur.p);
if (! CHAR_COMPOSABLE_P (c))
break;
val = CHAR_TABLE_REF (Vcomposition_function_table, c);
}
prev = cur;
/* Now search forward. */
- search_forward:
+ search_forward:
*gstring = Qnil;
if (! NILP (check_val) || limit >= orig.pos)
{
cur = orig;
else
cur = check;
- while (cur.pos < tail)
+ while (cur.pos < fore_check_limit)
{
int need_adjustment = 0;
if (NILP (check_val))
{
- c = STRING_CHAR (cur.p, 0);
+ c = STRING_CHAR (cur.p);
check_val = CHAR_TABLE_REF (Vcomposition_function_table, c);
}
for (; CONSP (check_val); check_val = XCDR (check_val))
cur = prev;
BACKWARD_CHAR (cur, stop);
orig = cur;
- tail = orig.pos;
+ fore_check_limit = orig.pos;
goto retry;
}
return 0;
}
+/* Return the adjusted point provided that point is moved from LAST_PT
+ to NEW_PT. */
+
int
-composition_adjust_point (last_pt)
- EMACS_INT last_pt;
+composition_adjust_point (last_pt, new_pt)
+ EMACS_INT last_pt, new_pt;
{
EMACS_INT charpos, bytepos, startpos, beg, end, pos;
Lisp_Object val;
int i;
- if (PT == BEGV || PT == ZV)
- return PT;
+ if (new_pt == BEGV || new_pt == ZV)
+ return new_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);
+ if (get_property_and_range (new_pt, Qcomposition, &val, &beg, &end, Qnil)
+ && COMPOSITION_VALID_P (beg, end, val))
+ {
+ if (beg < new_pt /* && end > new_pt <- It's always the case. */
+ && (last_pt <= beg || last_pt >= end))
+ return (new_pt < last_pt ? beg : end);
+ return new_pt;
+ }
if (NILP (current_buffer->enable_multibyte_characters)
- || ! FUNCTIONP (Vauto_composition_function))
- return PT;
+ || NILP (Vauto_composition_mode))
+ return new_pt;
/* Next check the automatic composition. */
- if (! find_automatic_composition (PT, -1, &beg, &end, &val, Qnil)
- || beg == PT)
- return PT;
+ if (! find_automatic_composition (new_pt, (EMACS_INT) -1, &beg, &end, &val,
+ Qnil)
+ || beg == new_pt)
+ return new_pt;
for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++)
{
Lisp_Object glyph = LGSTRING_GLYPH (val, i);
if (NILP (glyph))
break;
- if (beg + LGLYPH_FROM (glyph) == PT)
- return PT;
- if (beg + LGLYPH_TO (glyph) >= PT)
- return (PT < last_pt
+ if (beg + LGLYPH_FROM (glyph) == new_pt)
+ return new_pt;
+ if (beg + LGLYPH_TO (glyph) >= new_pt)
+ return (new_pt < last_pt
? beg + LGLYPH_FROM (glyph)
: beg + LGLYPH_TO (glyph) + 1);
}
- return PT;
+ return new_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
+a 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
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);
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;
{
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;
{
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;
{
if (!find_composition (from, to, &start, &end, &prop, string))
{
if (!NILP (current_buffer->enable_multibyte_characters)
- && FUNCTIONP (Vauto_composition_function)
+ && ! NILP (Vauto_composition_mode)
&& find_automatic_composition (from, to, &start, &end, &gstring,
string))
return list3 (make_number (start), make_number (end), gstring);
{
int i;
- Qcomposition = intern ("composition");
+ Qcomposition = intern_c_string ("composition");
staticpro (&Qcomposition);
/* Make a hash table for static composition. */
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
valid.
The default value is the function `compose-chars-after'. */);
- Vcompose_chars_after_function = intern ("compose-chars-after");
+ Vcompose_chars_after_function = intern_c_string ("compose-chars-after");
- Qauto_composed = intern ("auto-composed");
+ Qauto_composed = intern_c_string ("auto-composed");
staticpro (&Qauto_composed);
- Qauto_composition_function = intern ("auto-composition-function");
+ Qauto_composition_function = intern_c_string ("auto-composition-function");
staticpro (&Qauto_composition_function);
+ DEFVAR_LISP ("auto-composition-mode", &Vauto_composition_mode,
+ doc: /* Non-nil if Auto-Composition mode is enabled.
+Use the command `auto-composition-mode' to change this variable. */);
+ Vauto_composition_mode = Qt;
+
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
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.
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'. */);