X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c7c7a80c12c4c4cc79c69c77aa351df0c0b37943..e2749141d61c6127003b9bee567d1bf9ac54a3f6:/src/composite.c diff --git a/src/composite.c b/src/composite.c index 257ca66632..829e163b83 100644 --- a/src/composite.c +++ b/src/composite.c @@ -402,8 +402,8 @@ get_composition_id (charpos, bytepos, nchars, prop, string) } -/* Find a composition at or nearest to position POS of OBJECT (buffer - or string). +/* Find a static composition at or nearest to position POS of OBJECT + (buffer or string). OBJECT defaults to the current buffer. If there's a composition at POS, set *START and *END to the start and end of the sequence, @@ -810,11 +810,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); @@ -916,9 +915,10 @@ autocmp_chars (cft_element, charpos, bytepos, limit, win, face, string) FRAME_PTR f = XFRAME (win->frame); Lisp_Object pos = make_number (charpos); EMACS_INT pt = PT, pt_byte = PT_BYTE; + int lookback; record_unwind_save_match_data (); - for (; CONSP (cft_element); cft_element = XCDR (cft_element)) + for (lookback = -1; CONSP (cft_element); cft_element = XCDR (cft_element)) { Lisp_Object elt = XCAR (cft_element); Lisp_Object re; @@ -927,6 +927,10 @@ autocmp_chars (cft_element, charpos, bytepos, limit, win, face, string) if (! VECTORP (elt) || ASIZE (elt) != 3) continue; + if (lookback < 0) + lookback = XFASTINT (AREF (elt, 1)); + else if (lookback != XFASTINT (AREF (elt, 1))) + break; re = AREF (elt, 0); if (NILP (string)) TEMP_SET_PT_BOTH (charpos, bytepos); @@ -989,8 +993,14 @@ composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string) { EMACS_INT start, end, c; Lisp_Object prop, val; + /* This is from forward_to_next_line_start in xdisp.c. */ + const int MAX_NEWLINE_DISTANCE = 500; + if (endpos > charpos + MAX_NEWLINE_DISTANCE) + endpos = charpos + MAX_NEWLINE_DISTANCE; cmp_it->stop_pos = endpos; + cmp_it->id = -1; + cmp_it->ch = -2; if (find_composition (charpos, endpos, &start, &end, &prop, string) && COMPOSITION_VALID_P (start, end, prop)) { @@ -1015,6 +1025,11 @@ composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string) FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos); else FETCH_CHAR_ADVANCE (c, charpos, bytepos); + if (c == '\n') + { + cmp_it->ch = -2; + break; + } val = CHAR_TABLE_REF (Vcomposition_function_table, c); if (! NILP (val)) { @@ -1029,16 +1044,18 @@ composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string) } if (CONSP (val)) { - cmp_it->stop_pos = charpos - 1 - XFASTINT (AREF (elt, 1)); + cmp_it->lookback = XFASTINT (AREF (elt, 1)); + cmp_it->stop_pos = charpos - 1 - cmp_it->lookback; cmp_it->ch = c; - break; + return; } } } + cmp_it->stop_pos = charpos; } /* 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 @@ -1056,6 +1073,13 @@ composition_reseat_it (cmp_it, charpos, bytepos, endpos, w, face, string) struct face *face; Lisp_Object string; { + if (cmp_it->ch == -2) + { + composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string); + if (cmp_it->ch == -2) + return 0; + } + if (cmp_it->ch < 0) { /* We are looking at a static composition. */ @@ -1070,14 +1094,21 @@ composition_reseat_it (cmp_it, charpos, bytepos, endpos, w, face, string) cmp_it->nchars = end - start; cmp_it->nglyphs = composition_table[cmp_it->id]->glyph_len; } - else + else if (w) { - Lisp_Object val; + Lisp_Object val, elt; int i; val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch); + for (; CONSP (val); val = XCDR (val)) + { + elt = XCAR (val); + if (cmp_it->lookback == XFASTINT (AREF (elt, 1))) + break; + } if (NILP (val)) goto no_composition; + val = autocmp_chars (val, charpos, bytepos, endpos, w, face, string); if (! composition_gstring_p (val)) goto no_composition; @@ -1089,6 +1120,8 @@ composition_reseat_it (cmp_it, charpos, bytepos, endpos, w, face, string) break; cmp_it->nglyphs = i; } + else + goto no_composition; cmp_it->from = 0; return 1; @@ -1167,19 +1200,225 @@ composition_update_it (cmp_it, charpos, bytepos, string) } +struct position_record +{ + EMACS_INT pos, pos_byte; + unsigned char *p; +}; + +/* Update the members of POSTION to the next character boundary. */ +#define FORWARD_CHAR(POSITION, STOP) \ + do { \ + (POSITION).pos++; \ + if ((POSITION).pos == (STOP)) \ + { \ + (POSITION).p = GAP_END_ADDR; \ + (POSITION).pos_byte = GPT_BYTE; \ + } \ + else \ + { \ + (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \ + (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \ + } \ + } while (0) + +/* Update the members of POSTION to the previous character boundary. */ +#define BACKWARD_CHAR(POSITION, STOP) \ + do { \ + if ((POSITION).pos == STOP) \ + (POSITION).p = GPT_ADDR; \ + do { \ + (POSITION).pos_byte--; \ + (POSITION).p--; \ + } while (! CHAR_HEAD_P (*((POSITION).p))); \ + (POSITION).pos--; \ + } while (0) + +static Lisp_Object _work_val; +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')) + +/* This is like find_composition, but find an automatic composition + instead. If found, set *GSTRING to the glyph-string representing + the composition, and return 1. Otherwise, return 0. */ + +static int +find_automatic_composition (pos, limit, start, end, gstring, string) + EMACS_INT pos, limit, *start, *end; + Lisp_Object *gstring, string; +{ + EMACS_INT head, tail, stop; + struct position_record orig, cur, check, prev; + Lisp_Object check_val, val, elt; + int check_lookback; + int c; + Lisp_Object window; + struct window *w; + + window = Fget_buffer_window (Fcurrent_buffer (), Qnil); + if (NILP (window)) + return 0; + w = XWINDOW (window); + + orig.pos = pos; + if (NILP (string)) + { + head = BEGV, tail = ZV, stop = GPT; + orig.pos_byte = CHAR_TO_BYTE (orig.pos); + orig.p = BYTE_POS_ADDR (orig.pos_byte); + } + else + { + head = 0, tail = SCHARS (string), stop = -1; + orig.pos_byte = string_char_to_byte (string, orig.pos); + orig.p = SDATA (string) + orig.pos_byte; + } + if (limit < pos) + { + head = max (head, limit); + tail = min (tail, pos + 3); + } + else + { + tail = min (tail, limit + 3); + } + cur = orig; + + retry: + check_val = Qnil; + /* At first, check if POS is compoable. */ + c = STRING_CHAR (cur.p, 0); + if (! CHAR_COMPOSABLE_P (c)) + { + if (limit < 0) + return 0; + if (limit >= cur.pos) + goto search_forward; + } + else + { + val = CHAR_TABLE_REF (Vcomposition_function_table, c); + if (! NILP (val)) + check_val = val, check = cur; + else + while (cur.pos + 1 < tail) + { + FORWARD_CHAR (cur, stop); + c = STRING_CHAR (cur.p, 0); + if (! CHAR_COMPOSABLE_P (c)) + break; + val = CHAR_TABLE_REF (Vcomposition_function_table, c); + if (NILP (val)) + continue; + check_val = val, check = cur; + break; + } + cur = orig; + } + /* Rewind back to the position where we can safely search forward + for compositions. */ + while (cur.pos > head) + { + BACKWARD_CHAR (cur, stop); + c = STRING_CHAR (cur.p, 0); + if (! CHAR_COMPOSABLE_P (c)) + break; + val = CHAR_TABLE_REF (Vcomposition_function_table, c); + if (! NILP (val)) + check_val = val, check = cur; + } + prev = cur; + /* Now search forward. */ + search_forward: + *gstring = Qnil; + if (! NILP (check_val) || limit >= orig.pos) + { + if (NILP (check_val)) + cur = orig; + else + cur = check; + while (cur.pos < tail) + { + int need_adjustment = 0; + + if (NILP (check_val)) + { + c = STRING_CHAR (cur.p, 0); + check_val = CHAR_TABLE_REF (Vcomposition_function_table, c); + } + for (; CONSP (check_val); check_val = XCDR (check_val)) + { + elt = XCAR (check_val); + if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1)) + && cur.pos - XFASTINT (AREF (elt, 1)) >= head) + { + check.pos = cur.pos - XFASTINT (AREF (elt, 1)); + if (check.pos == cur.pos) + check.pos_byte = cur.pos_byte; + else + check.pos_byte = CHAR_TO_BYTE (check.pos); + val = autocmp_chars (check_val, check.pos, check.pos_byte, + tail, w, NULL, string); + need_adjustment = 1; + if (! NILP (val)) + { + *gstring = val; + *start = check.pos; + *end = check.pos + LGSTRING_CHAR_LEN (*gstring); + if (*start <= orig.pos ? *end > orig.pos + : limit >= orig.pos) + return 1; + cur.pos = *end; + cur.pos_byte = CHAR_TO_BYTE (cur.pos); + break; + } + } + } + if (need_adjustment) + { + /* As we have called Lisp, there's a possibilily that + buffer/string is relocated. */ + if (NILP (string)) + cur.p = BYTE_POS_ADDR (cur.pos_byte); + else + cur.p = SDATA (string) + cur.pos_byte; + } + if (! CONSP (check_val)) + FORWARD_CHAR (cur, stop); + check_val = Qnil; + } + } + if (! NILP (*gstring)) + return (limit >= 0 || (*start <= orig.pos && *end > orig.pos)); + if (limit >= 0 && limit < orig.pos && prev.pos > head) + { + cur = prev; + BACKWARD_CHAR (cur, stop); + orig = cur; + tail = orig.pos; + goto retry; + } + return 0; +} + 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; + Lisp_Object val; + int i; if (PT == BEGV || PT == ZV) return 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. */ @@ -1190,97 +1429,22 @@ composition_adjust_point (last_pt) || ! 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. */ + /* Next check the automatic composition. */ + if (! find_automatic_composition (PT, (EMACS_INT) -1, &beg, &end, &val, Qnil) + || beg == PT) 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) + for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++) { - c = FETCH_MULTIBYTE_CHAR (bytepos); - if (charpos > PT) - { - int ch; + Lisp_Object glyph = LGSTRING_GLYPH (val, i); - 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); + if (NILP (glyph)) + break; + if (beg + LGLYPH_FROM (glyph) == PT) + return PT; + if (beg + LGLYPH_TO (glyph) >= PT) + return (PT < last_pt + ? beg + LGLYPH_FROM (glyph) + : beg + LGLYPH_TO (glyph) + 1); } return PT; } @@ -1288,15 +1452,15 @@ 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. 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: @@ -1309,7 +1473,7 @@ where 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 @@ -1317,22 +1481,30 @@ 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 (! 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; + + 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); @@ -1348,7 +1520,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; { @@ -1369,7 +1541,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; { @@ -1391,23 +1563,23 @@ 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; { - Lisp_Object prop, tail; - EMACS_INT start, end; + Lisp_Object prop, tail, gstring; + EMACS_INT start, end, from, to; int id; CHECK_NUMBER_COERCE_MARKER (pos); - start = XINT (pos); + from = XINT (pos); if (!NILP (limit)) { CHECK_NUMBER_COERCE_MARKER (limit); - end = XINT (limit); + to = XINT (limit); } else - end = -1; + to = -1; if (!NILP (string)) { @@ -1421,8 +1593,23 @@ See `find-composition' for more detail. */) args_out_of_range (Fcurrent_buffer (), pos); } - if (!find_composition (start, end, &start, &end, &prop, string)) - return Qnil; + if (!find_composition (from, to, &start, &end, &prop, string)) + { + if (!NILP (current_buffer->enable_multibyte_characters) + && FUNCTIONP (Vauto_composition_function) + && find_automatic_composition (from, to, &start, &end, &gstring, + string)) + return list3 (make_number (start), make_number (end), gstring); + return Qnil; + } + if ((end <= XINT (pos) || start > XINT (pos))) + { + EMACS_INT s, e; + + if (find_automatic_composition (from, to, &s, &e, &gstring, string) + && (e <= XINT (pos) ? e > end : s < start)) + return list3 (make_number (start), make_number (end), gstring); + } if (!COMPOSITION_VALID_P (start, end, prop)) return Fcons (make_number (start), Fcons (make_number (end), Fcons (Qnil, Qnil))); @@ -1519,8 +1706,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 @@ -1538,7 +1725,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 @@ -1550,7 +1737,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. @@ -1558,25 +1745,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 +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'. */);