X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2fcea188d65c5a6dd35f49152ccd4935f6926958..0af583eff430597ee9e038d5bd9cec0ccf4c7224:/src/syntax.c diff --git a/src/syntax.c b/src/syntax.c index f00fb3c9dd..8c08aa56a1 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, 1987, 1993 Free Software Foundation, Inc. + Copyright (C) 1985, 1987, 1993, 1994, 1995 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -15,23 +15,29 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ -#include "config.h" +#include #include #include "lisp.h" #include "commands.h" #include "buffer.h" #include "syntax.h" -Lisp_Object Qsyntax_table_p; +Lisp_Object Qsyntax_table_p, Qsyntax_table; static void scan_sexps_forward (); static int char_quoted (); int words_include_escapes; +/* 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; + /* This is the internal form of the parse state used in parse-partial-sexp. */ struct lisp_parse_state @@ -84,7 +90,7 @@ find_defun_start (pos) return find_start_value; /* Back up to start of line. */ - tem = scan_buffer ('\n', pos, -1, &shortage); + tem = scan_buffer ('\n', pos, BEGV, -1, &shortage, 1); while (tem > BEGV) { @@ -92,7 +98,7 @@ find_defun_start (pos) if (SYNTAX (FETCH_CHAR (tem)) == Sopen) break; /* Move to beg of previous line. */ - tem = scan_buffer ('\n', tem, -2, &shortage); + tem = scan_buffer ('\n', tem, BEGV, -2, &shortage, 1); } /* Record what we found, for the next try. */ @@ -106,28 +112,26 @@ find_defun_start (pos) } DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0, - "Return t if ARG is a syntax table.\n\ -Any vector of 256 elements will do.") - (obj) - Lisp_Object obj; + "Return t if OBJECT is a syntax table.\n\ +Currently, any char-table counts as a syntax table.") + (object) + Lisp_Object object; { - if (XTYPE (obj) == Lisp_Vector && XVECTOR (obj)->size == 0400) + if (CHAR_TABLE_P (object) + && XCHAR_TABLE (object)->purpose == Qsyntax_table) return Qt; return Qnil; } -Lisp_Object +static void check_syntax_table (obj) Lisp_Object obj; { - register Lisp_Object tem; - while (tem = Fsyntax_table_p (obj), - NILP (tem)) - obj = wrong_type_argument (Qsyntax_table_p, obj); - return obj; + if (!(CHAR_TABLE_P (obj) + && 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.") @@ -151,20 +155,25 @@ It is a copy of the TABLE, which defaults to the standard syntax table.") (table) Lisp_Object table; { - Lisp_Object size, val; - XFASTINT (size) = 0400; - XFASTINT (val) = 0; - val = Fmake_vector (size, val); + Lisp_Object copy; + if (!NILP (table)) - table = check_syntax_table (table); - else if (NILP (Vstandard_syntax_table)) - /* Can only be null during initialization */ - return val; - else table = Vstandard_syntax_table; - - bcopy (XVECTOR (table)->contents, - XVECTOR (val)->contents, 0400 * sizeof (Lisp_Object)); - return val; + check_syntax_table (table); + else + table = Vstandard_syntax_table; + + copy = Fcopy_sequence (table); + + /* Only the standard syntax table should have a default element. + Other syntax tables should inherit from parents instead. */ + XCHAR_TABLE (copy)->defalt = Qnil; + + /* Copied syntax tables should all have parents. + If we copied one with no parent, such as the standard syntax table, + use the standard syntax table as the copy's parent. */ + if (NILP (XCHAR_TABLE (copy)->parent)) + Fset_char_table_parent (copy, Vstandard_syntax_table); + return copy; } DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 1, 0, @@ -173,7 +182,7 @@ One argument, a syntax table.") (table) Lisp_Object table; { - table = check_syntax_table (table); + check_syntax_table (table); current_buffer->syntax_table = table; /* Indicate that this buffer now has a specified syntax table. */ current_buffer->local_var_flags @@ -197,7 +206,7 @@ unsigned char syntax_spec_code[0400] = 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Scomment, 0377, (char) Sendcomment, 0377, - 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A, ... */ + (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */ 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword, 0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol, @@ -209,21 +218,61 @@ unsigned char syntax_spec_code[0400] = /* Indexed by syntax code, give the letter that describes it. */ -char syntax_code_spec[13] = +char syntax_code_spec[14] = { - ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>' + ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@' }; +/* Look up the value for CHARACTER in syntax table TABLE's parent + and its parents. SYNTAX_ENTRY calls this, when TABLE itself has nil + for CHARACTER. It's actually used only when not compiled with GCC. */ + +Lisp_Object +syntax_parent_lookup (table, character) + Lisp_Object table; + int character; +{ + Lisp_Object value; + + while (1) + { + table = XCHAR_TABLE (table)->parent; + if (NILP (table)) + return Qnil; + + value = XCHAR_TABLE (table)->contents[character]; + if (!NILP (value)) + return value; + } +} + DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0, - "Return the syntax code of CHAR, described by a character.\n\ -For example, if CHAR is a word constituent, the character `?w' is returned.\n\ + "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'.") - (ch) - Lisp_Object ch; + (character) + Lisp_Object character; +{ + int char_int; + CHECK_NUMBER (character, 0); + 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) + Lisp_Object character; { - CHECK_NUMBER (ch, 0); - return make_number (syntax_code_spec[(int) SYNTAX (0xFF & XINT (ch))]); + int char_int, code; + CHECK_NUMBER (character, 0); + char_int = XINT (character); + code = SYNTAX (char_int); + if (code == Sopen || code == Sclose) + return make_number (SYNTAX_MATCH (char_int)); + return Qnil; } /* This comment supplies the doc string for modify-syntax-entry, @@ -240,27 +289,28 @@ The first character of S should be one of the following:\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.\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 C is the start of a two-char comment start sequence.\n\ - 2 means C is the second character of such a sequence.\n\ - 3 means C is the start of a two-char comment end sequence.\n\ - 4 means C is the second character of such a sequence.\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 of a\n\ -comment-start, or the first character of a comment-end sequence) by using\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 C is part of comment sequence b.\n\ + b means CHAR is part of comment sequence b.\n\ \n\ - p means C is a prefix character for `backward-prefix-chars';\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) @@ -275,56 +325,70 @@ DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3, (c, newentry, syntax_table) Lisp_Object c, newentry, syntax_table; { - register unsigned char *p, match; + register unsigned char *p; register enum syntaxcode code; - Lisp_Object val; + int val; + Lisp_Object match; CHECK_NUMBER (c, 0); CHECK_STRING (newentry, 1); + if (NILP (syntax_table)) syntax_table = current_buffer->syntax_table; else - syntax_table = check_syntax_table (syntax_table); + check_syntax_table (syntax_table); p = XSTRING (newentry)->data; code = (enum syntaxcode) syntax_spec_code[*p++]; if (((int) code & 0377) == 0377) error ("invalid syntax description letter: %c", c); - match = *p; - if (match) p++; - if (match == ' ') match = 0; + if (code == Sinherit) + { + SET_RAW_SYNTAX_ENTRY (syntax_table, c, Qnil); + return Qnil; + } - XFASTINT (val) = (match << 8) + (int) code; + if (*p) + { + XSETINT (match, *p++); + if (XFASTINT (match) == ' ') + match = Qnil; + } + else + match = Qnil; + + val = (int) code; while (*p) switch (*p++) { case '1': - XFASTINT (val) |= 1 << 16; + val |= 1 << 16; break; case '2': - XFASTINT (val) |= 1 << 17; + val |= 1 << 17; break; case '3': - XFASTINT (val) |= 1 << 18; + val |= 1 << 18; break; case '4': - XFASTINT (val) |= 1 << 19; + val |= 1 << 19; break; case 'p': - XFASTINT (val) |= 1 << 20; + val |= 1 << 20; break; case 'b': - XFASTINT (val) |= 1 << 21; + val |= 1 << 21; break; } - XVECTOR (syntax_table)->contents[0xFF & XINT (c)] = val; + SET_RAW_SYNTAX_ENTRY (syntax_table, c, + Fcons (make_number (val), match)); return Qnil; } @@ -338,23 +402,38 @@ describe_syntax (value) register enum syntaxcode code; char desc, match, start1, start2, end1, end2, prefix, comstyle; char str[2]; + Lisp_Object first, match_lisp; Findent_to (make_number (16), make_number (1)); - if (XTYPE (value) != Lisp_Int) + if (NILP (value)) + { + insert_string ("inherit"); + return; + } + + if (!CONSP (value)) { insert_string ("invalid"); return; } - code = (enum syntaxcode) (XINT (value) & 0377); - match = (XINT (value) >> 8) & 0377; - start1 = (XINT (value) >> 16) & 1; - start2 = (XINT (value) >> 17) & 1; - end1 = (XINT (value) >> 18) & 1; - end2 = (XINT (value) >> 19) & 1; - prefix = (XINT (value) >> 20) & 1; - comstyle = (XINT (value) >> 21) & 1; + first = XCONS (value)->car; + match_lisp = XCONS (value)->cdr; + + if (!INTEGERP (first) || !(NILP (match_lisp) || INTEGERP (match_lisp))) + { + insert_string ("invalid"); + return; + } + + code = (enum syntaxcode) (first & 0377); + start1 = (XINT (first) >> 16) & 1; + start2 = (XINT (first) >> 17) & 1; + end1 = (XINT (first) >> 18) & 1; + end2 = (XINT (first) >> 19) & 1; + prefix = (XINT (first) >> 20) & 1; + comstyle = (XINT (first) >> 21) & 1; if ((int) code < 0 || (int) code >= (int) Smax) { @@ -366,10 +445,9 @@ describe_syntax (value) str[0] = desc, str[1] = 0; insert (str, 1); - str[0] = match ? match : ' '; + str[0] = !NILP (match_lisp) ? XINT (match_lisp) : ' '; insert (str, 1); - if (start1) insert ("1", 1); if (start2) @@ -387,11 +465,7 @@ describe_syntax (value) insert_string ("\twhich means: "); -#ifdef SWITCH_ENUM_BUG - switch ((int) code) -#else - switch (code) -#endif + switch (SWITCH_ENUM_CAST (code)) { case Swhitespace: insert_string ("whitespace"); break; @@ -424,10 +498,10 @@ describe_syntax (value) return; } - if (match) + if (!NILP (match_lisp)) { insert_string (", matches "); - insert_char (match); + insert_char (XINT (match_lisp)); } if (start1) @@ -454,7 +528,8 @@ describe_syntax_1 (vector) { struct buffer *old = current_buffer; set_buffer_internal (XBUFFER (Vstandard_output)); - describe_vector (vector, Qnil, describe_syntax, 0, Qnil); + describe_vector (vector, Qnil, describe_syntax, 0, Qnil, Qnil); + call0 (intern ("help-mode")); set_buffer_internal (old); return Qnil; } @@ -480,6 +555,7 @@ scan_words (from, count) register int beg = BEGV; register int end = ZV; register int code; + int charcode; immediate_quit = 1; QUIT; @@ -493,7 +569,8 @@ scan_words (from, count) immediate_quit = 0; return 0; } - code = SYNTAX (FETCH_CHAR (from)); + charcode = FETCH_CHAR (from); + code = SYNTAX (charcode); if (words_include_escapes && (code == Sescape || code == Scharquote)) break; @@ -504,7 +581,8 @@ scan_words (from, count) while (1) { if (from == end) break; - code = SYNTAX (FETCH_CHAR (from)); + charcode = FETCH_CHAR (from); + code = SYNTAX (charcode); if (!(words_include_escapes && (code == Sescape || code == Scharquote))) if (code != Sword) @@ -522,7 +600,8 @@ scan_words (from, count) immediate_quit = 0; return 0; } - code = SYNTAX (FETCH_CHAR (from - 1)); + charcode = FETCH_CHAR (from - 1); + code = SYNTAX (charcode); if (words_include_escapes && (code == Sescape || code == Scharquote)) break; @@ -533,7 +612,8 @@ scan_words (from, count) while (1) { if (from == beg) break; - code = SYNTAX (FETCH_CHAR (from - 1)); + charcode = FETCH_CHAR (from - 1); + code = SYNTAX (charcode); if (!(words_include_escapes && (code == Sescape || code == Scharquote))) if (code != Sword) @@ -579,7 +659,7 @@ between them, return t; otherwise return nil.") { register int from; register int stop; - register int c; + register int c, c1; register enum syntaxcode code; int comstyle = 0; /* style of comment encountered */ int found; @@ -596,63 +676,66 @@ between them, return t; otherwise return nil.") while (count1 > 0) { stop = ZV; - while (from < stop) + do { + if (from == stop) + { + SET_PT (from); + immediate_quit = 0; + return Qnil; + } c = FETCH_CHAR (from); code = SYNTAX (c); from++; comstyle = 0; if (from < stop && SYNTAX_COMSTART_FIRST (c) - && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from))) + && (c1 = FETCH_CHAR (from), + SYNTAX_COMSTART_SECOND (c1))) { - /* we have encountered a comment start sequence and we - are ignoring all text inside comments. we must record + /* 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 */ + the comment section. */ code = Scomment; - comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from)); + comstyle = SYNTAX_COMMENT_STYLE (c1); from++; } - - if (code == Scomment) - { - while (1) - { - if (from == stop) - { - immediate_quit = 0; - SET_PT (from); - return Qnil; - } - c = FETCH_CHAR (from); - 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; - from++; - if (from < stop && SYNTAX_COMEND_FIRST (c) - && SYNTAX_COMEND_SECOND (FETCH_CHAR (from)) - && SYNTAX_COMMENT_STYLE (c) == comstyle) - /* we have encountered a comment end of the same style - as the comment sequence which began this comment - section */ - { from++; break; } - } - /* We have skipped one comment. */ - break; - } - else if (code != Swhitespace && code != Sendcomment) + } + while (code == Swhitespace || code == Sendcomment); + if (code != Scomment) + { + immediate_quit = 0; + SET_PT (from - 1); + return Qnil; + } + /* We're at the start of a comment. */ + while (1) + { + if (from == stop) { immediate_quit = 0; - SET_PT (from - 1); + SET_PT (from); return Qnil; } + c = FETCH_CHAR (from); + from++; + 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 (from < stop && SYNTAX_COMEND_FIRST (c) + && (c1 = FETCH_CHAR (from), + 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 */ + { from++; break; } } - - /* End of comment reached */ + /* We have skipped one comment. */ count1--; } @@ -670,15 +753,18 @@ between them, return t; otherwise return nil.") c = FETCH_CHAR (from); code = SYNTAX (c); comstyle = 0; + if (code == Sendcomment) + comstyle = SYNTAX_COMMENT_STYLE (c); if (from > stop && SYNTAX_COMEND_SECOND (c) - && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1)) + && (c1 = FETCH_CHAR (from - 1), + SYNTAX_COMEND_FIRST (c1)) && !char_quoted (from - 1)) { - /* 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. */ code = Sendcomment; - comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from - 1)); + comstyle = SYNTAX_COMMENT_STYLE (c1); from--; } @@ -692,7 +778,8 @@ between them, return t; otherwise return nil.") if (from != stop) from--; while (1) { - if (SYNTAX (c = FETCH_CHAR (from)) == Scomment + if ((c = FETCH_CHAR (from), + SYNTAX (c) == Scomment) && SYNTAX_COMMENT_STYLE (c) == comstyle) break; if (from == stop) @@ -703,7 +790,8 @@ between them, return t; otherwise return nil.") } from--; if (SYNTAX_COMSTART_SECOND (c) - && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from)) + && (c1 = FETCH_CHAR (from), + SYNTAX_COMSTART_FIRST (c1)) && SYNTAX_COMMENT_STYLE (c) == comstyle && !char_quoted (from)) break; @@ -728,6 +816,7 @@ between them, return t; otherwise return nil.") int comment_end = from; int comstart_pos = 0; int comstart_parity = 0; + int scanstart = from - 1; /* At beginning of range to scan, we're outside of strings; that determines quote parity to the comment-end. */ @@ -746,15 +835,15 @@ between them, return t; otherwise return nil.") { code = Sendcomment; from--; + c = FETCH_CHAR (from); } - else if (from > stop && SYNTAX_COMSTART_SECOND (c) - && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from - 1)) - && comstyle == SYNTAX_COMMENT_STYLE (c)) - { - code = Scomment; - from--; - } + /* 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) + && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from + 1)) + && comstyle == SYNTAX_COMMENT_STYLE (FETCH_CHAR (from + 1))) + code = Scomment; /* Ignore escaped characters. */ if (char_quoted (from)) @@ -819,6 +908,8 @@ between them, return t; otherwise return nil.") from = comment_end; } } + /* We have skipped one comment. */ + break; } else if ((code != Swhitespace && code != Scomment) || quoted) { @@ -846,7 +937,7 @@ scan_lists (from, count, depth, sexpflag) Lisp_Object val; register int stop; register int c; - char stringterm; + unsigned char stringterm; int quoted; int mathexit = 0; register enum syntaxcode code; @@ -883,11 +974,7 @@ scan_lists (from, count, depth, sexpflag) if (SYNTAX_PREFIX (c)) continue; -#ifdef SWITCH_ENUM_BUG - switch ((int) code) -#else - switch (code) -#endif + switch (SWITCH_ENUM_CAST (code)) { case Sescape: case Scharquote: @@ -900,11 +987,7 @@ scan_lists (from, count, depth, sexpflag) /* This word counts as a sexp; return at end of it. */ while (from < stop) { -#ifdef SWITCH_ENUM_BUG - switch ((int) SYNTAX (FETCH_CHAR (from))) -#else - switch (SYNTAX (FETCH_CHAR (from))) -#endif + switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from)))) { case Scharquote: case Sescape: @@ -926,7 +1009,12 @@ scan_lists (from, count, depth, sexpflag) if (!parse_sexp_ignore_comments) break; while (1) { - if (from == stop) goto done; + if (from == stop) + { + if (depth == 0) + goto done; + goto lose; + } c = FETCH_CHAR (from); if (SYNTAX (c) == Sendcomment && SYNTAX_COMMENT_STYLE (c) == comstyle) @@ -974,11 +1062,7 @@ scan_lists (from, count, depth, sexpflag) { if (from >= stop) goto lose; if (FETCH_CHAR (from) == stringterm) break; -#ifdef SWITCH_ENUM_BUG - switch ((int) SYNTAX (FETCH_CHAR (from))) -#else - switch (SYNTAX (FETCH_CHAR (from))) -#endif + switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from)))) { case Scharquote: case Sescape: @@ -1013,6 +1097,9 @@ scan_lists (from, count, depth, sexpflag) from--; c = FETCH_CHAR (from); code = SYNTAX (c); + comstyle = 0; + if (code == Sendcomment) + comstyle = SYNTAX_COMMENT_STYLE (c); if (from > stop && SYNTAX_COMEND_SECOND (c) && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1)) && !char_quoted (from - 1) @@ -1029,11 +1116,7 @@ scan_lists (from, count, depth, sexpflag) if (SYNTAX_PREFIX (c)) continue; -#ifdef SWITCH_ENUM_BUG - switch ((int) (quoted ? Sword : code)) -#else - switch (quoted ? Sword : code) -#endif + switch (SWITCH_ENUM_CAST (quoted ? Sword : code)) { case Sword: case Ssymbol: @@ -1089,7 +1172,12 @@ scan_lists (from, count, depth, sexpflag) if (SYNTAX (c = FETCH_CHAR (from)) == Scomment && SYNTAX_COMMENT_STYLE (c) == comstyle) break; - if (from == stop) goto done; + if (from == stop) + { + if (depth == 0) + goto done2; + goto lose; + } from--; if (SYNTAX_COMSTART_SECOND (c) && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from)) @@ -1117,6 +1205,7 @@ scan_lists (from, count, depth, sexpflag) int comment_end = from; int comstart_pos = 0; int comstart_parity = 0; + int scanstart = from - 1; /* At beginning of range to scan, we're outside of strings; that determines quote parity to the comment-end. */ @@ -1135,15 +1224,15 @@ scan_lists (from, count, depth, sexpflag) { code = Sendcomment; from--; + c = FETCH_CHAR (from); } - else if (from > stop && SYNTAX_COMSTART_SECOND (c) - && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from - 1)) - && comstyle == SYNTAX_COMMENT_STYLE (c)) - { - code = Scomment; - from--; - } + /* 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) + && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from + 1)) + && comstyle == SYNTAX_COMMENT_STYLE (FETCH_CHAR (from + 1))) + code = Scomment; /* Ignore escaped characters. */ if (char_quoted (from)) @@ -1238,7 +1327,7 @@ scan_lists (from, count, depth, sexpflag) immediate_quit = 0; - XFASTINT (val) = from; + XSETFASTINT (val, from); return val; lose: @@ -1390,7 +1479,6 @@ scan_sexps_forward (stateptr, from, end, targetdepth, style a. if it is non-nil, we are in comment style b */ oldstate = Fcdr (oldstate); oldstate = Fcdr (oldstate); - oldstate = Fcdr (oldstate); tem = Fcar (oldstate); state.comstyle = !NILP (tem); } @@ -1431,11 +1519,7 @@ scan_sexps_forward (stateptr, from, end, targetdepth, if (SYNTAX_PREFIX (FETCH_CHAR (from - 1))) continue; -#ifdef SWITCH_ENUM_BUG - switch ((int) code) -#else - switch (code) -#endif + switch (SWITCH_ENUM_CAST (code)) { case Sescape: case Scharquote: @@ -1453,11 +1537,7 @@ scan_sexps_forward (stateptr, from, end, targetdepth, symstarted: while (from < end) { -#ifdef SWITCH_ENUM_BUG - switch ((int) SYNTAX (FETCH_CHAR (from))) -#else - switch (SYNTAX (FETCH_CHAR (from))) -#endif + switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from)))) { case Scharquote: case Sescape: @@ -1477,9 +1557,20 @@ scan_sexps_forward (stateptr, from, end, targetdepth, curlevel->prev = curlevel->last; break; + startincomment: + if (commentstop) + 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. */ + prev = FETCH_CHAR (from - 1); + goto startincomment_1; + } + /* At beginning of buffer, enter the loop the ordinary way. */ + case Scomment: state.incomment = 1; - startincomment: if (commentstop) goto done; while (1) @@ -1493,6 +1584,7 @@ scan_sexps_forward (stateptr, from, end, targetdepth, encountered. */ break; from++; + startincomment_1: if (from < end && SYNTAX_COMEND_FIRST (prev) && SYNTAX_COMEND_SECOND (FETCH_CHAR (from)) && SYNTAX_COMMENT_STYLE (prev) == state.comstyle) @@ -1514,7 +1606,7 @@ scan_sexps_forward (stateptr, from, end, targetdepth, error ("Nesting too deep for parser"); curlevel->prev = -1; curlevel->last = -1; - if (!--targetdepth) goto done; + if (targetdepth == depth) goto done; break; case Sclose: @@ -1524,7 +1616,7 @@ scan_sexps_forward (stateptr, from, end, targetdepth, if (curlevel != levelstart) curlevel--; curlevel->prev = curlevel->last; - if (!++targetdepth) goto done; + if (targetdepth == depth) goto done; break; case Sstring: @@ -1536,11 +1628,7 @@ scan_sexps_forward (stateptr, from, end, targetdepth, { if (from >= end) goto done; if (FETCH_CHAR (from) == state.instring) break; -#ifdef SWITCH_ENUM_BUG - switch ((int) SYNTAX (FETCH_CHAR (from))) -#else - switch (SYNTAX (FETCH_CHAR (from))) -#endif + switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from)))) { case Scharquote: case Sescape: @@ -1590,20 +1678,20 @@ Parsing stops at TO or when certain criteria are met;\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 eight elements describing final state of parsing:\n\ - 1. depth in parens.\n\ - 2. character address of start of innermost containing list; nil if none.\n\ - 3. character address of start of last complete sexp terminated.\n\ - 4. non-nil if inside a string.\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\ - 5. t if inside a comment.\n\ - 6. t if following a quote character.\n\ - 7. the minimum paren-depth encountered during this scan.\n\ - 8. t if in a comment of style `b'.\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'.\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 seven-list like what this function returns.\n\ +Fifth arg STATE is an eight-list like what this function returns.\n\ It is used to initialize the state of the parse. Its second and third elements are ignored. Sixth args COMMENTSTOP non-nil means stop at the start of a comment.") @@ -1647,39 +1735,60 @@ DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0, init_syntax_once () { register int i; - register struct Lisp_Vector *v; + Lisp_Object temp; + + /* This has to be done here, before we call Fmake_char_table. */ + Qsyntax_table = intern ("syntax-table"); + staticpro (&Qsyntax_table); - /* Set this now, so first buffer creation can refer to it. */ - /* Make it nil before calling copy-syntax-table - so that copy-syntax-table will know not to try to copy from garbage */ - Vstandard_syntax_table = Qnil; - Vstandard_syntax_table = Fcopy_syntax_table (Qnil); + /* Intern this now in case it isn't already done. + Setting this variable twice is harmless. + But don't staticpro it here--that is done in alloc.c. */ + Qchar_table_extra_slots = intern ("char-table-extra-slots"); - v = XVECTOR (Vstandard_syntax_table); + /* Now we are ready to set up this property, so we can + create syntax tables. */ + Fput (Qsyntax_table, Qchar_table_extra_slots, make_number (0)); + temp = Fcons (make_number ((int) Swhitespace), Qnil); + + Vstandard_syntax_table = Fmake_char_table (Qsyntax_table, temp); + + temp = Fcons (make_number ((int) Sword), Qnil); for (i = 'a'; i <= 'z'; i++) - XFASTINT (v->contents[i]) = (int) Sword; + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp); for (i = 'A'; i <= 'Z'; i++) - XFASTINT (v->contents[i]) = (int) Sword; + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp); for (i = '0'; i <= '9'; i++) - XFASTINT (v->contents[i]) = (int) Sword; - XFASTINT (v->contents['$']) = (int) Sword; - XFASTINT (v->contents['%']) = (int) Sword; - - XFASTINT (v->contents['(']) = (int) Sopen + (')' << 8); - XFASTINT (v->contents[')']) = (int) Sclose + ('(' << 8); - XFASTINT (v->contents['[']) = (int) Sopen + (']' << 8); - XFASTINT (v->contents[']']) = (int) Sclose + ('[' << 8); - XFASTINT (v->contents['{']) = (int) Sopen + ('}' << 8); - XFASTINT (v->contents['}']) = (int) Sclose + ('{' << 8); - XFASTINT (v->contents['"']) = (int) Sstring; - XFASTINT (v->contents['\\']) = (int) Sescape; - + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp); + + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '$', temp); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '%', temp); + + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '(', + Fcons (make_number (Sopen), make_number (')'))); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ')', + Fcons (make_number (Sclose), make_number ('('))); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '[', + Fcons (make_number (Sopen), make_number (']'))); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ']', + Fcons (make_number (Sclose), make_number ('['))); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '{', + Fcons (make_number (Sopen), make_number ('}'))); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '}', + Fcons (make_number (Sclose), make_number ('{'))); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '"', + Fcons (make_number ((int) Sstring), Qnil)); + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\\', + Fcons (make_number ((int) Sescape), Qnil)); + + temp = Fcons (make_number ((int) Ssymbol), Qnil); for (i = 0; i < 10; i++) - XFASTINT (v->contents["_-+*/&|<>="[i]]) = (int) Ssymbol; + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, "_-+*/&|<>="[i], temp); + temp = Fcons (make_number ((int) Spunct), Qnil); for (i = 0; i < 12; i++) - XFASTINT (v->contents[".,;:?!#@~^'`"[i]]) = (int) Spunct; + SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ".,;:?!#@~^'`"[i], temp); } syms_of_syntax () @@ -1700,6 +1809,7 @@ syms_of_syntax () defsubr (&Scopy_syntax_table); defsubr (&Sset_syntax_table); defsubr (&Schar_syntax); + defsubr (&Smatching_paren); defsubr (&Smodify_syntax_entry); defsubr (&Sdescribe_syntax);