#include <config.h>
#include <ctype.h>
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "charset.h"
#include "keymap.h"
#include "regex.h"
#define SYNTAX_ENTRY_VIA_PROPERTY
#include "syntax.h"
#include "intervals.h"
#define ST_COMMENT_STYLE (256 + 1)
#define ST_STRING_STYLE (256 + 2)
#include "category.h"
Lisp_Object Qsyntax_table_p, Qsyntax_table, Qscan_error;
int words_include_escapes;
int parse_sexp_lookup_properties;
int multibyte_syntax_as_symbol;
Lisp_Object syntax_temp;
int open_paren_in_column_0_is_defun_start;
struct lisp_parse_state
{
int depth;
int instring;
int incomment;
int comstyle;
int quoted;
int thislevelstart;
int prevlevelstart;
int location;
int mindepth;
int comstr_start;
Lisp_Object levelstarts;
};
static int find_start_pos;
static int find_start_value;
static int find_start_value_byte;
static struct buffer *find_start_buffer;
static int find_start_begv;
static int find_start_modiff;
static int find_defun_start P_ ((int, int));
static int back_comment P_ ((EMACS_INT, EMACS_INT, EMACS_INT, int, int,
EMACS_INT *, EMACS_INT *));
static int char_quoted P_ ((int, int));
static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object, int));
static Lisp_Object scan_lists P_ ((EMACS_INT, EMACS_INT, EMACS_INT, int));
static void scan_sexps_forward P_ ((struct lisp_parse_state *,
int, int, int, int,
int, Lisp_Object, int));
static int in_classes P_ ((int, Lisp_Object));
struct gl_state_s gl_state;
INTERVAL interval_of ();
#define INTERVALS_AT_ONCE 10
void
update_syntax_table (charpos, count, init, object)
int charpos, count, init;
Lisp_Object object;
{
Lisp_Object tmp_table;
int cnt = 0, invalidate = 1;
INTERVAL i;
if (init)
{
gl_state.old_prop = Qnil;
gl_state.start = gl_state.b_property;
gl_state.stop = gl_state.e_property;
i = interval_of (charpos, object);
gl_state.backward_i = gl_state.forward_i = i;
invalidate = 0;
if (NULL_INTERVAL_P (i))
return;
while (!NULL_PARENT (i))
{
if (AM_RIGHT_CHILD (i))
INTERVAL_PARENT (i)->position = i->position
- LEFT_TOTAL_LENGTH (i) + TOTAL_LENGTH (i)
- TOTAL_LENGTH (INTERVAL_PARENT (i))
+ LEFT_TOTAL_LENGTH (INTERVAL_PARENT (i));
else
INTERVAL_PARENT (i)->position = i->position - LEFT_TOTAL_LENGTH (i)
+ TOTAL_LENGTH (i);
i = INTERVAL_PARENT (i);
}
i = gl_state.forward_i;
gl_state.b_property = i->position - gl_state.offset;
gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset;
goto update;
}
i = count > 0 ? gl_state.forward_i : gl_state.backward_i;
if (NULL_INTERVAL_P (i))
error ("Error in syntax_table logic for to-the-end intervals");
else if (charpos < i->position)
{
if (count > 0)
error ("Error in syntax_table logic for intervals <-");
i = update_interval (i, charpos);
if (INTERVAL_LAST_POS (i) != gl_state.b_property)
{
invalidate = 0;
gl_state.forward_i = i;
gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset;
}
}
else if (charpos >= INTERVAL_LAST_POS (i))
{
if (count < 0)
error ("Error in syntax_table logic for intervals ->");
i = update_interval (i, charpos);
if (i->position != gl_state.e_property)
{
invalidate = 0;
gl_state.backward_i = i;
gl_state.b_property = i->position - gl_state.offset;
}
}
update:
tmp_table = textget (i->plist, Qsyntax_table);
if (invalidate)
invalidate = !EQ (tmp_table, gl_state.old_prop);
if (invalidate)
{
if (count > 0)
{
gl_state.backward_i = i;
gl_state.b_property = i->position - gl_state.offset;
}
else
{
gl_state.forward_i = i;
gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset;
}
}
if (!EQ (tmp_table, gl_state.old_prop))
{
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))
{
if (cnt && !EQ (tmp_table, textget (i->plist, Qsyntax_table)))
{
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) - gl_state.offset;
gl_state.backward_i = i;
}
return;
}
else if (cnt == INTERVALS_AT_ONCE)
{
if (count > 0)
{
gl_state.e_property
= i->position + LENGTH (i) - gl_state.offset
+ (NULL_INTERVAL_P (next_interval (i)) ? 1 : 0);
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);
}
eassert (NULL_INTERVAL_P (i));
if (count > 0)
gl_state.e_property = gl_state.stop;
else
gl_state.b_property = gl_state.start;
}
static int
char_quoted (charpos, bytepos)
register int charpos, bytepos;
{
register enum syntaxcode code;
register int beg = BEGV;
register int quoted = 0;
int orig = charpos;
DEC_BOTH (charpos, bytepos);
while (charpos >= beg)
{
int c;
UPDATE_SYNTAX_TABLE_BACKWARD (charpos);
c = FETCH_CHAR (bytepos);
code = SYNTAX (c);
if (! (code == Scharquote || code == Sescape))
break;
DEC_BOTH (charpos, bytepos);
quoted = !quoted;
}
UPDATE_SYNTAX_TABLE (orig);
return quoted;
}
INLINE int
inc_bytepos (bytepos)
int bytepos;
{
if (NILP (current_buffer->enable_multibyte_characters))
return bytepos + 1;
INC_POS (bytepos);
return bytepos;
}
INLINE int
dec_bytepos (bytepos)
int bytepos;
{
if (NILP (current_buffer->enable_multibyte_characters))
return bytepos - 1;
DEC_POS (bytepos);
return bytepos;
}
static int
find_defun_start (pos, pos_byte)
int pos, pos_byte;
{
int opoint = PT, opoint_byte = PT_BYTE;
if (!open_paren_in_column_0_is_defun_start)
{
find_start_value_byte = BEGV_BYTE;
return BEGV;
}
if (current_buffer == find_start_buffer
&& pos <= find_start_pos + 1000
&& pos >= find_start_value
&& BEGV == find_start_begv
&& MODIFF == find_start_modiff)
return find_start_value;
scan_newline (pos, pos_byte, BEGV, BEGV_BYTE, -1, 1);
gl_state.current_syntax_table = current_buffer->syntax_table;
gl_state.use_global = 0;
while (PT > BEGV)
{
int c;
c = FETCH_CHAR (PT_BYTE);
if (SYNTAX (c) == Sopen)
{
SETUP_SYNTAX_TABLE (PT + 1, -1);
c = FETCH_CHAR (PT_BYTE);
if (SYNTAX (c) == Sopen)
break;
gl_state.current_syntax_table = current_buffer->syntax_table;
gl_state.use_global = 0;
}
scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1);
}
find_start_value = PT;
find_start_value_byte = PT_BYTE;
find_start_buffer = current_buffer;
find_start_modiff = MODIFF;
find_start_begv = BEGV;
find_start_pos = pos;
TEMP_SET_PT_BOTH (opoint, opoint_byte);
return find_start_value;
}
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;
}
static int
back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_ptr)
EMACS_INT from, from_byte, stop;
int comnested, comstyle;
EMACS_INT *charpos_ptr, *bytepos_ptr;
{
int string_style = -1;
int string_lossage = 0;
int comment_lossage = 0;
int comment_end = from;
int comment_end_byte = from_byte;
int comstart_pos = 0;
int comstart_byte;
int defun_start = 0;
int defun_start_byte = 0;
register enum syntaxcode code;
int nesting = 1;
int c;
int syntax = 0;
while (from != stop)
{
int temp_byte, prev_syntax;
int com2start, com2end;
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);
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));
if (from > stop && (com2end || com2start))
{
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;
}
if (com2start && comstart_pos == 0)
com2end = 0;
if (com2end)
code = Sendcomment;
else if (com2start)
code = Scomment;
else if (code == Scomment
&& (comstyle != SYNTAX_FLAGS_COMMENT_STYLE (syntax)
|| SYNTAX_FLAGS_COMMENT_NESTED (syntax) != comnested))
continue;
if (code != Sendcomment && char_quoted (from, from_byte))
continue;
switch (code)
{
case Sstring_fence:
case Scomment_fence:
c = (code == Sstring_fence ? ST_STRING_STYLE : ST_COMMENT_STYLE);
case Sstring:
if (string_style == -1)
string_style = c;
else if (string_style == c)
string_style = -1;
else
string_lossage = 1;
break;
case Scomment:
if (string_style != -1 || comment_lossage || string_lossage)
goto lossage;
if (!comnested)
{
comstart_pos = from;
comstart_byte = from_byte;
}
else if (--nesting <= 0)
goto done;
break;
case Sendcomment:
if (SYNTAX_FLAGS_COMMENT_STYLE (syntax) == comstyle
&& ((com2end && SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax))
|| SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested)
{
if (comnested)
nesting++;
else
from = stop;
}
else if (comstart_pos != 0 || c != '\n')
comment_lossage = 1;
break;
case Sopen:
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;
default:
break;
}
}
if (comstart_pos == 0)
{
from = comment_end;
from_byte = comment_end_byte;
UPDATE_SYNTAX_TABLE_FORWARD (comment_end - 1);
}
else if (1)
{
from = comstart_pos;
from_byte = comstart_byte;
UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
}
else
{
struct lisp_parse_state state;
lossage:
if (defun_start == 0)
{
defun_start = find_defun_start (comment_end, comment_end_byte);
defun_start_byte = find_start_value_byte;
}
do
{
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)
{
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 == comment_end) ? -1 : from;
}
DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0,
doc: )
(object)
Lisp_Object object;
{
if (CHAR_TABLE_P (object)
&& EQ (XCHAR_TABLE (object)->purpose, Qsyntax_table))
return Qt;
return Qnil;
}
static void
check_syntax_table (obj)
Lisp_Object obj;
{
CHECK_TYPE (CHAR_TABLE_P (obj) && EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table),
Qsyntax_table_p, obj);
}
DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0,
doc: )
()
{
return current_buffer->syntax_table;
}
DEFUN ("standard-syntax-table", Fstandard_syntax_table,
Sstandard_syntax_table, 0, 0, 0,
doc: )
()
{
return Vstandard_syntax_table;
}
DEFUN ("copy-syntax-table", Fcopy_syntax_table, Scopy_syntax_table, 0, 1, 0,
doc: )
(table)
Lisp_Object table;
{
Lisp_Object copy;
if (!NILP (table))
check_syntax_table (table);
else
table = Vstandard_syntax_table;
copy = Fcopy_sequence (table);
XCHAR_TABLE (copy)->defalt = Qnil;
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,
doc: )
(table)
Lisp_Object table;
{
int idx;
check_syntax_table (table);
current_buffer->syntax_table = table;
idx = PER_BUFFER_VAR_IDX (syntax_table);
SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);
return table;
}
unsigned char syntax_spec_code[0400] =
{ 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
(char) Swhitespace, (char) Scomment_fence, (char) Sstring, 0377,
(char) Smath, 0377, 0377, (char) Squote,
(char) Sopen, (char) Sclose, 0377, 0377,
0377, (char) Swhitespace, (char) Spunct, (char) Scharquote,
0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
0377, 0377, 0377, 0377,
(char) Scomment, 0377, (char) Sendcomment, 0377,
(char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
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,
0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
0377, 0377, 0377, 0377, (char) Sstring_fence, 0377, 0377, 0377
};
char syntax_code_spec[16] =
{
' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@',
'!', '|'
};
static Lisp_Object Vsyntax_code_object;
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,
doc: )
(character)
Lisp_Object character;
{
int char_int;
gl_state.current_syntax_table = current_buffer->syntax_table;
gl_state.use_global = 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,
doc: )
(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);
char_int = XINT (character);
code = SYNTAX (char_int);
if (code == Sopen || code == Sclose)
return SYNTAX_MATCH (char_int);
return Qnil;
}
DEFUN ("string-to-syntax", Fstring_to_syntax, Sstring_to_syntax, 1, 1, 0,
doc: )
(string)
Lisp_Object string;
{
register const unsigned char *p;
register enum syntaxcode code;
int val;
Lisp_Object match;
CHECK_STRING (string);
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)
return Qnil;
if (*p)
{
int len;
int character = (STRING_CHAR_AND_LENGTH
(p, SBYTES (string) - 1, len));
XSETINT (match, character);
if (XFASTINT (match) == ' ')
match = Qnil;
p += len;
}
else
match = Qnil;
val = (int) code;
while (*p)
switch (*p++)
{
case '1':
val |= 1 << 16;
break;
case '2':
val |= 1 << 17;
break;
case '3':
val |= 1 << 18;
break;
case '4':
val |= 1 << 19;
break;
case 'p':
val |= 1 << 20;
break;
case 'b':
val |= 1 << 21;
break;
case 'n':
val |= 1 << 22;
break;
}
if (val < XVECTOR (Vsyntax_code_object)->size && NILP (match))
return XVECTOR (Vsyntax_code_object)->contents[val];
else
return Fcons (make_number (val), match);
}
DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3,
"cSet syntax for character: \nsSet syntax for %s to: ",
doc: )
(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));
clear_regexp_cache ();
return Qnil;
}
DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
Sinternal_describe_syntax_value, 1, 1, 0,
doc: )
(syntax)
Lisp_Object syntax;
{
register enum syntaxcode code;
char desc, start1, start2, end1, end2, prefix, comstyle, comnested;
char str[2];
Lisp_Object first, match_lisp, value = syntax;
if (NILP (value))
{
insert_string ("default");
return syntax;
}
if (CHAR_TABLE_P (value))
{
insert_string ("deeper char-table ...");
return syntax;
}
if (!CONSP (value))
{
insert_string ("invalid");
return syntax;
}
first = XCAR (value);
match_lisp = XCDR (value);
if (!INTEGERP (first) || !(NILP (match_lisp) || INTEGERP (match_lisp)))
{
insert_string ("invalid");
return syntax;
}
code = (enum syntaxcode) (XINT (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;
comnested = (XINT (first) >> 22) & 1;
if ((int) code < 0 || (int) code >= (int) Smax)
{
insert_string ("invalid");
return syntax;
}
desc = syntax_code_spec[(int) code];
str[0] = desc, str[1] = 0;
insert (str, 1);
if (NILP (match_lisp))
insert (" ", 1);
else
insert_char (XINT (match_lisp));
if (start1)
insert ("1", 1);
if (start2)
insert ("2", 1);
if (end1)
insert ("3", 1);
if (end2)
insert ("4", 1);
if (prefix)
insert ("p", 1);
if (comstyle)
insert ("b", 1);
if (comnested)
insert ("n", 1);
insert_string ("\twhich means: ");
switch (SWITCH_ENUM_CAST (code))
{
case Swhitespace:
insert_string ("whitespace"); break;
case Spunct:
insert_string ("punctuation"); break;
case Sword:
insert_string ("word"); break;
case Ssymbol:
insert_string ("symbol"); break;
case Sopen:
insert_string ("open"); break;
case Sclose:
insert_string ("close"); break;
case Squote:
insert_string ("prefix"); break;
case Sstring:
insert_string ("string"); break;
case Smath:
insert_string ("math"); break;
case Sescape:
insert_string ("escape"); break;
case Scharquote:
insert_string ("charquote"); break;
case Scomment:
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 syntax;
}
if (!NILP (match_lisp))
{
insert_string (", matches ");
insert_char (XINT (match_lisp));
}
if (start1)
insert_string (",\n\t is the first character of a comment-start sequence");
if (start2)
insert_string (",\n\t is the second character of a comment-start sequence");
if (end1)
insert_string (",\n\t is the first character of a comment-end sequence");
if (end2)
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'");
return syntax;
}
int parse_sexp_ignore_comments;
int
scan_words (from, count)
register int from, count;
{
register int beg = BEGV;
register int end = ZV;
register int from_byte = CHAR_TO_BYTE (from);
register enum syntaxcode code;
int ch0, ch1;
immediate_quit = 1;
QUIT;
SETUP_SYNTAX_TABLE (from, count);
while (count > 0)
{
while (1)
{
if (from == end)
{
immediate_quit = 0;
return 0;
}
UPDATE_SYNTAX_TABLE_FORWARD (from);
ch0 = FETCH_CHAR (from_byte);
code = SYNTAX (ch0);
INC_BOTH (from, from_byte);
if (words_include_escapes
&& (code == Sescape || code == Scharquote))
break;
if (code == Sword)
break;
}
while (1)
{
if (from == end) break;
UPDATE_SYNTAX_TABLE_FORWARD (from);
ch1 = FETCH_CHAR (from_byte);
code = SYNTAX (ch1);
if (!(words_include_escapes
&& (code == Sescape || code == Scharquote)))
if (code != Sword || WORD_BOUNDARY_P (ch0, ch1))
break;
INC_BOTH (from, from_byte);
ch0 = ch1;
}
count--;
}
while (count < 0)
{
while (1)
{
if (from == beg)
{
immediate_quit = 0;
return 0;
}
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
ch1 = FETCH_CHAR (from_byte);
code = SYNTAX (ch1);
if (words_include_escapes
&& (code == Sescape || code == Scharquote))
break;
if (code == Sword)
break;
}
while (1)
{
int temp_byte;
if (from == beg)
break;
temp_byte = dec_bytepos (from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
ch0 = FETCH_CHAR (temp_byte);
code = SYNTAX (ch0);
if (!(words_include_escapes
&& (code == Sescape || code == Scharquote)))
if (code != Sword || WORD_BOUNDARY_P (ch0, ch1))
break;
DEC_BOTH (from, from_byte);
ch1 = ch0;
}
count++;
}
immediate_quit = 0;
return from;
}
DEFUN ("forward-word", Fforward_word, Sforward_word, 0, 1, "p",
doc: )
(arg)
Lisp_Object arg;
{
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;
tmp = Fconstrain_to_field (make_number (val), make_number (PT),
Qt, Qnil, Qnil);
val = XFASTINT (tmp);
SET_PT (val);
return val == orig_val ? Qt : Qnil;
}
Lisp_Object skip_chars ();
DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0,
doc: )
(string, lim)
Lisp_Object string, lim;
{
return skip_chars (1, 0, string, lim, 1);
}
DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
doc: )
(string, lim)
Lisp_Object string, lim;
{
return skip_chars (0, 0, string, lim, 1);
}
DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0,
doc: )
(syntax, lim)
Lisp_Object syntax, lim;
{
return skip_chars (1, 1, syntax, lim, 0);
}
DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0,
doc: )
(syntax, lim)
Lisp_Object syntax, lim;
{
return skip_chars (0, 1, syntax, lim, 0);
}
static Lisp_Object
skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes)
int forwardp, syntaxp;
Lisp_Object string, lim;
int handle_iso_classes;
{
register unsigned int c;
unsigned char fastmap[0400];
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;
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;
if (multibyte != string_multibyte)
{
int nbytes;
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);
if (XINT (lim) > ZV)
XSETFASTINT (lim, ZV);
if (XINT (lim) < BEGV)
XSETFASTINT (lim, BEGV);
bzero (fastmap, sizeof fastmap);
i_byte = 0;
if (i_byte < size_byte
&& SREF (string, 0) == '^')
{
negate = 1; i_byte++;
}
while (i_byte < size_byte)
{
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;
unsigned char class_name[CHAR_CLASS_MAX_LENGTH + 1];
re_wctype_t cc;
if (class_limit - class_beg > CHAR_CLASS_MAX_LENGTH)
class_limit = class_beg + CHAR_CLASS_MAX_LENGTH;
while (class_end < class_limit
&& *class_end >= 'a' && *class_end <= 'z')
class_end++;
if (class_end == class_beg
|| *class_end != ':' || class_end[1] != ']')
goto not_a_class_name;
bcopy (class_beg, class_name, class_end - class_beg);
class_name[class_end - class_beg] = 0;
cc = re_wctype (class_name);
if (cc == 0)
error ("Invalid ISO C character class");
iso_classes = Fcons (make_number (cc), iso_classes);
i_byte = class_end + 2 - str;
continue;
}
not_a_class_name:
if (c == '\\')
{
if (i_byte == size_byte)
break;
c = STRING_CHAR_AND_LENGTH (str + i_byte,
size_byte - i_byte, len);
i_byte += len;
}
if (i_byte + 1 < size_byte
&& str[i_byte] == '-')
{
unsigned int c2;
i_byte++;
c2 = STRING_CHAR_AND_LENGTH (str + i_byte,
size_byte - i_byte, len);
i_byte += len;
if (SINGLE_BYTE_CHAR_P (c))
{
if (! SINGLE_BYTE_CHAR_P (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)
{
char_ranges[n_char_ranges++] = c;
char_ranges[n_char_ranges++] = c2;
}
}
else
{
if (SINGLE_BYTE_CHAR_P (c))
fastmap[c] = 1;
else
{
char_ranges[n_char_ranges++] = c;
char_ranges[n_char_ranges++] = c;
}
}
}
}
if (negate)
for (i = 0; i < sizeof fastmap; i++)
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)
{
SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
if (forwardp)
{
if (multibyte)
while (1)
{
int nbytes;
if (p >= stop)
{
if (p >= endp)
break;
p = GAP_END_ADDR;
stop = endp;
}
c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes);
if (! fastmap[(int) SYNTAX (c)])
break;
p += nbytes, pos++, pos_byte += nbytes;
UPDATE_SYNTAX_TABLE_FORWARD (pos);
}
else
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 (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
while (1)
{
if (p <= stop)
{
if (p <= endp)
break;
p = GPT_ADDR;
stop = endp;
}
UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
if (! fastmap[(int) SYNTAX (p[-1])])
break;
p--, pos--;
}
}
}
else
{
if (forwardp)
{
if (multibyte)
while (1)
{
int nbytes;
if (p >= stop)
{
if (p >= endp)
break;
p = GAP_END_ADDR;
stop = endp;
}
c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes);
if (! NILP (iso_classes) && in_classes (c, iso_classes))
{
if (negate)
break;
else
goto fwd_ok;
}
if (SINGLE_BYTE_CHAR_P (c))
{
if (!fastmap[c])
break;
}
else
{
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 (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 (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);
if (! NILP (iso_classes) && in_classes (c, iso_classes))
{
if (negate)
break;
else
goto back_ok;
}
if (SINGLE_BYTE_CHAR_P (c))
{
if (!fastmap[c])
break;
}
else
{
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 (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--;
}
}
}
#if 0
if (multibyte
&& (forwardp ? (pos > XINT (lim)) : (pos < XINT (lim))))
pos = XINT (lim);
#endif
if (! multibyte)
pos_byte = pos;
SET_PT_BOTH (pos, pos_byte);
immediate_quit = 0;
return make_number (PT - start_point);
}
}
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;
}
static int
forw_comment (from, from_byte, stop, nesting, style, prev_syntax,
charpos_ptr, bytepos_ptr, incomment_ptr)
EMACS_INT from, from_byte, stop;
int nesting, style, prev_syntax;
EMACS_INT *charpos_ptr, *bytepos_ptr;
int *incomment_ptr;
{
register int c, c1;
register enum syntaxcode code;
register int syntax;
if (nesting <= 0) nesting = -1;
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))
break;
if (code == Scomment_fence
&& style == ST_COMMENT_STYLE)
break;
if (nesting > 0
&& code == Scomment
&& SYNTAX_FLAGS_COMMENT_NESTED (syntax)
&& SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style)
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)
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)))
{
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,
doc: )
(count)
Lisp_Object count;
{
register EMACS_INT from;
EMACS_INT from_byte;
register EMACS_INT stop;
register int c, c1;
register enum syntaxcode code;
int comstyle = 0;
int comnested = 0;
int found;
EMACS_INT count1;
EMACS_INT out_charpos, out_bytepos;
int dummy;
CHECK_NUMBER (count);
count1 = XINT (count);
stop = count1 > 0 ? ZV : BEGV;
immediate_quit = 1;
QUIT;
from = PT;
from_byte = PT_BYTE;
SETUP_SYNTAX_TABLE (from, count1);
while (count1 > 0)
{
do
{
int comstart_first;
if (from == stop)
{
SET_PT_BOTH (from, from_byte);
immediate_quit = 0;
return Qnil;
}
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);
UPDATE_SYNTAX_TABLE_FORWARD (from);
if (from < stop && comstart_first
&& (c1 = FETCH_CHAR (from_byte),
SYNTAX_COMSTART_SECOND (c1)))
{
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 && c == '\n'));
if (code == Scomment_fence)
comstyle = ST_COMMENT_STYLE;
else if (code != Scomment)
{
immediate_quit = 0;
DEC_BOTH (from, from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
}
found = forw_comment (from, from_byte, stop, comnested, comstyle, 0,
&out_charpos, &out_bytepos, &dummy);
from = out_charpos; from_byte = out_bytepos;
if (!found)
{
immediate_quit = 0;
SET_PT_BOTH (from, from_byte);
return Qnil;
}
INC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
count1--;
}
while (count1 < 0)
{
while (1)
{
int quoted;
if (from <= stop)
{
SET_PT_BOTH (BEGV, BEGV_BYTE);
immediate_quit = 0;
return Qnil;
}
DEC_BOTH (from, from_byte);
quoted = char_quoted (from, from_byte);
c = FETCH_CHAR (from_byte);
code = SYNTAX (c);
comstyle = 0;
comnested = SYNTAX_COMMENT_NESTED (c);
if (code == Sendcomment)
comstyle = SYNTAX_COMMENT_STYLE (c);
if (from > stop && SYNTAX_COMEND_SECOND (c)
&& prev_char_comend_first (from, from_byte)
&& !char_quoted (from - 1, dec_bytepos (from_byte)))
{
DEC_BOTH (from, from_byte);
code = Sendcomment;
c1 = FETCH_CHAR (from_byte);
comstyle = SYNTAX_COMMENT_STYLE (c1);
comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
}
if (code == Scomment_fence)
{
int found = 0, ini = from, ini_byte = from_byte;
while (1)
{
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
c = FETCH_CHAR (from_byte);
if (SYNTAX (c) == Scomment_fence
&& !char_quoted (from, from_byte))
{
found = 1;
break;
}
else if (from == stop)
break;
}
if (found == 0)
{
from = ini;
from_byte = ini_byte;
goto leave;
}
else
break;
}
else if (code == Sendcomment)
{
found = back_comment (from, from_byte, stop, comnested, comstyle,
&out_charpos, &out_bytepos);
if (found == -1)
{
if (c == '\n')
;
else
{
if (SYNTAX(c) != code)
INC_BOTH (from, from_byte);
goto leave;
}
}
else
{
from = out_charpos, from_byte = out_bytepos;
break;
}
}
else if (code != Swhitespace || quoted)
{
leave:
immediate_quit = 0;
INC_BOTH (from, from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
}
}
count1++;
}
SET_PT_BOTH (from, from_byte);
immediate_quit = 0;
return Qt;
}
#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 EMACS_INT from;
EMACS_INT count, depth;
int sexpflag;
{
Lisp_Object val;
register EMACS_INT stop = count > 0 ? ZV : BEGV;
register int c, c1;
int stringterm;
int quoted;
int mathexit = 0;
register enum syntaxcode code, temp_code;
int min_depth = depth;
int comstyle = 0;
int comnested = 0;
EMACS_INT temp_pos;
EMACS_INT last_good = from;
int found;
EMACS_INT from_byte;
EMACS_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;
SETUP_SYNTAX_TABLE (from, count);
while (count > 0)
{
while (from < stop)
{
int comstart_first, prefix;
UPDATE_SYNTAX_TABLE_FORWARD (from);
c = FETCH_CHAR (from_byte);
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 && comstart_first
&& (c = FETCH_CHAR (from_byte), SYNTAX_COMSTART_SECOND (c))
&& parse_sexp_ignore_comments)
{
code = Scomment;
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);
}
if (prefix)
continue;
switch (SWITCH_ENUM_CAST (code))
{
case Sescape:
case Scharquote:
if (from == stop) goto lose;
INC_BOTH (from, from_byte);
case Sword:
case Ssymbol:
if (depth || !sexpflag) break;
while (from < stop)
{
UPDATE_SYNTAX_TABLE_FORWARD (from);
c = FETCH_CHAR (from_byte);
temp = SYNTAX_WITH_MULTIBYTE_CHECK (c);
switch (temp)
{
case Scharquote:
case Sescape:
INC_BOTH (from, from_byte);
if (from == stop) goto lose;
break;
case Sword:
case Ssymbol:
case Squote:
break;
default:
goto done;
}
INC_BOTH (from, from_byte);
}
goto done;
case Scomment_fence:
comstyle = ST_COMMENT_STYLE;
case Scomment:
if (!parse_sexp_ignore_comments) break;
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 (depth == 0)
goto done;
goto lose;
}
INC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
break;
case Smath:
if (!sexpflag)
break;
if (from != stop && c == FETCH_CHAR (from_byte))
{
INC_BOTH (from, from_byte);
}
if (mathexit)
{
mathexit = 0;
goto close1;
}
mathexit = 1;
case Sopen:
if (!++depth) goto done;
break;
case Sclose:
close1:
if (!--depth) goto done;
if (depth < min_depth)
xsignal3 (Qscan_error,
build_string ("Containing expression ends prematurely"),
make_number (last_good), make_number (from));
break;
case Sstring:
case Sstring_fence:
temp_pos = dec_bytepos (from_byte);
stringterm = FETCH_CHAR (temp_pos);
while (1)
{
if (from >= stop) goto lose;
UPDATE_SYNTAX_TABLE_FORWARD (from);
c = FETCH_CHAR (from_byte);
if (code == Sstring
? (c == stringterm
&& SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring)
: SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring_fence)
break;
temp = SYNTAX_WITH_MULTIBYTE_CHECK (c);
switch (temp)
{
case Scharquote:
case Sescape:
INC_BOTH (from, from_byte);
}
INC_BOTH (from, from_byte);
}
INC_BOTH (from, from_byte);
if (!depth && sexpflag) goto done;
break;
default:
break;
}
}
if (depth) goto lose;
immediate_quit = 0;
return Qnil;
done:
count--;
}
while (count < 0)
{
while (from > stop)
{
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
c = FETCH_CHAR (from_byte);
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);
if (from > stop && SYNTAX_COMEND_SECOND (c)
&& prev_char_comend_first (from, from_byte)
&& parse_sexp_ignore_comments)
{
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
code = Sendcomment;
c1 = FETCH_CHAR (from_byte);
comstyle = SYNTAX_COMMENT_STYLE (c1);
comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
}
if (code != Sendcomment && char_quoted (from, from_byte))
{
DEC_BOTH (from, from_byte);
code = Sword;
}
else if (SYNTAX_PREFIX (c))
continue;
switch (SWITCH_ENUM_CAST (code))
{
case Sword:
case Ssymbol:
case Sescape:
case Scharquote:
if (depth || !sexpflag) break;
while (from > stop)
{
temp_pos = from_byte;
if (! NILP (current_buffer->enable_multibyte_characters))
DEC_POS (temp_pos);
else
temp_pos--;
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
c1 = FETCH_CHAR (temp_pos);
temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1);
if (temp_code == Sendcomment)
goto done2;
quoted = char_quoted (from - 1, temp_pos);
if (quoted)
{
DEC_BOTH (from, from_byte);
temp_pos = dec_bytepos (temp_pos);
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
}
c1 = FETCH_CHAR (temp_pos);
temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1);
if (! (quoted || temp_code == Sword
|| temp_code == Ssymbol
|| temp_code == Squote))
goto done2;
DEC_BOTH (from, from_byte);
}
goto done2;
case Smath:
if (!sexpflag)
break;
temp_pos = dec_bytepos (from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
if (from != stop && c == FETCH_CHAR (temp_pos))
DEC_BOTH (from, from_byte);
if (mathexit)
{
mathexit = 0;
goto open2;
}
mathexit = 1;
case Sclose:
if (!++depth) goto done2;
break;
case Sopen:
open2:
if (!--depth) goto done2;
if (depth < min_depth)
xsignal3 (Qscan_error,
build_string ("Containing expression ends prematurely"),
make_number (last_good), make_number (from));
break;
case Sendcomment:
if (!parse_sexp_ignore_comments)
break;
found = back_comment (from, from_byte, stop, comnested, comstyle,
&out_charpos, &out_bytepos);
if (found != -1)
from = out_charpos, from_byte = out_bytepos;
break;
case Scomment_fence:
case Sstring_fence:
while (1)
{
if (from == stop) goto lose;
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
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;
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;
}
if (!depth && sexpflag) goto done2;
break;
default:
break;
}
}
if (depth) goto lose;
immediate_quit = 0;
return Qnil;
done2:
count++;
}
immediate_quit = 0;
XSETFASTINT (val, from);
return val;
lose:
xsignal3 (Qscan_error,
build_string ("Unbalanced parentheses"),
make_number (last_good), make_number (from));
}
DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0,
doc: )
(from, count, depth)
Lisp_Object from, count, depth;
{
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,
doc: )
(from, count)
Lisp_Object from, count;
{
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,
doc: )
()
{
int beg = BEGV;
int opoint = PT;
int opoint_byte = PT_BYTE;
int pos = PT;
int pos_byte = PT_BYTE;
int c;
if (pos <= beg)
{
SET_PT_BOTH (opoint, opoint_byte);
return Qnil;
}
SETUP_SYNTAX_TABLE (pos, -1);
DEC_BOTH (pos, pos_byte);
while (!char_quoted (pos, pos_byte)
&& ((c = FETCH_CHAR (pos_byte), SYNTAX (c) == Squote)
|| SYNTAX_PREFIX (c)))
{
opoint = pos;
opoint_byte = pos_byte;
if (pos + 1 > beg)
DEC_BOTH (pos, pos_byte);
}
SET_PT_BOTH (opoint, opoint_byte);
return Qnil;
}
static void
scan_sexps_forward (stateptr, from, from_byte, end, targetdepth,
stopbefore, oldstate, commentstop)
struct lisp_parse_state *stateptr;
register int from;
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;
register int depth;
int mindepth;
int start_quoted = 0;
Lisp_Object tem;
int prev_from;
int prev_from_byte;
int prev_from_syntax;
int boundary_stop = commentstop == -1;
int nofence;
int found;
EMACS_INT out_bytepos, out_charpos;
int temp;
prev_from = from;
prev_from_byte = from_byte;
if (from != BEGV)
DEC_BOTH (prev_from, prev_from_byte);
#define INC_FROM \
do { prev_from = from; \
prev_from_byte = from_byte; \
temp = FETCH_CHAR (prev_from_byte); \
prev_from_syntax = SYNTAX_WITH_FLAGS (temp); \
INC_BOTH (from, from_byte); \
if (from < end) \
UPDATE_SYNTAX_TABLE_FORWARD (from); \
} while (0)
immediate_quit = 1;
QUIT;
if (NILP (oldstate))
{
depth = 0;
state.instring = -1;
state.incomment = 0;
state.comstyle = 0;
state.comstr_start = -1;
}
else
{
tem = Fcar (oldstate);
if (!NILP (tem))
depth = XINT (tem);
else
depth = 0;
oldstate = Fcdr (oldstate);
oldstate = Fcdr (oldstate);
oldstate = Fcdr (oldstate);
tem = Fcar (oldstate);
state.instring = (!NILP (tem)
? (INTEGERP (tem) ? XINT (tem) : ST_STRING_STYLE)
: -1);
oldstate = Fcdr (oldstate);
tem = Fcar (oldstate);
state.incomment = (!NILP (tem)
? (INTEGERP (tem) ? XINT (tem) : -1)
: 0);
oldstate = Fcdr (oldstate);
tem = Fcar (oldstate);
start_quoted = !NILP (tem);
oldstate = Fcdr (oldstate);
oldstate = Fcdr (oldstate);
tem = Fcar (oldstate);
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))
{
curlevel->last = XINT (Fcar (tem));
if (++curlevel == endlevel)
curlevel--;
curlevel->prev = -1;
curlevel->last = -1;
tem = Fcdr (tem);
}
}
state.quoted = 0;
mindepth = depth;
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);
if (state.incomment)
goto startincomment;
if (state.instring >= 0)
{
nofence = state.instring != ST_STRING_STYLE;
if (start_quoted)
goto startquotedinstring;
goto startinstring;
}
else if (start_quoted)
goto startquoted;
while (from < end)
{
INC_FROM;
code = prev_from_syntax & 0xff;
if (from < end
&& SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
&& (c1 = FETCH_CHAR (from_byte),
SYNTAX_COMSTART_SECOND (c1)))
{
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)
{
state.comstyle = ST_COMMENT_STYLE;
state.incomment = -1;
state.comstr_start = prev_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;
switch (SWITCH_ENUM_CAST (code))
{
case Sescape:
case Scharquote:
if (stopbefore) goto stop;
curlevel->last = prev_from;
startquoted:
if (from == end) goto endquoted;
INC_FROM;
goto symstarted;
case Sword:
case Ssymbol:
if (stopbefore) goto stop;
curlevel->last = prev_from;
symstarted:
while (from < end)
{
temp = FETCH_CHAR (from_byte);
temp = SYNTAX (temp);
switch (temp)
{
case Scharquote:
case Sescape:
INC_FROM;
if (from == end) goto endquoted;
break;
case Sword:
case Ssymbol:
case Squote:
break;
default:
goto symdone;
}
INC_FROM;
}
symdone:
curlevel->prev = curlevel->last;
break;
case Scomment_fence:
case Scomment:
if (commentstop || boundary_stop) goto done;
startincomment:
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;
if (!found) goto done;
INC_FROM;
state.incomment = 0;
state.comstyle = 0;
if (boundary_stop) goto done;
break;
case Sopen:
if (stopbefore) goto stop;
depth++;
curlevel->last = prev_from;
if (++curlevel == endlevel)
curlevel--;
curlevel->prev = -1;
curlevel->last = -1;
if (targetdepth == depth) goto done;
break;
case Sclose:
depth--;
if (depth < mindepth)
mindepth = depth;
if (curlevel != levelstart)
curlevel--;
curlevel->prev = curlevel->last;
if (targetdepth == depth) goto done;
break;
case Sstring:
case Sstring_fence:
state.comstr_start = from - 1;
if (stopbefore) goto stop;
curlevel->last = prev_from;
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);
temp = SYNTAX (c);
if (nofence && c == state.instring && temp == Sstring)
break;
switch (temp)
{
case Sstring_fence:
if (!nofence) goto string_end;
break;
case Scharquote:
case Sescape:
INC_FROM;
startquotedinstring:
if (from >= end) goto endquoted;
}
INC_FROM;
}
}
string_end:
state.instring = -1;
curlevel->prev = curlevel->last;
INC_FROM;
if (boundary_stop) goto done;
break;
case Smath:
break;
default:
break;
}
}
goto done;
stop:
from = prev_from;
goto done;
endquoted:
state.quoted = 1;
done:
state.depth = depth;
state.mindepth = mindepth;
state.thislevelstart = curlevel->prev;
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;
}
DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0,
doc: )
(from, to, targetdepth, stopbefore, oldstate, commentstop)
Lisp_Object from, to, targetdepth, stopbefore, oldstate, commentstop;
{
struct lisp_parse_state state;
int target;
if (!NILP (targetdepth))
{
CHECK_NUMBER (targetdepth);
target = XINT (targetdepth);
}
else
target = -100000;
validate_region (&from, &to);
scan_sexps_forward (&state, XINT (from), CHAR_TO_BYTE (XINT (from)),
XINT (to),
target, !NILP (stopbefore), oldstate,
(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
? Qt : make_number (state.instring)) : Qnil,
Fcons (state.incomment < 0 ? Qt :
(state.incomment == 0 ? Qnil :
make_number (state.incomment)),
Fcons (state.quoted ? Qt : Qnil,
Fcons (make_number (state.mindepth),
Fcons ((state.comstyle
? (state.comstyle == ST_COMMENT_STYLE
? Qsyntax_table : Qt) :
Qnil),
Fcons (((state.incomment
|| (state.instring >= 0))
? make_number (state.comstr_start)
: Qnil),
Fcons (state.levelstarts, Qnil))))))))));
}
void
init_syntax_once ()
{
register int i, c;
Lisp_Object temp;
Qsyntax_table = intern ("syntax-table");
staticpro (&Qsyntax_table);
Qchar_table_extra_slots = intern ("char-table-extra-slots");
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);
Fput (Qsyntax_table, Qchar_table_extra_slots, make_number (0));
temp = XVECTOR (Vsyntax_code_object)->contents[(int) Swhitespace];
Vstandard_syntax_table = Fmake_char_table (Qsyntax_table, temp);
temp = XVECTOR (Vsyntax_code_object)->contents[(int) Spunct];
for (i = 0; i <= ' ' - 1; i++)
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 0177, temp);
temp = XVECTOR (Vsyntax_code_object)->contents[(int) Swhitespace];
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ' ', temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\t', temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\n', temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 015, temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 014, temp);
temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword];
for (i = 'a'; i <= 'z'; i++)
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
for (i = 'A'; i <= 'Z'; i++)
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
for (i = '0'; i <= '9'; i++)
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 = XVECTOR (Vsyntax_code_object)->contents[(int) Ssymbol];
for (i = 0; i < 10; i++)
{
c = "_-+*/&|<>="[i];
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp);
}
temp = XVECTOR (Vsyntax_code_object)->contents[(int) Spunct];
for (i = 0; i < 12; i++)
{
c = ".,;:?!#@~^'`"[i];
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp);
}
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");
staticpro (&Qsyntax_table_p);
staticpro (&Vsyntax_code_object);
staticpro (&gl_state.object);
staticpro (&gl_state.global_code);
staticpro (&gl_state.current_syntax_table);
staticpro (&gl_state.old_prop);
staticpro (&re_match_object);
Qscan_error = intern ("scan-error");
staticpro (&Qscan_error);
Fput (Qscan_error, Qerror_conditions,
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,
doc: );
DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties,
doc: );
words_include_escapes = 0;
DEFVAR_BOOL ("words-include-escapes", &words_include_escapes,
doc: );
DEFVAR_BOOL ("multibyte-syntax-as-symbol", &multibyte_syntax_as_symbol,
doc: );
multibyte_syntax_as_symbol = 0;
DEFVAR_BOOL ("open-paren-in-column-0-is-defun-start",
&open_paren_in_column_0_is_defun_start,
doc: );
open_paren_in_column_0_is_defun_start = 1;
defsubr (&Ssyntax_table_p);
defsubr (&Ssyntax_table);
defsubr (&Sstandard_syntax_table);
defsubr (&Scopy_syntax_table);
defsubr (&Sset_syntax_table);
defsubr (&Schar_syntax);
defsubr (&Smatching_paren);
defsubr (&Sstring_to_syntax);
defsubr (&Smodify_syntax_entry);
defsubr (&Sinternal_describe_syntax_value);
defsubr (&Sforward_word);
defsubr (&Sskip_chars_forward);
defsubr (&Sskip_chars_backward);
defsubr (&Sskip_syntax_forward);
defsubr (&Sskip_syntax_backward);
defsubr (&Sforward_comment);
defsubr (&Sscan_lists);
defsubr (&Sscan_sexps);
defsubr (&Sbackward_prefix_chars);
defsubr (&Sparse_partial_sexp);
}