/* GNU Emacs routines to deal with syntax tables; also word and list parsing.
- Copyright (C) 1985, 87, 93, 94, 95, 97, 1998, 1999, 2004 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1987, 1993, 1994, 1995, 1997, 1998, 1999, 2002,
+ 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
This file is part of GNU Emacs.
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, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
#include <config.h>
#include "buffer.h"
#include "charset.h"
#include "keymap.h"
+#include "regex.h"
/* Make syntax table lookup grant data in gl_state. */
#define SYNTAX_ENTRY_VIA_PROPERTY
static int find_defun_start P_ ((int, int));
-static int back_comment P_ ((int, int, int, int, int, 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));
-static Lisp_Object scan_lists P_ ((int, int, 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));
\f
struct gl_state_s gl_state; /* Global state of syntax parser. */
{
Lisp_Object tmp_table;
int cnt = 0, invalidate = 1;
- INTERVAL i, oldi;
+ INTERVAL i;
if (init)
{
gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset;
goto update;
}
- oldi = i = count > 0 ? gl_state.forward_i : gl_state.backward_i;
+ i = count > 0 ? gl_state.forward_i : gl_state.backward_i;
/* We are guaranteed to be called with CHARPOS either in i,
or further off. */
}
else
{
- gl_state.b_property = i->position + LENGTH (i) - gl_state.offset;
+ gl_state.b_property
+ = i->position + LENGTH (i) - gl_state.offset;
gl_state.backward_i = i;
}
return;
{
if (count > 0)
{
- gl_state.e_property = i->position + LENGTH (i) - gl_state.offset;
+ gl_state.e_property
+ = i->position + LENGTH (i) - gl_state.offset
+ /* e_property at EOB is not set to ZV but to ZV+1, so that
+ we can do INC(from);UPDATE_SYNTAX_TABLE_FORWARD without
+ having to check eob between the two. */
+ + (NULL_INTERVAL_P (next_interval (i)) ? 1 : 0);
gl_state.forward_i = i;
}
else
DEC_BOTH (charpos, bytepos);
- while (bytepos >= beg)
+ while (charpos >= beg)
{
int c;
static int
back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_ptr)
- int from, from_byte, stop;
+ EMACS_INT from, from_byte, stop;
int comnested, comstyle;
- int *charpos_ptr, *bytepos_ptr;
+ EMACS_INT *charpos_ptr, *bytepos_ptr;
{
/* Look back, counting the parity of string-quotes,
and recording the comment-starters seen.
{
from = comstart_pos;
from_byte = comstart_byte;
- /* Globals are correct now. */
+ UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
}
else
{
check_syntax_table (obj)
Lisp_Object obj;
{
- if (!(CHAR_TABLE_P (obj)
- && EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table)))
- wrong_type_argument (Qsyntax_table_p, 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,
p = SDATA (string);
code = (enum syntaxcode) syntax_spec_code[*p++];
if (((int) code & 0377) == 0377)
- error ("invalid syntax description letter: %c", p[-1]);
+ error ("Invalid syntax description letter: %c", p[-1]);
if (code == Sinherit)
return Qnil;
check_syntax_table (syntax_table);
SET_RAW_SYNTAX_ENTRY (syntax_table, XINT (c), Fstring_to_syntax (newentry));
+
+ /* We clear the regexp cache, since character classes can now have
+ different values from those in the compiled regexps.*/
+ clear_regexp_cache ();
+
return Qnil;
}
\f
(arg)
Lisp_Object arg;
{
+ Lisp_Object tmp;
int orig_val, val;
if (NILP (arg))
val = XINT (arg) > 0 ? ZV : BEGV;
/* Avoid jumping out of an input field. */
- val = XFASTINT (Fconstrain_to_field (make_number (val), make_number (PT),
- Qt, Qnil, Qnil));
+ 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;
(but not as the end of a range; quoting is never needed there).
Thus, with arg "a-zA-Z", this skips letters stopping before first nonletter.
With arg "^a-zA-Z", skips nonletters stopping before first letter.
-Returns the distance traveled, either zero or positive.
-Note that char classes, e.g. `[:alpha:]', are not currently supported;
-they will be treated as literals. */)
+Char classes, e.g. `[:alpha:]', are supported.
+
+Returns the distance traveled, either zero or positive. */)
(string, lim)
Lisp_Object string, lim;
{
- return skip_chars (1, 0, string, lim);
+ return skip_chars (1, 0, string, lim, 1);
}
DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
(string, lim)
Lisp_Object string, lim;
{
- return skip_chars (0, 0, string, lim);
+ return skip_chars (0, 0, string, lim, 1);
}
DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0,
(syntax, lim)
Lisp_Object syntax, lim;
{
- return skip_chars (1, 1, syntax, lim);
+ return skip_chars (1, 1, syntax, lim, 0);
}
DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0,
(syntax, lim)
Lisp_Object syntax, lim;
{
- return skip_chars (0, 1, syntax, lim);
+ return skip_chars (0, 1, syntax, lim, 0);
}
static Lisp_Object
-skip_chars (forwardp, syntaxp, string, lim)
+skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes)
int forwardp, syntaxp;
Lisp_Object string, lim;
+ int handle_iso_classes;
{
register unsigned int c;
unsigned char fastmap[0400];
int size_byte;
const unsigned char *str;
int len;
+ Lisp_Object iso_classes;
CHECK_STRING (string);
char_ranges = (int *) alloca (SCHARS (string) * (sizeof (int)) * 2);
string_multibyte = STRING_MULTIBYTE (string);
str = SDATA (string);
size_byte = SBYTES (string);
+ iso_classes = Qnil;
/* Adjust the multibyteness of the string to that of the buffer. */
if (multibyte != string_multibyte)
fastmap[syntax_spec_code[c & 0377]] = 1;
else
{
+ if (handle_iso_classes && c == '['
+ && i_byte < size_byte
+ && STRING_CHAR (str + i_byte, size_byte - i_byte) == ':')
+ {
+ const unsigned char *class_beg = str + i_byte + 1;
+ const unsigned char *class_end = class_beg;
+ const unsigned char *class_limit = str + size_byte - 2;
+ /* Leave room for the null. */
+ unsigned char class_name[CHAR_CLASS_MAX_LENGTH + 1];
+ re_wctype_t cc;
+
+ if (class_limit - class_beg > CHAR_CLASS_MAX_LENGTH)
+ class_limit = class_beg + CHAR_CLASS_MAX_LENGTH;
+
+ while (class_end < class_limit
+ && *class_end >= 'a' && *class_end <= 'z')
+ class_end++;
+
+ if (class_end == class_beg
+ || *class_end != ':' || class_end[1] != ']')
+ goto not_a_class_name;
+
+ bcopy (class_beg, class_name, class_end - class_beg);
+ class_name[class_end - class_beg] = 0;
+
+ cc = re_wctype (class_name);
+ if (cc == 0)
+ error ("Invalid ISO C character class");
+
+ iso_classes = Fcons (make_number (cc), iso_classes);
+
+ i_byte = class_end + 2 - str;
+ continue;
+ }
+
+ not_a_class_name:
if (c == '\\')
{
if (i_byte == size_byte)
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])
if (!(negate ^ (i < n_char_ranges)))
break;
}
+ fwd_ok:
p += nbytes, pos++, pos_byte += nbytes;
}
else
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++;
}
}
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])
if (!(negate ^ (i < n_char_ranges)))
break;
}
+ back_ok:
pos--, pos_byte -= nbytes;
}
else
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--;
}
}
return make_number (PT - start_point);
}
}
+
+/* Return 1 if character C belongs to one of the ISO classes
+ in the list ISO_CLASSES. Each class is represented by an
+ integer which is its type according to re_wctype. */
+
+static int
+in_classes (c, iso_classes)
+ int c;
+ Lisp_Object iso_classes;
+{
+ int fits_class = 0;
+
+ while (! NILP (iso_classes))
+ {
+ Lisp_Object elt;
+ elt = XCAR (iso_classes);
+ iso_classes = XCDR (iso_classes);
+
+ if (re_iswctype (c, XFASTINT (elt)))
+ fits_class = 1;
+ }
+
+ return fits_class;
+}
\f
/* Jump over a comment, assuming we are at the beginning of one.
FROM is the current position.
static int
forw_comment (from, from_byte, stop, nesting, style, prev_syntax,
charpos_ptr, bytepos_ptr, incomment_ptr)
- int from, from_byte, stop;
+ EMACS_INT from, from_byte, stop;
int nesting, style, prev_syntax;
- int *charpos_ptr, *bytepos_ptr, *incomment_ptr;
+ EMACS_INT *charpos_ptr, *bytepos_ptr;
+ int *incomment_ptr;
{
register int c, c1;
register enum syntaxcode code;
(count)
Lisp_Object count;
{
- register int from;
- int from_byte;
- register int stop;
+ register EMACS_INT from;
+ EMACS_INT from_byte;
+ register EMACS_INT stop;
register int c, c1;
register enum syntaxcode code;
int comstyle = 0; /* style of comment encountered */
int comnested = 0; /* whether the comment is nestable or not */
int found;
- int count1;
- int out_charpos, out_bytepos;
+ EMACS_INT count1;
+ EMACS_INT out_charpos, out_bytepos;
int dummy;
CHECK_NUMBER (count);
while (1)
{
DEC_BOTH (from, from_byte);
- if (from == stop)
- break;
UPDATE_SYNTAX_TABLE_BACKWARD (from);
c = FETCH_CHAR (from_byte);
if (SYNTAX (c) == Scomment_fence
found = 1;
break;
}
+ else if (from == stop)
+ break;
}
if (found == 0)
{
from_byte = ini_byte;
goto leave;
}
+ else
+ /* We have skipped one comment. */
+ break;
}
else if (code == Sendcomment)
{
static Lisp_Object
scan_lists (from, count, depth, sexpflag)
- register int from;
- int count, depth, sexpflag;
+ register EMACS_INT from;
+ EMACS_INT count, depth;
+ int sexpflag;
{
Lisp_Object val;
- register int stop = count > 0 ? ZV : BEGV;
+ register EMACS_INT stop = count > 0 ? ZV : BEGV;
register int c, c1;
int stringterm;
int quoted;
int min_depth = depth; /* Err out if depth gets less than this. */
int comstyle = 0; /* style of comment encountered */
int comnested = 0; /* whether the comment is nestable or not */
- int temp_pos;
- int last_good = from;
+ EMACS_INT temp_pos;
+ EMACS_INT last_good = from;
int found;
- int from_byte;
- int out_bytepos, out_charpos;
+ EMACS_INT from_byte;
+ EMACS_INT out_bytepos, out_charpos;
int temp, dummy;
int multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
close1:
if (!--depth) goto done;
if (depth < min_depth)
- Fsignal (Qscan_error,
- Fcons (build_string ("Containing expression ends prematurely"),
- Fcons (make_number (last_good),
- Fcons (make_number (from), Qnil))));
+ xsignal3 (Qscan_error,
+ build_string ("Containing expression ends prematurely"),
+ make_number (last_good), make_number (from));
break;
case Sstring:
open2:
if (!--depth) goto done2;
if (depth < min_depth)
- Fsignal (Qscan_error,
- Fcons (build_string ("Containing expression ends prematurely"),
- Fcons (make_number (last_good),
- Fcons (make_number (from), Qnil))));
+ xsignal3 (Qscan_error,
+ build_string ("Containing expression ends prematurely"),
+ make_number (last_good), make_number (from));
break;
case Sendcomment:
return val;
lose:
- Fsignal (Qscan_error,
- Fcons (build_string ("Unbalanced parentheses"),
- Fcons (make_number (last_good),
- Fcons (make_number (from), Qnil))));
- abort ();
- /* NOTREACHED */
+ xsignal3 (Qscan_error,
+ build_string ("Unbalanced parentheses"),
+ make_number (last_good), make_number (from));
}
DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0,
int boundary_stop = commentstop == -1;
int nofence;
int found;
- int out_bytepos, out_charpos;
+ EMACS_INT out_bytepos, out_charpos;
int temp;
prev_from = from;
INC_FROM;
code = prev_from_syntax & 0xff;
- if (code == Scomment)
+ if (from < end
+ && SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
+ && (c1 = FETCH_CHAR (from_byte),
+ SYNTAX_COMSTART_SECOND (c1)))
+ /* Duplicate code to avoid a complex if-expression
+ which causes trouble for the SGI compiler. */
{
- state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax);
- state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
- 1 : -1);
+ /* Record the comment style we have entered so that only
+ the comment-end sequence of the same style actually
+ terminates the comment section. */
+ state.comstyle = SYNTAX_COMMENT_STYLE (c1);
+ comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax);
+ comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
+ state.incomment = comnested ? 1 : -1;
state.comstr_start = prev_from;
+ INC_FROM;
+ code = Scomment;
}
else if (code == Scomment_fence)
{
state.comstr_start = prev_from;
code = Scomment;
}
- else if (from < end)
- if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax))
- if (c1 = FETCH_CHAR (from_byte),
- SYNTAX_COMSTART_SECOND (c1))
- /* Duplicate code to avoid a complex if-expression
- which causes trouble for the SGI compiler. */
- {
- /* Record the comment style we have entered so that only
- the comment-end sequence of the same style actually
- terminates the comment section. */
- state.comstyle = SYNTAX_COMMENT_STYLE (c1);
- comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax);
- comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
- state.incomment = comnested ? 1 : -1;
- state.comstr_start = prev_from;
- INC_FROM;
- code = Scomment;
- }
+ else if (code == Scomment)
+ {
+ 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;
point is set to where parsing stops.
If fifth arg OLDSTATE is omitted or nil,
parsing assumes that FROM is the beginning of a function.
-Value is a list of ten elements describing final state of parsing:
+Value is a list of elements describing final state of parsing:
0. depth in parens.
1. character address of start of innermost containing list; nil if none.
2. character address of start of last complete sexp terminated.
in parentheses becomes equal to TARGETDEPTH.
Fourth arg STOPBEFORE non-nil means stop when come to
any character that starts a sexp.
-Fifth arg OLDSTATE is a nine-element list like what this function returns.
+Fifth arg OLDSTATE is a list like what this function returns.
It is used to initialize the state of the parse. Elements number 1, 2, 6
and 8 are ignored; you can leave off element 8 (the last) entirely.
Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
Vstandard_syntax_table = Fmake_char_table (Qsyntax_table, temp);
+ /* Control characters should not be whitespace. */
+ 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);
+
+ /* Except that a few really are whitespace. */
+ 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);
staticpro (&Vsyntax_code_object);
+ staticpro (&gl_state.object);
+ staticpro (&gl_state.global_code);
+ staticpro (&gl_state.current_syntax_table);
+ staticpro (&gl_state.old_prop);
+
+ /* Defined in regex.c */
+ staticpro (&re_match_object);
+
Qscan_error = intern ("scan-error");
staticpro (&Qscan_error);
Fput (Qscan_error, Qerror_conditions,