/* GNU Emacs routines to deal with syntax tables; also word and list parsing.
- Copyright (C) 1985, 1987, 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1987, 1993, 1994, 1995 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#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
return find_start_value;
/* Back up to start of line. */
- tem = scan_buffer ('\n', pos, -1, &shortage, 1);
+ tem = scan_buffer ('\n', pos, BEGV, -1, &shortage, 1);
while (tem > BEGV)
{
if (SYNTAX (FETCH_CHAR (tem)) == Sopen)
break;
/* Move to beg of previous line. */
- tem = scan_buffer ('\n', tem, -2, &shortage, 1);
+ tem = scan_buffer ('\n', tem, BEGV, -2, &shortage, 1);
}
/* Record what we found, for the next try. */
\f
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.")
+Currently, any char-table counts as a syntax table.")
(obj)
Lisp_Object obj;
{
- if (XTYPE (obj) == Lisp_Vector && XVECTOR (obj)->size == 0400)
+ if (CHAR_TABLE_P (obj)
+ && XCHAR_TABLE (obj)->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.")
(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);
+ Fset_char_table_parent (copy, Vstandard_syntax_table);
+ return copy;
}
DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 1, 0,
(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
' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@'
};
\f
+/* 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\
(ch)
Lisp_Object ch;
{
+ int char_int;
CHECK_NUMBER (ch, 0);
- return make_number (syntax_code_spec[(int) SYNTAX (XINT (ch))]);
+ char_int = XINT (ch);
+ return make_number (syntax_code_spec[(int) SYNTAX (char_int)]);
}
DEFUN ("matching-paren", Fmatching_paren, Smatching_paren, 1, 1, 0,
(ch)
Lisp_Object ch;
{
- int code;
+ int char_int, code;
CHECK_NUMBER (ch, 0);
- code = SYNTAX (XINT (ch));
+ char_int = XINT (ch);
+ code = SYNTAX (char_int);
if (code == Sopen || code == Sclose)
- return make_number (SYNTAX_MATCH (XINT (ch)));
+ return make_number (SYNTAX_MATCH (char_int));
return Qnil;
}
(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;
}
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;
+ }
+
+ 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) (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;
+ 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)
{
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)
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;
insert_string ("comment"); break;
case Sendcomment:
insert_string ("endcomment"); break;
- case Sinherit:
- insert_string ("inherit"); break;
default:
insert_string ("invalid");
return;
}
- if (match)
+ if (!NILP (match_lisp))
{
insert_string (", matches ");
- insert_char (match);
+ insert_char (XINT (match_lisp));
}
if (start1)
{
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;
}
register int beg = BEGV;
register int end = ZV;
register int code;
+ int charcode;
immediate_quit = 1;
QUIT;
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;
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)
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;
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)
{
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;
if (from == stop)
{
SET_PT (from);
+ immediate_quit = 0;
return Qnil;
}
c = FETCH_CHAR (from);
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
only a comment end of the same style actually ends
the comment section. */
code = Scomment;
- comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from));
+ comstyle = SYNTAX_COMMENT_STYLE (c1);
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;
- from++;
if (from < stop && SYNTAX_COMEND_FIRST (c)
- && SYNTAX_COMEND_SECOND (FETCH_CHAR (from))
+ && (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
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
later, we can match only the proper comment begin
sequence of the same style. */
code = Sendcomment;
- comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from - 1));
+ comstyle = SYNTAX_COMMENT_STYLE (c1);
from--;
}
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)
}
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;
Lisp_Object val;
register int stop;
register int c;
- char stringterm;
+ unsigned char stringterm;
int quoted;
int mathexit = 0;
register enum syntaxcode code;
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:
/* 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:
{
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:
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:
immediate_quit = 0;
- XFASTINT (val) = from;
+ XSETFASTINT (val, from);
return val;
lose:
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:
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:
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)
encountered. */
break;
from++;
+ startincomment_1:
if (from < end && SYNTAX_COMEND_FIRST (prev)
&& SYNTAX_COMEND_SECOND (FETCH_CHAR (from))
&& SYNTAX_COMMENT_STYLE (prev) == state.comstyle)
error ("Nesting too deep for parser");
curlevel->prev = -1;
curlevel->last = -1;
- if (!--targetdepth) goto done;
+ if (targetdepth == depth) goto done;
break;
case Sclose:
if (curlevel != levelstart)
curlevel--;
curlevel->prev = curlevel->last;
- if (!++targetdepth) goto done;
+ if (targetdepth == depth) goto done;
break;
case Sstring:
{
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:
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 ()