X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1fd3172dd4819524d0b63337e525cd48e062e0f5..d12168d677a284c1597853031c9a506dfb08e788:/src/syntax.c diff --git a/src/syntax.c b/src/syntax.c index 0235767160..fa34c2433c 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -1,5 +1,5 @@ /* GNU Emacs routines to deal with syntax tables; also word and list parsing. - Copyright (C) 1985, 87, 93, 94, 95, 97, 1998 Free Software Foundation, Inc. + Copyright (C) 1985, 87, 93, 94, 95, 97, 1998, 1999, 2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -25,6 +25,8 @@ Boston, MA 02111-1307, USA. */ #include "commands.h" #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 @@ -45,18 +47,27 @@ Lisp_Object Qsyntax_table_p, Qsyntax_table, Qscan_error; int words_include_escapes; int parse_sexp_lookup_properties; +/* Nonzero means `scan-sexps' treat all multibyte characters as symbol. */ +int multibyte_syntax_as_symbol; + /* Used as a temporary in SYNTAX_ENTRY and other macros in syntax.h, if not compiled with GCC. No need to mark it, since it is used only very temporarily. */ Lisp_Object syntax_temp; +/* Non-zero means an open parenthesis in column 0 is always considered + to be the start of a defun. Zero means an open parenthesis in + column 0 has no special meaning. */ + +int open_paren_in_column_0_is_defun_start; + /* This is the internal form of the parse state used in parse-partial-sexp. */ struct lisp_parse_state { int depth; /* Depth at end of parsing. */ int instring; /* -1 if not within string, else desired terminator. */ - int incomment; /* Nonzero if within a comment at end of parsing. */ + int incomment; /* -1 if in unnestable comment else comment nesting */ int comstyle; /* comment style a=0, or b=1, or ST_COMMENT_STYLE. */ int quoted; /* Nonzero if just after an escape char at end of parsing */ int thislevelstart; /* Char number of most recent start-of-expression at current level */ @@ -64,6 +75,8 @@ struct lisp_parse_state int location; /* Char number at which parsing stopped. */ int mindepth; /* Minimum depth seen while scanning. */ int comstr_start; /* Position just after last comment/string starter. */ + Lisp_Object levelstarts; /* Char numbers of starts-of-expression + of levels (starting from outermost). */ }; /* These variables are a cache for finding the start of a defun. @@ -83,13 +96,14 @@ static int find_start_modiff; static int find_defun_start P_ ((int, int)); -static int back_comment P_ ((int, int, int, int, int *, int *)); +static int back_comment P_ ((int, int, int, int, int, int *, int *)); static int char_quoted P_ ((int, int)); -static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object)); +static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object, int)); static Lisp_Object scan_lists P_ ((int, int, 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. */ @@ -117,116 +131,110 @@ update_syntax_table (charpos, count, init, object) Lisp_Object object; { Lisp_Object tmp_table; - int cnt = 0, doing_extra = 0, invalidate = 1; + int cnt = 0, invalidate = 1; INTERVAL i, oldi; if (init) { + gl_state.old_prop = Qnil; gl_state.start = gl_state.b_property; gl_state.stop = gl_state.e_property; - gl_state.forward_i = interval_of (charpos, object); - i = gl_state.backward_i = gl_state.forward_i; - gl_state.left_ok = gl_state.right_ok = 1; + i = interval_of (charpos, object); + gl_state.backward_i = gl_state.forward_i = i; invalidate = 0; if (NULL_INTERVAL_P (i)) return; - /* interval_of () updates only ->position of the return value, + /* interval_of updates only ->position of the return value, so update the parents manually to speed up update_interval. */ - while (!NULL_PARENT (i)) + while (!NULL_PARENT (i)) { if (AM_RIGHT_CHILD (i)) - i->parent->position = i->position + INTERVAL_PARENT (i)->position = i->position - LEFT_TOTAL_LENGTH (i) + TOTAL_LENGTH (i) /* right end */ - - TOTAL_LENGTH (i->parent) - + LEFT_TOTAL_LENGTH (i->parent); + - TOTAL_LENGTH (INTERVAL_PARENT (i)) + + LEFT_TOTAL_LENGTH (INTERVAL_PARENT (i)); else - i->parent->position = i->position - LEFT_TOTAL_LENGTH (i) + INTERVAL_PARENT (i)->position = i->position - LEFT_TOTAL_LENGTH (i) + TOTAL_LENGTH (i); - i = i->parent; + i = INTERVAL_PARENT (i); } i = gl_state.forward_i; - gl_state.b_property = i->position - 1 - gl_state.offset; + gl_state.b_property = i->position - gl_state.offset; 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; - /* We are guarantied to be called with CHARPOS either in i, + /* We are guaranteed to be called with CHARPOS either in i, or further off. */ if (NULL_INTERVAL_P (i)) error ("Error in syntax_table logic for to-the-end intervals"); else if (charpos < i->position) /* Move left. */ { if (count > 0) - error ("Error in syntax_table logic for intervals <-."); + error ("Error in syntax_table logic for intervals <-"); /* Update the interval. */ i = update_interval (i, charpos); - if (oldi->position != INTERVAL_LAST_POS (i)) + if (INTERVAL_LAST_POS (i) != gl_state.b_property) { invalidate = 0; - gl_state.right_ok = 1; /* Invalidate the other end. */ gl_state.forward_i = i; gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset; } - } + } else if (charpos >= INTERVAL_LAST_POS (i)) /* Move right. */ { if (count < 0) - error ("Error in syntax_table logic for intervals ->."); + error ("Error in syntax_table logic for intervals ->"); /* Update the interval. */ i = update_interval (i, charpos); - if (i->position != INTERVAL_LAST_POS (oldi)) + if (i->position != gl_state.e_property) { invalidate = 0; - gl_state.left_ok = 1; /* Invalidate the other end. */ gl_state.backward_i = i; - gl_state.b_property = i->position - 1 - gl_state.offset; + gl_state.b_property = i->position - gl_state.offset; } } - else if (count > 0 ? gl_state.right_ok : gl_state.left_ok) - { - /* We do not need to recalculate tmp_table. */ - tmp_table = gl_state.old_prop; - } update: tmp_table = textget (i->plist, Qsyntax_table); 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. */ + + if (invalidate) /* Did not get to adjacent interval. */ + { /* with the same table => */ + /* invalidate the old range. */ if (count > 0) { gl_state.backward_i = i; - gl_state.left_ok = 1; /* Invalidate the other end. */ - gl_state.b_property = i->position - 1 - gl_state.offset; - } - else + gl_state.b_property = i->position - gl_state.offset; + } + else { - gl_state.forward_i = i; - gl_state.right_ok = 1; /* Invalidate the other end. */ + gl_state.forward_i = i; gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset; } } - gl_state.current_syntax_table = tmp_table; - gl_state.old_prop = tmp_table; - 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 + if (!EQ (tmp_table, gl_state.old_prop)) { - gl_state.use_global = 0; - gl_state.current_syntax_table = current_buffer->syntax_table; + gl_state.current_syntax_table = tmp_table; + gl_state.old_prop = tmp_table; + 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 + { + gl_state.use_global = 0; + gl_state.current_syntax_table = current_buffer->syntax_table; + } } while (!NULL_INTERVAL_P (i)) @@ -234,42 +242,39 @@ update_syntax_table (charpos, count, init, object) if (cnt && !EQ (tmp_table, textget (i->plist, Qsyntax_table))) { if (count > 0) - gl_state.right_ok = 0; - else - gl_state.left_ok = 0; - break; + { + gl_state.e_property = i->position - gl_state.offset; + gl_state.forward_i = i; + } + else + { + 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.right_ok = 1; - else - gl_state.left_ok = 1; - break; + { + gl_state.e_property = i->position + LENGTH (i) - gl_state.offset; + gl_state.forward_i = i; + } + else + { + gl_state.b_property = i->position - gl_state.offset; + gl_state.backward_i = i; + } + return; } cnt++; i = count > 0 ? next_interval (i) : previous_interval (i); } - if (NULL_INTERVAL_P (i)) - { /* This property goes to the end. */ - if (count > 0) - gl_state.e_property = gl_state.stop; - else - gl_state.b_property = gl_state.start; - } - else - { - if (count > 0) - { - gl_state.e_property = i->position - gl_state.offset; - gl_state.forward_i = i; - } - else - { - gl_state.b_property = i->position + LENGTH (i) - 1 - gl_state.offset; - gl_state.backward_i = i; - } - } + eassert (NULL_INTERVAL_P (i)); /* This property goes to the end. */ + if (count > 0) + gl_state.e_property = gl_state.stop; + else + gl_state.b_property = gl_state.start; } /* Returns TRUE if char at CHARPOS is quoted. @@ -287,10 +292,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; @@ -330,9 +338,15 @@ dec_bytepos (bytepos) return bytepos; } -/* Find a defun-start that is the last one before POS (or nearly the last). - We record what we find, so that another call in the same area - can return the same value right away. +/* Return a defun-start position before before POS and not too far before. + It should be the last one before POS, or nearly the last. + + When open_paren_in_column_0_is_defun_start is nonzero, + 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 + can return the same value very quickly. There is no promise at which position the global syntax data is valid on return from the subroutine, so the caller should explicitly @@ -342,10 +356,14 @@ static int find_defun_start (pos, pos_byte) int pos, pos_byte; { - int tem; - int shortage; 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. @@ -367,11 +385,16 @@ find_defun_start (pos, pos_byte) gl_state.use_global = 0; while (PT > BEGV) { - /* Open-paren at start of line means we found our defun-start. */ - if (SYNTAX (FETCH_CHAR (PT_BYTE)) == Sopen) + 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) { SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */ - if (SYNTAX (FETCH_CHAR (PT_BYTE)) == Sopen) + 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; @@ -394,6 +417,38 @@ find_defun_start (pos, pos_byte) return find_start_value; } +/* Return the SYNTAX_COMEND_FIRST of the character before POS, POS_BYTE. */ + +static int +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); + val = SYNTAX_COMEND_FIRST (c); + UPDATE_SYNTAX_TABLE_FORWARD (pos + 1); + return val; +} + +/* Return the SYNTAX_COMSTART_FIRST of the character before POS, POS_BYTE. */ + +/* static int + * prev_char_comstart_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); + * val = SYNTAX_COMSTART_FIRST (c); + * UPDATE_SYNTAX_TABLE_FORWARD (pos + 1); + * return val; + * } */ + /* Checks whether charpos FROM is at the end of a comment. FROM_BYTE is the bytepos corresponding to FROM. Do not move back before STOP. @@ -408,9 +463,9 @@ find_defun_start (pos, pos_byte) the returned value (or at FROM, if the search was not successful). */ static int -back_comment (from, from_byte, stop, comstyle, charpos_ptr, bytepos_ptr) +back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_ptr) int from, from_byte, stop; - int comstyle; + int comnested, comstyle; int *charpos_ptr, *bytepos_ptr; { /* Look back, counting the parity of string-quotes, @@ -422,111 +477,186 @@ back_comment (from, from_byte, stop, comstyle, charpos_ptr, bytepos_ptr) OFROM[I] is position of the earliest comment-starter seen which is I+2X quotes from the comment-end. PARITY is current parity of quotes from the comment end. */ - int parity = 0; - int my_stringend = 0; + 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 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 *) */ + int comment_lossage = 0; int comment_end = from; int comment_end_byte = from_byte; int comstart_pos = 0; int comstart_byte; - /* Value that PARITY had, when we reached the position - in COMSTART_POS. */ - int comstart_parity = 0; - int scanstart = from - 1; /* Place where the containing defun starts, or 0 if we didn't come across it yet. */ int defun_start = 0; int defun_start_byte = 0; register enum syntaxcode code; + int nesting = 1; /* current comment nesting */ int c; + int syntax = 0; + + /* FIXME: A }} comment-ender style leads to incorrect behavior + in the case of {{ c }}} because we ignore the last two chars which are + assumed to be comment-enders although they aren't. */ /* At beginning of range to scan, we're outside of strings; that determines quote parity to the comment-end. */ while (from != stop) { - int temp_byte; + int temp_byte, prev_syntax; + int com2start, com2end; /* Move back and examine a character. */ DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); + prev_syntax = syntax; c = FETCH_CHAR (from_byte); + syntax = SYNTAX_WITH_FLAGS (c); code = SYNTAX (c); - /* If this char is the second of a 2-char comment end sequence, - back up and give the pair the appropriate syntax. */ - if (from > stop && SYNTAX_COMEND_SECOND (c) - && (temp_byte = dec_bytepos (from_byte), - SYNTAX_COMEND_FIRST (FETCH_CHAR (temp_byte)))) + /* Check for 2-char comment markers. */ + com2start = (SYNTAX_FLAGS_COMSTART_FIRST (syntax) + && SYNTAX_FLAGS_COMSTART_SECOND (prev_syntax) + && comstyle == SYNTAX_FLAGS_COMMENT_STYLE (prev_syntax) + && (SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax) + || SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested); + com2end = (SYNTAX_FLAGS_COMEND_FIRST (syntax) + && SYNTAX_FLAGS_COMEND_SECOND (prev_syntax)); + + /* Nasty cases with overlapping 2-char comment markers: + - snmp-mode: -- c -- foo -- c -- + --- c -- + ------ c -- + - c-mode: *||* + |* *|* *| + |*| |* |*| + /// */ + + /* If a 2-char comment sequence partly overlaps with another, + we don't try to be clever. */ + if (from > stop && (com2end || com2start)) { - code = Sendcomment; - DEC_BOTH (from, from_byte); - /* This is apparently the best we can do: */ - UPDATE_SYNTAX_TABLE_BACKWARD (from); - c = FETCH_CHAR (from_byte); + int next = from, next_byte = from_byte, next_c, next_syntax; + DEC_BOTH (next, next_byte); + UPDATE_SYNTAX_TABLE_BACKWARD (next); + next_c = FETCH_CHAR (next_byte); + next_syntax = SYNTAX_WITH_FLAGS (next_c); + if (((com2start || comnested) + && SYNTAX_FLAGS_COMEND_SECOND (syntax) + && SYNTAX_FLAGS_COMEND_FIRST (next_syntax)) + || ((com2end || comnested) + && SYNTAX_FLAGS_COMSTART_SECOND (syntax) + && comstyle == SYNTAX_FLAGS_COMMENT_STYLE (syntax) + && SYNTAX_FLAGS_COMSTART_FIRST (next_syntax))) + goto lossage; + /* UPDATE_SYNTAX_TABLE_FORWARD (next + 1); */ } - - /* If this char starts a 2-char comment start sequence, - treat it like a 1-char comment starter. */ - if (from < scanstart && SYNTAX_COMSTART_FIRST (c) - && (temp_byte = inc_bytepos (from_byte), - (SYNTAX_COMSTART_SECOND (FETCH_CHAR (temp_byte)) - && comstyle == SYNTAX_COMMENT_STYLE (FETCH_CHAR (temp_byte))))) + + if (com2start && comstart_pos == 0) + /* We're looking at a comment starter. But it might be a comment + ender as well (see snmp-mode). The first time we see one, we + need to consider it as a comment starter, + and the subsequent times as a comment ender. */ + com2end = 0; + + /* Turn a 2-char comment sequences into the appropriate syntax. */ + if (com2end) + code = Sendcomment; + else if (com2start) code = Scomment; + /* Ignore comment starters of a different style. */ + else if (code == Scomment + && (comstyle != SYNTAX_FLAGS_COMMENT_STYLE (syntax) + || SYNTAX_FLAGS_COMMENT_NESTED (syntax) != comnested)) + continue; /* Ignore escaped characters, except comment-enders. */ if (code != Sendcomment && char_quoted (from, from_byte)) continue; - /* Track parity of quotes. */ - if (code == Sstring) + switch (code) { - parity ^= 1; - if (my_stringend == 0) - my_stringend = c; - /* If we have two kinds of string delimiters. - There's no way to grok this scanning backwards. */ - else if (my_stringend != c) + case Sstring_fence: + case Scomment_fence: + c = (code == Sstring_fence ? ST_STRING_STYLE : ST_COMMENT_STYLE); + case Sstring: + /* Track parity of quotes. */ + if (string_style == -1) + /* Entering a string. */ + string_style = c; + else if (string_style == c) + /* Leaving the string. */ + string_style = -1; + else + /* If we have two kinds of string delimiters. + There's no way to grok this scanning backwards. */ string_lossage = 1; - } + break; - if (code == Sstring_fence || code == Scomment_fence) - { - parity ^= 1; - if (my_stringend == 0) - my_stringend - = code == Sstring_fence ? ST_STRING_STYLE : ST_COMMENT_STYLE; - /* If we have two kinds of string delimiters. - There's no way to grok this scanning backwards. */ - else if (my_stringend != (code == Sstring_fence - ? ST_STRING_STYLE : ST_COMMENT_STYLE)) - string_lossage = 1; - } + case Scomment: + /* We've already checked that it is the relevant comstyle. */ + if (string_style != -1 || comment_lossage || string_lossage) + /* There are odd string quotes involved, so let's be careful. + Test case in Pascal: " { " a { " } */ + goto lossage; - /* Record comment-starters according to that - quote-parity to the comment-end. */ - if (code == Scomment) - { - comstart_parity = parity; - comstart_pos = from; - comstart_byte = from_byte; - } + if (!comnested) + { + /* Record best comment-starter so far. */ + comstart_pos = from; + comstart_byte = from_byte; + } + else if (--nesting <= 0) + /* nested comments have to be balanced, so we don't need to + keep looking for earlier ones. We use here the same (slightly + incorrect) reasoning as below: since it is followed by uniform + paired string quotes, this comment-start has to be outside of + strings, else the comment-end itself would be inside a string. */ + goto done; + break; - /* If we find another earlier comment-ender, - any comment-starts earlier than that don't count - (because they go with the earlier comment-ender). */ - if (code == Sendcomment - && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte)) == comstyle) - break; + case Sendcomment: + if (SYNTAX_FLAGS_COMMENT_STYLE (syntax) == comstyle + && ((com2end && SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax)) + || SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested) + /* This is the same style of comment ender as ours. */ + { + if (comnested) + nesting++; + else + /* Anything before that can't count because it would match + this comment-ender rather than ours. */ + from = stop; /* Break out of the loop. */ + } + else if (comstart_pos != 0 || c != '\n') + /* We're mixing comment styles here, so we'd better be careful. + The (comstart_pos != 0 || c != '\n') check is not quite correct + (we should just always set comment_lossage), but removing it + would imply that any multiline comment in C would go through + lossage, which seems overkill. + The failure should only happen in the rare cases such as + { (* } *) */ + comment_lossage = 1; + break; - /* Assume a defun-start point is outside of strings. */ - if (code == Sopen - && (from == stop - || (temp_byte = dec_bytepos (from_byte), - FETCH_CHAR (temp_byte) == '\n'))) - { - defun_start = from; - defun_start_byte = from_byte; + case Sopen: + /* Assume a defun-start point is outside of strings. */ + if (open_paren_in_column_0_is_defun_start + && (from == stop + || (temp_byte = dec_bytepos (from_byte), + FETCH_CHAR (temp_byte) == '\n'))) + { + defun_start = from; + defun_start_byte = from_byte; + from = stop; /* Break out of the loop. */ + } + break; + + default: break; } } @@ -537,59 +667,68 @@ back_comment (from, from_byte, stop, comstyle, charpos_ptr, bytepos_ptr) from_byte = comment_end_byte; UPDATE_SYNTAX_TABLE_FORWARD (comment_end - 1); } - /* If the earliest comment starter - is followed by uniform paired string quotes or none, - we know it can't be inside a string - since if it were then the comment ender would be inside one. - So it does start a comment. Skip back to it. */ - else if (comstart_parity == 0 && !string_lossage) + /* If comstart_pos is set and we get here (ie. didn't jump to `lossage' + or `done'), then we've found the beginning of the non-nested comment. */ + else if (1) /* !comnested */ { from = comstart_pos; from_byte = comstart_byte; - /* Globals are correct now. */ + UPDATE_SYNTAX_TABLE_FORWARD (from - 1); } else { + struct lisp_parse_state state; + lossage: /* We had two kinds of string delimiters mixed up together. Decode this going forwards. - Scan fwd from the previous comment ender + Scan fwd from a known safe place (beginning-of-defun) to the one in question; this records where we last passed a comment starter. */ - struct lisp_parse_state state; /* If we did not already find the defun start, find it now. */ if (defun_start == 0) { defun_start = find_defun_start (comment_end, comment_end_byte); defun_start_byte = find_start_value_byte; } - scan_sexps_forward (&state, - defun_start, defun_start_byte, - comment_end - 1, -10000, 0, Qnil, 0); - if (state.incomment) - { - /* scan_sexps_forward changed the direction of search in - global variables, so we need to update it completely. */ - - from = state.comstr_start; - } - else + do { - from = comment_end; - } + scan_sexps_forward (&state, + defun_start, defun_start_byte, + comment_end, -10000, 0, Qnil, 0); + defun_start = comment_end; + if (state.incomment == (comnested ? 1 : -1) + && state.comstyle == comstyle) + from = state.comstr_start; + else + { + from = comment_end; + if (state.incomment) + /* If comment_end is inside some other comment, maybe ours + is nested, so we need to try again from within the + surrounding comment. Example: { a (* " *) */ + { + /* FIXME: We should advance by one or two chars. */ + defun_start = state.comstr_start + 2; + defun_start_byte = CHAR_TO_BYTE (defun_start); + } + } + } while (defun_start < comment_end); + from_byte = CHAR_TO_BYTE (from); UPDATE_SYNTAX_TABLE_FORWARD (from - 1); } - + + done: *charpos_ptr = from; *bytepos_ptr = from_byte; - return from; + return (from == comment_end) ? -1 : from; } DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0, - "Return t if OBJECT is a syntax table.\n\ -Currently, any char-table counts as a syntax table.") - (object) + doc: /* Return t if OBJECT is a syntax table. +Currently, any char-table counts as a syntax table. */) + (object) Lisp_Object object; { if (CHAR_TABLE_P (object) @@ -605,29 +744,29 @@ check_syntax_table (obj) if (!(CHAR_TABLE_P (obj) && EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table))) wrong_type_argument (Qsyntax_table_p, obj); -} +} DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0, - "Return the current syntax table.\n\ -This is the one specified by the current buffer.") - () + doc: /* Return the current syntax table. +This is the one specified by the current buffer. */) + () { return current_buffer->syntax_table; } DEFUN ("standard-syntax-table", Fstandard_syntax_table, Sstandard_syntax_table, 0, 0, 0, - "Return the standard syntax table.\n\ -This is the one used for new buffers.") - () + doc: /* Return the standard syntax table. +This is the one used for new buffers. */) + () { return Vstandard_syntax_table; } DEFUN ("copy-syntax-table", Fcopy_syntax_table, Scopy_syntax_table, 0, 1, 0, - "Construct a new syntax table and return it.\n\ -It is a copy of the TABLE, which defaults to the standard syntax table.") - (table) + doc: /* Construct a new syntax table and return it. +It is a copy of the TABLE, which defaults to the standard syntax table. */) + (table) Lisp_Object table; { Lisp_Object copy; @@ -652,16 +791,17 @@ It is a copy of the TABLE, which defaults to the standard syntax table.") } DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 1, 0, - "Select a new syntax table for the current buffer.\n\ -One argument, a syntax table.") - (table) + doc: /* Select a new syntax table for the current buffer. +One argument, a syntax table. */) + (table) Lisp_Object table; { + int idx; check_syntax_table (table); current_buffer->syntax_table = table; /* Indicate that this buffer now has a specified syntax table. */ - current_buffer->local_var_flags - |= XFASTINT (buffer_local_flags.syntax_table); + idx = PER_BUFFER_VAR_IDX (syntax_table); + SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1); return table; } @@ -731,32 +871,32 @@ syntax_parent_lookup (table, character) } DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0, - "Return the syntax code of CHARACTER, described by a character.\n\ -For example, if CHARACTER is a word constituent,\n\ -the character `w' is returned.\n\ -The characters that correspond to various syntax codes\n\ -are listed in the documentation of `modify-syntax-entry'.") - (character) + doc: /* Return the syntax code of CHARACTER, described by a character. +For example, if CHARACTER is a word constituent, +the character `w' is returned. +The characters that correspond to various syntax codes +are listed in the documentation of `modify-syntax-entry'. */) + (character) Lisp_Object character; { int char_int; gl_state.current_syntax_table = current_buffer->syntax_table; gl_state.use_global = 0; - CHECK_NUMBER (character, 0); + CHECK_NUMBER (character); char_int = XINT (character); return make_number (syntax_code_spec[(int) SYNTAX (char_int)]); } DEFUN ("matching-paren", Fmatching_paren, Smatching_paren, 1, 1, 0, - "Return the matching parenthesis of CHARACTER, or nil if none.") - (character) + doc: /* Return the matching parenthesis of CHARACTER, or nil if none. */) + (character) Lisp_Object character; { int char_int, code; gl_state.current_syntax_table = current_buffer->syntax_table; gl_state.use_global = 0; - CHECK_NUMBER (character, 0); + CHECK_NUMBER (character); char_int = XINT (character); code = SYNTAX (char_int); if (code == Sopen || code == Sclose) @@ -764,85 +904,35 @@ DEFUN ("matching-paren", Fmatching_paren, Smatching_paren, 1, 1, 0, return Qnil; } -/* This comment supplies the doc string for modify-syntax-entry, - for make-docfile to see. We cannot put this in the real DEFUN - due to limits in the Unix cpp. - -DEFUN ("modify-syntax-entry", foo, bar, 2, 3, 0, - "Set syntax for character CHAR according to string S.\n\ -The syntax is changed only for table TABLE, which defaults to\n\ - the current buffer's syntax table.\n\ -The first character of S should be one of the following:\n\ - Space or - whitespace syntax. w word constituent.\n\ - _ symbol constituent. . punctuation.\n\ - ( open-parenthesis. ) close-parenthesis.\n\ - \" string quote. \\ escape.\n\ - $ paired delimiter. ' expression quote or prefix operator.\n\ - < comment starter. > comment ender.\n\ - / character-quote. @ inherit from `standard-syntax-table'.\n\ -\n\ -Only single-character comment start and end sequences are represented thus.\n\ -Two-character sequences are represented as described below.\n\ -The second character of S is the matching parenthesis,\n\ - used only if the first character is `(' or `)'.\n\ -Any additional characters are flags.\n\ -Defined flags are the characters 1, 2, 3, 4, b, and p.\n\ - 1 means CHAR is the start of a two-char comment start sequence.\n\ - 2 means CHAR is the second character of such a sequence.\n\ - 3 means CHAR is the start of a two-char comment end sequence.\n\ - 4 means CHAR is the second character of such a sequence.\n\ -\n\ -There can be up to two orthogonal comment sequences. This is to support\n\ -language modes such as C++. By default, all comment sequences are of style\n\ -a, but you can set the comment sequence style to b (on the second character\n\ -of a comment-start, or the first character of a comment-end sequence) using\n\ -this flag:\n\ - b means CHAR is part of comment sequence b.\n\ -\n\ - p means CHAR is a prefix character for `backward-prefix-chars';\n\ - such characters are treated as whitespace when they occur\n\ - between expressions.") - (char, s, table) -*/ - -DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3, - /* I really don't know why this is interactive - help-form should at least be made useful whilst reading the second arg - */ - "cSet syntax for character: \nsSet syntax for %s to: ", - 0 /* See immediately above */) - (c, newentry, syntax_table) - Lisp_Object c, newentry, syntax_table; +DEFUN ("string-to-syntax", Fstring_to_syntax, Sstring_to_syntax, 1, 1, 0, + doc: /* Convert a syntax specification STRING into syntax cell form. +STRING should be a string as it is allowed as argument of +`modify-syntax-entry'. Value is the equivalent cons cell +(CODE . MATCHING-CHAR) that can be used as value of a `syntax-table' +text property. */) + (string) + Lisp_Object string; { - register unsigned char *p; + register const unsigned char *p; register enum syntaxcode code; int val; Lisp_Object match; - CHECK_NUMBER (c, 0); - CHECK_STRING (newentry, 1); - - if (NILP (syntax_table)) - syntax_table = current_buffer->syntax_table; - else - check_syntax_table (syntax_table); + CHECK_STRING (string); - p = XSTRING (newentry)->data; + p = SDATA (string); code = (enum syntaxcode) syntax_spec_code[*p++]; if (((int) code & 0377) == 0377) error ("invalid syntax description letter: %c", p[-1]); if (code == Sinherit) - { - SET_RAW_SYNTAX_ENTRY (syntax_table, XINT (c), Qnil); - return Qnil; - } + return Qnil; if (*p) { int len; - int character = STRING_CHAR_AND_LENGTH (p, XSTRING (newentry)->size - 1, - len); + int character = (STRING_CHAR_AND_LENGTH + (p, SBYTES (string) - 1, len)); XSETINT (match, character); if (XFASTINT (match) == ' ') match = Qnil; @@ -878,57 +968,111 @@ DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3, case 'b': val |= 1 << 21; break; + + case 'n': + val |= 1 << 22; + break; } - + if (val < XVECTOR (Vsyntax_code_object)->size && NILP (match)) - newentry = XVECTOR (Vsyntax_code_object)->contents[val]; + return XVECTOR (Vsyntax_code_object)->contents[val]; else /* Since we can't use a shared object, let's make a new one. */ - newentry = Fcons (make_number (val), match); - - SET_RAW_SYNTAX_ENTRY (syntax_table, XINT (c), newentry); + return Fcons (make_number (val), match); +} + +/* 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, + "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 current buffer's syntax table. +The first character of NEWENTRY should be one of the following: + Space or - whitespace syntax. w word constituent. + _ symbol constituent. . punctuation. + ( open-parenthesis. ) close-parenthesis. + " string quote. \\ escape. + $ paired delimiter. ' expression quote or prefix operator. + < comment starter. > comment ender. + / character-quote. @ inherit from `standard-syntax-table'. + | generic string fence. ! generic comment fence. + +Only single-character comment start and end sequences are represented thus. +Two-character sequences are represented as described below. +The second character of NEWENTRY is the matching parenthesis, + used only if the first character is `(' or `)'. +Any additional characters are flags. +Defined flags are the characters 1, 2, 3, 4, b, p, and n. + 1 means CHAR is the start of a two-char comment start sequence. + 2 means CHAR is the second character of such a sequence. + 3 means CHAR is the start of a two-char comment end sequence. + 4 means CHAR is the second character of such a sequence. + +There can be up to two orthogonal comment sequences. This is to support +language modes such as C++. By default, all comment sequences are of style +a, but you can set the comment sequence style to b (on the second character +of a comment-start, or the first character of a comment-end sequence) using +this flag: + b means CHAR is part of comment sequence b. + n means CHAR is part of a nestable comment sequence. + + p means CHAR is a prefix character for `backward-prefix-chars'; + such characters are treated as whitespace when they occur + between expressions. +usage: (modify-syntax-entry CHAR NEWENTRY &optional SYNTAX-TABLE) */) + (c, newentry, syntax_table) + Lisp_Object c, newentry, syntax_table; +{ + CHECK_NUMBER (c); + + if (NILP (syntax_table)) + syntax_table = current_buffer->syntax_table; + else + check_syntax_table (syntax_table); + SET_RAW_SYNTAX_ENTRY (syntax_table, XINT (c), Fstring_to_syntax (newentry)); return Qnil; } /* Dump syntax table to buffer in human-readable format */ -static void -describe_syntax (value) - Lisp_Object value; +DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, + Sinternal_describe_syntax_value, 1, 1, 0, + doc: /* Insert a description of the internal syntax description SYNTAX at point. */) + (syntax) + Lisp_Object syntax; { register enum syntaxcode code; - char desc, match, start1, start2, end1, end2, prefix, comstyle; + char desc, start1, start2, end1, end2, prefix, comstyle, comnested; char str[2]; - Lisp_Object first, match_lisp; - - Findent_to (make_number (16), make_number (1)); + Lisp_Object first, match_lisp, value = syntax; if (NILP (value)) { - insert_string ("default\n"); - return; + insert_string ("default"); + return syntax; } if (CHAR_TABLE_P (value)) { - insert_string ("deeper char-table ...\n"); - return; + insert_string ("deeper char-table ..."); + return syntax; } if (!CONSP (value)) { - insert_string ("invalid\n"); - return; + insert_string ("invalid"); + return syntax; } - first = XCONS (value)->car; - match_lisp = XCONS (value)->cdr; + first = XCAR (value); + match_lisp = XCDR (value); if (!INTEGERP (first) || !(NILP (match_lisp) || INTEGERP (match_lisp))) { - insert_string ("invalid\n"); - return; + insert_string ("invalid"); + return syntax; } code = (enum syntaxcode) (XINT (first) & 0377); @@ -938,11 +1082,12 @@ describe_syntax (value) end2 = (XINT (first) >> 19) & 1; prefix = (XINT (first) >> 20) & 1; comstyle = (XINT (first) >> 21) & 1; + comnested = (XINT (first) >> 22) & 1; if ((int) code < 0 || (int) code >= (int) Smax) { insert_string ("invalid"); - return; + return syntax; } desc = syntax_code_spec[(int) code]; @@ -968,6 +1113,8 @@ describe_syntax (value) insert ("p", 1); if (comstyle) insert ("b", 1); + if (comnested) + insert ("n", 1); insert_string ("\twhich means: "); @@ -986,7 +1133,7 @@ describe_syntax (value) case Sclose: insert_string ("close"); break; case Squote: - insert_string ("quote"); break; + insert_string ("prefix"); break; case Sstring: insert_string ("string"); break; case Smath: @@ -999,9 +1146,15 @@ describe_syntax (value) insert_string ("comment"); break; case Sendcomment: insert_string ("endcomment"); break; + case Sinherit: + insert_string ("inherit"); break; + case Scomment_fence: + insert_string ("comment fence"); break; + case Sstring_fence: + insert_string ("string fence"); break; default: insert_string ("invalid"); - return; + return syntax; } if (!NILP (match_lisp)) @@ -1021,42 +1174,13 @@ describe_syntax (value) insert_string (",\n\t is the second character of a comment-end sequence"); if (comstyle) insert_string (" (comment style b)"); + if (comnested) + insert_string (" (nestable)"); if (prefix) insert_string (",\n\t is a prefix character for `backward-prefix-chars'"); - insert_string ("\n"); -} - -static Lisp_Object -describe_syntax_1 (vector) - Lisp_Object vector; -{ - struct buffer *old = current_buffer; - set_buffer_internal (XBUFFER (Vstandard_output)); - describe_vector (vector, Qnil, describe_syntax, 0, Qnil, Qnil, (int *) 0, 0); - while (! NILP (XCHAR_TABLE (vector)->parent)) - { - vector = XCHAR_TABLE (vector)->parent; - insert_string ("\nThe parent syntax table is:"); - describe_vector (vector, Qnil, describe_syntax, 0, Qnil, Qnil, - (int *) 0, 0); - } - - call0 (intern ("help-mode")); - set_buffer_internal (old); - return Qnil; -} - -DEFUN ("describe-syntax", Fdescribe_syntax, Sdescribe_syntax, 0, 0, "", - "Describe the syntax specifications in the syntax table.\n\ -The descriptions are inserted in a buffer, which is then displayed.") - () -{ - internal_with_output_to_temp_buffer - ("*Help*", describe_syntax_1, current_buffer->syntax_table); - - return Qnil; + return syntax; } int parse_sexp_ignore_comments; @@ -1065,6 +1189,7 @@ int parse_sexp_ignore_comments; If that many words cannot be found before the end of the buffer, return 0. COUNT negative means scan backward and stop at word beginning. */ +int scan_words (from, count) register int from, count; { @@ -1161,105 +1286,141 @@ scan_words (from, count) return from; } -DEFUN ("forward-word", Fforward_word, Sforward_word, 1, 1, "p", - "Move point forward ARG words (backward if ARG is negative).\n\ -Normally returns t.\n\ -If an edge of the buffer is reached, point is left there\n\ -and nil is returned.") - (count) - Lisp_Object count; +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. */) + (arg) + Lisp_Object arg; { - int val; - CHECK_NUMBER (count, 0); + Lisp_Object tmp; + int orig_val, val; + + if (NILP (arg)) + XSETFASTINT (arg, 1); + else + CHECK_NUMBER (arg); + + val = orig_val = scan_words (PT, XINT (arg)); + if (! orig_val) + val = XINT (arg) > 0 ? ZV : BEGV; + + /* Avoid jumping out of an input field. */ + tmp = Fconstrain_to_field (make_number (val), make_number (PT), + Qt, Qnil, Qnil); + val = XFASTINT (tmp); - if (!(val = scan_words (PT, XINT (count)))) - { - SET_PT (XINT (count) > 0 ? ZV : BEGV); - return Qnil; - } SET_PT (val); - return Qt; + return val == orig_val ? Qt : Qnil; } Lisp_Object skip_chars (); DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0, - "Move point forward, stopping before a char not in STRING, or at pos LIM.\n\ -STRING is like the inside of a `[...]' in a regular expression\n\ -except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\ -Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\ -With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\ -Returns the distance traveled, either zero or positive.") - (string, lim) + doc: /* Move point forward, stopping before a char not in STRING, or at pos LIM. +STRING is like the inside of a `[...]' in a regular expression +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, - "Move point backward, stopping after a char not in STRING, or at pos LIM.\n\ -See `skip-chars-forward' for details.\n\ -Returns the distance traveled, either zero or negative.") - (string, lim) + doc: /* Move point backward, stopping after a char not in STRING, or at pos LIM. +See `skip-chars-forward' for details. +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, - "Move point forward across chars in specified syntax classes.\n\ -SYNTAX is a string of syntax code characters.\n\ -Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\ -If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\ -This function returns the distance traveled, either zero or positive.") - (syntax, lim) + doc: /* Move point forward across chars in specified syntax classes. +SYNTAX is a string of syntax code characters. +Stop before a char whose syntax is not in SYNTAX, or at position LIM. +If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX. +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, - "Move point backward across chars in specified syntax classes.\n\ -SYNTAX is a string of syntax code characters.\n\ -Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\ -If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\ -This function returns the distance traveled, either zero or negative.") - (syntax, lim) + doc: /* Move point backward across chars in specified syntax classes. +SYNTAX is a string of syntax code characters. +Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM. +If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX. +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 char *p, *pend; register unsigned int c; - register int ch; unsigned char fastmap[0400]; /* If SYNTAXP is 0, STRING may contain multi-byte form of characters - of which codes don't fit in FASTMAP. In that case, we set the - first byte of multibyte form (i.e. base leading-code) in FASTMAP - and set the actual ranges of characters in CHAR_RANGES. In the - form "X-Y" of STRING, both X and Y must belong to the same - character set because a range striding across character sets is - meaningless. */ + of which codes don't fit in FASTMAP. In that case, set the + ranges of characters in CHAR_RANGES. */ int *char_ranges; int n_char_ranges = 0; int negate = 0; register int i, i_byte; int multibyte = !NILP (current_buffer->enable_multibyte_characters); - int string_multibyte = STRING_MULTIBYTE (string); + int string_multibyte; + 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) + { + int nbytes; - CHECK_STRING (string, 0); - char_ranges = (int *) alloca (XSTRING (string)->size * (sizeof (int)) * 2); + if (multibyte) + nbytes = count_size_as_multibyte (SDATA (string), + SCHARS (string)); + else + nbytes = SCHARS (string); + if (nbytes != size_byte) + { + unsigned char *tmp = (unsigned char *) alloca (nbytes); + copy_text (SDATA (string), tmp, size_byte, + string_multibyte, multibyte); + size_byte = nbytes; + str = tmp; + } + } if (NILP (lim)) XSETINT (lim, forwardp ? ZV : BEGV); else - CHECK_NUMBER_COERCE_MARKER (lim, 0); + CHECK_NUMBER_COERCE_MARKER (lim); /* In any case, don't allow scan outside bounds of buffer. */ if (XINT (lim) > ZV) @@ -1269,87 +1430,121 @@ skip_chars (forwardp, syntaxp, string, lim) bzero (fastmap, sizeof fastmap); - i = 0, i_byte = 0; + i_byte = 0; - if (i < XSTRING (string)->size - && XSTRING (string)->data[0] == '^') + if (i_byte < size_byte + && SREF (string, 0) == '^') { - negate = 1; i++, i_byte++; + negate = 1; i_byte++; } /* Find the characters specified and set their elements of fastmap. If syntaxp, each character counts as itself. Otherwise, handle backslashes and ranges specially. */ - while (i < XSTRING (string)->size) + while (i_byte < size_byte) { - int c_leading_code; - - if (string_multibyte) - { - c_leading_code = XSTRING (string)->data[i_byte]; - FETCH_STRING_CHAR_ADVANCE (c, string, i, i_byte); - } - else - c = c_leading_code = XSTRING (string)->data[i++]; - - /* Convert multibyteness between what the string has - and what the buffer has. */ - if (multibyte) - c = unibyte_char_to_multibyte (c); - else - c &= 0377; + c = STRING_CHAR_AND_LENGTH (str + i_byte, size_byte - i_byte, len); + i_byte += len; if (syntaxp) 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 == XSTRING (string)->size) + if (i_byte == size_byte) break; - if (string_multibyte) - FETCH_STRING_CHAR_ADVANCE (c, string, i, i_byte); - else - c = XSTRING (string)->data[i++]; + c = STRING_CHAR_AND_LENGTH (str + i_byte, + size_byte - i_byte, len); + i_byte += len; } - if (i < XSTRING (string)->size && XSTRING (string)->data[i] == '-') + /* Treat `-' as range character only if another character + follows. */ + if (i_byte + 1 < size_byte + && str[i_byte] == '-') { unsigned int c2; /* Skip over the dash. */ - i++, i_byte++; - - if (i == XSTRING (string)->size) - break; + i_byte++; /* Get the end of the range. */ - if (string_multibyte) - FETCH_STRING_CHAR_ADVANCE (c2, string, i, i_byte); - else - c2 = XSTRING (string)->data[i++]; + c2 = STRING_CHAR_AND_LENGTH (str + i_byte, + size_byte - i_byte, len); + i_byte += len; if (SINGLE_BYTE_CHAR_P (c)) - while (c <= c2) - { - fastmap[c] = 1; - c++; - } - else { - fastmap[c_leading_code] = 1; - if (c <= c2) + if (! SINGLE_BYTE_CHAR_P (c2)) { - char_ranges[n_char_ranges++] = c; + /* Handle a range starting with a character of + less than 256, and ending with a character of + not less than 256. Split that into two + ranges, the low one ending at 0377, and the + high one starting at the smallest character + in the charset of C2 and ending at C2. */ + int charset = CHAR_CHARSET (c2); + int c1 = MAKE_CHAR (charset, 0, 0); + + char_ranges[n_char_ranges++] = c1; char_ranges[n_char_ranges++] = c2; + c2 = 0377; } + while (c <= c2) + { + fastmap[c] = 1; + c++; + } + } + else if (c <= c2) /* Both C and C2 are multibyte char. */ + { + char_ranges[n_char_ranges++] = c; + char_ranges[n_char_ranges++] = c2; } } else { - fastmap[c_leading_code] = 1; - if (!SINGLE_BYTE_CHAR_P (c)) + if (SINGLE_BYTE_CHAR_P (c)) + fastmap[c] = 1; + else { char_ranges[n_char_ranges++] = c; char_ranges[n_char_ranges++] = c; @@ -1358,24 +1553,27 @@ skip_chars (forwardp, syntaxp, string, lim) } } - /* If ^ was the first character, complement the fastmap. In - addition, as all multibyte characters have possibility of - matching, set all entries for base leading codes, which is - harmless even if SYNTAXP is 1. */ - + /* If ^ was the first character, complement the fastmap. */ if (negate) for (i = 0; i < sizeof fastmap; i++) - { - if (!multibyte || !BASE_LEADING_CODE_P (i)) - fastmap[i] ^= 1; - else - fastmap[i] = 1; - } + fastmap[i] ^= 1; { 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) @@ -1384,60 +1582,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 @@ -1445,77 +1668,149 @@ skip_chars (forwardp, syntaxp, string, lim) if (forwardp) { if (multibyte) - while (pos < XINT (lim) && fastmap[(c = FETCH_BYTE (pos_byte))]) + while (1) { - if (!BASE_LEADING_CODE_P (c)) - INC_BOTH (pos, pos_byte); - else if (n_char_ranges) + int nbytes; + + if (p >= stop) { - /* We much check CHAR_RANGES for a multibyte - character. */ - ch = FETCH_MULTIBYTE_CHAR (pos_byte); - for (i = 0; i < n_char_ranges; i += 2) - if ((ch >= char_ranges[i] && ch <= char_ranges[i + 1])) - break; - if (!(negate ^ (i < n_char_ranges))) + 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]) break; - - INC_BOTH (pos, pos_byte); } else { - if (!negate) break; - INC_BOTH (pos, pos_byte); + /* If we are looking at a multibyte character, + we must look up the character in the table + CHAR_RANGES. If there's no data in the + table, that character is not what we want to + skip. */ + + /* The following code do the right thing even if + n_char_ranges is zero (i.e. no data in + CHAR_RANGES). */ + for (i = 0; i < n_char_ranges; i += 2) + if (c >= char_ranges[i] && c <= char_ranges[i + 1]) + break; + if (!(negate ^ (i < n_char_ranges))) + break; } + 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 savepos = pos_byte; - DEC_BOTH (pos, pos_byte); - if (fastmap[(c = FETCH_BYTE (pos_byte))]) + unsigned char *prev_p; + int nbytes; + + if (p <= stop) { - if (!BASE_LEADING_CODE_P (c)) - ; - else if (n_char_ranges) - { - /* We much check CHAR_RANGES for a multibyte - character. */ - ch = FETCH_MULTIBYTE_CHAR (pos_byte); - for (i = 0; i < n_char_ranges; i += 2) - if (ch >= char_ranges[i] && ch <= char_ranges[i + 1]) - break; - if (!(negate ^ (i < n_char_ranges))) - { - pos++; - pos_byte = savepos; - break; - } - } + 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 - if (!negate) - { - pos++; - pos_byte = savepos; - break; - } + goto back_ok; + } + + if (SINGLE_BYTE_CHAR_P (c)) + { + if (!fastmap[c]) + break; } else { - pos++; - pos_byte = savepos; - break; + /* See the comment in the previous similar code. */ + for (i = 0; i < n_char_ranges; i += 2) + if (c >= char_ranges[i] && c <= char_ranges[i + 1]) + break; + if (!(negate ^ (i < n_char_ranges))) + break; } + 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--; + } } } @@ -1536,14 +1831,158 @@ 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. + FROM_BYTE is the bytepos corresponding to FROM. + Do not move past STOP (a charpos). + The comment over which we have to jump is of style STYLE + (either SYNTAX_COMMENT_STYLE(foo) or ST_COMMENT_STYLE). + NESTING should be positive to indicate the nesting at the beginning + for nested comments and should be zero or negative else. + ST_COMMENT_STYLE cannot be nested. + PREV_SYNTAX is the SYNTAX_WITH_FLAGS of the previous character + (or 0 If the search cannot start in the middle of a two-character). + + If successful, return 1 and store the charpos of the comment's end + into *CHARPOS_PTR and the corresponding bytepos into *BYTEPOS_PTR. + Else, return 0 and store the charpos STOP into *CHARPOS_PTR, the + corresponding bytepos into *BYTEPOS_PTR and the current nesting + (as defined for state.incomment) in *INCOMMENT_PTR. + + The comment end is the last character of the comment rather than the + character just after the comment. + + Global syntax data is assumed to initially be valid for FROM and + remains valid for forward search starting at the returned position. */ + +static int +forw_comment (from, from_byte, stop, nesting, style, prev_syntax, + charpos_ptr, bytepos_ptr, incomment_ptr) + int from, from_byte, stop; + int nesting, style, prev_syntax; + int *charpos_ptr, *bytepos_ptr, *incomment_ptr; +{ + register int c, c1; + register enum syntaxcode code; + register int syntax; + + if (nesting <= 0) nesting = -1; + + /* Enter the loop in the middle so that we find + a 2-char comment ender if we start in the middle of it. */ + syntax = prev_syntax; + if (syntax != 0) goto forw_incomment; + + while (1) + { + if (from == stop) + { + *incomment_ptr = nesting; + *charpos_ptr = from; + *bytepos_ptr = from_byte; + return 0; + } + c = FETCH_CHAR (from_byte); + syntax = SYNTAX_WITH_FLAGS (c); + code = syntax & 0xff; + if (code == Sendcomment + && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style + && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ? + (nesting > 0 && --nesting == 0) : nesting < 0)) + /* we have encountered a comment end of the same style + as the comment sequence which began this comment + section */ + break; + if (code == Scomment_fence + && style == ST_COMMENT_STYLE) + /* we have encountered a comment end of the same style + as the comment sequence which began this comment + section. */ + break; + if (nesting > 0 + && code == Scomment + && SYNTAX_FLAGS_COMMENT_NESTED (syntax) + && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style) + /* we have encountered a nested comment of the same style + as the comment sequence which began this comment section */ + 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 + && (c1 = FETCH_CHAR (from_byte), + SYNTAX_COMEND_SECOND (c1)) + && ((SYNTAX_FLAGS_COMMENT_NESTED (syntax) || + SYNTAX_COMMENT_NESTED (c1)) ? nesting > 0 : nesting < 0)) + { + if (--nesting <= 0) + /* we have encountered a comment end of the same style + as the comment sequence which began this comment + section */ + break; + else + { + INC_BOTH (from, from_byte); + UPDATE_SYNTAX_TABLE_FORWARD (from); + } + } + if (nesting > 0 + && from < stop + && SYNTAX_FLAGS_COMSTART_FIRST (syntax) + && (c1 = FETCH_CHAR (from_byte), + SYNTAX_COMMENT_STYLE (c1) == style + && SYNTAX_COMSTART_SECOND (c1)) + && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) || + SYNTAX_COMMENT_NESTED (c1))) + /* we have encountered a nested comment of the same style + as the comment sequence which began this comment + section */ + { + INC_BOTH (from, from_byte); + UPDATE_SYNTAX_TABLE_FORWARD (from); + nesting++; + } + } + *charpos_ptr = from; + *bytepos_ptr = from_byte; + return 1; +} + DEFUN ("forward-comment", Fforward_comment, Sforward_comment, 1, 1, 0, - "Move forward across up to N comments. If N is negative, move backward.\n\ -Stop scanning if we find something other than a comment or whitespace.\n\ -Set point to where scanning stops.\n\ -If N comments are found as expected, with nothing except whitespace\n\ -between them, return t; otherwise return nil.") - (count) + 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 COUNT comments are found as expected, with nothing except whitespace +between them, return t; otherwise return nil. */) + (count) Lisp_Object count; { register int from; @@ -1552,12 +1991,13 @@ between them, return t; otherwise return nil.") 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 temp_pos; int out_charpos, out_bytepos; + int dummy; - CHECK_NUMBER (count, 0); + CHECK_NUMBER (count); count1 = XINT (count); stop = count1 > 0 ? ZV : BEGV; @@ -1572,34 +2012,42 @@ between them, return t; otherwise return nil.") { do { + int comstart_first; + if (from == stop) { SET_PT_BOTH (from, from_byte); immediate_quit = 0; return Qnil; } - UPDATE_SYNTAX_TABLE_FORWARD (from); c = FETCH_CHAR (from_byte); code = SYNTAX (c); + comstart_first = SYNTAX_COMSTART_FIRST (c); + comnested = SYNTAX_COMMENT_NESTED (c); + comstyle = SYNTAX_COMMENT_STYLE (c); INC_BOTH (from, from_byte); - comstyle = 0; - if (from < stop && SYNTAX_COMSTART_FIRST (c) + UPDATE_SYNTAX_TABLE_FORWARD (from); + if (from < stop && comstart_first && (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 the comment section. */ code = Scomment; comstyle = SYNTAX_COMMENT_STYLE (c1); + comnested = comnested || SYNTAX_COMMENT_NESTED (c1); INC_BOTH (from, from_byte); + UPDATE_SYNTAX_TABLE_FORWARD (from); } } - while (code == Swhitespace || code == Sendcomment); + while (code == Swhitespace || (code == Sendcomment && c == '\n')); - if (code != Scomment && code != Scomment_fence) + if (code == Scomment_fence) + comstyle = ST_COMMENT_STYLE; + else if (code != Scomment) { immediate_quit = 0; DEC_BOTH (from, from_byte); @@ -1607,41 +2055,17 @@ between them, return t; otherwise return nil.") return Qnil; } /* We're at the start of a comment. */ - while (1) + found = forw_comment (from, from_byte, stop, comnested, comstyle, 0, + &out_charpos, &out_bytepos, &dummy); + from = out_charpos; from_byte = out_bytepos; + if (!found) { - if (from == stop) - { - immediate_quit = 0; - SET_PT_BOTH (from, from_byte); - return Qnil; - } - UPDATE_SYNTAX_TABLE_FORWARD (from); - c = FETCH_CHAR (from_byte); - INC_BOTH (from, from_byte); - if (SYNTAX (c) == Sendcomment - && SYNTAX_COMMENT_STYLE (c) == comstyle) - /* we have encountered a comment end of the same style - as the comment sequence which began this comment - section */ - break; - if (SYNTAX (c) == Scomment_fence - && comstyle == ST_COMMENT_STYLE) - /* we have encountered a comment end of the same style - as the comment sequence which began this comment - section. */ - break; - if (from < stop && SYNTAX_COMEND_FIRST (c) - && (c1 = FETCH_CHAR (from_byte), - SYNTAX_COMEND_SECOND (c1)) - && SYNTAX_COMMENT_STYLE (c) == comstyle) - /* we have encountered a comment end of the same style - as the comment sequence which began this comment - section */ - { - INC_BOTH (from, from_byte); - break; - } + immediate_quit = 0; + SET_PT_BOTH (from, from_byte); + return Qnil; } + INC_BOTH (from, from_byte); + UPDATE_SYNTAX_TABLE_FORWARD (from); /* We have skipped one comment. */ count1--; } @@ -1651,6 +2075,7 @@ between them, return t; otherwise return nil.") while (1) { int quoted; + if (from <= stop) { SET_PT_BOTH (BEGV, BEGV_BYTE); @@ -1659,48 +2084,35 @@ between them, return t; otherwise return nil.") } DEC_BOTH (from, from_byte); + /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */ quoted = char_quoted (from, from_byte); - if (quoted) - { - DEC_BOTH (from, from_byte); - goto leave; - } - UPDATE_SYNTAX_TABLE_BACKWARD (from); c = FETCH_CHAR (from_byte); code = SYNTAX (c); comstyle = 0; + comnested = SYNTAX_COMMENT_NESTED (c); if (code == Sendcomment) comstyle = SYNTAX_COMMENT_STYLE (c); - temp_pos = dec_bytepos (from_byte); if (from > stop && SYNTAX_COMEND_SECOND (c) - && (c1 = FETCH_CHAR (temp_pos), - SYNTAX_COMEND_FIRST (c1)) - && !char_quoted (from - 1, temp_pos)) + && prev_char_comend_first (from, from_byte) + && !char_quoted (from - 1, dec_bytepos (from_byte))) { /* We must record the comment style encountered so that later, we can match only the proper comment begin sequence of the same style. */ + DEC_BOTH (from, from_byte); code = Sendcomment; + /* Calling char_quoted, above, set up global syntax position + at the new value of FROM. */ + c1 = FETCH_CHAR (from_byte); comstyle = SYNTAX_COMMENT_STYLE (c1); - DEC_BOTH (from, from_byte); - } - if (from > stop && SYNTAX_COMSTART_SECOND (c) - && (c1 = FETCH_CHAR (temp_pos), - SYNTAX_COMSTART_FIRST (c1)) - && !char_quoted (from - 1, temp_pos)) - { - /* We must record the comment style encountered so that - later, we can match only the proper comment begin - sequence of the same style. */ - code = Scomment; - DEC_BOTH (from, from_byte); + comnested = comnested || SYNTAX_COMMENT_NESTED (c1); } if (code == Scomment_fence) { /* Skip until first preceding unquoted comment_fence. */ int found = 0, ini = from, ini_byte = from_byte; - + while (1) { DEC_BOTH (from, from_byte); @@ -1709,9 +2121,9 @@ between them, return t; otherwise return nil.") 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; } } @@ -1724,14 +2136,33 @@ between them, return t; otherwise return nil.") } else if (code == Sendcomment) { - found = back_comment (from, from_byte, stop, comstyle, + found = back_comment (from, from_byte, stop, comnested, comstyle, &out_charpos, &out_bytepos); - if (found != -1) - from = out_charpos, from_byte = out_bytepos; - /* We have skipped one comment. */ - break; + if (found == -1) + { + if (c == '\n') + /* This end-of-line is not an end-of-comment. + Treat it like a whitespace. + CC-mode (and maybe others) relies on this behavior. */ + ; + else + { + /* Failure: we should go back to the end of this + not-quite-endcomment. */ + if (SYNTAX(c) != code) + /* It was a two-char Sendcomment. */ + INC_BOTH (from, from_byte); + goto leave; + } + } + else + { + /* We have skipped one comment. */ + from = out_charpos, from_byte = out_bytepos; + break; + } } - else if (code != Swhitespace && code != Scomment) + else if (code != Swhitespace || quoted) { leave: immediate_quit = 0; @@ -1749,6 +2180,13 @@ between them, return t; otherwise return nil.") return Qt; } +/* Return syntax code of character C if C is a single byte character + or `multibyte_symbol_p' is zero. Otherwise, return Ssymbol. */ + +#define SYNTAX_WITH_MULTIBYTE_CHECK(c) \ + ((SINGLE_BYTE_CHAR_P (c) || !multibyte_symbol_p) \ + ? SYNTAX (c) : Ssymbol) + static Lisp_Object scan_lists (from, count, depth, sexpflag) register int from; @@ -1763,14 +2201,22 @@ scan_lists (from, count, depth, sexpflag) register enum syntaxcode code, temp_code; 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; int found; - int from_byte = CHAR_TO_BYTE (from); + int from_byte; int out_bytepos, out_charpos; + int temp, dummy; + int multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol; if (depth > 0) min_depth = 0; + if (from > ZV) from = ZV; + if (from < BEGV) from = BEGV; + + from_byte = CHAR_TO_BYTE (from); + immediate_quit = 1; QUIT; @@ -1779,29 +2225,36 @@ scan_lists (from, count, depth, sexpflag) { while (from < stop) { + int comstart_first, prefix; UPDATE_SYNTAX_TABLE_FORWARD (from); c = FETCH_CHAR (from_byte); - code = SYNTAX (c); + code = SYNTAX_WITH_MULTIBYTE_CHECK (c); + comstart_first = SYNTAX_COMSTART_FIRST (c); + comnested = SYNTAX_COMMENT_NESTED (c); + comstyle = SYNTAX_COMMENT_STYLE (c); + prefix = SYNTAX_PREFIX (c); if (depth == min_depth) last_good = from; INC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); - if (from < stop && SYNTAX_COMSTART_FIRST (c) - && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte)) + if (from < stop && comstart_first + && (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 the comment section */ code = Scomment; - comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte)); + c1 = FETCH_CHAR (from_byte); + comstyle = SYNTAX_COMMENT_STYLE (c1); + comnested = comnested || SYNTAX_COMMENT_NESTED (c1); INC_BOTH (from, from_byte); + UPDATE_SYNTAX_TABLE_FORWARD (from); } - - UPDATE_SYNTAX_TABLE_FORWARD (from); - if (SYNTAX_PREFIX (c)) + + if (prefix) continue; switch (SWITCH_ENUM_CAST (code)) @@ -1818,7 +2271,11 @@ scan_lists (from, count, depth, sexpflag) while (from < stop) { UPDATE_SYNTAX_TABLE_FORWARD (from); - switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from_byte)))) + + /* Some compilers can't handle this inside the switch. */ + c = FETCH_CHAR (from_byte); + temp = SYNTAX_WITH_MULTIBYTE_CHECK (c); + switch (temp) { case Scharquote: case Sescape: @@ -1836,40 +2293,24 @@ scan_lists (from, count, depth, sexpflag) } goto done; - case Scomment: case Scomment_fence: + comstyle = ST_COMMENT_STYLE; + /* FALLTHROUGH */ + case Scomment: if (!parse_sexp_ignore_comments) break; - while (1) + UPDATE_SYNTAX_TABLE_FORWARD (from); + found = forw_comment (from, from_byte, stop, + comnested, comstyle, 0, + &out_charpos, &out_bytepos, &dummy); + from = out_charpos, from_byte = out_bytepos; + if (!found) { - if (from == stop) - { - if (depth == 0) - goto done; - goto lose; - } - UPDATE_SYNTAX_TABLE_FORWARD (from); - c = FETCH_CHAR (from_byte); - if (code == Scomment - ? (SYNTAX (c) == Sendcomment - && SYNTAX_COMMENT_STYLE (c) == comstyle) - : (SYNTAX (c) == Scomment_fence)) - /* we have encountered a comment end of the same style - as the comment sequence which began this comment - section */ - break; - INC_BOTH (from, from_byte); - if (from < stop && SYNTAX_COMEND_FIRST (c) - && SYNTAX_COMEND_SECOND (FETCH_CHAR (from_byte)) - && SYNTAX_COMMENT_STYLE (c) == comstyle - && code == Scomment) - /* we have encountered a comment end of the same style - as the comment sequence which began this comment - section */ - { - INC_BOTH (from, from_byte); - break; - } + if (depth == 0) + goto done; + goto lose; } + INC_BOTH (from, from_byte); + UPDATE_SYNTAX_TABLE_FORWARD (from); break; case Smath: @@ -1908,11 +2349,16 @@ scan_lists (from, count, depth, sexpflag) { if (from >= stop) goto lose; UPDATE_SYNTAX_TABLE_FORWARD (from); - if (code == Sstring - ? (FETCH_CHAR (from_byte) == stringterm) - : SYNTAX (FETCH_CHAR (from_byte)) == Sstring_fence) + c = FETCH_CHAR (from_byte); + if (code == Sstring + ? (c == stringterm + && SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring) + : SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring_fence) break; - switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from_byte)))) + + /* Some compilers can't handle this inside the switch. */ + temp = SYNTAX_WITH_MULTIBYTE_CHECK (c); + switch (temp) { case Scharquote: case Sescape: @@ -1923,6 +2369,9 @@ scan_lists (from, count, depth, sexpflag) INC_BOTH (from, from_byte); if (!depth && sexpflag) goto done; break; + default: + /* Ignore whitespace, punctuation, quote, endcomment. */ + break; } } @@ -1944,33 +2393,36 @@ scan_lists (from, count, depth, sexpflag) DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); c = FETCH_CHAR (from_byte); - code = SYNTAX (c); + code = SYNTAX_WITH_MULTIBYTE_CHECK (c); if (depth == min_depth) last_good = from; comstyle = 0; + comnested = SYNTAX_COMMENT_NESTED (c); if (code == Sendcomment) comstyle = SYNTAX_COMMENT_STYLE (c); - temp_pos = from_byte; - if (! NILP (current_buffer->enable_multibyte_characters)) - DEC_POS (temp_pos); - else - temp_pos--; if (from > stop && SYNTAX_COMEND_SECOND (c) - && (c1 = FETCH_CHAR (temp_pos), SYNTAX_COMEND_FIRST (c1)) + && prev_char_comend_first (from, from_byte) && parse_sexp_ignore_comments) { - /* we must record the comment style encountered so that + /* We must record the comment style encountered so that later, we can match only the proper comment begin - sequence of the same style */ + sequence of the same style. */ + DEC_BOTH (from, from_byte); + UPDATE_SYNTAX_TABLE_BACKWARD (from); code = Sendcomment; + c1 = FETCH_CHAR (from_byte); comstyle = SYNTAX_COMMENT_STYLE (c1); - DEC_BOTH (from, from_byte); + comnested = comnested || SYNTAX_COMMENT_NESTED (c1); } - + /* Quoting turns anything except a comment-ender - into a word character. */ + into a word character. Note that this cannot be true + if we decremented FROM in the if-statement above. */ if (code != Sendcomment && char_quoted (from, from_byte)) - code = Sword; + { + DEC_BOTH (from, from_byte); + code = Sword; + } else if (SYNTAX_PREFIX (c)) continue; @@ -1992,7 +2444,7 @@ scan_lists (from, count, depth, sexpflag) temp_pos--; UPDATE_SYNTAX_TABLE_BACKWARD (from - 1); c1 = FETCH_CHAR (temp_pos); - temp_code = SYNTAX (c1); + temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1); /* Don't allow comment-end to be quoted. */ if (temp_code == Sendcomment) goto done2; @@ -2004,7 +2456,7 @@ scan_lists (from, count, depth, sexpflag) UPDATE_SYNTAX_TABLE_BACKWARD (from - 1); } c1 = FETCH_CHAR (temp_pos); - temp_code = SYNTAX (c1); + temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1); if (! (quoted || temp_code == Sword || temp_code == Ssymbol || temp_code == Squote)) @@ -2044,8 +2496,14 @@ scan_lists (from, count, depth, sexpflag) case Sendcomment: if (!parse_sexp_ignore_comments) break; - found = back_comment (from, from_byte, stop, comstyle, + found = back_comment (from, from_byte, stop, comnested, comstyle, &out_charpos, &out_bytepos); + /* FIXME: if found == -1, then it really wasn't a comment-end. + For single-char Sendcomment, we can't do much about it apart + from skipping the char. + For 2-char endcomments, we could try again, taking both + chars as separate entities, but it's a lot of trouble + for very little gain, so we don't bother either. -sm */ if (found != -1) from = out_charpos, from_byte = out_bytepos; break; @@ -2054,35 +2512,34 @@ 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) - && SYNTAX (FETCH_CHAR (from_byte)) == code) + 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 == FETCH_CHAR (temp_pos)) - break; 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); if (!depth && sexpflag) goto done2; break; + default: + /* Ignore whitespace, punctuation, quote, endcomment. */ + break; } } @@ -2106,59 +2563,59 @@ scan_lists (from, count, depth, sexpflag) Fcons (build_string ("Unbalanced parentheses"), Fcons (make_number (last_good), Fcons (make_number (from), Qnil)))); - + abort (); /* NOTREACHED */ } DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0, - "Scan from character number FROM by COUNT lists.\n\ -Returns the character number of the position thus found.\n\ -\n\ -If DEPTH is nonzero, paren depth begins counting from that value,\n\ -only places where the depth in parentheses becomes zero\n\ -are candidates for stopping; COUNT such places are counted.\n\ -Thus, a positive value for DEPTH means go out levels.\n\ -\n\ -Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\ -\n\ -If the beginning or end of (the accessible part of) the buffer is reached\n\ -and the depth is wrong, an error is signaled.\n\ -If the depth is right but the count is not used up, nil is returned.") - (from, count, depth) + doc: /* Scan from character number FROM by COUNT lists. +Returns the character number of the position thus found. + +If DEPTH is nonzero, paren depth begins counting from that value, +only places where the depth in parentheses becomes zero +are candidates for stopping; COUNT such places are counted. +Thus, a positive value for DEPTH means go out levels. + +Comments are ignored if `parse-sexp-ignore-comments' is non-nil. + +If the beginning or end of (the accessible part of) the buffer is reached +and the depth is wrong, an error is signaled. +If the depth is right but the count is not used up, nil is returned. */) + (from, count, depth) Lisp_Object from, count, depth; { - CHECK_NUMBER (from, 0); - CHECK_NUMBER (count, 1); - CHECK_NUMBER (depth, 2); + CHECK_NUMBER (from); + CHECK_NUMBER (count); + CHECK_NUMBER (depth); return scan_lists (XINT (from), XINT (count), XINT (depth), 0); } DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0, - "Scan from character number FROM by COUNT balanced expressions.\n\ -If COUNT is negative, scan backwards.\n\ -Returns the character number of the position thus found.\n\ -\n\ -Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\ -\n\ -If the beginning or end of (the accessible part of) the buffer is reached\n\ -in the middle of a parenthetical grouping, an error is signaled.\n\ -If the beginning or end is reached between groupings\n\ -but before count is used up, nil is returned.") - (from, count) + doc: /* Scan from character number FROM by COUNT balanced expressions. +If COUNT is negative, scan backwards. +Returns the character number of the position thus found. + +Comments are ignored if `parse-sexp-ignore-comments' is non-nil. + +If the beginning or end of (the accessible part of) the buffer is reached +in the middle of a parenthetical grouping, an error is signaled. +If the beginning or end is reached between groupings +but before count is used up, nil is returned. */) + (from, count) Lisp_Object from, count; { - CHECK_NUMBER (from, 0); - CHECK_NUMBER (count, 1); + CHECK_NUMBER (from); + CHECK_NUMBER (count); return scan_lists (XINT (from), XINT (count), 0, 1); } DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars, - 0, 0, 0, - "Move point backward over any number of chars with prefix syntax.\n\ -This includes chars with \"quote\" or \"prefix\" syntax (' or p).") - () + 0, 0, 0, + doc: /* Move point backward over any number of chars with prefix syntax. +This includes chars with "quote" or "prefix" syntax (' or p). */) + () { int beg = BEGV; int opoint = PT; @@ -2167,11 +2624,15 @@ This includes chars with \"quote\" or \"prefix\" syntax (' or p).") int pos_byte = PT_BYTE; int c; - if (pos > beg) + if (pos <= beg) { - SETUP_SYNTAX_TABLE (pos, -1); + SET_PT_BOTH (opoint, opoint_byte); + + return Qnil; } + SETUP_SYNTAX_TABLE (pos, -1); + DEC_BOTH (pos, pos_byte); while (!char_quoted (pos, pos_byte) @@ -2204,18 +2665,19 @@ 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; { struct lisp_parse_state state; register enum syntaxcode code; + int c1; + int comnested; struct level { int last, prev; }; struct level levelstart[100]; register struct level *curlevel = levelstart; struct level *endlevel = levelstart + 100; - int prev; register int depth; /* Paren depth of current scanning location. level - levelstart equals this except when the depth becomes negative. */ @@ -2227,6 +2689,9 @@ scan_sexps_forward (stateptr, from, from_byte, end, targetdepth, int prev_from_syntax; int boundary_stop = commentstop == -1; int nofence; + int found; + int out_bytepos, out_charpos; + int temp; prev_from = from; prev_from_byte = from_byte; @@ -2237,10 +2702,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; @@ -2267,29 +2733,43 @@ 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) - : -1); + state.instring = (!NILP (tem) + ? (INTEGERP (tem) ? XINT (tem) : ST_STRING_STYLE) + : -1); oldstate = Fcdr (oldstate); tem = Fcar (oldstate); - state.incomment = !NILP (tem); + state.incomment = (!NILP (tem) + ? (INTEGERP (tem) ? XINT (tem) : -1) + : 0); oldstate = Fcdr (oldstate); tem = Fcar (oldstate); start_quoted = !NILP (tem); - /* if the eight element of the list is nil, we are in comment + /* if the eighth element of the list is nil, we are in comment style a. If it is non-nil, we are in comment style b */ oldstate = Fcdr (oldstate); oldstate = Fcdr (oldstate); tem = Fcar (oldstate); - state.comstyle = NILP (tem) ? 0 : ( EQ (tem, Qsyntax_table) - ? ST_COMMENT_STYLE : 1 ); + state.comstyle = NILP (tem) ? 0 : (EQ (tem, Qsyntax_table) + ? ST_COMMENT_STYLE : 1); oldstate = Fcdr (oldstate); tem = Fcar (oldstate); state.comstr_start = NILP (tem) ? -1 : XINT (tem) ; + oldstate = Fcdr (oldstate); + tem = Fcar (oldstate); + while (!NILP (tem)) /* >= second enclosing sexps. */ + { + /* curlevel++->last ran into compiler bug on Apollo */ + curlevel->last = XINT (Fcar (tem)); + if (++curlevel == endlevel) + curlevel--; /* error ("Nesting too deep for parser"); */ + curlevel->prev = -1; + curlevel->last = -1; + tem = Fcdr (tem); + } } state.quoted = 0; mindepth = depth; @@ -2297,59 +2777,65 @@ do { prev_from = from; \ curlevel->prev = -1; curlevel->last = -1; + SETUP_SYNTAX_TABLE (prev_from, 1); + 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. */ - if (state.incomment) goto startincomment; + if (state.incomment) + goto startincomment; if (state.instring >= 0) { nofence = state.instring != ST_STRING_STYLE; - if (start_quoted) goto startquotedinstring; + if (start_quoted) + goto startquotedinstring; goto startinstring; } - if (start_quoted) goto startquoted; - - - SETUP_SYNTAX_TABLE (prev_from, 1); - prev_from_syntax = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); - UPDATE_SYNTAX_TABLE_FORWARD (from); + else if (start_quoted) + goto startquoted; while (from < end) { INC_FROM; code = prev_from_syntax & 0xff; - if (code == Scomment) - state.comstr_start = prev_from; + 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. */ + { + /* 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) { /* 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 = ( code == Scomment_fence - ? ST_COMMENT_STYLE - : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte))); + state.comstyle = ST_COMMENT_STYLE; + state.incomment = -1; state.comstr_start = prev_from; - if (code != Scomment_fence) - INC_FROM; code = Scomment; } - else if (from < end) - if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)) - if (SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte))) - /* 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 = ( code == Scomment_fence - ? ST_COMMENT_STYLE - : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte))); - state.comstr_start = prev_from; - if (code != Scomment_fence) - 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; @@ -2371,7 +2857,10 @@ do { prev_from = from; \ symstarted: while (from < end) { - switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from_byte)))) + /* Some compilers can't handle this inside the switch. */ + temp = FETCH_CHAR (from_byte); + temp = SYNTAX (temp); + switch (temp) { case Scharquote: case Sescape: @@ -2391,48 +2880,25 @@ do { prev_from = from; \ curlevel->prev = curlevel->last; break; - startincomment: - if (commentstop == 1) - goto done; - if (from != BEGV) - { - /* Enter the loop in the middle so that we find - a 2-char comment ender if we start in the middle of it. */ - goto startincomment_1; - } - /* At beginning of buffer, enter the loop the ordinary way. */ - state.incomment = 1; - goto commentloop; - + case Scomment_fence: /* Can't happen because it's handled above. */ case Scomment: - state.incomment = 1; if (commentstop || boundary_stop) goto done; - commentloop: - while (1) - { - if (from == end) goto done; - prev = FETCH_CHAR (from_byte); - if (SYNTAX (prev) == Sendcomment - && SYNTAX_COMMENT_STYLE (prev) == state.comstyle) - /* Only terminate the comment section if the endcomment - of the same style as the start sequence has been - encountered. */ - break; - if (state.comstyle == ST_COMMENT_STYLE - && SYNTAX (prev) == Scomment_fence) - break; - INC_FROM; - startincomment_1: - if (from < end && SYNTAX_FLAGS_COMEND_FIRST (prev_from_syntax) - && SYNTAX_COMEND_SECOND (FETCH_CHAR (from_byte)) - && (SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax) - == state.comstyle)) - /* Only terminate the comment section if the end-comment - sequence of the same style as the start sequence has - been encountered. */ - break; - } - INC_FROM; + startincomment: + /* The (from == BEGV) test was to enter the loop in the middle so + that we find a 2-char comment ender even if we start in the + middle of it. We don't want to do that if we're just at the + beginning of the comment (think of (*) ... (*)). */ + found = forw_comment (from, from_byte, end, + state.incomment, state.comstyle, + (from == BEGV || from < state.comstr_start + 3) + ? 0 : prev_from_syntax, + &out_charpos, &out_bytepos, &state.incomment); + from = out_charpos; from_byte = out_bytepos; + /* Beware! prev_from and friends are invalid now. + Luckily, the `done' doesn't use them and the INC_FROM + sets them to a sane value without looking at them. */ + if (!found) goto done; + INC_FROM; state.incomment = 0; state.comstyle = 0; /* reset the comment style */ if (boundary_stop) goto done; @@ -2444,7 +2910,7 @@ do { prev_from = from; \ /* curlevel++->last ran into compiler bug on Apollo */ curlevel->last = prev_from; if (++curlevel == endlevel) - error ("Nesting too deep for parser"); + curlevel--; /* error ("Nesting too deep for parser"); */ curlevel->prev = -1; curlevel->last = -1; if (targetdepth == depth) goto done; @@ -2465,22 +2931,30 @@ 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; if (from >= end) goto done; c = FETCH_CHAR (from_byte); - if (nofence && c == state.instring) break; - switch (SWITCH_ENUM_CAST (SYNTAX (c))) + /* Some compilers can't handle this inside the switch. */ + temp = SYNTAX (c); + + /* Check TEMP here so that if the char has + a syntax-table property which says it is NOT + a string character, it does not end the string. */ + if (nofence && c == state.instring && temp == Sstring) + break; + + switch (temp) { case Sstring_fence: if (!nofence) goto string_end; @@ -2502,6 +2976,10 @@ do { prev_from = from; \ break; case Smath: + /* FIXME: We should do something with it. */ + break; + default: + /* Ignore whitespace, punctuation, quote, endcomment. */ break; } } @@ -2520,50 +2998,47 @@ do { prev_from = from; \ state.prevlevelstart = (curlevel == levelstart) ? -1 : (curlevel - 1)->last; state.location = from; + state.levelstarts = Qnil; + while (--curlevel >= levelstart) + state.levelstarts = Fcons (make_number (curlevel->last), + state.levelstarts); immediate_quit = 0; *stateptr = state; } -/* This comment supplies the doc string for parse-partial-sexp, - for make-docfile to see. We cannot put this in the real DEFUN - due to limits in the Unix cpp. - -DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0, - "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\ -Parsing stops at TO or when certain criteria are met;\n\ - point is set to where parsing stops.\n\ -If fifth arg STATE is omitted or nil,\n\ - parsing assumes that FROM is the beginning of a function.\n\ -Value is a list of nine elements describing final state of parsing:\n\ - 0. depth in parens.\n\ - 1. character address of start of innermost containing list; nil if none.\n\ - 2. character address of start of last complete sexp terminated.\n\ - 3. non-nil if inside a string.\n\ - (it is the character that will terminate the string,\n\ - or t if the string should be terminated by a generic string delimiter.)\n\ - 4. t if inside a comment.\n\ - 5. t if following a quote character.\n\ - 6. the minimum paren-depth encountered during this scan.\n\ - 7. t if in a comment of style b; `syntax-table' if the comment\n\ - should be terminated by a generic comment delimiter.\n\ - 8. character address of start of comment or string; nil if not in one.\n\ -If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\ -in parentheses becomes equal to TARGETDEPTH.\n\ -Fourth arg STOPBEFORE non-nil means stop when come to\n\ - any character that starts a sexp.\n\ -Fifth arg STATE is a nine-element list like what this function returns.\n\ - It is used to initialize the state of the parse. Elements number 1, 2, 6\n\ - and 8 are ignored; you can leave off element 8 (the last) entirely.\n\ -Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.\n\ - If it is `syntax-table', stop after the start of a comment or a string,\n\ - or after end of a comment or a string.") - (from, to, targetdepth, stopbefore, state, commentstop) -*/ - DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0, - 0 /* See immediately above */) - (from, to, targetdepth, stopbefore, oldstate, commentstop) + doc: /* Parse Lisp syntax starting at FROM until TO; return status of parse at TO. +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: + 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, + else an integer (the current comment nesting). + 5. t if following a quote character. + 6. the minimum paren-depth encountered during this scan. + 7. t if in a comment of style b; symbol `syntax-table' if the comment + should be terminated by a generic comment delimiter. + 8. character address of start of comment or string; nil if not in one. + 9. Intermediate data for continuation of parsing (subject to change). +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. + 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. + If it is symbol `syntax-table', stop after the start of a comment or a + string, or after end of a comment or a string. */) + (from, to, targetdepth, stopbefore, oldstate, commentstop) Lisp_Object from, to, targetdepth, stopbefore, oldstate, commentstop; { struct lisp_parse_state state; @@ -2571,7 +3046,7 @@ DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0, if (!NILP (targetdepth)) { - CHECK_NUMBER (targetdepth, 3); + CHECK_NUMBER (targetdepth); target = XINT (targetdepth); } else @@ -2581,30 +3056,34 @@ DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0, 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 ? Qt : 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), - Fcons ((state.incomment || state.instring + Fcons (((state.incomment + || (state.instring >= 0)) ? make_number (state.comstr_start) : Qnil), - Qnil))))))))); + Fcons (state.levelstarts, Qnil)))))))))); } +void init_syntax_once () { register int i, c; @@ -2620,7 +3099,7 @@ init_syntax_once () Qchar_table_extra_slots = intern ("char-table-extra-slots"); /* Create objects which can be shared among syntax tables. */ - Vsyntax_code_object = Fmake_vector (make_number (13), Qnil); + Vsyntax_code_object = Fmake_vector (make_number (Smax), Qnil); for (i = 0; i < XVECTOR (Vsyntax_code_object)->size; i++) XVECTOR (Vsyntax_code_object)->contents[i] = Fcons (make_number (i), Qnil); @@ -2674,8 +3153,14 @@ init_syntax_once () c = ".,;:?!#@~^'`"[i]; SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp); } + + /* All multibyte characters have syntax `word' by default. */ + temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword]; + for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++) + XCHAR_TABLE (Vstandard_syntax_table)->contents[i] = temp; } +void syms_of_syntax () { Qsyntax_table_p = intern ("syntax-table-p"); @@ -2686,23 +3171,31 @@ syms_of_syntax () Qscan_error = intern ("scan-error"); staticpro (&Qscan_error); Fput (Qscan_error, Qerror_conditions, - Fcons (Qerror, Qnil)); + Fcons (Qscan_error, Fcons (Qerror, Qnil))); Fput (Qscan_error, Qerror_message, build_string ("Scan error")); DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments, - "Non-nil means `forward-sexp', etc., should treat comments as whitespace."); + doc: /* Non-nil means `forward-sexp', etc., should treat comments as whitespace. */); DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties, - "Non-nil means `forward-sexp', etc., grant `syntax-table' property.\n\ -The value of this property should be either a syntax table, or a cons\n\ -of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric\n\ -syntax code, MATCHCHAR being nil or the character to match (which is\n\ -relevant only for open/close type."); + doc: /* Non-nil means `forward-sexp', etc., obey `syntax-table' property. +Otherwise, that text property is simply ignored. +See the info node `(elisp)Syntax Properties' for a description of the +`syntax-table' property. */); words_include_escapes = 0; DEFVAR_BOOL ("words-include-escapes", &words_include_escapes, - "Non-nil means `forward-word', etc., should treat escape chars part of words."); + doc: /* Non-nil means `forward-word', etc., should treat escape chars part of words. */); + + DEFVAR_BOOL ("multibyte-syntax-as-symbol", &multibyte_syntax_as_symbol, + doc: /* Non-nil means `scan-sexps' treats all multibyte characters as symbol. */); + multibyte_syntax_as_symbol = 0; + + 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. */); + open_paren_in_column_0_is_defun_start = 1; defsubr (&Ssyntax_table_p); defsubr (&Ssyntax_table); @@ -2711,8 +3204,9 @@ relevant only for open/close type."); defsubr (&Sset_syntax_table); defsubr (&Schar_syntax); defsubr (&Smatching_paren); + defsubr (&Sstring_to_syntax); defsubr (&Smodify_syntax_entry); - defsubr (&Sdescribe_syntax); + defsubr (&Sinternal_describe_syntax_value); defsubr (&Sforward_word); @@ -2727,3 +3221,6 @@ relevant only for open/close type."); defsubr (&Sbackward_prefix_chars); defsubr (&Sparse_partial_sexp); } + +/* arch-tag: 3e297b9f-088e-4b64-8f4c-fb0b3443e412 + (do not change this comment) */