X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/240c43e89c8fa9b08a4c2718acfc8d4df7b97fbf..d0a29e1de77e4c1c01c46d80b6ac2df06b1df2b3:/src/syntax.c diff --git a/src/syntax.c b/src/syntax.c index 0f2cda592a..eee9151f87 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -1,5 +1,6 @@ /* GNU Emacs routines to deal with syntax tables; also word and list parsing. - Copyright (C) 1985, 87, 93, 94, 95, 97, 1998, 1999 Free Software Foundation, Inc. + Copyright (C) 1985, 1987, 1993, 1994, 1995, 1997, 1998, 1999, 2002, + 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -15,8 +16,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include @@ -26,6 +27,7 @@ Boston, MA 02111-1307, USA. */ #include "buffer.h" #include "charset.h" #include "keymap.h" +#include "regex.h" /* Make syntax table lookup grant data in gl_state. */ #define SYNTAX_ENTRY_VIA_PROPERTY @@ -95,13 +97,15 @@ static int find_start_modiff; static int find_defun_start P_ ((int, int)); -static int back_comment P_ ((int, int, int, int, int, int *, int *)); +static int back_comment P_ ((EMACS_INT, EMACS_INT, EMACS_INT, int, int, + EMACS_INT *, EMACS_INT *)); static int char_quoted P_ ((int, int)); -static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object)); -static Lisp_Object scan_lists P_ ((int, int, int, int)); +static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object, int)); +static Lisp_Object scan_lists P_ ((EMACS_INT, EMACS_INT, EMACS_INT, int)); static void scan_sexps_forward P_ ((struct lisp_parse_state *, int, int, int, int, int, Lisp_Object, int)); +static int in_classes P_ ((int, Lisp_Object)); struct gl_state_s gl_state; /* Global state of syntax parser. */ @@ -130,7 +134,7 @@ update_syntax_table (charpos, count, init, object) { Lisp_Object tmp_table; int cnt = 0, invalidate = 1; - INTERVAL i, oldi; + INTERVAL i; if (init) { @@ -161,7 +165,7 @@ update_syntax_table (charpos, count, init, object) gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset; goto update; } - oldi = i = count > 0 ? gl_state.forward_i : gl_state.backward_i; + i = count > 0 ? gl_state.forward_i : gl_state.backward_i; /* We are guaranteed to be called with CHARPOS either in i, or further off. */ @@ -199,7 +203,7 @@ update_syntax_table (charpos, count, init, object) if (invalidate) invalidate = !EQ (tmp_table, gl_state.old_prop); /* Need to invalidate? */ - + if (invalidate) /* Did not get to adjacent interval. */ { /* with the same table => */ /* invalidate the old range. */ @@ -222,13 +226,13 @@ update_syntax_table (charpos, count, init, object) if (EQ (Fsyntax_table_p (tmp_table), Qt)) { gl_state.use_global = 0; - } + } else if (CONSP (tmp_table)) { gl_state.use_global = 1; gl_state.global_code = tmp_table; } - else + else { gl_state.use_global = 0; gl_state.current_syntax_table = current_buffer->syntax_table; @@ -246,16 +250,22 @@ update_syntax_table (charpos, count, init, object) } else { - gl_state.b_property = i->position + LENGTH (i) - gl_state.offset; + gl_state.b_property + = i->position + LENGTH (i) - gl_state.offset; gl_state.backward_i = i; } return; } - else if (cnt == INTERVALS_AT_ONCE) + else if (cnt == INTERVALS_AT_ONCE) { if (count > 0) { - gl_state.e_property = i->position + LENGTH (i) - gl_state.offset; + gl_state.e_property + = i->position + LENGTH (i) - gl_state.offset + /* e_property at EOB is not set to ZV but to ZV+1, so that + we can do INC(from);UPDATE_SYNTAX_TABLE_FORWARD without + having to check eob between the two. */ + + (NULL_INTERVAL_P (next_interval (i)) ? 1 : 0); gl_state.forward_i = i; } else @@ -290,10 +300,13 @@ char_quoted (charpos, bytepos) DEC_BOTH (charpos, bytepos); - while (bytepos >= beg) + while (charpos >= beg) { + int c; + UPDATE_SYNTAX_TABLE_BACKWARD (charpos); - code = SYNTAX (FETCH_CHAR (bytepos)); + c = FETCH_CHAR (bytepos); + code = SYNTAX (c); if (! (code == Scharquote || code == Sescape)) break; @@ -337,7 +350,7 @@ dec_bytepos (bytepos) It should be the last one before POS, or nearly the last. When open_paren_in_column_0_is_defun_start is nonzero, - the beginning of every line is treated as a defun-start. + only the beginning of the buffer is treated as a defun-start. We record the information about where the scan started and what its result was, so that another call in the same area @@ -353,6 +366,12 @@ find_defun_start (pos, pos_byte) { int opoint = PT, opoint_byte = PT_BYTE; + if (!open_paren_in_column_0_is_defun_start) + { + find_start_value_byte = BEGV_BYTE; + return BEGV; + } + /* Use previous finding, if it's valid and applies to this inquiry. */ if (current_buffer == find_start_buffer /* Reuse the defun-start even if POS is a little farther on. @@ -372,24 +391,25 @@ find_defun_start (pos, pos_byte) syntax-tables. */ gl_state.current_syntax_table = current_buffer->syntax_table; gl_state.use_global = 0; - if (open_paren_in_column_0_is_defun_start) + while (PT > BEGV) { - while (PT > BEGV) + int c; + + /* Open-paren at start of line means we may have found our + defun-start. */ + c = FETCH_CHAR (PT_BYTE); + if (SYNTAX (c) == Sopen) { - /* Open-paren at start of line means we may have found our - defun-start. */ - if (SYNTAX (FETCH_CHAR (PT_BYTE)) == Sopen) - { - SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */ - if (SYNTAX (FETCH_CHAR (PT_BYTE)) == Sopen) - break; - /* Now fallback to the default value. */ - gl_state.current_syntax_table = current_buffer->syntax_table; - gl_state.use_global = 0; - } - /* Move to beg of previous line. */ - scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1); + SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */ + c = FETCH_CHAR (PT_BYTE); + if (SYNTAX (c) == Sopen) + break; + /* Now fallback to the default value. */ + gl_state.current_syntax_table = current_buffer->syntax_table; + gl_state.use_global = 0; } + /* Move to beg of previous line. */ + scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1); } /* Record what we found, for the next try. */ @@ -428,7 +448,7 @@ prev_char_comend_first (pos, pos_byte) * int pos, pos_byte; * { * int c, val; - * + * * DEC_BOTH (pos, pos_byte); * UPDATE_SYNTAX_TABLE_BACKWARD (pos); * c = FETCH_CHAR (pos_byte); @@ -452,9 +472,9 @@ prev_char_comend_first (pos, pos_byte) static int back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_ptr) - int from, from_byte, stop; + EMACS_INT from, from_byte, stop; int comnested, comstyle; - int *charpos_ptr, *bytepos_ptr; + EMACS_INT *charpos_ptr, *bytepos_ptr; { /* Look back, counting the parity of string-quotes, and recording the comment-starters seen. @@ -468,7 +488,7 @@ back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_p int string_style = -1; /* Presumed outside of any string. */ int string_lossage = 0; /* Not a real lossage: indicates that we have passed a matching comment - starter plus an non-matching comment-ender, meaning that any matching + starter plus a non-matching comment-ender, meaning that any matching comment-starter we might see later could be a false positive (hidden inside another comment). Test case: { a (* b } c (* d *) */ @@ -584,7 +604,7 @@ back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_p There's no way to grok this scanning backwards. */ string_lossage = 1; break; - + case Scomment: /* We've already checked that it is the relevant comstyle. */ if (string_style != -1 || comment_lossage || string_lossage) @@ -609,7 +629,7 @@ back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_p case Sendcomment: if (SYNTAX_FLAGS_COMMENT_STYLE (syntax) == comstyle - && (SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax) + && ((com2end && SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax)) || SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested) /* This is the same style of comment ender as ours. */ { @@ -661,7 +681,7 @@ back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_p { from = comstart_pos; from_byte = comstart_byte; - /* Globals are correct now. */ + UPDATE_SYNTAX_TABLE_FORWARD (from - 1); } else { @@ -705,7 +725,7 @@ back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_p from_byte = CHAR_TO_BYTE (from); UPDATE_SYNTAX_TABLE_FORWARD (from - 1); } - + done: *charpos_ptr = from; *bytepos_ptr = from_byte; @@ -729,10 +749,9 @@ static void check_syntax_table (obj) Lisp_Object obj; { - if (!(CHAR_TABLE_P (obj) - && EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table))) - wrong_type_argument (Qsyntax_table_p, obj); -} + CHECK_TYPE (CHAR_TABLE_P (obj) && EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table), + Qsyntax_table_p, obj); +} DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0, doc: /* Return the current syntax table. @@ -911,7 +930,7 @@ text property. */) p = SDATA (string); code = (enum syntaxcode) syntax_spec_code[*p++]; if (((int) code & 0377) == 0377) - error ("invalid syntax description letter: %c", p[-1]); + error ("Invalid syntax description letter: %c", p[-1]); if (code == Sinherit) return Qnil; @@ -961,7 +980,7 @@ text property. */) val |= 1 << 22; break; } - + if (val < XVECTOR (Vsyntax_code_object)->size && NILP (match)) return XVECTOR (Vsyntax_code_object)->contents[val]; else @@ -971,10 +990,10 @@ text property. */) /* I really don't know why this is interactive help-form should at least be made useful whilst reading the second arg. */ -DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3, +DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3, "cSet syntax for character: \nsSet syntax for %s to: ", doc: /* Set syntax for character CHAR according to string NEWENTRY. -The syntax is changed only for table SYNTAX_TABLE, which defaults to +The syntax is changed only for table SYNTAX-TABLE, which defaults to the current buffer's syntax table. The first character of NEWENTRY should be one of the following: Space or - whitespace syntax. w word constituent. @@ -1274,26 +1293,32 @@ scan_words (from, count) return from; } -DEFUN ("forward-word", Fforward_word, Sforward_word, 1, 1, "p", +DEFUN ("forward-word", Fforward_word, Sforward_word, 0, 1, "p", doc: /* Move point forward ARG words (backward if ARG is negative). Normally returns t. If an edge of the buffer or a field boundary is reached, point is left there and the function returns nil. Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */) - (count) - Lisp_Object count; + (arg) + Lisp_Object arg; { + Lisp_Object tmp; int orig_val, val; - CHECK_NUMBER (count); - val = orig_val = scan_words (PT, XINT (count)); + if (NILP (arg)) + XSETFASTINT (arg, 1); + else + CHECK_NUMBER (arg); + + val = orig_val = scan_words (PT, XINT (arg)); if (! orig_val) - val = XINT (count) > 0 ? ZV : BEGV; + val = XINT (arg) > 0 ? ZV : BEGV; /* Avoid jumping out of an input field. */ - val = XFASTINT (Fconstrain_to_field (make_number (val), make_number (PT), - Qt, Qnil, Qnil)); - + tmp = Fconstrain_to_field (make_number (val), make_number (PT), + Qt, Qnil, Qnil); + val = XFASTINT (tmp); + SET_PT (val); return val == orig_val ? Qt : Qnil; } @@ -1307,11 +1332,13 @@ except that `]' is never special and `\\' quotes `^', `-' or `\\' (but not as the end of a range; quoting is never needed there). Thus, with arg "a-zA-Z", this skips letters stopping before first nonletter. With arg "^a-zA-Z", skips nonletters stopping before first letter. +Char classes, e.g. `[:alpha:]', are supported. + Returns the distance traveled, either zero or positive. */) (string, lim) Lisp_Object string, lim; { - return skip_chars (1, 0, string, lim); + return skip_chars (1, 0, string, lim, 1); } DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0, @@ -1321,7 +1348,7 @@ Returns the distance traveled, either zero or negative. */) (string, lim) Lisp_Object string, lim; { - return skip_chars (0, 0, string, lim); + return skip_chars (0, 0, string, lim, 1); } DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0, @@ -1333,7 +1360,7 @@ This function returns the distance traveled, either zero or positive. */) (syntax, lim) Lisp_Object syntax, lim; { - return skip_chars (1, 1, syntax, lim); + return skip_chars (1, 1, syntax, lim, 0); } DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0, @@ -1345,13 +1372,14 @@ This function returns the distance traveled, either zero or negative. */) (syntax, lim) Lisp_Object syntax, lim; { - return skip_chars (0, 1, syntax, lim); + return skip_chars (0, 1, syntax, lim, 0); } static Lisp_Object -skip_chars (forwardp, syntaxp, string, lim) +skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes) int forwardp, syntaxp; Lisp_Object string, lim; + int handle_iso_classes; { register unsigned int c; unsigned char fastmap[0400]; @@ -1367,12 +1395,14 @@ skip_chars (forwardp, syntaxp, string, lim) int size_byte; const unsigned char *str; int len; + Lisp_Object iso_classes; CHECK_STRING (string); char_ranges = (int *) alloca (SCHARS (string) * (sizeof (int)) * 2); string_multibyte = STRING_MULTIBYTE (string); str = SDATA (string); size_byte = SBYTES (string); + iso_classes = Qnil; /* Adjust the multibyteness of the string to that of the buffer. */ if (multibyte != string_multibyte) @@ -1428,15 +1458,54 @@ skip_chars (forwardp, syntaxp, string, lim) fastmap[syntax_spec_code[c & 0377]] = 1; else { + if (handle_iso_classes && c == '[' + && i_byte < size_byte + && STRING_CHAR (str + i_byte, size_byte - i_byte) == ':') + { + const unsigned char *class_beg = str + i_byte + 1; + const unsigned char *class_end = class_beg; + const unsigned char *class_limit = str + size_byte - 2; + /* Leave room for the null. */ + unsigned char class_name[CHAR_CLASS_MAX_LENGTH + 1]; + re_wctype_t cc; + + if (class_limit - class_beg > CHAR_CLASS_MAX_LENGTH) + class_limit = class_beg + CHAR_CLASS_MAX_LENGTH; + + while (class_end < class_limit + && *class_end >= 'a' && *class_end <= 'z') + class_end++; + + if (class_end == class_beg + || *class_end != ':' || class_end[1] != ']') + goto not_a_class_name; + + bcopy (class_beg, class_name, class_end - class_beg); + class_name[class_end - class_beg] = 0; + + cc = re_wctype (class_name); + if (cc == 0) + error ("Invalid ISO C character class"); + + iso_classes = Fcons (make_number (cc), iso_classes); + + i_byte = class_end + 2 - str; + continue; + } + + not_a_class_name: if (c == '\\') { if (i_byte == size_byte) break; - c = STRING_CHAR_AND_LENGTH (str+i_byte, size_byte-i_byte, len); + c = STRING_CHAR_AND_LENGTH (str + i_byte, + size_byte - i_byte, len); i_byte += len; } - if (i_byte < size_byte + /* Treat `-' as range character only if another character + follows. */ + if (i_byte + 1 < size_byte && str[i_byte] == '-') { unsigned int c2; @@ -1444,11 +1513,9 @@ skip_chars (forwardp, syntaxp, string, lim) /* Skip over the dash. */ i_byte++; - if (i_byte == size_byte) - break; - /* Get the end of the range. */ - c2 =STRING_CHAR_AND_LENGTH (str+i_byte, size_byte-i_byte, len); + c2 = STRING_CHAR_AND_LENGTH (str + i_byte, + size_byte - i_byte, len); i_byte += len; if (SINGLE_BYTE_CHAR_P (c)) @@ -1502,6 +1569,18 @@ skip_chars (forwardp, syntaxp, string, lim) int start_point = PT; int pos = PT; int pos_byte = PT_BYTE; + unsigned char *p = PT_ADDR, *endp, *stop; + + if (forwardp) + { + endp = (XINT (lim) == GPT) ? GPT_ADDR : CHAR_POS_ADDR (XINT (lim)); + stop = (pos < GPT && GPT < XINT (lim)) ? GPT_ADDR : endp; + } + else + { + endp = CHAR_POS_ADDR (XINT (lim)); + stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; + } immediate_quit = 1; if (syntaxp) @@ -1510,60 +1589,85 @@ skip_chars (forwardp, syntaxp, string, lim) if (forwardp) { if (multibyte) - { - if (pos < XINT (lim)) - while (fastmap[(int) SYNTAX (FETCH_CHAR (pos_byte))]) + while (1) + { + int nbytes; + + if (p >= stop) { - /* Since we already checked for multibyteness, - avoid using INC_BOTH which checks again. */ - INC_POS (pos_byte); - pos++; - if (pos >= XINT (lim)) - break; - UPDATE_SYNTAX_TABLE_FORWARD (pos); + if (p >= endp) + break; + p = GAP_END_ADDR; + stop = endp; } - } + c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes); + if (! fastmap[(int) SYNTAX (c)]) + break; + p += nbytes, pos++, pos_byte += nbytes; + UPDATE_SYNTAX_TABLE_FORWARD (pos); + } else - { - while (pos < XINT (lim) - && fastmap[(int) SYNTAX (FETCH_BYTE (pos))]) - { - pos++; - UPDATE_SYNTAX_TABLE_FORWARD (pos); - } - } + while (1) + { + if (p >= stop) + { + if (p >= endp) + break; + p = GAP_END_ADDR; + stop = endp; + } + if (! fastmap[(int) SYNTAX (*p)]) + break; + p++, pos++; + UPDATE_SYNTAX_TABLE_FORWARD (pos); + } } else { if (multibyte) - { - while (pos > XINT (lim)) - { - int savepos = pos_byte; - /* Since we already checked for multibyteness, - avoid using DEC_BOTH which checks again. */ - pos--; - DEC_POS (pos_byte); - UPDATE_SYNTAX_TABLE_BACKWARD (pos); - if (!fastmap[(int) SYNTAX (FETCH_CHAR (pos_byte))]) - { - pos++; - pos_byte = savepos; + while (1) + { + unsigned char *prev_p; + int nbytes; + + if (p <= stop) + { + if (p <= endp) break; - } - } - } + p = GPT_ADDR; + stop = endp; + } + prev_p = p; + while (--p >= stop && ! CHAR_HEAD_P (*p)); + PARSE_MULTIBYTE_SEQ (p, MAX_MULTIBYTE_LENGTH, nbytes); + if (prev_p - p > nbytes) + p = prev_p - 1, c = *p, nbytes = 1; + else + c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH); + pos--, pos_byte -= nbytes; + UPDATE_SYNTAX_TABLE_BACKWARD (pos); + if (! fastmap[(int) SYNTAX (c)]) + { + pos++; + pos_byte += nbytes; + break; + } + } else - { - if (pos > XINT (lim)) - while (fastmap[(int) SYNTAX (FETCH_BYTE (pos - 1))]) + while (1) + { + if (p <= stop) { - pos--; - if (pos <= XINT (lim)) + if (p <= endp) break; - UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); + p = GPT_ADDR; + stop = endp; } - } + if (! fastmap[(int) SYNTAX (p[-1])]) + break; + p--, pos--; + UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); + } } } else @@ -1571,9 +1675,27 @@ skip_chars (forwardp, syntaxp, string, lim) if (forwardp) { if (multibyte) - while (pos < XINT (lim)) + while (1) { - c = FETCH_MULTIBYTE_CHAR (pos_byte); + int nbytes; + + if (p >= stop) + { + if (p >= endp) + break; + p = GAP_END_ADDR; + stop = endp; + } + c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes); + + if (! NILP (iso_classes) && in_classes (c, iso_classes)) + { + if (negate) + break; + else + goto fwd_ok; + } + if (SINGLE_BYTE_CHAR_P (c)) { if (!fastmap[c]) @@ -1596,21 +1718,65 @@ skip_chars (forwardp, syntaxp, string, lim) if (!(negate ^ (i < n_char_ranges))) break; } - INC_BOTH (pos, pos_byte); + fwd_ok: + p += nbytes, pos++, pos_byte += nbytes; } else - while (pos < XINT (lim) && fastmap[FETCH_BYTE (pos)]) - pos++; + while (1) + { + if (p >= stop) + { + if (p >= endp) + break; + p = GAP_END_ADDR; + stop = endp; + } + + if (!NILP (iso_classes) && in_classes (*p, iso_classes)) + { + if (negate) + break; + else + goto fwd_unibyte_ok; + } + + if (!fastmap[*p]) + break; + fwd_unibyte_ok: + p++, pos++; + } } else { if (multibyte) - while (pos > XINT (lim)) + while (1) { - int prev_pos_byte = pos_byte; + unsigned char *prev_p; + int nbytes; + + if (p <= stop) + { + if (p <= endp) + break; + p = GPT_ADDR; + stop = endp; + } + prev_p = p; + while (--p >= stop && ! CHAR_HEAD_P (*p)); + PARSE_MULTIBYTE_SEQ (p, MAX_MULTIBYTE_LENGTH, nbytes); + if (prev_p - p > nbytes) + p = prev_p - 1, c = *p, nbytes = 1; + else + c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH); + + if (! NILP (iso_classes) && in_classes (c, iso_classes)) + { + if (negate) + break; + else + goto back_ok; + } - DEC_POS (prev_pos_byte); - c = FETCH_MULTIBYTE_CHAR (prev_pos_byte); if (SINGLE_BYTE_CHAR_P (c)) { if (!fastmap[c]) @@ -1625,12 +1791,33 @@ skip_chars (forwardp, syntaxp, string, lim) if (!(negate ^ (i < n_char_ranges))) break; } - pos--; - pos_byte = prev_pos_byte; + back_ok: + pos--, pos_byte -= nbytes; } else - while (pos > XINT (lim) && fastmap[FETCH_BYTE (pos - 1)]) - pos--; + while (1) + { + if (p <= stop) + { + if (p <= endp) + break; + p = GPT_ADDR; + stop = endp; + } + + if (! NILP (iso_classes) && in_classes (p[-1], iso_classes)) + { + if (negate) + break; + else + goto back_unibyte_ok; + } + + if (!fastmap[p[-1]]) + break; + back_unibyte_ok: + p--, pos--; + } } } @@ -1651,6 +1838,30 @@ skip_chars (forwardp, syntaxp, string, lim) return make_number (PT - start_point); } } + +/* Return 1 if character C belongs to one of the ISO classes + in the list ISO_CLASSES. Each class is represented by an + integer which is its type according to re_wctype. */ + +static int +in_classes (c, iso_classes) + int c; + Lisp_Object iso_classes; +{ + int fits_class = 0; + + while (! NILP (iso_classes)) + { + Lisp_Object elt; + elt = XCAR (iso_classes); + iso_classes = XCDR (iso_classes); + + if (re_iswctype (c, XFASTINT (elt))) + fits_class = 1; + } + + return fits_class; +} /* Jump over a comment, assuming we are at the beginning of one. FROM is the current position. @@ -1679,9 +1890,10 @@ skip_chars (forwardp, syntaxp, string, lim) static int forw_comment (from, from_byte, stop, nesting, style, prev_syntax, charpos_ptr, bytepos_ptr, incomment_ptr) - int from, from_byte, stop; + EMACS_INT from, from_byte, stop; int nesting, style, prev_syntax; - int *charpos_ptr, *bytepos_ptr, *incomment_ptr; + EMACS_INT *charpos_ptr, *bytepos_ptr; + int *incomment_ptr; { register int c, c1; register enum syntaxcode code; @@ -1729,7 +1941,7 @@ forw_comment (from, from_byte, stop, nesting, style, prev_syntax, nesting++; INC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); - + forw_incomment: if (from < stop && SYNTAX_FLAGS_COMEND_FIRST (syntax) && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style @@ -1772,24 +1984,25 @@ forw_comment (from, from_byte, stop, nesting, style, prev_syntax, } DEFUN ("forward-comment", Fforward_comment, Sforward_comment, 1, 1, 0, - doc: /* Move forward across up to N comments. If N is negative, move backward. + doc: /* +Move forward across up to COUNT comments. If COUNT is negative, move backward. Stop scanning if we find something other than a comment or whitespace. Set point to where scanning stops. -If N comments are found as expected, with nothing except whitespace +If COUNT comments are found as expected, with nothing except whitespace between them, return t; otherwise return nil. */) (count) Lisp_Object count; { - register int from; - int from_byte; - register int stop; + register EMACS_INT from; + EMACS_INT from_byte; + register EMACS_INT stop; register int c, c1; register enum syntaxcode code; int comstyle = 0; /* style of comment encountered */ int comnested = 0; /* whether the comment is nestable or not */ int found; - int count1; - int out_charpos, out_bytepos; + EMACS_INT count1; + EMACS_INT out_charpos, out_bytepos; int dummy; CHECK_NUMBER (count); @@ -1826,7 +2039,7 @@ between them, return t; otherwise return nil. */) && (c1 = FETCH_CHAR (from_byte), SYNTAX_COMSTART_SECOND (c1))) { - /* We have encountered a comment start sequence and we + /* We have encountered a comment start sequence and we are ignoring all text inside comments. We must record the comment style this sequence begins so that later, only a comment end of the same style actually ends @@ -1907,20 +2120,20 @@ between them, return t; otherwise return nil. */) { /* Skip until first preceding unquoted comment_fence. */ int found = 0, ini = from, ini_byte = from_byte; - + while (1) { DEC_BOTH (from, from_byte); - if (from == stop) - break; UPDATE_SYNTAX_TABLE_BACKWARD (from); c = FETCH_CHAR (from_byte); if (SYNTAX (c) == Scomment_fence - && !char_quoted (from, from_byte)) + && !char_quoted (from, from_byte)) { - found = 1; + found = 1; break; } + else if (from == stop) + break; } if (found == 0) { @@ -1928,6 +2141,9 @@ between them, return t; otherwise return nil. */) from_byte = ini_byte; goto leave; } + else + /* We have skipped one comment. */ + break; } else if (code == Sendcomment) { @@ -1984,11 +2200,12 @@ between them, return t; otherwise return nil. */) static Lisp_Object scan_lists (from, count, depth, sexpflag) - register int from; - int count, depth, sexpflag; + register EMACS_INT from; + EMACS_INT count, depth; + int sexpflag; { Lisp_Object val; - register int stop = count > 0 ? ZV : BEGV; + register EMACS_INT stop = count > 0 ? ZV : BEGV; register int c, c1; int stringterm; int quoted; @@ -1997,11 +2214,11 @@ scan_lists (from, count, depth, sexpflag) int min_depth = depth; /* Err out if depth gets less than this. */ int comstyle = 0; /* style of comment encountered */ int comnested = 0; /* whether the comment is nestable or not */ - int temp_pos; - int last_good = from; + EMACS_INT temp_pos; + EMACS_INT last_good = from; int found; - int from_byte; - int out_bytepos, out_charpos; + EMACS_INT from_byte; + EMACS_INT out_bytepos, out_charpos; int temp, dummy; int multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol; @@ -2033,10 +2250,10 @@ scan_lists (from, count, depth, sexpflag) INC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); if (from < stop && comstart_first - && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte)) + && (c = FETCH_CHAR (from_byte), SYNTAX_COMSTART_SECOND (c)) && parse_sexp_ignore_comments) { - /* we have encountered a comment start sequence and we + /* we have encountered a comment start sequence and we are ignoring all text inside comments. We must record the comment style this sequence begins so that later, only a comment end of the same style actually ends @@ -2048,7 +2265,7 @@ scan_lists (from, count, depth, sexpflag) INC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); } - + if (prefix) continue; @@ -2130,10 +2347,9 @@ scan_lists (from, count, depth, sexpflag) close1: if (!--depth) goto done; if (depth < min_depth) - Fsignal (Qscan_error, - Fcons (build_string ("Containing expression ends prematurely"), - Fcons (make_number (last_good), - Fcons (make_number (from), Qnil)))); + xsignal3 (Qscan_error, + build_string ("Containing expression ends prematurely"), + make_number (last_good), make_number (from)); break; case Sstring: @@ -2209,7 +2425,7 @@ scan_lists (from, count, depth, sexpflag) comstyle = SYNTAX_COMMENT_STYLE (c1); comnested = comnested || SYNTAX_COMMENT_NESTED (c1); } - + /* Quoting turns anything except a comment-ender into a word character. Note that this cannot be true if we decremented FROM in the if-statement above. */ @@ -2282,10 +2498,9 @@ scan_lists (from, count, depth, sexpflag) open2: if (!--depth) goto done2; if (depth < min_depth) - Fsignal (Qscan_error, - Fcons (build_string ("Containing expression ends prematurely"), - Fcons (make_number (last_good), - Fcons (make_number (from), Qnil)))); + xsignal3 (Qscan_error, + build_string ("Containing expression ends prematurely"), + make_number (last_good), make_number (from)); break; case Sendcomment: @@ -2307,35 +2522,29 @@ scan_lists (from, count, depth, sexpflag) case Sstring_fence: while (1) { - DEC_BOTH (from, from_byte); if (from == stop) goto lose; + DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); - if (!char_quoted (from, from_byte) + if (!char_quoted (from, from_byte) && (c = FETCH_CHAR (from_byte), SYNTAX_WITH_MULTIBYTE_CHECK (c) == code)) break; } if (code == Sstring_fence && !depth && sexpflag) goto done2; break; - + case Sstring: stringterm = FETCH_CHAR (from_byte); while (1) { if (from == stop) goto lose; - temp_pos = from_byte; - if (! NILP (current_buffer->enable_multibyte_characters)) - DEC_POS (temp_pos); - else - temp_pos--; - UPDATE_SYNTAX_TABLE_BACKWARD (from - 1); - if (!char_quoted (from - 1, temp_pos) - && stringterm == (c = FETCH_CHAR (temp_pos)) + DEC_BOTH (from, from_byte); + UPDATE_SYNTAX_TABLE_BACKWARD (from); + if (!char_quoted (from, from_byte) + && stringterm == (c = FETCH_CHAR (from_byte)) && SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring) break; - DEC_BOTH (from, from_byte); } - DEC_BOTH (from, from_byte); if (!depth && sexpflag) goto done2; break; default: @@ -2360,12 +2569,9 @@ scan_lists (from, count, depth, sexpflag) return val; lose: - Fsignal (Qscan_error, - Fcons (build_string ("Unbalanced parentheses"), - Fcons (make_number (last_good), - Fcons (make_number (from), Qnil)))); - - /* NOTREACHED */ + xsignal3 (Qscan_error, + build_string ("Unbalanced parentheses"), + make_number (last_good), make_number (from)); } DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0, @@ -2425,7 +2631,7 @@ This includes chars with "quote" or "prefix" syntax (' or p). */) int pos_byte = PT_BYTE; int c; - if (pos <= beg) + if (pos <= beg) { SET_PT_BOTH (opoint, opoint_byte); @@ -2466,7 +2672,7 @@ scan_sexps_forward (stateptr, from, from_byte, end, targetdepth, stopbefore, oldstate, commentstop) struct lisp_parse_state *stateptr; register int from; - int end, targetdepth, stopbefore; + int end, targetdepth, stopbefore, from_byte; Lisp_Object oldstate; int commentstop; { @@ -2491,7 +2697,7 @@ scan_sexps_forward (stateptr, from, from_byte, end, targetdepth, int boundary_stop = commentstop == -1; int nofence; int found; - int out_bytepos, out_charpos; + EMACS_INT out_bytepos, out_charpos; int temp; prev_from = from; @@ -2503,10 +2709,11 @@ scan_sexps_forward (stateptr, from, from_byte, end, targetdepth, #define INC_FROM \ do { prev_from = from; \ prev_from_byte = from_byte; \ - prev_from_syntax \ - = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); \ + temp = FETCH_CHAR (prev_from_byte); \ + prev_from_syntax = SYNTAX_WITH_FLAGS (temp); \ INC_BOTH (from, from_byte); \ - UPDATE_SYNTAX_TABLE_FORWARD (from); \ + if (from < end) \ + UPDATE_SYNTAX_TABLE_FORWARD (from); \ } while (0) immediate_quit = 1; @@ -2533,8 +2740,8 @@ do { prev_from = from; \ oldstate = Fcdr (oldstate); tem = Fcar (oldstate); /* Check whether we are inside string_fence-style string: */ - state.instring = (!NILP (tem) - ? (INTEGERP (tem) ? XINT (tem) : ST_STRING_STYLE) + state.instring = (!NILP (tem) + ? (INTEGERP (tem) ? XINT (tem) : ST_STRING_STYLE) : -1); oldstate = Fcdr (oldstate); @@ -2552,7 +2759,7 @@ do { prev_from = from; \ oldstate = Fcdr (oldstate); oldstate = Fcdr (oldstate); tem = Fcar (oldstate); - state.comstyle = NILP (tem) ? 0 : (EQ (tem, Qsyntax_table) + state.comstyle = NILP (tem) ? 0 : (EQ (tem, Qsyntax_table) ? ST_COMMENT_STYLE : 1); oldstate = Fcdr (oldstate); @@ -2578,7 +2785,8 @@ do { prev_from = from; \ curlevel->last = -1; SETUP_SYNTAX_TABLE (prev_from, 1); - prev_from_syntax = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); + temp = FETCH_CHAR (prev_from_byte); + prev_from_syntax = SYNTAX_WITH_FLAGS (temp); UPDATE_SYNTAX_TABLE_FORWARD (from); /* Enter the loop at a place appropriate for initial state. */ @@ -2595,23 +2803,28 @@ do { prev_from = from; \ else if (start_quoted) goto startquoted; -#if 0 /* This seems to be redundant with the identical code above. */ - SETUP_SYNTAX_TABLE (prev_from, 1); - prev_from_syntax = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); - UPDATE_SYNTAX_TABLE_FORWARD (from); -#endif - while (from < end) { INC_FROM; code = prev_from_syntax & 0xff; - if (code == Scomment) + if (from < end + && SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax) + && (c1 = FETCH_CHAR (from_byte), + SYNTAX_COMSTART_SECOND (c1))) + /* Duplicate code to avoid a complex if-expression + which causes trouble for the SGI compiler. */ { - state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax); - state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ? - 1 : -1); + /* Record the comment style we have entered so that only + the comment-end sequence of the same style actually + terminates the comment section. */ + state.comstyle = SYNTAX_COMMENT_STYLE (c1); + comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax); + comnested = comnested || SYNTAX_COMMENT_NESTED (c1); + state.incomment = comnested ? 1 : -1; state.comstr_start = prev_from; + INC_FROM; + code = Scomment; } else if (code == Scomment_fence) { @@ -2623,24 +2836,13 @@ do { prev_from = from; \ state.comstr_start = prev_from; code = Scomment; } - else if (from < end) - if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)) - if (c1 = FETCH_CHAR (from_byte), - SYNTAX_COMSTART_SECOND (c1)) - /* Duplicate code to avoid a complex if-expression - which causes trouble for the SGI compiler. */ - { - /* Record the comment style we have entered so that only - the comment-end sequence of the same style actually - terminates the comment section. */ - state.comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte)); - comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax); - comnested = comnested || SYNTAX_COMMENT_NESTED (c1); - state.incomment = comnested ? 1 : -1; - state.comstr_start = prev_from; - INC_FROM; - code = Scomment; - } + else if (code == Scomment) + { + state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax); + state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ? + 1 : -1); + state.comstr_start = prev_from; + } if (SYNTAX_FLAGS_PREFIX (prev_from_syntax)) continue; @@ -2663,7 +2865,8 @@ do { prev_from = from; \ while (from < end) { /* Some compilers can't handle this inside the switch. */ - temp = SYNTAX (FETCH_CHAR (from_byte)); + temp = FETCH_CHAR (from_byte); + temp = SYNTAX (temp); switch (temp) { case Scharquote: @@ -2735,14 +2938,14 @@ do { prev_from = from; \ state.comstr_start = from - 1; if (stopbefore) goto stop; /* this arg means stop at sexp start */ curlevel->last = prev_from; - state.instring = (code == Sstring + state.instring = (code == Sstring ? (FETCH_CHAR (prev_from_byte)) : ST_STRING_STYLE); if (boundary_stop) goto done; startinstring: { nofence = state.instring != ST_STRING_STYLE; - + while (1) { int c; @@ -2817,14 +3020,14 @@ Parsing stops at TO or when certain criteria are met; point is set to where parsing stops. If fifth arg OLDSTATE is omitted or nil, parsing assumes that FROM is the beginning of a function. -Value is a list of ten elements describing final state of parsing: +Value is a list of elements describing final state of parsing: 0. depth in parens. 1. character address of start of innermost containing list; nil if none. 2. character address of start of last complete sexp terminated. 3. non-nil if inside a string. (it is the character that will terminate the string, or t if the string should be terminated by a generic string delimiter.) - 4. nil if outside a comment, t if inside a non-nestable comment, + 4. nil if outside a comment, t if inside a non-nestable comment, else an integer (the current comment nesting). 5. t if following a quote character. 6. the minimum paren-depth encountered during this scan. @@ -2836,7 +3039,7 @@ If third arg TARGETDEPTH is non-nil, parsing stops if the depth in parentheses becomes equal to TARGETDEPTH. Fourth arg STOPBEFORE non-nil means stop when come to any character that starts a sexp. -Fifth arg OLDSTATE is a nine-element list like what this function returns. +Fifth arg OLDSTATE is a list like what this function returns. It is used to initialize the state of the parse. Elements number 1, 2, 6 and 8 are ignored; you can leave off element 8 (the last) entirely. Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. @@ -2860,23 +3063,23 @@ Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. scan_sexps_forward (&state, XINT (from), CHAR_TO_BYTE (XINT (from)), XINT (to), target, !NILP (stopbefore), oldstate, - (NILP (commentstop) + (NILP (commentstop) ? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1))); SET_PT (state.location); - + return Fcons (make_number (state.depth), Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart), Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart), - Fcons (state.instring >= 0 - ? (state.instring == ST_STRING_STYLE + Fcons (state.instring >= 0 + ? (state.instring == ST_STRING_STYLE ? Qt : make_number (state.instring)) : Qnil, Fcons (state.incomment < 0 ? Qt : (state.incomment == 0 ? Qnil : make_number (state.incomment)), Fcons (state.quoted ? Qt : Qnil, Fcons (make_number (state.mindepth), - Fcons ((state.comstyle + Fcons ((state.comstyle ? (state.comstyle == ST_COMMENT_STYLE ? Qsyntax_table : Qt) : Qnil), @@ -2916,6 +3119,20 @@ init_syntax_once () Vstandard_syntax_table = Fmake_char_table (Qsyntax_table, temp); + /* Control characters should not be whitespace. */ + temp = XVECTOR (Vsyntax_code_object)->contents[(int) Spunct]; + for (i = 0; i <= ' ' - 1; i++) + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 0177, temp); + + /* Except that a few really are whitespace. */ + temp = XVECTOR (Vsyntax_code_object)->contents[(int) Swhitespace]; + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ' ', temp); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\t', temp); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\n', temp); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 015, temp); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 014, temp); + temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword]; for (i = 'a'; i <= 'z'; i++) SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp); @@ -2972,6 +3189,14 @@ syms_of_syntax () staticpro (&Vsyntax_code_object); + staticpro (&gl_state.object); + staticpro (&gl_state.global_code); + staticpro (&gl_state.current_syntax_table); + staticpro (&gl_state.old_prop); + + /* Defined in regex.c */ + staticpro (&re_match_object); + Qscan_error = intern ("scan-error"); staticpro (&Qscan_error); Fput (Qscan_error, Qerror_conditions, @@ -2998,7 +3223,7 @@ See the info node `(elisp)Syntax Properties' for a description of the DEFVAR_BOOL ("open-paren-in-column-0-is-defun-start", &open_paren_in_column_0_is_defun_start, - doc: /* Non-nil means an open paren in column 0 denotes the start of a defun. */); + doc: /* *Non-nil means an open paren in column 0 denotes the start of a defun. */); open_paren_in_column_0_is_defun_start = 1; defsubr (&Ssyntax_table_p); @@ -3025,3 +3250,6 @@ See the info node `(elisp)Syntax Properties' for a description of the defsubr (&Sbackward_prefix_chars); defsubr (&Sparse_partial_sexp); } + +/* arch-tag: 3e297b9f-088e-4b64-8f4c-fb0b3443e412 + (do not change this comment) */