X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Fsyntax.c;h=42628c50a64bc48b53d8c27cae41d032bb8aa3a2;hp=3388e6dd08cb1f8fa0e4ffcb3544135fea3fd85e;hb=ac7d0619aad74b1d57c4748ebb3ab29d9c32e3d8;hpb=dbf2768f7b146e97e37a27316f70bb313f1acf15 diff --git a/src/syntax.c b/src/syntax.c index 3388e6d..42628c5 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -104,7 +104,9 @@ struct lisp_parse_state Bufpos prevlevelstart;/* Char number of start of containing expression */ Bufpos location; /* Char number at which parsing stopped */ int mindepth; /* Minimum depth seen while scanning */ - Bufpos comstr_start; /* Position just after last comment/string starter */ + Bufpos comstr_start; /* Position just after last comment/string starter + (if the 'syntax-table text property is not + supported, used only for comment starts) */ Lisp_Object levelstarts; /* Char numbers of starts-of-expression of levels (starting from outermost). */ }; @@ -145,6 +147,7 @@ find_defun_start (struct buffer *buf, Bufpos pos) /* Back up to start of line. */ tem = find_next_newline (buf, pos, -1); + SCS_STATISTICS_SET_FUNCTION (scs_find_defun_start); SETUP_SYNTAX_CACHE (tem, 1); while (tem > BUF_BEGV (buf)) { @@ -254,84 +257,242 @@ struct syntax_cache syntax_cache; whatever is returned by get-char-property. It might be worth it at some point to merge provided syntax tables - outward to the current buffer. */ + outward to the current buffer. + + sjt sez: + This implementation has to rather inefficient, since it looks at + next-extent-change, and a heavily font-locked buffer will be rife + with irrelevant extents. We could do a sledgehammer check on this + by looking at the distribution of extent lengths. Also count up + cache hits and misses. + + If we assume that syntax-table is a _text_ property (which also + deals with the issue of overlapping syntax-table properties), then + the following strategy recommends itself + o give the syntax cache a `valid' flag, to be reset whenever a + syntax-table property is added, changed, or removed; this could + be done by setting syntax_cache's prev_change > next_change + (but not compatible with using extents/markers here); if it's a + Lisp variable, doing it in Lisp shouldn't be too inefficient + o lazily initialize the cache whenever the object being examined + differs from the object the cache currently refers to + o by using {previous,next-single-property-change} we should be + able to get much bigger cache intervals (in most cases, the + whole buffer) + o cache markers instead of positions so the mere insertion or + deletion of text doesn't invalidate the cache, only if it + involves a syntax-table property (we could also cache the + extents carrying the syntax-table text-property; that gives us + another check for invalid cache). + + If I understand this correctly, we need to invalidate the cache in the + following cases: + o If the referenced object changes (it's a global cache) + o If there are insertions or deletions of text (the positions are + absolute; fix: use markers or an extent instead?) + o If the syntax-table property is altered == added and different or + removed and the same (fix: probably computable from range overlap, + but is it worth it? would interact with ins/del); this includes + detachment of extents with the same value (but only the boundary + extents, as otherwise the range coalesces across the deletion point) + and attachment of extents with a different value + Note: the above looks a lot like what Ben has implemented in 21.5, but + he goes one better by making the cache buffer-local. + + Note: cperl mode uses the text property API, not extents/overlays. +*/ + +#ifdef SYNTAX_CACHE_STATISTICS +struct syntax_cache_statistics scs_statistics = + { 0, 0, 0, 0, -1, -1, 0.0, 0.0, scs_no_function}; + +char* syntax_cache_statistics_function_names[scs_number_of_functions] = { + "find_context", + "find_defun_start", + "scan_words", + "Fforward_comment", + "scan_lists", + "Fbackward_prefix_characters", + "scan_sexps_forward" +}; +#endif /* SYNTAX_CACHE_STATISTICS */ void -update_syntax_cache (int pos, int count, int init) +update_syntax_cache (int pos, int count) { Lisp_Object tmp_table; - if (init) +#ifdef SYNTAX_CACHE_STATISTICS + if (scs_statistics.total_updates == 0) { - syntax_cache.prev_change = -1; - syntax_cache.next_change = -1; + int i; + for (i = 0; i < scs_number_of_functions; ++i) + scs_statistics.functions[i] = 0; } - - if (pos > syntax_cache.prev_change && - pos < syntax_cache.next_change) + if (syntax_cache.prev_change > syntax_cache.next_change) + scs_statistics.inits++; + else if (pos < syntax_cache.prev_change) + scs_statistics.misses_lo++; + else if (pos >= syntax_cache.next_change) + scs_statistics.misses_hi++; +#endif /* SYNTAX_CACHE_STATISTICS */ + + /* #### Since font-lock undoes any narrowing, maybe the BUF_ZV and + BUF_BEGV below should be BUF_Z and BUF_BEG respectively? */ + if (BUFFERP (syntax_cache.object)) { - /* do nothing */ + int get_change_before = pos + 1; + + tmp_table = Fget_char_property (make_int(pos), Qsyntax_table, + syntax_cache.object, Qnil); +#if NEXT_SINGLE_PROPERTY_CHANGE + /* #### shouldn't we be using BUF_BEGV here? */ + syntax_cache.next_change = + XINT (Fnext_single_property_change + (make_int (pos > 0 ? pos : 1), Qsyntax_table, + syntax_cache.object, make_int (BUF_ZV (syntax_cache.buffer)))); +#else + syntax_cache.next_change = + XINT (Fnext_extent_change (make_int (pos > 0 ? pos : 1), + syntax_cache.object)); +#endif + + /* #### shouldn't we be using BUF_BEGV here? */ + if (get_change_before < 1) + get_change_before = 1; + else if (get_change_before > BUF_ZV (syntax_cache.buffer)) + get_change_before = BUF_ZV (syntax_cache.buffer); + +#if PREVIOUS_SINGLE_PROPERTY_CHANGE + /* #### shouldn't we be using BUF_BEGV here? */ + syntax_cache.prev_change = + XINT (Fprevious_single_property_change + (make_int (get_change_before), Qsyntax_table, + syntax_cache.object, make_int(1))); +#else + syntax_cache.prev_change = + XINT (Fprevious_extent_change (make_int (get_change_before), + syntax_cache.object)); +#endif } - else + else if (STRINGP (syntax_cache.object)) { - if (NILP (syntax_cache.object) || EQ (syntax_cache.object, Qt)) - { - int get_change_before = pos + 1; - - tmp_table = Fget_char_property (make_int(pos), Qsyntax_table, - make_buffer (syntax_cache.buffer), Qnil); - syntax_cache.next_change = - XINT (Fnext_extent_change (make_int (pos > 0 ? pos : 1), - make_buffer (syntax_cache.buffer))); - - if (get_change_before < 1) - get_change_before = 1; - else if (get_change_before > BUF_ZV (syntax_cache.buffer)) - get_change_before = BUF_ZV (syntax_cache.buffer); - - syntax_cache.prev_change = - XINT (Fprevious_extent_change (make_int (get_change_before), - make_buffer (syntax_cache.buffer))); - } - else - { - int get_change_before = pos + 1; + int get_change_before = pos + 1; + + tmp_table = Fget_char_property (make_int(pos), Qsyntax_table, + syntax_cache.object, Qnil); +#if NEXT_SINGLE_PROPERTY_CHANGE + /* #### shouldn't we be using BUF_BEGV here? */ + syntax_cache.next_change = + XINT (Fnext_single_property_change + (make_int (pos >= 0 ? pos : 0), Qsyntax_table, + syntax_cache.object, + make_int(XSTRING_LENGTH(syntax_cache.object)))); +#else + syntax_cache.next_change = + XINT (Fnext_extent_change (make_int (pos >= 0 ? pos : 0), + syntax_cache.object)); +#endif - tmp_table = Fget_char_property (make_int(pos), Qsyntax_table, - syntax_cache.object, Qnil); - syntax_cache.next_change = - XINT (Fnext_extent_change (make_int (pos >= 0 ? pos : 0), + if (get_change_before < 0) + get_change_before = 0; + else if (get_change_before > XSTRING_LENGTH(syntax_cache.object)) + get_change_before = XSTRING_LENGTH(syntax_cache.object); + +#if PREVIOUS_SINGLE_PROPERTY_CHANGE + syntax_cache.prev_change = + XINT (Fprevious_single_property_change + (make_int (get_change_before), Qsyntax_table, + syntax_cache.object, make_int(0))); +#else + syntax_cache.prev_change = + XINT (Fprevious_extent_change (make_int (get_change_before), syntax_cache.object)); +#endif + } + else + { + tmp_table = Qnil; /* silence compiler */ + /* Always aborts. #### Is there another sensible thing to do here? */ + assert (BUFFERP (syntax_cache.object) || STRINGP (syntax_cache.object)); + } - if (get_change_before < 0) - get_change_before = 0; - else if (get_change_before > XSTRING_LENGTH(syntax_cache.object)) - get_change_before = XSTRING_LENGTH(syntax_cache.object); + if (EQ (Fsyntax_table_p (tmp_table), Qt)) + { + syntax_cache.use_code = 0; + syntax_cache.current_syntax_table = + XCHAR_TABLE (tmp_table)->mirror_table; + } + else if (CONSP (tmp_table) && INTP (XCAR (tmp_table))) + { + syntax_cache.use_code = 1; + syntax_cache.syntax_code = XINT (XCAR(tmp_table)); + } + else + { + syntax_cache.use_code = 0; + syntax_cache.current_syntax_table = + syntax_cache.buffer->mirror_syntax_table; + } - syntax_cache.prev_change = - XINT (Fprevious_extent_change (make_int (pos >= 0 ? pos : 0), - syntax_cache.object)); - } +#ifdef SYNTAX_CACHE_STATISTICS + { + int length = syntax_cache.next_change - syntax_cache.prev_change; + int misses = scs_statistics.misses_lo + + scs_statistics.misses_hi + scs_statistics.inits; + + if (scs_statistics.min_length == -1 || scs_statistics.min_length > length) + scs_statistics.min_length = length; + if (scs_statistics.max_length == -1 || scs_statistics.max_length < length) + scs_statistics.max_length = length; + scs_statistics.mean_length_on_miss = + ((misses - 1) * scs_statistics.mean_length_on_miss + length) / misses; + } + + scs_statistics.mean_length + = scs_statistics.total_updates*scs_statistics.mean_length + + syntax_cache.next_change - syntax_cache.prev_change; + scs_statistics.total_updates++; + scs_statistics.mean_length /= scs_statistics.total_updates; + + if (scs_statistics.this_function != scs_no_function) + { + scs_statistics.functions[scs_statistics.this_function]++; + scs_statistics.this_function = scs_no_function; + } - if (EQ (Fsyntax_table_p (tmp_table), Qt)) - { - syntax_cache.use_code = 0; - syntax_cache.current_syntax_table = - XCHAR_TABLE (tmp_table)->mirror_table; - } - else if (CONSP (tmp_table) && INTP (XCAR (tmp_table))) - { - syntax_cache.use_code = 1; - syntax_cache.syntax_code = XINT (XCAR(tmp_table)); - } - else - { - syntax_cache.use_code = 0; - syntax_cache.current_syntax_table = - syntax_cache.buffer->mirror_syntax_table; - } + if (!(scs_statistics.total_updates % SYNTAX_CACHE_STATISTICS_REPORT_INTERVAL)) + { + fprintf (stderr, "Syntax cache stats:\n "); + fprintf (stderr, "updates %d, inits %d, misses low %d, misses high %d,", + scs_statistics.total_updates, scs_statistics.inits, + scs_statistics.misses_lo, scs_statistics.misses_hi); + fprintf (stderr, "\n "); + +#define REPORT_FUNCTION(i) \ + fprintf (stderr, " %s %d,", \ + syntax_cache_statistics_function_names[i], \ + scs_statistics.functions[i]); + + REPORT_FUNCTION(scs_find_context); + REPORT_FUNCTION(scs_find_defun_start); + REPORT_FUNCTION(scs_scan_words); + REPORT_FUNCTION(scs_Fforward_comment); + fprintf (stderr, "\n "); + REPORT_FUNCTION(scs_scan_lists); + REPORT_FUNCTION(scs_Fbackward_prefix_characters); + REPORT_FUNCTION(scs_scan_sexps_forward); +#undef REPORT_FUNCTION + + fprintf (stderr, "\n min length %d, max length %d,", + scs_statistics.min_length, scs_statistics.max_length); + fprintf (stderr, "\n mean length %.1f, mean length on miss %.1f\n", + scs_statistics.mean_length, + scs_statistics.mean_length_on_miss); } +#endif /* SYNTAX_CACHE_STATISTICS */ } + /* Convert a letter which signifies a syntax code into the code it signifies. @@ -464,6 +625,7 @@ scan_words (struct buffer *buf, Bufpos from, int count) Emchar ch0, ch1; enum syntaxcode code; + SCS_STATISTICS_SET_FUNCTION (scs_scan_words); SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, from, count); /* #### is it really worth it to hand expand both cases? JV */ @@ -643,23 +805,23 @@ find_start_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, UPDATE_SYNTAX_CACHE_BACKWARD (from); c = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, c); syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + code = SYNTAX_FROM_CODE (syncode); /* is this a 1-char comment end sequence? if so, try to see if style matches previously extracted mask */ if (code == Sendcomment) { - styles_match_p = - SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask; + /* MT had SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask + but (as a Boolean) that's just a complicated way to write: */ + styles_match_p = SYNTAX_CODE_MATCHES_1CHAR_P (syncode, mask); } /* or are we looking at a 1-char comment start sequence of the style matching mask? */ else if (code == Scomment) { - styles_match_p = - SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask; + styles_match_p = SYNTAX_CODE_MATCHES_1CHAR_P (syncode, mask); } /* otherwise, is this a 2-char comment end or start sequence? */ @@ -672,14 +834,14 @@ find_start_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int prev_syncode; UPDATE_SYNTAX_CACHE_BACKWARD (from - 1); prev_syncode = - SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from - 1)); + SYNTAX_CODE_FROM_CACHE (mirrortab, + BUF_FETCH_CHAR (buf, from - 1)); if (SYNTAX_CODES_END_P (prev_syncode, syncode)) { code = Sendcomment; styles_match_p = - SYNTAX_CODES_COMMENT_MASK_END (prev_syncode, syncode) - & mask; + SYNTAX_CODES_MATCH_END_P (prev_syncode, syncode, mask); from--; UPDATE_SYNTAX_CACHE_BACKWARD (from); c = BUF_FETCH_CHAR (buf, from); @@ -696,14 +858,14 @@ find_start_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int prev_syncode; UPDATE_SYNTAX_CACHE_BACKWARD (from - 1); prev_syncode = - SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from - 1)); + SYNTAX_CODE_FROM_CACHE (mirrortab, + BUF_FETCH_CHAR (buf, from - 1)); if (SYNTAX_CODES_START_P (prev_syncode, syncode)) { code = Scomment; styles_match_p = - SYNTAX_CODES_COMMENT_MASK_START (prev_syncode, syncode) - & mask; + SYNTAX_CODES_MATCH_START_P (prev_syncode, syncode, mask); from--; UPDATE_SYNTAX_CACHE_BACKWARD (from); c = BUF_FETCH_CHAR (buf, from); @@ -794,7 +956,8 @@ static Bufpos find_end_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int comstyle) { int c; - int prev_code; + int syncode; + enum syntaxcode code, next_code; /* mask to match comment styles against; for ST_COMMENT_STYLE, this will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */ int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A; @@ -810,47 +973,32 @@ find_end_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int comstyle) UPDATE_SYNTAX_CACHE_FORWARD (from); c = BUF_FETCH_CHAR (buf, from); + syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + code = SYNTAX_FROM_CODE (syncode); - /* Test for generic comments */ + from++; + UPDATE_SYNTAX_CACHE_FORWARD (from); + + /* At end of current generic comment? */ if (comstyle == ST_COMMENT_STYLE) { - if (SYNTAX_FROM_CACHE (mirrortab, c) == Scomment_fence) - { - from++; - UPDATE_SYNTAX_CACHE_FORWARD (from); - break; - } - from++; - continue; /* No need to test other comment styles in a - generic comment */ + if (code == Scomment_fence) + break; /* matched */ + else + continue; /* Ignore other styles in generic comments */ } - else - - if (SYNTAX_FROM_CACHE (mirrortab, c) == Sendcomment - && SYNTAX_CODE_MATCHES_1CHAR_P - (SYNTAX_CODE_FROM_CACHE (mirrortab, c), mask)) - /* we have encountered a comment end of the same style - as the comment sequence which began this comment - section */ + /* At end of current one-character comment of specified style? */ + else if (code == Sendcomment && + SYNTAX_CODE_MATCHES_1CHAR_P (syncode, mask)) { - from++; - UPDATE_SYNTAX_CACHE_FORWARD (from); + /* pre-MT code effectively does from-- here, that seems wrong */ break; } - prev_code = SYNTAX_CODE_FROM_CACHE (mirrortab, c); - from++; - UPDATE_SYNTAX_CACHE_FORWARD (from); - if (from < stop - && SYNTAX_CODES_MATCH_END_P - (prev_code, - SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from)), - mask) - - ) - /* we have encountered a comment end of the same style - as the comment sequence which began this comment - section */ + /* At end of current two-character comment of specified style? */ + c = BUF_FETCH_CHAR (buf, from); + next_code = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + if (from < stop && SYNTAX_CODES_MATCH_END_P (syncode, next_code, mask)) { from++; UPDATE_SYNTAX_CACHE_FORWARD (from); @@ -897,6 +1045,7 @@ COUNT defaults to 1, and BUFFER defaults to the current buffer. from = BUF_PT (buf); + SCS_STATISTICS_SET_FUNCTION (scs_Fforward_comment); SETUP_SYNTAX_CACHE (from, n); while (n > 0) { @@ -905,7 +1054,8 @@ COUNT defaults to 1, and BUFFER defaults to the current buffer. stop = BUF_ZV (buf); while (from < stop) { - int comstyle = 0; /* mask for finding matching comment style */ + int comstyle = 0; /* Code for comment style: 0 for A, 1 for B, + or ST_COMMENT_STYLE */ if (char_quoted (buf, from)) { @@ -915,8 +1065,8 @@ COUNT defaults to 1, and BUFFER defaults to the current buffer. UPDATE_SYNTAX_CACHE_FORWARD (from); c = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, c); syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + code = SYNTAX_FROM_CODE (syncode); if (code == Scomment) { @@ -925,7 +1075,8 @@ COUNT defaults to 1, and BUFFER defaults to the current buffer. we must record the comment style this character begins so that later, only a comment end of the same style actually ends the comment section */ - comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) + comstyle = + SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; } @@ -936,8 +1087,7 @@ COUNT defaults to 1, and BUFFER defaults to the current buffer. comstyle = ST_COMMENT_STYLE; } - else if (from < stop - && SYNTAX_CODE_START_FIRST_P (syncode)) + else if (from < stop && SYNTAX_CODE_START_FIRST_P (syncode)) { int next_syncode; UPDATE_SYNTAX_CACHE_FORWARD (from + 1); @@ -995,7 +1145,8 @@ COUNT defaults to 1, and BUFFER defaults to the current buffer. stop = BUF_BEGV (buf); while (from > stop) { - int comstyle = 0; /* mask for finding matching comment style */ + int comstyle = 0; /* Code for comment style: 0 for A, 1 for B, + or ST_COMMENT_STYLE */ from--; if (char_quoted (buf, from)) @@ -1005,15 +1156,16 @@ COUNT defaults to 1, and BUFFER defaults to the current buffer. } c = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, c); syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + code = SYNTAX_FROM_CODE (syncode); if (code == Sendcomment) { /* we have found a single char end comment. we must record the comment style encountered so that later, we can match only the proper comment begin sequence of the same style */ - comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) + comstyle = + SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; } @@ -1024,6 +1176,8 @@ COUNT defaults to 1, and BUFFER defaults to the current buffer. } else if (from > stop + /* #### This seems logical but it's not in 21.4.9 */ + /* && !char_quoted (buf, from - 1) */ && SYNTAX_CODE_END_SECOND_P (syncode)) { int prev_syncode; @@ -1037,8 +1191,9 @@ COUNT defaults to 1, and BUFFER defaults to the current buffer. later, we can match only the proper comment begin sequence of the same style. */ code = Sendcomment; - comstyle = SYNTAX_CODES_COMMENT_MASK_END - (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; + comstyle = + SYNTAX_CODES_COMMENT_MASK_END (prev_syncode, syncode) + == SYNTAX_COMMENT_STYLE_A ? 0 : 1; from--; } } @@ -1080,6 +1235,7 @@ scan_lists (struct buffer *buf, Bufpos from, int count, int depth, if (depth > 0) min_depth = 0; + SCS_STATISTICS_SET_FUNCTION (scs_scan_lists); SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, from, count); while (count > 0) { @@ -1089,11 +1245,12 @@ scan_lists (struct buffer *buf, Bufpos from, int count, int depth, while (from < stop) { int comstyle = 0; /* mask for finding matching comment style */ + Emchar stringterm = '\0'; /* Used by Sstring case in switch */ UPDATE_SYNTAX_CACHE_FORWARD (from); c = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, c); syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + code = SYNTAX_FROM_CODE (syncode); from++; /* a 1-char comment start sequence */ @@ -1115,16 +1272,17 @@ scan_lists (struct buffer *buf, Bufpos from, int count, int depth, if (SYNTAX_CODES_START_P (syncode, next_syncode)) { - /* 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 - the comment section */ - code = Scomment; - comstyle = SYNTAX_CODES_COMMENT_MASK_START - (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; - from++; - } + /* 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 + the comment section */ + code = Scomment; + comstyle = + SYNTAX_CODES_COMMENT_MASK_START (syncode, next_syncode) + == SYNTAX_COMMENT_STYLE_A ? 0 : 1; + from++; + } } UPDATE_SYNTAX_CACHE_FORWARD (from); @@ -1166,6 +1324,7 @@ scan_lists (struct buffer *buf, Bufpos from, int count, int depth, case Scomment_fence: comstyle = ST_COMMENT_STYLE; + /* falls through! */ case Scomment: if (!parse_sexp_ignore_comments) break; @@ -1212,52 +1371,45 @@ scan_lists (struct buffer *buf, Bufpos from, int count, int depth, } break; - case Sstring_fence: case Sstring: - { - Emchar stringterm; - - if (code != Sstring_fence) - { + { /* XEmacs change: call syntax_match on character */ - Emchar ch = BUF_FETCH_CHAR (buf, from - 1); - Lisp_Object stermobj = - syntax_match (syntax_cache.current_syntax_table, ch); + Emchar ch = BUF_FETCH_CHAR (buf, from - 1); + Lisp_Object stermobj = + syntax_match (syntax_cache.current_syntax_table, ch); if (CHARP (stermobj)) stringterm = XCHAR (stermobj); else stringterm = ch; - } - else - stringterm = '\0'; /* avoid compiler warnings */ + } + /* falls through! */ + case Sstring_fence: + while (1) + { + if (from >= stop) + goto lose; + UPDATE_SYNTAX_CACHE_FORWARD (from); + c = BUF_FETCH_CHAR (buf, from); + if (code == Sstring + ? c == stringterm + : SYNTAX_FROM_CACHE (mirrortab, c) == Sstring_fence) + break; - while (1) - { - if (from >= stop) - goto lose; - UPDATE_SYNTAX_CACHE_FORWARD (from); - c = BUF_FETCH_CHAR (buf, from); - if (code == Sstring - ? c == stringterm - : SYNTAX_FROM_CACHE (mirrortab, c) == Sstring_fence) + switch (SYNTAX_FROM_CACHE (mirrortab, c)) + { + case Scharquote: + case Sescape: + from++; break; - - switch (SYNTAX_FROM_CACHE (mirrortab, c)) - { - case Scharquote: - case Sescape: - from++; - break; - default: - break; - } - from++; - } - from++; - if (!depth && sexpflag) goto done; - break; - } + default: + break; + } + from++; + } + from++; + if (!depth && sexpflag) goto done; + break; default: break; @@ -1283,6 +1435,7 @@ scan_lists (struct buffer *buf, Bufpos from, int count, int depth, while (from > stop) { int comstyle = 0; /* mask for finding matching comment style */ + Emchar stringterm = '\0'; /* used by case Sstring in switch below */ from--; UPDATE_SYNTAX_CACHE_BACKWARD (from); @@ -1294,8 +1447,8 @@ scan_lists (struct buffer *buf, Bufpos from, int count, int depth, } c = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, c); syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + code = SYNTAX_FROM_CODE (syncode); if (code == Sendcomment && parse_sexp_ignore_comments) { @@ -1318,14 +1471,15 @@ scan_lists (struct buffer *buf, Bufpos from, int count, int depth, if (SYNTAX_CODES_END_P (prev_syncode, syncode)) { - /* we must record the comment style encountered so that - later, we can match only the proper comment begin - sequence of the same style */ - code = Sendcomment; - comstyle = SYNTAX_CODES_COMMENT_MASK_END - (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; - from--; - } + /* we must record the comment style encountered so that + later, we can match only the proper comment begin + sequence of the same style */ + code = Sendcomment; + comstyle = + SYNTAX_CODES_COMMENT_MASK_END (prev_syncode, syncode) + == SYNTAX_COMMENT_STYLE_A ? 0 : 1; + from--; + } } if (SYNTAX_CODE_PREFIX (syncode)) @@ -1340,6 +1494,7 @@ scan_lists (struct buffer *buf, Bufpos from, int count, int depth, passing it. */ while (from > stop) { + /* enum syntaxcode syncode; */ UPDATE_SYNTAX_CACHE_BACKWARD (from); quoted = char_quoted (buf, from - 1); @@ -1386,52 +1541,45 @@ scan_lists (struct buffer *buf, Bufpos from, int count, int depth, case Scomment_fence: comstyle = ST_COMMENT_STYLE; + /* falls through! */ case Sendcomment: if (parse_sexp_ignore_comments) from = find_start_of_comment (buf, from, stop, comstyle); break; - case Sstring_fence: case Sstring: { - Emchar stringterm; - - if (code != Sstring_fence) - { /* XEmacs change: call syntax_match() on character */ Emchar ch = BUF_FETCH_CHAR (buf, from); - Lisp_Object stermobj = - syntax_match (syntax_cache.current_syntax_table, ch); - + Lisp_Object stermobj = + syntax_match (syntax_cache.current_syntax_table, ch); if (CHARP (stermobj)) stringterm = XCHAR (stermobj); else stringterm = ch; - } - else - stringterm = '\0'; /* avoid compiler warnings */ - - while (1) - { - if (from == stop) goto lose; - - UPDATE_SYNTAX_CACHE_BACKWARD (from - 1); - c = BUF_FETCH_CHAR (buf, from - 1); + } - if ((code == Sstring - ? c == stringterm - : SYNTAX_FROM_CACHE (mirrortab, c) == Sstring_fence) - && !char_quoted (buf, from - 1)) - { + /* falls through! */ + case Sstring_fence: + while (1) + { + if (from == stop) goto lose; + + UPDATE_SYNTAX_CACHE_BACKWARD (from - 1); + c = BUF_FETCH_CHAR (buf, from - 1); + if ((code == Sstring + ? c == stringterm + : SYNTAX_FROM_CACHE (mirrortab, c) == Sstring_fence) + && !char_quoted (buf, from - 1)) + { break; - } + } - from--; - } - from--; - if (!depth && sexpflag) goto done2; - break; - } + from--; + } + from--; + if (!depth && sexpflag) goto done2; + break; } } @@ -1555,11 +1703,13 @@ Optional arg BUFFER defaults to the current buffer. Emchar c = '\0'; /* initialize to avoid compiler warnings */ + SCS_STATISTICS_SET_FUNCTION (scs_Fbackward_prefix_characters); SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, pos, -1); while (pos > beg && !char_quoted (buf, pos - 1) /* Previous statement updates syntax table. */ && (SYNTAX_FROM_CACHE (mirrortab, c = BUF_FETCH_CHAR (buf, pos - 1)) == Squote + /* equivalent to SYNTAX_PREFIX (mirrortab, c) */ || SYNTAX_CODE_PREFIX (SYNTAX_CODE_FROM_CACHE (mirrortab, c)))) pos--; @@ -1572,7 +1722,8 @@ Optional arg BUFFER defaults to the current buffer. assuming that FROM has state OLDSTATE (nil means FROM is start of function), and return a description of the state of the parse at END. If STOPBEFORE is nonzero, stop at the start of an atom. - If COMMENTSTOP is nonzero, stop at the start of a comment. */ + If COMMENTSTOP is 1, stop at the start of a comment; if it is -1, + stop at the start of a comment or a string */ static void scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr, @@ -1596,6 +1747,7 @@ scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr, int boundary_stop = commentstop == -1; Lisp_Object tem; + SCS_STATISTICS_SET_FUNCTION (scs_scan_sexps_forward); SETUP_SYNTAX_CACHE (from, 1); if (NILP (oldstate)) { @@ -1634,6 +1786,8 @@ scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr, we are in a generic comment */ oldstate = Fcdr (oldstate); oldstate = Fcdr (oldstate); + /* The code below was changed radically for syntax-table properties. + A reasonable place to look if a bug manifests. */ tem = Fcar (oldstate); /* elt 7, comment style a/b/fence */ state.comstyle = NILP (tem) ? 0 : ( EQ (tem, Qsyntax_table) ? ST_COMMENT_STYLE : 1 ); @@ -1657,6 +1811,7 @@ scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr, curlevel->last = -1; tem = Fcdr (tem); } + /* end radical change section */ } state.quoted = 0; mindepth = depth; @@ -1683,8 +1838,8 @@ scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr, UPDATE_SYNTAX_CACHE_FORWARD (from); c = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, c); syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + code = SYNTAX_FROM_CODE (syncode); from++; /* record the comment style we have entered so that only the @@ -1715,12 +1870,13 @@ scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr, SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from)); if (SYNTAX_CODES_START_P (syncode, next_syncode)) - { - code = Scomment; - state.comstyle = SYNTAX_CODES_COMMENT_MASK_START - (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; + { + code = Scomment; + state.comstyle = + SYNTAX_CODES_COMMENT_MASK_START (syncode, next_syncode) + == SYNTAX_COMMENT_STYLE_A ? 0 : 1; state.comstr_start = from - 1; - from++; + from++; UPDATE_SYNTAX_CACHE_FORWARD (from); } } @@ -1830,7 +1986,7 @@ scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr, state.instring = XCHAR (stermobj); else state.instring = ch; - } + } if (boundary_stop) goto done; startinstring: while (1) @@ -2106,13 +2262,14 @@ Non-nil means `forward-sexp', etc., should treat comments as whitespace. parse_sexp_ignore_comments = 0; DEFVAR_BOOL ("lookup-syntax-properties", &lookup_syntax_properties /* -Non-nil means `forward-sexp', etc., grant `syntax-table' property. +Non-nil means `forward-sexp', etc., look up character syntax in the +table that is the value of the `syntax-table' text property, if non-nil. The value of this property should be either a syntax table, or a cons of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric syntax code, MATCHCHAR being nil or the character to match (which is relevant only for open/close type. */ ); - lookup_syntax_properties = 1; + lookup_syntax_properties = 0; /* #### default off until optimized */ DEFVAR_BOOL ("words-include-escapes", &words_include_escapes /* Non-nil means `forward-word', etc., should treat escape chars part of words.