Update years in copyright notice; nfc.
[bpt/emacs.git] / src / syntax.c
CommitLineData
8489eb67 1/* GNU Emacs routines to deal with syntax tables; also word and list parsing.
0b5538bd
TTN
2 Copyright (C) 1985, 1987, 1993, 1994, 1995, 1997, 1998, 1999, 2002,
3 2003, 2004, 2005 Free Software Foundation, Inc.
8489eb67
RS
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
a4275ad1 9the Free Software Foundation; either version 2, or (at your option)
8489eb67
RS
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
4fc5845f
LK
19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20Boston, MA 02110-1301, USA. */
8489eb67
RS
21
22
18160b98 23#include <config.h>
8489eb67
RS
24#include <ctype.h>
25#include "lisp.h"
26#include "commands.h"
27#include "buffer.h"
93da5fff 28#include "charset.h"
e35f6ff7 29#include "keymap.h"
a1bc88d4 30#include "regex.h"
195d1361
RS
31
32/* Make syntax table lookup grant data in gl_state. */
33#define SYNTAX_ENTRY_VIA_PROPERTY
34
8489eb67 35#include "syntax.h"
195d1361
RS
36#include "intervals.h"
37
38/* We use these constants in place for comment-style and
39 string-ender-char to distinguish comments/strings started by
40 comment_fence and string_fence codes. */
41
42#define ST_COMMENT_STYLE (256 + 1)
43#define ST_STRING_STYLE (256 + 2)
93da5fff 44#include "category.h"
8489eb67 45
7bf5e9e4 46Lisp_Object Qsyntax_table_p, Qsyntax_table, Qscan_error;
8489eb67
RS
47
48int words_include_escapes;
195d1361 49int parse_sexp_lookup_properties;
8489eb67 50
bd25db08
KH
51/* Nonzero means `scan-sexps' treat all multibyte characters as symbol. */
52int multibyte_syntax_as_symbol;
53
8ea151b2
RS
54/* Used as a temporary in SYNTAX_ENTRY and other macros in syntax.h,
55 if not compiled with GCC. No need to mark it, since it is used
56 only very temporarily. */
57Lisp_Object syntax_temp;
58
f4ed767f
GM
59/* Non-zero means an open parenthesis in column 0 is always considered
60 to be the start of a defun. Zero means an open parenthesis in
61 column 0 has no special meaning. */
62
63int open_paren_in_column_0_is_defun_start;
64
e5d4f4dc
RS
65/* This is the internal form of the parse state used in parse-partial-sexp. */
66
67struct lisp_parse_state
68 {
195d1361
RS
69 int depth; /* Depth at end of parsing. */
70 int instring; /* -1 if not within string, else desired terminator. */
95ff8dfc 71 int incomment; /* -1 if in unnestable comment else comment nesting */
195d1361 72 int comstyle; /* comment style a=0, or b=1, or ST_COMMENT_STYLE. */
e5d4f4dc
RS
73 int quoted; /* Nonzero if just after an escape char at end of parsing */
74 int thislevelstart; /* Char number of most recent start-of-expression at current level */
75 int prevlevelstart; /* Char number of start of containing expression */
195d1361 76 int location; /* Char number at which parsing stopped. */
e5d4f4dc 77 int mindepth; /* Minimum depth seen while scanning. */
195d1361 78 int comstr_start; /* Position just after last comment/string starter. */
1a102a58
RS
79 Lisp_Object levelstarts; /* Char numbers of starts-of-expression
80 of levels (starting from outermost). */
e5d4f4dc
RS
81 };
82\f
37bef230
RS
83/* These variables are a cache for finding the start of a defun.
84 find_start_pos is the place for which the defun start was found.
85 find_start_value is the defun start position found for it.
6a140a74 86 find_start_value_byte is the corresponding byte position.
37bef230
RS
87 find_start_buffer is the buffer it was found in.
88 find_start_begv is the BEGV value when it was found.
89 find_start_modiff is the value of MODIFF when it was found. */
90
91static int find_start_pos;
92static int find_start_value;
6a140a74 93static int find_start_value_byte;
37bef230
RS
94static struct buffer *find_start_buffer;
95static int find_start_begv;
96static int find_start_modiff;
6a140a74
RS
97
98
99static int find_defun_start P_ ((int, int));
95ff8dfc 100static int back_comment P_ ((int, int, int, int, int, int *, int *));
6a140a74 101static int char_quoted P_ ((int, int));
a1bc88d4 102static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object, int));
6a140a74
RS
103static Lisp_Object scan_lists P_ ((int, int, int, int));
104static void scan_sexps_forward P_ ((struct lisp_parse_state *,
105 int, int, int, int,
106 int, Lisp_Object, int));
a1bc88d4 107static int in_classes P_ ((int, Lisp_Object));
195d1361
RS
108\f
109
110struct gl_state_s gl_state; /* Global state of syntax parser. */
111
112INTERVAL interval_of ();
113#define INTERVALS_AT_ONCE 10 /* 1 + max-number of intervals
114 to scan to property-change. */
115
6a140a74
RS
116/* Update gl_state to an appropriate interval which contains CHARPOS. The
117 sign of COUNT give the relative position of CHARPOS wrt the previously
195d1361 118 valid interval. If INIT, only [be]_property fields of gl_state are
6a140a74 119 valid at start, the rest is filled basing on OBJECT.
195d1361 120
6a140a74 121 `gl_state.*_i' are the intervals, and CHARPOS is further in the search
195d1361
RS
122 direction than the intervals - or in an interval. We update the
123 current syntax-table basing on the property of this interval, and
6a140a74 124 update the interval to start further than CHARPOS - or be
195d1361 125 NULL_INTERVAL. We also update lim_property to be the next value of
6a140a74 126 charpos to call this subroutine again - or be before/after the
195d1361
RS
127 start/end of OBJECT. */
128
129void
6a140a74
RS
130update_syntax_table (charpos, count, init, object)
131 int charpos, count, init;
195d1361
RS
132 Lisp_Object object;
133{
134 Lisp_Object tmp_table;
4ffe723b 135 int cnt = 0, invalidate = 1;
195d1361
RS
136 INTERVAL i, oldi;
137
138 if (init)
139 {
bb0de084 140 gl_state.old_prop = Qnil;
195d1361
RS
141 gl_state.start = gl_state.b_property;
142 gl_state.stop = gl_state.e_property;
bb0de084
SM
143 i = interval_of (charpos, object);
144 gl_state.backward_i = gl_state.forward_i = i;
195d1361
RS
145 invalidate = 0;
146 if (NULL_INTERVAL_P (i))
147 return;
f902a008 148 /* interval_of updates only ->position of the return value, so
d80f4cc7 149 update the parents manually to speed up update_interval. */
bb0de084 150 while (!NULL_PARENT (i))
d80f4cc7
RS
151 {
152 if (AM_RIGHT_CHILD (i))
439d5cb4 153 INTERVAL_PARENT (i)->position = i->position
d80f4cc7 154 - LEFT_TOTAL_LENGTH (i) + TOTAL_LENGTH (i) /* right end */
439d5cb4
KR
155 - TOTAL_LENGTH (INTERVAL_PARENT (i))
156 + LEFT_TOTAL_LENGTH (INTERVAL_PARENT (i));
d80f4cc7 157 else
439d5cb4 158 INTERVAL_PARENT (i)->position = i->position - LEFT_TOTAL_LENGTH (i)
d80f4cc7 159 + TOTAL_LENGTH (i);
439d5cb4 160 i = INTERVAL_PARENT (i);
d80f4cc7
RS
161 }
162 i = gl_state.forward_i;
bb0de084 163 gl_state.b_property = i->position - gl_state.offset;
ee0cdb48 164 gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset;
195d1361
RS
165 goto update;
166 }
167 oldi = i = count > 0 ? gl_state.forward_i : gl_state.backward_i;
168
423e705d 169 /* We are guaranteed to be called with CHARPOS either in i,
6a140a74 170 or further off. */
195d1361
RS
171 if (NULL_INTERVAL_P (i))
172 error ("Error in syntax_table logic for to-the-end intervals");
6a140a74 173 else if (charpos < i->position) /* Move left. */
195d1361
RS
174 {
175 if (count > 0)
f902a008 176 error ("Error in syntax_table logic for intervals <-");
195d1361 177 /* Update the interval. */
6a140a74 178 i = update_interval (i, charpos);
bb0de084 179 if (INTERVAL_LAST_POS (i) != gl_state.b_property)
195d1361
RS
180 {
181 invalidate = 0;
195d1361 182 gl_state.forward_i = i;
ee0cdb48 183 gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset;
195d1361 184 }
423e705d 185 }
6a140a74 186 else if (charpos >= INTERVAL_LAST_POS (i)) /* Move right. */
195d1361
RS
187 {
188 if (count < 0)
f902a008 189 error ("Error in syntax_table logic for intervals ->");
195d1361 190 /* Update the interval. */
6a140a74 191 i = update_interval (i, charpos);
bb0de084 192 if (i->position != gl_state.e_property)
195d1361
RS
193 {
194 invalidate = 0;
195d1361 195 gl_state.backward_i = i;
bb0de084 196 gl_state.b_property = i->position - gl_state.offset;
195d1361
RS
197 }
198 }
195d1361
RS
199
200 update:
201 tmp_table = textget (i->plist, Qsyntax_table);
202
203 if (invalidate)
204 invalidate = !EQ (tmp_table, gl_state.old_prop); /* Need to invalidate? */
7d0393cf 205
423e705d
SM
206 if (invalidate) /* Did not get to adjacent interval. */
207 { /* with the same table => */
208 /* invalidate the old range. */
195d1361
RS
209 if (count > 0)
210 {
211 gl_state.backward_i = i;
bb0de084
SM
212 gl_state.b_property = i->position - gl_state.offset;
213 }
214 else
195d1361 215 {
bb0de084 216 gl_state.forward_i = i;
ee0cdb48 217 gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset;
195d1361
RS
218 }
219 }
37bef230 220
bb0de084 221 if (!EQ (tmp_table, gl_state.old_prop))
195d1361 222 {
bb0de084
SM
223 gl_state.current_syntax_table = tmp_table;
224 gl_state.old_prop = tmp_table;
225 if (EQ (Fsyntax_table_p (tmp_table), Qt))
226 {
227 gl_state.use_global = 0;
7d0393cf 228 }
bb0de084
SM
229 else if (CONSP (tmp_table))
230 {
231 gl_state.use_global = 1;
232 gl_state.global_code = tmp_table;
233 }
7d0393cf 234 else
bb0de084
SM
235 {
236 gl_state.use_global = 0;
237 gl_state.current_syntax_table = current_buffer->syntax_table;
238 }
195d1361
RS
239 }
240
241 while (!NULL_INTERVAL_P (i))
242 {
243 if (cnt && !EQ (tmp_table, textget (i->plist, Qsyntax_table)))
244 {
245 if (count > 0)
bb0de084
SM
246 {
247 gl_state.e_property = i->position - gl_state.offset;
248 gl_state.forward_i = i;
249 }
250 else
251 {
252 gl_state.b_property = i->position + LENGTH (i) - gl_state.offset;
253 gl_state.backward_i = i;
254 }
255 return;
195d1361 256 }
7d0393cf 257 else if (cnt == INTERVALS_AT_ONCE)
195d1361
RS
258 {
259 if (count > 0)
bb0de084
SM
260 {
261 gl_state.e_property = i->position + LENGTH (i) - gl_state.offset;
262 gl_state.forward_i = i;
263 }
264 else
265 {
266 gl_state.b_property = i->position - gl_state.offset;
267 gl_state.backward_i = i;
268 }
269 return;
195d1361
RS
270 }
271 cnt++;
272 i = count > 0 ? next_interval (i) : previous_interval (i);
273 }
bb0de084
SM
274 eassert (NULL_INTERVAL_P (i)); /* This property goes to the end. */
275 if (count > 0)
276 gl_state.e_property = gl_state.stop;
277 else
278 gl_state.b_property = gl_state.start;
195d1361
RS
279}
280\f
6a140a74
RS
281/* Returns TRUE if char at CHARPOS is quoted.
282 Global syntax-table data should be set up already to be good at CHARPOS
283 or after. On return global syntax data is good for lookup at CHARPOS. */
195d1361
RS
284
285static int
6a140a74
RS
286char_quoted (charpos, bytepos)
287 register int charpos, bytepos;
195d1361
RS
288{
289 register enum syntaxcode code;
290 register int beg = BEGV;
291 register int quoted = 0;
6a140a74
RS
292 int orig = charpos;
293
294 DEC_BOTH (charpos, bytepos);
195d1361 295
709a47ce 296 while (charpos >= beg)
195d1361 297 {
ab229fdd
AS
298 int c;
299
6a140a74 300 UPDATE_SYNTAX_TABLE_BACKWARD (charpos);
ab229fdd
AS
301 c = FETCH_CHAR (bytepos);
302 code = SYNTAX (c);
6a140a74
RS
303 if (! (code == Scharquote || code == Sescape))
304 break;
305
306 DEC_BOTH (charpos, bytepos);
307 quoted = !quoted;
195d1361 308 }
6a140a74
RS
309
310 UPDATE_SYNTAX_TABLE (orig);
195d1361
RS
311 return quoted;
312}
6a140a74
RS
313
314/* Return the bytepos one character after BYTEPOS.
315 We assume that BYTEPOS is not at the end of the buffer. */
316
317INLINE int
318inc_bytepos (bytepos)
319 int bytepos;
320{
ef316cf0
RS
321 if (NILP (current_buffer->enable_multibyte_characters))
322 return bytepos + 1;
323
6a140a74
RS
324 INC_POS (bytepos);
325 return bytepos;
326}
327
328/* Return the bytepos one character before BYTEPOS.
329 We assume that BYTEPOS is not at the start of the buffer. */
330
331INLINE int
332dec_bytepos (bytepos)
333 int bytepos;
334{
ef316cf0
RS
335 if (NILP (current_buffer->enable_multibyte_characters))
336 return bytepos - 1;
337
6a140a74
RS
338 DEC_POS (bytepos);
339 return bytepos;
340}
195d1361 341\f
7cc80f0a
RS
342/* Return a defun-start position before before POS and not too far before.
343 It should be the last one before POS, or nearly the last.
344
345 When open_paren_in_column_0_is_defun_start is nonzero,
1fd1cc2f 346 only the beginning of the buffer is treated as a defun-start.
7cc80f0a
RS
347
348 We record the information about where the scan started
349 and what its result was, so that another call in the same area
350 can return the same value very quickly.
195d1361
RS
351
352 There is no promise at which position the global syntax data is
353 valid on return from the subroutine, so the caller should explicitly
354 update the global data. */
37bef230
RS
355
356static int
6a140a74
RS
357find_defun_start (pos, pos_byte)
358 int pos, pos_byte;
37bef230 359{
6a140a74 360 int opoint = PT, opoint_byte = PT_BYTE;
37bef230 361
1fd1cc2f
RS
362 if (!open_paren_in_column_0_is_defun_start)
363 {
364 find_start_value_byte = BEGV_BYTE;
365 return BEGV;
366 }
367
37bef230
RS
368 /* Use previous finding, if it's valid and applies to this inquiry. */
369 if (current_buffer == find_start_buffer
370 /* Reuse the defun-start even if POS is a little farther on.
371 POS might be in the next defun, but that's ok.
372 Our value may not be the best possible, but will still be usable. */
373 && pos <= find_start_pos + 1000
374 && pos >= find_start_value
375 && BEGV == find_start_begv
376 && MODIFF == find_start_modiff)
377 return find_start_value;
378
379 /* Back up to start of line. */
6a140a74 380 scan_newline (pos, pos_byte, BEGV, BEGV_BYTE, -1, 1);
37bef230 381
195d1361
RS
382 /* We optimize syntax-table lookup for rare updates. Thus we accept
383 only those `^\s(' which are good in global _and_ text-property
384 syntax-tables. */
385 gl_state.current_syntax_table = current_buffer->syntax_table;
386 gl_state.use_global = 0;
1fd1cc2f 387 while (PT > BEGV)
37bef230 388 {
ab229fdd
AS
389 int c;
390
1fd1cc2f
RS
391 /* Open-paren at start of line means we may have found our
392 defun-start. */
ab229fdd
AS
393 c = FETCH_CHAR (PT_BYTE);
394 if (SYNTAX (c) == Sopen)
195d1361 395 {
1fd1cc2f 396 SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */
ab229fdd
AS
397 c = FETCH_CHAR (PT_BYTE);
398 if (SYNTAX (c) == Sopen)
1fd1cc2f
RS
399 break;
400 /* Now fallback to the default value. */
401 gl_state.current_syntax_table = current_buffer->syntax_table;
402 gl_state.use_global = 0;
195d1361 403 }
1fd1cc2f
RS
404 /* Move to beg of previous line. */
405 scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1);
37bef230
RS
406 }
407
408 /* Record what we found, for the next try. */
6a140a74
RS
409 find_start_value = PT;
410 find_start_value_byte = PT_BYTE;
37bef230
RS
411 find_start_buffer = current_buffer;
412 find_start_modiff = MODIFF;
413 find_start_begv = BEGV;
414 find_start_pos = pos;
415
6a140a74
RS
416 TEMP_SET_PT_BOTH (opoint, opoint_byte);
417
37bef230
RS
418 return find_start_value;
419}
420\f
f902a008
RS
421/* Return the SYNTAX_COMEND_FIRST of the character before POS, POS_BYTE. */
422
423static int
424prev_char_comend_first (pos, pos_byte)
425 int pos, pos_byte;
426{
427 int c, val;
428
429 DEC_BOTH (pos, pos_byte);
430 UPDATE_SYNTAX_TABLE_BACKWARD (pos);
431 c = FETCH_CHAR (pos_byte);
432 val = SYNTAX_COMEND_FIRST (c);
433 UPDATE_SYNTAX_TABLE_FORWARD (pos + 1);
434 return val;
435}
436
437/* Return the SYNTAX_COMSTART_FIRST of the character before POS, POS_BYTE. */
438
3f679f55
SM
439/* static int
440 * prev_char_comstart_first (pos, pos_byte)
441 * int pos, pos_byte;
442 * {
443 * int c, val;
7d0393cf 444 *
3f679f55
SM
445 * DEC_BOTH (pos, pos_byte);
446 * UPDATE_SYNTAX_TABLE_BACKWARD (pos);
447 * c = FETCH_CHAR (pos_byte);
448 * val = SYNTAX_COMSTART_FIRST (c);
449 * UPDATE_SYNTAX_TABLE_FORWARD (pos + 1);
450 * return val;
451 * } */
f902a008 452
6a140a74
RS
453/* Checks whether charpos FROM is at the end of a comment.
454 FROM_BYTE is the bytepos corresponding to FROM.
455 Do not move back before STOP.
456
457 Return a positive value if we find a comment ending at FROM/FROM_BYTE;
458 return -1 otherwise.
459
460 If successful, store the charpos of the comment's beginning
461 into *CHARPOS_PTR, and the bytepos into *BYTEPOS_PTR.
527a32d9
KH
462
463 Global syntax data remains valid for backward search starting at
464 the returned value (or at FROM, if the search was not successful). */
195d1361
RS
465
466static int
95ff8dfc 467back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_ptr)
6a140a74 468 int from, from_byte, stop;
95ff8dfc 469 int comnested, comstyle;
6a140a74 470 int *charpos_ptr, *bytepos_ptr;
195d1361
RS
471{
472 /* Look back, counting the parity of string-quotes,
473 and recording the comment-starters seen.
474 When we reach a safe place, assume that's not in a string;
475 then step the main scan to the earliest comment-starter seen
476 an even number of string quotes away from the safe place.
477
478 OFROM[I] is position of the earliest comment-starter seen
479 which is I+2X quotes from the comment-end.
480 PARITY is current parity of quotes from the comment end. */
3ee5041c 481 int string_style = -1; /* Presumed outside of any string. */
195d1361 482 int string_lossage = 0;
f7c436c1 483 /* Not a real lossage: indicates that we have passed a matching comment
7d0393cf 484 starter plus a non-matching comment-ender, meaning that any matching
f7c436c1
SM
485 comment-starter we might see later could be a false positive (hidden
486 inside another comment).
487 Test case: { a (* b } c (* d *) */
488 int comment_lossage = 0;
195d1361 489 int comment_end = from;
6a140a74 490 int comment_end_byte = from_byte;
195d1361 491 int comstart_pos = 0;
6a140a74 492 int comstart_byte;
eb35b628
RS
493 /* Place where the containing defun starts,
494 or 0 if we didn't come across it yet. */
495 int defun_start = 0;
496 int defun_start_byte = 0;
195d1361 497 register enum syntaxcode code;
95ff8dfc 498 int nesting = 1; /* current comment nesting */
ea315ed6 499 int c;
3f679f55
SM
500 int syntax = 0;
501
502 /* FIXME: A }} comment-ender style leads to incorrect behavior
503 in the case of {{ c }}} because we ignore the last two chars which are
504 assumed to be comment-enders although they aren't. */
195d1361
RS
505
506 /* At beginning of range to scan, we're outside of strings;
507 that determines quote parity to the comment-end. */
508 while (from != stop)
509 {
3f679f55
SM
510 int temp_byte, prev_syntax;
511 int com2start, com2end;
6a140a74 512
195d1361 513 /* Move back and examine a character. */
6a140a74 514 DEC_BOTH (from, from_byte);
195d1361
RS
515 UPDATE_SYNTAX_TABLE_BACKWARD (from);
516
3f679f55 517 prev_syntax = syntax;
6a140a74 518 c = FETCH_CHAR (from_byte);
3f679f55 519 syntax = SYNTAX_WITH_FLAGS (c);
195d1361
RS
520 code = SYNTAX (c);
521
3f679f55
SM
522 /* Check for 2-char comment markers. */
523 com2start = (SYNTAX_FLAGS_COMSTART_FIRST (syntax)
524 && SYNTAX_FLAGS_COMSTART_SECOND (prev_syntax)
525 && comstyle == SYNTAX_FLAGS_COMMENT_STYLE (prev_syntax)
526 && (SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax)
527 || SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested);
528 com2end = (SYNTAX_FLAGS_COMEND_FIRST (syntax)
529 && SYNTAX_FLAGS_COMEND_SECOND (prev_syntax));
530
531 /* Nasty cases with overlapping 2-char comment markers:
532 - snmp-mode: -- c -- foo -- c --
533 --- c --
534 ------ c --
535 - c-mode: *||*
536 |* *|* *|
537 |*| |* |*|
538 /// */
539
540 /* If a 2-char comment sequence partly overlaps with another,
541 we don't try to be clever. */
542 if (from > stop && (com2end || com2start))
195d1361 543 {
3f679f55
SM
544 int next = from, next_byte = from_byte, next_c, next_syntax;
545 DEC_BOTH (next, next_byte);
546 UPDATE_SYNTAX_TABLE_BACKWARD (next);
547 next_c = FETCH_CHAR (next_byte);
548 next_syntax = SYNTAX_WITH_FLAGS (next_c);
549 if (((com2start || comnested)
550 && SYNTAX_FLAGS_COMEND_SECOND (syntax)
551 && SYNTAX_FLAGS_COMEND_FIRST (next_syntax))
552 || ((com2end || comnested)
553 && SYNTAX_FLAGS_COMSTART_SECOND (syntax)
554 && comstyle == SYNTAX_FLAGS_COMMENT_STYLE (syntax)
555 && SYNTAX_FLAGS_COMSTART_FIRST (next_syntax)))
556 goto lossage;
557 /* UPDATE_SYNTAX_TABLE_FORWARD (next + 1); */
f902a008 558 }
3f679f55
SM
559
560 if (com2start && comstart_pos == 0)
561 /* We're looking at a comment starter. But it might be a comment
562 ender as well (see snmp-mode). The first time we see one, we
563 need to consider it as a comment starter,
564 and the subsequent times as a comment ender. */
565 com2end = 0;
566
567 /* Turn a 2-char comment sequences into the appropriate syntax. */
568 if (com2end)
569 code = Sendcomment;
570 else if (com2start)
571 code = Scomment;
572 /* Ignore comment starters of a different style. */
573 else if (code == Scomment
574 && (comstyle != SYNTAX_FLAGS_COMMENT_STYLE (syntax)
575 || SYNTAX_FLAGS_COMMENT_NESTED (syntax) != comnested))
1aa963c8 576 continue;
195d1361 577
9828a477
KH
578 /* Ignore escaped characters, except comment-enders. */
579 if (code != Sendcomment && char_quoted (from, from_byte))
195d1361
RS
580 continue;
581
3ee5041c 582 switch (code)
195d1361 583 {
3ee5041c
SM
584 case Sstring_fence:
585 case Scomment_fence:
586 c = (code == Sstring_fence ? ST_STRING_STYLE : ST_COMMENT_STYLE);
587 case Sstring:
588 /* Track parity of quotes. */
589 if (string_style == -1)
590 /* Entering a string. */
591 string_style = c;
592 else if (string_style == c)
593 /* Leaving the string. */
594 string_style = -1;
595 else
596 /* If we have two kinds of string delimiters.
597 There's no way to grok this scanning backwards. */
195d1361 598 string_lossage = 1;
3ee5041c 599 break;
7d0393cf 600
3ee5041c
SM
601 case Scomment:
602 /* We've already checked that it is the relevant comstyle. */
f7c436c1 603 if (string_style != -1 || comment_lossage || string_lossage)
3ee5041c
SM
604 /* There are odd string quotes involved, so let's be careful.
605 Test case in Pascal: " { " a { " } */
606 goto lossage;
607
f7c436c1
SM
608 if (!comnested)
609 {
610 /* Record best comment-starter so far. */
611 comstart_pos = from;
612 comstart_byte = from_byte;
613 }
614 else if (--nesting <= 0)
95ff8dfc
RS
615 /* nested comments have to be balanced, so we don't need to
616 keep looking for earlier ones. We use here the same (slightly
617 incorrect) reasoning as below: since it is followed by uniform
618 paired string quotes, this comment-start has to be outside of
619 strings, else the comment-end itself would be inside a string. */
620 goto done;
3ee5041c
SM
621 break;
622
02010917 623 case Sendcomment:
3f679f55 624 if (SYNTAX_FLAGS_COMMENT_STYLE (syntax) == comstyle
d070eb22 625 && ((com2end && SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax))
3f679f55 626 || SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested)
02010917
SM
627 /* This is the same style of comment ender as ours. */
628 {
629 if (comnested)
630 nesting++;
631 else
632 /* Anything before that can't count because it would match
633 this comment-ender rather than ours. */
634 from = stop; /* Break out of the loop. */
635 }
f7c436c1
SM
636 else if (comstart_pos != 0 || c != '\n')
637 /* We're mixing comment styles here, so we'd better be careful.
638 The (comstart_pos != 0 || c != '\n') check is not quite correct
639 (we should just always set comment_lossage), but removing it
640 would imply that any multiline comment in C would go through
641 lossage, which seems overkill.
642 The failure should only happen in the rare cases such as
643 { (* } *) */
644 comment_lossage = 1;
02010917 645 break;
195d1361 646
02010917
SM
647 case Sopen:
648 /* Assume a defun-start point is outside of strings. */
649 if (open_paren_in_column_0_is_defun_start
650 && (from == stop
651 || (temp_byte = dec_bytepos (from_byte),
652 FETCH_CHAR (temp_byte) == '\n')))
653 {
654 defun_start = from;
655 defun_start_byte = from_byte;
656 from = stop; /* Break out of the loop. */
657 }
eb35b628 658 break;
02010917
SM
659
660 default:
f7c436c1 661 break;
eb35b628 662 }
195d1361
RS
663 }
664
665 if (comstart_pos == 0)
666 {
667 from = comment_end;
6a140a74 668 from_byte = comment_end_byte;
195d1361
RS
669 UPDATE_SYNTAX_TABLE_FORWARD (comment_end - 1);
670 }
f7c436c1
SM
671 /* If comstart_pos is set and we get here (ie. didn't jump to `lossage'
672 or `done'), then we've found the beginning of the non-nested comment. */
673 else if (1) /* !comnested */
195d1361
RS
674 {
675 from = comstart_pos;
6a140a74 676 from_byte = comstart_byte;
789f3320 677 UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
195d1361
RS
678 }
679 else
680 {
3ee5041c
SM
681 struct lisp_parse_state state;
682 lossage:
195d1361
RS
683 /* We had two kinds of string delimiters mixed up
684 together. Decode this going forwards.
02010917 685 Scan fwd from a known safe place (beginning-of-defun)
195d1361
RS
686 to the one in question; this records where we
687 last passed a comment starter. */
eb35b628
RS
688 /* If we did not already find the defun start, find it now. */
689 if (defun_start == 0)
690 {
691 defun_start = find_defun_start (comment_end, comment_end_byte);
692 defun_start_byte = find_start_value_byte;
693 }
02010917 694 do
195d1361 695 {
02010917
SM
696 scan_sexps_forward (&state,
697 defun_start, defun_start_byte,
698 comment_end, -10000, 0, Qnil, 0);
699 defun_start = comment_end;
700 if (state.incomment == (comnested ? 1 : -1)
701 && state.comstyle == comstyle)
702 from = state.comstr_start;
703 else
704 {
705 from = comment_end;
706 if (state.incomment)
707 /* If comment_end is inside some other comment, maybe ours
708 is nested, so we need to try again from within the
709 surrounding comment. Example: { a (* " *) */
710 {
711 /* FIXME: We should advance by one or two chars. */
712 defun_start = state.comstr_start + 2;
713 defun_start_byte = CHAR_TO_BYTE (defun_start);
714 }
715 }
716 } while (defun_start < comment_end);
717
6a140a74 718 from_byte = CHAR_TO_BYTE (from);
195d1361
RS
719 UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
720 }
7d0393cf 721
95ff8dfc 722 done:
6a140a74
RS
723 *charpos_ptr = from;
724 *bytepos_ptr = from_byte;
725
1aa963c8 726 return (from == comment_end) ? -1 : from;
195d1361
RS
727}
728\f
8489eb67 729DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0,
fdb82f93
PJ
730 doc: /* Return t if OBJECT is a syntax table.
731Currently, any char-table counts as a syntax table. */)
732 (object)
2203e1e8 733 Lisp_Object object;
8489eb67 734{
2203e1e8 735 if (CHAR_TABLE_P (object)
e704cb4b 736 && EQ (XCHAR_TABLE (object)->purpose, Qsyntax_table))
8489eb67
RS
737 return Qt;
738 return Qnil;
739}
740
8ea151b2 741static void
8489eb67
RS
742check_syntax_table (obj)
743 Lisp_Object obj;
744{
d1be9f0f 745 if (!(CHAR_TABLE_P (obj)
e704cb4b 746 && EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table)))
d1be9f0f 747 wrong_type_argument (Qsyntax_table_p, obj);
7d0393cf 748}
8489eb67 749
8489eb67 750DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0,
fdb82f93
PJ
751 doc: /* Return the current syntax table.
752This is the one specified by the current buffer. */)
753 ()
8489eb67
RS
754{
755 return current_buffer->syntax_table;
756}
757
758DEFUN ("standard-syntax-table", Fstandard_syntax_table,
759 Sstandard_syntax_table, 0, 0, 0,
fdb82f93
PJ
760 doc: /* Return the standard syntax table.
761This is the one used for new buffers. */)
762 ()
8489eb67
RS
763{
764 return Vstandard_syntax_table;
765}
766
767DEFUN ("copy-syntax-table", Fcopy_syntax_table, Scopy_syntax_table, 0, 1, 0,
fdb82f93
PJ
768 doc: /* Construct a new syntax table and return it.
769It is a copy of the TABLE, which defaults to the standard syntax table. */)
770 (table)
8489eb67
RS
771 Lisp_Object table;
772{
8ea151b2
RS
773 Lisp_Object copy;
774
265a9e55 775 if (!NILP (table))
8ea151b2
RS
776 check_syntax_table (table);
777 else
778 table = Vstandard_syntax_table;
779
780 copy = Fcopy_sequence (table);
0f867324
RS
781
782 /* Only the standard syntax table should have a default element.
783 Other syntax tables should inherit from parents instead. */
784 XCHAR_TABLE (copy)->defalt = Qnil;
785
786 /* Copied syntax tables should all have parents.
787 If we copied one with no parent, such as the standard syntax table,
788 use the standard syntax table as the copy's parent. */
789 if (NILP (XCHAR_TABLE (copy)->parent))
790 Fset_char_table_parent (copy, Vstandard_syntax_table);
8ea151b2 791 return copy;
8489eb67
RS
792}
793
794DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 1, 0,
fdb82f93
PJ
795 doc: /* Select a new syntax table for the current buffer.
796One argument, a syntax table. */)
797 (table)
8489eb67
RS
798 Lisp_Object table;
799{
4e4dfa78 800 int idx;
8ea151b2 801 check_syntax_table (table);
8489eb67
RS
802 current_buffer->syntax_table = table;
803 /* Indicate that this buffer now has a specified syntax table. */
f6cd0527
GM
804 idx = PER_BUFFER_VAR_IDX (syntax_table);
805 SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);
8489eb67
RS
806 return table;
807}
808\f
809/* Convert a letter which signifies a syntax code
810 into the code it signifies.
195d1361 811 This is used by modify-syntax-entry, and other things. */
8489eb67
RS
812
813unsigned char syntax_spec_code[0400] =
814 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
815 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
816 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
817 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
195d1361 818 (char) Swhitespace, (char) Scomment_fence, (char) Sstring, 0377,
8489eb67
RS
819 (char) Smath, 0377, 0377, (char) Squote,
820 (char) Sopen, (char) Sclose, 0377, 0377,
821 0377, (char) Swhitespace, (char) Spunct, (char) Scharquote,
822 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
823 0377, 0377, 0377, 0377,
824 (char) Scomment, 0377, (char) Sendcomment, 0377,
6cb71bf6 825 (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */
8489eb67
RS
826 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
827 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
828 0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol,
829 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
830 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
831 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
195d1361 832 0377, 0377, 0377, 0377, (char) Sstring_fence, 0377, 0377, 0377
8489eb67
RS
833 };
834
195d1361 835/* Indexed by syntax code, give the letter that describes it. */
8489eb67 836
195d1361 837char syntax_code_spec[16] =
8489eb67 838 {
195d1361
RS
839 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@',
840 '!', '|'
8489eb67 841 };
93da5fff
KH
842
843/* Indexed by syntax code, give the object (cons of syntax code and
844 nil) to be stored in syntax table. Since these objects can be
845 shared among syntax tables, we generate them in advance. By
846 sharing objects, the function `describe-syntax' can give a more
847 compact listing. */
848static Lisp_Object Vsyntax_code_object;
849
8489eb67 850\f
8ea151b2
RS
851/* Look up the value for CHARACTER in syntax table TABLE's parent
852 and its parents. SYNTAX_ENTRY calls this, when TABLE itself has nil
853 for CHARACTER. It's actually used only when not compiled with GCC. */
854
855Lisp_Object
856syntax_parent_lookup (table, character)
857 Lisp_Object table;
858 int character;
859{
860 Lisp_Object value;
861
862 while (1)
863 {
864 table = XCHAR_TABLE (table)->parent;
865 if (NILP (table))
866 return Qnil;
867
868 value = XCHAR_TABLE (table)->contents[character];
869 if (!NILP (value))
870 return value;
871 }
872}
873
8489eb67 874DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0,
fdb82f93
PJ
875 doc: /* Return the syntax code of CHARACTER, described by a character.
876For example, if CHARACTER is a word constituent,
877the character `w' is returned.
878The characters that correspond to various syntax codes
879are listed in the documentation of `modify-syntax-entry'. */)
880 (character)
2203e1e8 881 Lisp_Object character;
8489eb67 882{
8ea151b2 883 int char_int;
195d1361
RS
884 gl_state.current_syntax_table = current_buffer->syntax_table;
885
886 gl_state.use_global = 0;
b7826503 887 CHECK_NUMBER (character);
2203e1e8 888 char_int = XINT (character);
8ea151b2 889 return make_number (syntax_code_spec[(int) SYNTAX (char_int)]);
beefa22e
RS
890}
891
892DEFUN ("matching-paren", Fmatching_paren, Smatching_paren, 1, 1, 0,
fdb82f93
PJ
893 doc: /* Return the matching parenthesis of CHARACTER, or nil if none. */)
894 (character)
2203e1e8 895 Lisp_Object character;
beefa22e 896{
8ea151b2 897 int char_int, code;
195d1361
RS
898 gl_state.current_syntax_table = current_buffer->syntax_table;
899 gl_state.use_global = 0;
b7826503 900 CHECK_NUMBER (character);
2203e1e8 901 char_int = XINT (character);
8ea151b2 902 code = SYNTAX (char_int);
a8bd7cd8 903 if (code == Sopen || code == Sclose)
2e34157c 904 return SYNTAX_MATCH (char_int);
beefa22e 905 return Qnil;
8489eb67
RS
906}
907
c65adb44 908DEFUN ("string-to-syntax", Fstring_to_syntax, Sstring_to_syntax, 1, 1, 0,
fdb82f93
PJ
909 doc: /* Convert a syntax specification STRING into syntax cell form.
910STRING should be a string as it is allowed as argument of
911`modify-syntax-entry'. Value is the equivalent cons cell
912(CODE . MATCHING-CHAR) that can be used as value of a `syntax-table'
913text property. */)
914 (string)
c65adb44 915 Lisp_Object string;
8489eb67 916{
2e567bd3 917 register const unsigned char *p;
8489eb67 918 register enum syntaxcode code;
247e20a8 919 int val;
8ea151b2 920 Lisp_Object match;
8489eb67 921
b7826503 922 CHECK_STRING (string);
8489eb67 923
d5db4077 924 p = SDATA (string);
8489eb67
RS
925 code = (enum syntaxcode) syntax_spec_code[*p++];
926 if (((int) code & 0377) == 0377)
b764a653 927 error ("Invalid syntax description letter: %c", p[-1]);
8489eb67 928
8ea151b2 929 if (code == Sinherit)
c65adb44 930 return Qnil;
8ea151b2
RS
931
932 if (*p)
d1be9f0f 933 {
93da5fff 934 int len;
7c19e8e1 935 int character = (STRING_CHAR_AND_LENGTH
d5db4077 936 (p, SBYTES (string) - 1, len));
93da5fff 937 XSETINT (match, character);
d1be9f0f
RS
938 if (XFASTINT (match) == ' ')
939 match = Qnil;
93da5fff 940 p += len;
d1be9f0f
RS
941 }
942 else
8ea151b2 943 match = Qnil;
8489eb67 944
8ea151b2 945 val = (int) code;
8489eb67
RS
946 while (*p)
947 switch (*p++)
948 {
949 case '1':
247e20a8 950 val |= 1 << 16;
8489eb67
RS
951 break;
952
953 case '2':
247e20a8 954 val |= 1 << 17;
8489eb67
RS
955 break;
956
957 case '3':
247e20a8 958 val |= 1 << 18;
8489eb67
RS
959 break;
960
961 case '4':
247e20a8 962 val |= 1 << 19;
8489eb67
RS
963 break;
964
965 case 'p':
247e20a8 966 val |= 1 << 20;
8489eb67 967 break;
e5d4f4dc
RS
968
969 case 'b':
247e20a8 970 val |= 1 << 21;
e5d4f4dc 971 break;
95ff8dfc
RS
972
973 case 'n':
974 val |= 1 << 22;
975 break;
8489eb67 976 }
7d0393cf 977
93da5fff 978 if (val < XVECTOR (Vsyntax_code_object)->size && NILP (match))
c65adb44 979 return XVECTOR (Vsyntax_code_object)->contents[val];
93da5fff
KH
980 else
981 /* Since we can't use a shared object, let's make a new one. */
c65adb44
SM
982 return Fcons (make_number (val), match);
983}
984
fdb82f93 985/* I really don't know why this is interactive
2c9e1900 986 help-form should at least be made useful whilst reading the second arg. */
7d0393cf 987DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3,
c65adb44 988 "cSet syntax for character: \nsSet syntax for %s to: ",
a50a10a0 989 doc: /* Set syntax for character CHAR according to string NEWENTRY.
d7ee9fab 990The syntax is changed only for table SYNTAX-TABLE, which defaults to
fdb82f93
PJ
991 the current buffer's syntax table.
992The first character of NEWENTRY should be one of the following:
993 Space or - whitespace syntax. w word constituent.
994 _ symbol constituent. . punctuation.
995 ( open-parenthesis. ) close-parenthesis.
996 " string quote. \\ escape.
997 $ paired delimiter. ' expression quote or prefix operator.
998 < comment starter. > comment ender.
999 / character-quote. @ inherit from `standard-syntax-table'.
1000 | generic string fence. ! generic comment fence.
1001
1002Only single-character comment start and end sequences are represented thus.
1003Two-character sequences are represented as described below.
1004The second character of NEWENTRY is the matching parenthesis,
1005 used only if the first character is `(' or `)'.
1006Any additional characters are flags.
1007Defined flags are the characters 1, 2, 3, 4, b, p, and n.
a50a10a0
PJ
1008 1 means CHAR is the start of a two-char comment start sequence.
1009 2 means CHAR is the second character of such a sequence.
1010 3 means CHAR is the start of a two-char comment end sequence.
1011 4 means CHAR is the second character of such a sequence.
fdb82f93
PJ
1012
1013There can be up to two orthogonal comment sequences. This is to support
1014language modes such as C++. By default, all comment sequences are of style
1015a, but you can set the comment sequence style to b (on the second character
1016of a comment-start, or the first character of a comment-end sequence) using
1017this flag:
a50a10a0
PJ
1018 b means CHAR is part of comment sequence b.
1019 n means CHAR is part of a nestable comment sequence.
fdb82f93 1020
a50a10a0 1021 p means CHAR is a prefix character for `backward-prefix-chars';
fdb82f93 1022 such characters are treated as whitespace when they occur
a50a10a0
PJ
1023 between expressions.
1024usage: (modify-syntax-entry CHAR NEWENTRY &optional SYNTAX-TABLE) */)
fdb82f93 1025 (c, newentry, syntax_table)
c65adb44
SM
1026 Lisp_Object c, newentry, syntax_table;
1027{
b7826503 1028 CHECK_NUMBER (c);
c65adb44
SM
1029
1030 if (NILP (syntax_table))
1031 syntax_table = current_buffer->syntax_table;
1032 else
1033 check_syntax_table (syntax_table);
8489eb67 1034
c65adb44 1035 SET_RAW_SYNTAX_ENTRY (syntax_table, XINT (c), Fstring_to_syntax (newentry));
8489eb67
RS
1036 return Qnil;
1037}
1038\f
1039/* Dump syntax table to buffer in human-readable format */
1040
62abe9cb
SM
1041DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
1042 Sinternal_describe_syntax_value, 1, 1, 0,
1043 doc: /* Insert a description of the internal syntax description SYNTAX at point. */)
1044 (syntax)
1045 Lisp_Object syntax;
8489eb67
RS
1046{
1047 register enum syntaxcode code;
e6365855 1048 char desc, start1, start2, end1, end2, prefix, comstyle, comnested;
8489eb67 1049 char str[2];
62abe9cb 1050 Lisp_Object first, match_lisp, value = syntax;
8489eb67 1051
8ea151b2
RS
1052 if (NILP (value))
1053 {
62abe9cb
SM
1054 insert_string ("default");
1055 return syntax;
8ea151b2
RS
1056 }
1057
908b7fea
KH
1058 if (CHAR_TABLE_P (value))
1059 {
62abe9cb
SM
1060 insert_string ("deeper char-table ...");
1061 return syntax;
908b7fea
KH
1062 }
1063
8ea151b2
RS
1064 if (!CONSP (value))
1065 {
62abe9cb
SM
1066 insert_string ("invalid");
1067 return syntax;
8ea151b2
RS
1068 }
1069
c1d497be
KR
1070 first = XCAR (value);
1071 match_lisp = XCDR (value);
8ea151b2
RS
1072
1073 if (!INTEGERP (first) || !(NILP (match_lisp) || INTEGERP (match_lisp)))
8489eb67 1074 {
62abe9cb
SM
1075 insert_string ("invalid");
1076 return syntax;
8489eb67
RS
1077 }
1078
e704cb4b 1079 code = (enum syntaxcode) (XINT (first) & 0377);
8ea151b2
RS
1080 start1 = (XINT (first) >> 16) & 1;
1081 start2 = (XINT (first) >> 17) & 1;
1082 end1 = (XINT (first) >> 18) & 1;
1083 end2 = (XINT (first) >> 19) & 1;
1084 prefix = (XINT (first) >> 20) & 1;
1085 comstyle = (XINT (first) >> 21) & 1;
e6365855 1086 comnested = (XINT (first) >> 22) & 1;
8489eb67
RS
1087
1088 if ((int) code < 0 || (int) code >= (int) Smax)
1089 {
1090 insert_string ("invalid");
62abe9cb 1091 return syntax;
8489eb67
RS
1092 }
1093 desc = syntax_code_spec[(int) code];
1094
1095 str[0] = desc, str[1] = 0;
1096 insert (str, 1);
1097
93da5fff
KH
1098 if (NILP (match_lisp))
1099 insert (" ", 1);
1100 else
1101 insert_char (XINT (match_lisp));
8489eb67 1102
8489eb67
RS
1103 if (start1)
1104 insert ("1", 1);
1105 if (start2)
1106 insert ("2", 1);
1107
1108 if (end1)
1109 insert ("3", 1);
1110 if (end2)
1111 insert ("4", 1);
1112
1113 if (prefix)
1114 insert ("p", 1);
e5d4f4dc
RS
1115 if (comstyle)
1116 insert ("b", 1);
e6365855
SM
1117 if (comnested)
1118 insert ("n", 1);
8489eb67
RS
1119
1120 insert_string ("\twhich means: ");
1121
0220c518 1122 switch (SWITCH_ENUM_CAST (code))
8489eb67
RS
1123 {
1124 case Swhitespace:
1125 insert_string ("whitespace"); break;
1126 case Spunct:
1127 insert_string ("punctuation"); break;
1128 case Sword:
1129 insert_string ("word"); break;
1130 case Ssymbol:
1131 insert_string ("symbol"); break;
1132 case Sopen:
1133 insert_string ("open"); break;
1134 case Sclose:
1135 insert_string ("close"); break;
1136 case Squote:
d671382e 1137 insert_string ("prefix"); break;
8489eb67
RS
1138 case Sstring:
1139 insert_string ("string"); break;
1140 case Smath:
1141 insert_string ("math"); break;
1142 case Sescape:
1143 insert_string ("escape"); break;
1144 case Scharquote:
1145 insert_string ("charquote"); break;
1146 case Scomment:
1147 insert_string ("comment"); break;
1148 case Sendcomment:
1149 insert_string ("endcomment"); break;
d671382e
SM
1150 case Sinherit:
1151 insert_string ("inherit"); break;
1152 case Scomment_fence:
1153 insert_string ("comment fence"); break;
1154 case Sstring_fence:
1155 insert_string ("string fence"); break;
8489eb67
RS
1156 default:
1157 insert_string ("invalid");
62abe9cb 1158 return syntax;
8489eb67
RS
1159 }
1160
8ea151b2 1161 if (!NILP (match_lisp))
8489eb67
RS
1162 {
1163 insert_string (", matches ");
8ea151b2 1164 insert_char (XINT (match_lisp));
8489eb67
RS
1165 }
1166
1167 if (start1)
1168 insert_string (",\n\t is the first character of a comment-start sequence");
1169 if (start2)
1170 insert_string (",\n\t is the second character of a comment-start sequence");
1171
1172 if (end1)
1173 insert_string (",\n\t is the first character of a comment-end sequence");
1174 if (end2)
1175 insert_string (",\n\t is the second character of a comment-end sequence");
e5d4f4dc
RS
1176 if (comstyle)
1177 insert_string (" (comment style b)");
e6365855
SM
1178 if (comnested)
1179 insert_string (" (nestable)");
e5d4f4dc 1180
8489eb67
RS
1181 if (prefix)
1182 insert_string (",\n\t is a prefix character for `backward-prefix-chars'");
1183
62abe9cb
SM
1184 return syntax;
1185}
8489eb67 1186\f
195d1361
RS
1187int parse_sexp_ignore_comments;
1188
8489eb67
RS
1189/* Return the position across COUNT words from FROM.
1190 If that many words cannot be found before the end of the buffer, return 0.
1191 COUNT negative means scan backward and stop at word beginning. */
1192
dfcf069d 1193int
8489eb67
RS
1194scan_words (from, count)
1195 register int from, count;
1196{
1197 register int beg = BEGV;
1198 register int end = ZV;
6a140a74 1199 register int from_byte = CHAR_TO_BYTE (from);
93da5fff
KH
1200 register enum syntaxcode code;
1201 int ch0, ch1;
8489eb67
RS
1202
1203 immediate_quit = 1;
1204 QUIT;
1205
195d1361
RS
1206 SETUP_SYNTAX_TABLE (from, count);
1207
8489eb67
RS
1208 while (count > 0)
1209 {
1210 while (1)
1211 {
1212 if (from == end)
1213 {
1214 immediate_quit = 0;
1215 return 0;
1216 }
195d1361 1217 UPDATE_SYNTAX_TABLE_FORWARD (from);
6a140a74 1218 ch0 = FETCH_CHAR (from_byte);
93da5fff 1219 code = SYNTAX (ch0);
6a140a74 1220 INC_BOTH (from, from_byte);
8489eb67
RS
1221 if (words_include_escapes
1222 && (code == Sescape || code == Scharquote))
1223 break;
1224 if (code == Sword)
1225 break;
8489eb67 1226 }
93da5fff
KH
1227 /* Now CH0 is a character which begins a word and FROM is the
1228 position of the next character. */
8489eb67
RS
1229 while (1)
1230 {
1231 if (from == end) break;
195d1361 1232 UPDATE_SYNTAX_TABLE_FORWARD (from);
6a140a74 1233 ch1 = FETCH_CHAR (from_byte);
93da5fff 1234 code = SYNTAX (ch1);
8489eb67
RS
1235 if (!(words_include_escapes
1236 && (code == Sescape || code == Scharquote)))
93da5fff 1237 if (code != Sword || WORD_BOUNDARY_P (ch0, ch1))
8489eb67 1238 break;
6a140a74 1239 INC_BOTH (from, from_byte);
93da5fff 1240 ch0 = ch1;
8489eb67
RS
1241 }
1242 count--;
1243 }
1244 while (count < 0)
1245 {
1246 while (1)
1247 {
1248 if (from == beg)
1249 {
1250 immediate_quit = 0;
1251 return 0;
1252 }
6a140a74 1253 DEC_BOTH (from, from_byte);
195d1361 1254 UPDATE_SYNTAX_TABLE_BACKWARD (from);
6a140a74 1255 ch1 = FETCH_CHAR (from_byte);
93da5fff 1256 code = SYNTAX (ch1);
8489eb67
RS
1257 if (words_include_escapes
1258 && (code == Sescape || code == Scharquote))
1259 break;
1260 if (code == Sword)
1261 break;
8489eb67 1262 }
93da5fff
KH
1263 /* Now CH1 is a character which ends a word and FROM is the
1264 position of it. */
8489eb67
RS
1265 while (1)
1266 {
6a140a74
RS
1267 int temp_byte;
1268
1269 if (from == beg)
1270 break;
1271 temp_byte = dec_bytepos (from_byte);
195d1361 1272 UPDATE_SYNTAX_TABLE_BACKWARD (from);
6a140a74 1273 ch0 = FETCH_CHAR (temp_byte);
93da5fff 1274 code = SYNTAX (ch0);
8489eb67
RS
1275 if (!(words_include_escapes
1276 && (code == Sescape || code == Scharquote)))
93da5fff 1277 if (code != Sword || WORD_BOUNDARY_P (ch0, ch1))
8489eb67 1278 break;
6a140a74 1279 DEC_BOTH (from, from_byte);
93da5fff 1280 ch1 = ch0;
8489eb67
RS
1281 }
1282 count++;
1283 }
1284
1285 immediate_quit = 0;
1286
1287 return from;
1288}
1289
29e16385 1290DEFUN ("forward-word", Fforward_word, Sforward_word, 0, 1, "p",
fdb82f93
PJ
1291 doc: /* Move point forward ARG words (backward if ARG is negative).
1292Normally returns t.
1293If an edge of the buffer or a field boundary is reached, point is left there
1294and the function returns nil. Field boundaries are not noticed if
1295`inhibit-field-text-motion' is non-nil. */)
29e16385
RS
1296 (arg)
1297 Lisp_Object arg;
8489eb67 1298{
c096ae4d 1299 Lisp_Object tmp;
2c6ea900 1300 int orig_val, val;
8489eb67 1301
29e16385
RS
1302 if (NILP (arg))
1303 XSETFASTINT (arg, 1);
1304 else
1305 CHECK_NUMBER (arg);
1306
1307 val = orig_val = scan_words (PT, XINT (arg));
2c6ea900 1308 if (! orig_val)
29e16385 1309 val = XINT (arg) > 0 ? ZV : BEGV;
5878ee6f 1310
b8855607 1311 /* Avoid jumping out of an input field. */
c096ae4d
SM
1312 tmp = Fconstrain_to_field (make_number (val), make_number (PT),
1313 Qt, Qnil, Qnil);
1314 val = XFASTINT (tmp);
7d0393cf 1315
8489eb67 1316 SET_PT (val);
e6d8341f 1317 return val == orig_val ? Qt : Qnil;
8489eb67
RS
1318}
1319\f
195d1361
RS
1320Lisp_Object skip_chars ();
1321
1322DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0,
fdb82f93
PJ
1323 doc: /* Move point forward, stopping before a char not in STRING, or at pos LIM.
1324STRING is like the inside of a `[...]' in a regular expression
1325except that `]' is never special and `\\' quotes `^', `-' or `\\'
1326 (but not as the end of a range; quoting is never needed there).
1327Thus, with arg "a-zA-Z", this skips letters stopping before first nonletter.
1328With arg "^a-zA-Z", skips nonletters stopping before first letter.
a1bc88d4
RS
1329Char classes, e.g. `[:alpha:]', are supported.
1330
1331Returns the distance traveled, either zero or positive. */)
fdb82f93 1332 (string, lim)
195d1361
RS
1333 Lisp_Object string, lim;
1334{
a1bc88d4 1335 return skip_chars (1, 0, string, lim, 1);
195d1361
RS
1336}
1337
1338DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
fdb82f93
PJ
1339 doc: /* Move point backward, stopping after a char not in STRING, or at pos LIM.
1340See `skip-chars-forward' for details.
1341Returns the distance traveled, either zero or negative. */)
1342 (string, lim)
195d1361
RS
1343 Lisp_Object string, lim;
1344{
a1bc88d4 1345 return skip_chars (0, 0, string, lim, 1);
195d1361
RS
1346}
1347
1348DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0,
fdb82f93
PJ
1349 doc: /* Move point forward across chars in specified syntax classes.
1350SYNTAX is a string of syntax code characters.
1351Stop before a char whose syntax is not in SYNTAX, or at position LIM.
1352If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
1353This function returns the distance traveled, either zero or positive. */)
1354 (syntax, lim)
195d1361
RS
1355 Lisp_Object syntax, lim;
1356{
a1bc88d4 1357 return skip_chars (1, 1, syntax, lim, 0);
195d1361
RS
1358}
1359
1360DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0,
fdb82f93
PJ
1361 doc: /* Move point backward across chars in specified syntax classes.
1362SYNTAX is a string of syntax code characters.
1363Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.
1364If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
1365This function returns the distance traveled, either zero or negative. */)
1366 (syntax, lim)
195d1361
RS
1367 Lisp_Object syntax, lim;
1368{
a1bc88d4 1369 return skip_chars (0, 1, syntax, lim, 0);
195d1361
RS
1370}
1371
6a140a74 1372static Lisp_Object
a1bc88d4 1373skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes)
195d1361
RS
1374 int forwardp, syntaxp;
1375 Lisp_Object string, lim;
a1bc88d4 1376 int handle_iso_classes;
195d1361 1377{
195d1361
RS
1378 register unsigned int c;
1379 unsigned char fastmap[0400];
7e68b0ea 1380 /* If SYNTAXP is 0, STRING may contain multi-byte form of characters
9690d026
KH
1381 of which codes don't fit in FASTMAP. In that case, set the
1382 ranges of characters in CHAR_RANGES. */
5df4982e 1383 int *char_ranges;
7e68b0ea 1384 int n_char_ranges = 0;
195d1361 1385 int negate = 0;
4101e6fe 1386 register int i, i_byte;
7e68b0ea 1387 int multibyte = !NILP (current_buffer->enable_multibyte_characters);
1674d9a2
RS
1388 int string_multibyte;
1389 int size_byte;
2e567bd3 1390 const unsigned char *str;
82d497fc 1391 int len;
a1bc88d4 1392 Lisp_Object iso_classes;
195d1361 1393
b7826503 1394 CHECK_STRING (string);
d5db4077 1395 char_ranges = (int *) alloca (SCHARS (string) * (sizeof (int)) * 2);
1674d9a2 1396 string_multibyte = STRING_MULTIBYTE (string);
d5db4077
KR
1397 str = SDATA (string);
1398 size_byte = SBYTES (string);
a1bc88d4 1399 iso_classes = Qnil;
195d1361 1400
82d497fc
KH
1401 /* Adjust the multibyteness of the string to that of the buffer. */
1402 if (multibyte != string_multibyte)
1403 {
1404 int nbytes;
1405
1406 if (multibyte)
d5db4077
KR
1407 nbytes = count_size_as_multibyte (SDATA (string),
1408 SCHARS (string));
82d497fc 1409 else
d5db4077 1410 nbytes = SCHARS (string);
82d497fc
KH
1411 if (nbytes != size_byte)
1412 {
2e567bd3
KR
1413 unsigned char *tmp = (unsigned char *) alloca (nbytes);
1414 copy_text (SDATA (string), tmp, size_byte,
82d497fc
KH
1415 string_multibyte, multibyte);
1416 size_byte = nbytes;
2e567bd3 1417 str = tmp;
82d497fc
KH
1418 }
1419 }
1420
195d1361
RS
1421 if (NILP (lim))
1422 XSETINT (lim, forwardp ? ZV : BEGV);
1423 else
b7826503 1424 CHECK_NUMBER_COERCE_MARKER (lim);
195d1361
RS
1425
1426 /* In any case, don't allow scan outside bounds of buffer. */
195d1361
RS
1427 if (XINT (lim) > ZV)
1428 XSETFASTINT (lim, ZV);
1429 if (XINT (lim) < BEGV)
1430 XSETFASTINT (lim, BEGV);
1431
195d1361
RS
1432 bzero (fastmap, sizeof fastmap);
1433
82d497fc 1434 i_byte = 0;
4101e6fe 1435
13090112 1436 if (i_byte < size_byte
d5db4077 1437 && SREF (string, 0) == '^')
195d1361 1438 {
82d497fc 1439 negate = 1; i_byte++;
195d1361
RS
1440 }
1441
1442 /* Find the characters specified and set their elements of fastmap.
1443 If syntaxp, each character counts as itself.
1444 Otherwise, handle backslashes and ranges specially. */
1445
13090112 1446 while (i_byte < size_byte)
195d1361 1447 {
82d497fc
KH
1448 c = STRING_CHAR_AND_LENGTH (str + i_byte, size_byte - i_byte, len);
1449 i_byte += len;
4101e6fe 1450
195d1361 1451 if (syntaxp)
4101e6fe 1452 fastmap[syntax_spec_code[c & 0377]] = 1;
195d1361
RS
1453 else
1454 {
a1bc88d4
RS
1455 if (handle_iso_classes && c == '['
1456 && i_byte < size_byte
1457 && STRING_CHAR (str + i_byte, size_byte - i_byte) == ':')
1458 {
1459 const unsigned char *class_beg = str + i_byte + 1;
1460 const unsigned char *class_end = class_beg;
b3bda4fd 1461 const unsigned char *class_limit = str + size_byte - 2;
a1bc88d4
RS
1462 /* Leave room for the null. */
1463 unsigned char class_name[CHAR_CLASS_MAX_LENGTH + 1];
1464 re_wctype_t cc;
1465
1466 if (class_limit - class_beg > CHAR_CLASS_MAX_LENGTH)
1467 class_limit = class_beg + CHAR_CLASS_MAX_LENGTH;
1468
b3bda4fd
KS
1469 while (class_end < class_limit
1470 && *class_end >= 'a' && *class_end <= 'z')
a1bc88d4
RS
1471 class_end++;
1472
b3bda4fd
KS
1473 if (class_end == class_beg
1474 || *class_end != ':' || class_end[1] != ']')
1475 goto not_a_class_name;
a1bc88d4
RS
1476
1477 bcopy (class_beg, class_name, class_end - class_beg);
1478 class_name[class_end - class_beg] = 0;
1479
1480 cc = re_wctype (class_name);
1481 if (cc == 0)
1482 error ("Invalid ISO C character class");
1483
1484 iso_classes = Fcons (make_number (cc), iso_classes);
1485
1486 i_byte = class_end + 2 - str;
1487 continue;
1488 }
1489
b3bda4fd 1490 not_a_class_name:
195d1361
RS
1491 if (c == '\\')
1492 {
13090112 1493 if (i_byte == size_byte)
4101e6fe
RS
1494 break;
1495
57951c2e
AS
1496 c = STRING_CHAR_AND_LENGTH (str + i_byte,
1497 size_byte - i_byte, len);
82d497fc 1498 i_byte += len;
195d1361 1499 }
57951c2e
AS
1500 /* Treat `-' as range character only if another character
1501 follows. */
1502 if (i_byte + 1 < size_byte
82d497fc 1503 && str[i_byte] == '-')
195d1361 1504 {
9690d026 1505 unsigned int c2;
4101e6fe
RS
1506
1507 /* Skip over the dash. */
82d497fc 1508 i_byte++;
4101e6fe 1509
4101e6fe 1510 /* Get the end of the range. */
57951c2e
AS
1511 c2 = STRING_CHAR_AND_LENGTH (str + i_byte,
1512 size_byte - i_byte, len);
82d497fc 1513 i_byte += len;
7e68b0ea 1514
4101e6fe 1515 if (SINGLE_BYTE_CHAR_P (c))
06274af5
KH
1516 {
1517 if (! SINGLE_BYTE_CHAR_P (c2))
e39091b6 1518 {
7ae339a7
KH
1519 /* Handle a range starting with a character of
1520 less than 256, and ending with a character of
1521 not less than 256. Split that into two
1522 ranges, the low one ending at 0377, and the
1523 high one starting at the smallest character
1524 in the charset of C2 and ending at C2. */
e39091b6
KH
1525 int charset = CHAR_CHARSET (c2);
1526 int c1 = MAKE_CHAR (charset, 0, 0);
1527
e39091b6
KH
1528 char_ranges[n_char_ranges++] = c1;
1529 char_ranges[n_char_ranges++] = c2;
465cf84c 1530 c2 = 0377;
e39091b6 1531 }
06274af5
KH
1532 while (c <= c2)
1533 {
1534 fastmap[c] = 1;
1535 c++;
1536 }
1537 }
9690d026 1538 else if (c <= c2) /* Both C and C2 are multibyte char. */
195d1361 1539 {
9690d026
KH
1540 char_ranges[n_char_ranges++] = c;
1541 char_ranges[n_char_ranges++] = c2;
195d1361 1542 }
195d1361
RS
1543 }
1544 else
7e68b0ea 1545 {
e39091b6
KH
1546 if (SINGLE_BYTE_CHAR_P (c))
1547 fastmap[c] = 1;
1548 else
7e68b0ea 1549 {
4101e6fe
RS
1550 char_ranges[n_char_ranges++] = c;
1551 char_ranges[n_char_ranges++] = c;
7e68b0ea
RS
1552 }
1553 }
195d1361
RS
1554 }
1555 }
1556
9690d026 1557 /* If ^ was the first character, complement the fastmap. */
195d1361
RS
1558 if (negate)
1559 for (i = 0; i < sizeof fastmap; i++)
9690d026 1560 fastmap[i] ^= 1;
195d1361
RS
1561
1562 {
1563 int start_point = PT;
1564 int pos = PT;
6a140a74 1565 int pos_byte = PT_BYTE;
9af7511a
KH
1566 unsigned char *p = PT_ADDR, *endp, *stop;
1567
1568 if (forwardp)
1569 {
1570 endp = (XINT (lim) == GPT) ? GPT_ADDR : CHAR_POS_ADDR (XINT (lim));
d7ee9fab 1571 stop = (pos < GPT && GPT < XINT (lim)) ? GPT_ADDR : endp;
9af7511a
KH
1572 }
1573 else
1574 {
1575 endp = CHAR_POS_ADDR (XINT (lim));
d7ee9fab 1576 stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp;
9af7511a 1577 }
195d1361
RS
1578
1579 immediate_quit = 1;
1580 if (syntaxp)
1581 {
1582 SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
1583 if (forwardp)
1584 {
7e68b0ea 1585 if (multibyte)
9af7511a
KH
1586 while (1)
1587 {
1588 int nbytes;
1589
1590 if (p >= stop)
ee0cdb48 1591 {
9af7511a
KH
1592 if (p >= endp)
1593 break;
1594 p = GAP_END_ADDR;
1595 stop = endp;
ee0cdb48 1596 }
9af7511a
KH
1597 c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes);
1598 if (! fastmap[(int) SYNTAX (c)])
1599 break;
1600 p += nbytes, pos++, pos_byte += nbytes;
1601 UPDATE_SYNTAX_TABLE_FORWARD (pos);
1602 }
7e68b0ea 1603 else
9af7511a
KH
1604 while (1)
1605 {
1606 if (p >= stop)
1607 {
1608 if (p >= endp)
1609 break;
1610 p = GAP_END_ADDR;
1611 stop = endp;
1612 }
1613 if (! fastmap[(int) SYNTAX (*p)])
1614 break;
1615 p++, pos++;
1616 UPDATE_SYNTAX_TABLE_FORWARD (pos);
1617 }
195d1361
RS
1618 }
1619 else
1620 {
7e68b0ea 1621 if (multibyte)
9af7511a
KH
1622 while (1)
1623 {
1624 unsigned char *prev_p;
1625 int nbytes;
1626
1627 if (p <= stop)
1628 {
1629 if (p <= endp)
7e68b0ea 1630 break;
9af7511a
KH
1631 p = GPT_ADDR;
1632 stop = endp;
1633 }
1634 prev_p = p;
1635 while (--p >= stop && ! CHAR_HEAD_P (*p));
1636 PARSE_MULTIBYTE_SEQ (p, MAX_MULTIBYTE_LENGTH, nbytes);
1637 if (prev_p - p > nbytes)
1638 p = prev_p - 1, c = *p, nbytes = 1;
1639 else
1640 c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH);
1641 pos--, pos_byte -= nbytes;
1642 UPDATE_SYNTAX_TABLE_BACKWARD (pos);
1643 if (! fastmap[(int) SYNTAX (c)])
1644 {
1645 pos++;
1646 pos_byte += nbytes;
1647 break;
1648 }
1649 }
7e68b0ea 1650 else
9af7511a
KH
1651 while (1)
1652 {
1653 if (p <= stop)
ee0cdb48 1654 {
9af7511a 1655 if (p <= endp)
4c8535eb 1656 break;
9af7511a
KH
1657 p = GPT_ADDR;
1658 stop = endp;
ee0cdb48 1659 }
9af7511a
KH
1660 if (! fastmap[(int) SYNTAX (p[-1])])
1661 break;
1662 p--, pos--;
1663 UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
1664 }
195d1361
RS
1665 }
1666 }
1667 else
1668 {
1669 if (forwardp)
1670 {
7e68b0ea 1671 if (multibyte)
9af7511a 1672 while (1)
7e68b0ea 1673 {
9af7511a
KH
1674 int nbytes;
1675
1676 if (p >= stop)
1677 {
1678 if (p >= endp)
1679 break;
1680 p = GAP_END_ADDR;
1681 stop = endp;
1682 }
1683 c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes);
a1bc88d4
RS
1684
1685 if (! NILP (iso_classes) && in_classes (c, iso_classes))
1686 {
1687 if (negate)
1688 break;
1689 else
1690 goto fwd_ok;
1691 }
1692
9690d026 1693 if (SINGLE_BYTE_CHAR_P (c))
7e68b0ea 1694 {
9690d026
KH
1695 if (!fastmap[c])
1696 break;
1697 }
1698 else
1699 {
1700 /* If we are looking at a multibyte character,
1701 we must look up the character in the table
1702 CHAR_RANGES. If there's no data in the
1703 table, that character is not what we want to
1704 skip. */
1705
e39091b6
KH
1706 /* The following code do the right thing even if
1707 n_char_ranges is zero (i.e. no data in
1708 CHAR_RANGES). */
7e68b0ea 1709 for (i = 0; i < n_char_ranges; i += 2)
e39091b6 1710 if (c >= char_ranges[i] && c <= char_ranges[i + 1])
7e68b0ea
RS
1711 break;
1712 if (!(negate ^ (i < n_char_ranges)))
1713 break;
7e68b0ea 1714 }
a1bc88d4 1715 fwd_ok:
9af7511a 1716 p += nbytes, pos++, pos_byte += nbytes;
7e68b0ea
RS
1717 }
1718 else
9af7511a
KH
1719 while (1)
1720 {
1721 if (p >= stop)
1722 {
1723 if (p >= endp)
1724 break;
1725 p = GAP_END_ADDR;
1726 stop = endp;
1727 }
a1bc88d4
RS
1728
1729 if (!NILP (iso_classes) && in_classes (*p, iso_classes))
1730 {
1731 if (negate)
1732 break;
1733 else
1ad6e4db 1734 goto fwd_unibyte_ok;
a1bc88d4
RS
1735 }
1736
4e837cd0 1737 if (!fastmap[*p])
9af7511a 1738 break;
1ad6e4db 1739 fwd_unibyte_ok:
9af7511a
KH
1740 p++, pos++;
1741 }
195d1361
RS
1742 }
1743 else
1744 {
7e68b0ea 1745 if (multibyte)
9af7511a 1746 while (1)
7e68b0ea 1747 {
9af7511a
KH
1748 unsigned char *prev_p;
1749 int nbytes;
e39091b6 1750
9af7511a
KH
1751 if (p <= stop)
1752 {
1753 if (p <= endp)
1754 break;
1755 p = GPT_ADDR;
1756 stop = endp;
1757 }
1758 prev_p = p;
1759 while (--p >= stop && ! CHAR_HEAD_P (*p));
1760 PARSE_MULTIBYTE_SEQ (p, MAX_MULTIBYTE_LENGTH, nbytes);
1761 if (prev_p - p > nbytes)
1762 p = prev_p - 1, c = *p, nbytes = 1;
1763 else
1764 c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH);
a1bc88d4
RS
1765
1766 if (! NILP (iso_classes) && in_classes (c, iso_classes))
1767 {
1768 if (negate)
1769 break;
1770 else
1771 goto back_ok;
1772 }
1773
9690d026
KH
1774 if (SINGLE_BYTE_CHAR_P (c))
1775 {
1776 if (!fastmap[c])
1777 break;
1778 }
1779 else
7e68b0ea 1780 {
9690d026 1781 /* See the comment in the previous similar code. */
e39091b6
KH
1782 for (i = 0; i < n_char_ranges; i += 2)
1783 if (c >= char_ranges[i] && c <= char_ranges[i + 1])
1784 break;
1785 if (!(negate ^ (i < n_char_ranges)))
1786 break;
7e68b0ea 1787 }
a1bc88d4 1788 back_ok:
9af7511a 1789 pos--, pos_byte -= nbytes;
7e68b0ea
RS
1790 }
1791 else
9af7511a
KH
1792 while (1)
1793 {
1794 if (p <= stop)
1795 {
1796 if (p <= endp)
1797 break;
1798 p = GPT_ADDR;
1799 stop = endp;
1800 }
a1bc88d4
RS
1801
1802 if (! NILP (iso_classes) && in_classes (p[-1], iso_classes))
1803 {
1804 if (negate)
1805 break;
1806 else
1ad6e4db 1807 goto back_unibyte_ok;
a1bc88d4
RS
1808 }
1809
4e837cd0 1810 if (!fastmap[p[-1]])
9af7511a 1811 break;
1ad6e4db 1812 back_unibyte_ok:
9af7511a
KH
1813 p--, pos--;
1814 }
195d1361
RS
1815 }
1816 }
7e68b0ea 1817
6a140a74
RS
1818#if 0 /* Not needed now that a position in mid-character
1819 cannot be specified in Lisp. */
7e68b0ea
RS
1820 if (multibyte
1821 /* INC_POS or DEC_POS might have moved POS over LIM. */
1822 && (forwardp ? (pos > XINT (lim)) : (pos < XINT (lim))))
1823 pos = XINT (lim);
6a140a74 1824#endif
7e68b0ea 1825
6a140a74
RS
1826 if (! multibyte)
1827 pos_byte = pos;
1828
1829 SET_PT_BOTH (pos, pos_byte);
195d1361
RS
1830 immediate_quit = 0;
1831
1832 return make_number (PT - start_point);
1833 }
1834}
a1bc88d4
RS
1835
1836/* Return 1 if character C belongs to one of the ISO classes
1837 in the list ISO_CLASSES. Each class is represented by an
1838 integer which is its type according to re_wctype. */
1839
1840static int
1841in_classes (c, iso_classes)
1842 int c;
1843 Lisp_Object iso_classes;
1844{
1845 int fits_class = 0;
1846
1847 while (! NILP (iso_classes))
1848 {
1849 Lisp_Object elt;
1850 elt = XCAR (iso_classes);
1851 iso_classes = XCDR (iso_classes);
1852
1853 if (re_iswctype (c, XFASTINT (elt)))
1854 fits_class = 1;
1855 }
1856
1857 return fits_class;
1858}
195d1361 1859\f
95ff8dfc
RS
1860/* Jump over a comment, assuming we are at the beginning of one.
1861 FROM is the current position.
1862 FROM_BYTE is the bytepos corresponding to FROM.
1863 Do not move past STOP (a charpos).
1864 The comment over which we have to jump is of style STYLE
1865 (either SYNTAX_COMMENT_STYLE(foo) or ST_COMMENT_STYLE).
1866 NESTING should be positive to indicate the nesting at the beginning
1867 for nested comments and should be zero or negative else.
1868 ST_COMMENT_STYLE cannot be nested.
1869 PREV_SYNTAX is the SYNTAX_WITH_FLAGS of the previous character
1870 (or 0 If the search cannot start in the middle of a two-character).
1871
1872 If successful, return 1 and store the charpos of the comment's end
1873 into *CHARPOS_PTR and the corresponding bytepos into *BYTEPOS_PTR.
1874 Else, return 0 and store the charpos STOP into *CHARPOS_PTR, the
1875 corresponding bytepos into *BYTEPOS_PTR and the current nesting
1876 (as defined for state.incomment) in *INCOMMENT_PTR.
1877
1878 The comment end is the last character of the comment rather than the
1879 character just after the comment.
1880
1881 Global syntax data is assumed to initially be valid for FROM and
1882 remains valid for forward search starting at the returned position. */
1883
1884static int
1885forw_comment (from, from_byte, stop, nesting, style, prev_syntax,
1886 charpos_ptr, bytepos_ptr, incomment_ptr)
1887 int from, from_byte, stop;
1888 int nesting, style, prev_syntax;
1889 int *charpos_ptr, *bytepos_ptr, *incomment_ptr;
1890{
1891 register int c, c1;
1892 register enum syntaxcode code;
1893 register int syntax;
1894
1895 if (nesting <= 0) nesting = -1;
1896
1897 /* Enter the loop in the middle so that we find
1898 a 2-char comment ender if we start in the middle of it. */
1899 syntax = prev_syntax;
1900 if (syntax != 0) goto forw_incomment;
1901
1902 while (1)
1903 {
1904 if (from == stop)
1905 {
1906 *incomment_ptr = nesting;
1907 *charpos_ptr = from;
1908 *bytepos_ptr = from_byte;
1909 return 0;
1910 }
1911 c = FETCH_CHAR (from_byte);
1912 syntax = SYNTAX_WITH_FLAGS (c);
1913 code = syntax & 0xff;
1914 if (code == Sendcomment
1915 && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style
abf8a9ff
SM
1916 && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ?
1917 (nesting > 0 && --nesting == 0) : nesting < 0))
95ff8dfc
RS
1918 /* we have encountered a comment end of the same style
1919 as the comment sequence which began this comment
1920 section */
1921 break;
1922 if (code == Scomment_fence
1923 && style == ST_COMMENT_STYLE)
1924 /* we have encountered a comment end of the same style
1925 as the comment sequence which began this comment
1926 section. */
1927 break;
1928 if (nesting > 0
1929 && code == Scomment
abf8a9ff 1930 && SYNTAX_FLAGS_COMMENT_NESTED (syntax)
95ff8dfc
RS
1931 && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style)
1932 /* we have encountered a nested comment of the same style
1933 as the comment sequence which began this comment section */
1934 nesting++;
1935 INC_BOTH (from, from_byte);
1936 UPDATE_SYNTAX_TABLE_FORWARD (from);
7d0393cf 1937
95ff8dfc
RS
1938 forw_incomment:
1939 if (from < stop && SYNTAX_FLAGS_COMEND_FIRST (syntax)
1940 && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style
1941 && (c1 = FETCH_CHAR (from_byte),
abf8a9ff
SM
1942 SYNTAX_COMEND_SECOND (c1))
1943 && ((SYNTAX_FLAGS_COMMENT_NESTED (syntax) ||
1944 SYNTAX_COMMENT_NESTED (c1)) ? nesting > 0 : nesting < 0))
4ffe723b
GM
1945 {
1946 if (--nesting <= 0)
1947 /* we have encountered a comment end of the same style
1948 as the comment sequence which began this comment
1949 section */
1950 break;
1951 else
1952 {
1953 INC_BOTH (from, from_byte);
1954 UPDATE_SYNTAX_TABLE_FORWARD (from);
1955 }
1956 }
95ff8dfc
RS
1957 if (nesting > 0
1958 && from < stop
1959 && SYNTAX_FLAGS_COMSTART_FIRST (syntax)
1960 && (c1 = FETCH_CHAR (from_byte),
1961 SYNTAX_COMMENT_STYLE (c1) == style
abf8a9ff
SM
1962 && SYNTAX_COMSTART_SECOND (c1))
1963 && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ||
1964 SYNTAX_COMMENT_NESTED (c1)))
95ff8dfc
RS
1965 /* we have encountered a nested comment of the same style
1966 as the comment sequence which began this comment
1967 section */
1968 {
1969 INC_BOTH (from, from_byte);
1970 UPDATE_SYNTAX_TABLE_FORWARD (from);
1971 nesting++;
1972 }
1973 }
1974 *charpos_ptr = from;
1975 *bytepos_ptr = from_byte;
1976 return 1;
1977}
1978
b3cfe0c8 1979DEFUN ("forward-comment", Fforward_comment, Sforward_comment, 1, 1, 0,
177c0ea7 1980 doc: /*
ee648c11 1981Move forward across up to COUNT comments. If COUNT is negative, move backward.
fdb82f93
PJ
1982Stop scanning if we find something other than a comment or whitespace.
1983Set point to where scanning stops.
ee648c11 1984If COUNT comments are found as expected, with nothing except whitespace
fdb82f93
PJ
1985between them, return t; otherwise return nil. */)
1986 (count)
840f481c 1987 Lisp_Object count;
b3cfe0c8
RS
1988{
1989 register int from;
6a140a74 1990 int from_byte;
b3cfe0c8 1991 register int stop;
8ea151b2 1992 register int c, c1;
b3cfe0c8
RS
1993 register enum syntaxcode code;
1994 int comstyle = 0; /* style of comment encountered */
95ff8dfc 1995 int comnested = 0; /* whether the comment is nestable or not */
be720845 1996 int found;
840f481c 1997 int count1;
6a140a74 1998 int out_charpos, out_bytepos;
95ff8dfc 1999 int dummy;
840f481c 2000
b7826503 2001 CHECK_NUMBER (count);
840f481c 2002 count1 = XINT (count);
195d1361 2003 stop = count1 > 0 ? ZV : BEGV;
b3cfe0c8
RS
2004
2005 immediate_quit = 1;
2006 QUIT;
2007
2008 from = PT;
6a140a74 2009 from_byte = PT_BYTE;
b3cfe0c8 2010
195d1361 2011 SETUP_SYNTAX_TABLE (from, count1);
840f481c 2012 while (count1 > 0)
b3cfe0c8 2013 {
04882296 2014 do
b3cfe0c8 2015 {
f902a008
RS
2016 int comstart_first;
2017
04882296
KH
2018 if (from == stop)
2019 {
ef316cf0 2020 SET_PT_BOTH (from, from_byte);
b7e6e612 2021 immediate_quit = 0;
04882296
KH
2022 return Qnil;
2023 }
6a140a74 2024 c = FETCH_CHAR (from_byte);
b3cfe0c8 2025 code = SYNTAX (c);
f902a008 2026 comstart_first = SYNTAX_COMSTART_FIRST (c);
95ff8dfc 2027 comnested = SYNTAX_COMMENT_NESTED (c);
e6365855 2028 comstyle = SYNTAX_COMMENT_STYLE (c);
6a140a74 2029 INC_BOTH (from, from_byte);
f902a008 2030 UPDATE_SYNTAX_TABLE_FORWARD (from);
f902a008 2031 if (from < stop && comstart_first
6a140a74 2032 && (c1 = FETCH_CHAR (from_byte),
8ea151b2 2033 SYNTAX_COMSTART_SECOND (c1)))
b3cfe0c8 2034 {
7d0393cf 2035 /* We have encountered a comment start sequence and we
7fc8191e 2036 are ignoring all text inside comments. We must record
b3cfe0c8
RS
2037 the comment style this sequence begins so that later,
2038 only a comment end of the same style actually ends
7fc8191e 2039 the comment section. */
b3cfe0c8 2040 code = Scomment;
8ea151b2 2041 comstyle = SYNTAX_COMMENT_STYLE (c1);
95ff8dfc 2042 comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
6a140a74 2043 INC_BOTH (from, from_byte);
95ff8dfc 2044 UPDATE_SYNTAX_TABLE_FORWARD (from);
b3cfe0c8 2045 }
04882296 2046 }
abf8a9ff 2047 while (code == Swhitespace || (code == Sendcomment && c == '\n'));
6a140a74 2048
da71ab91
KH
2049 if (code == Scomment_fence)
2050 comstyle = ST_COMMENT_STYLE;
2051 else if (code != Scomment)
04882296
KH
2052 {
2053 immediate_quit = 0;
6a140a74 2054 DEC_BOTH (from, from_byte);
ef316cf0 2055 SET_PT_BOTH (from, from_byte);
04882296
KH
2056 return Qnil;
2057 }
2058 /* We're at the start of a comment. */
95ff8dfc
RS
2059 found = forw_comment (from, from_byte, stop, comnested, comstyle, 0,
2060 &out_charpos, &out_bytepos, &dummy);
2061 from = out_charpos; from_byte = out_bytepos;
2062 if (!found)
04882296 2063 {
95ff8dfc
RS
2064 immediate_quit = 0;
2065 SET_PT_BOTH (from, from_byte);
2066 return Qnil;
b3cfe0c8 2067 }
95ff8dfc
RS
2068 INC_BOTH (from, from_byte);
2069 UPDATE_SYNTAX_TABLE_FORWARD (from);
04882296 2070 /* We have skipped one comment. */
840f481c 2071 count1--;
b3cfe0c8
RS
2072 }
2073
840f481c 2074 while (count1 < 0)
b3cfe0c8 2075 {
b9145dbb 2076 while (1)
b3cfe0c8 2077 {
c65adb44 2078 int quoted;
f902a008 2079
b9145dbb
RS
2080 if (from <= stop)
2081 {
6a140a74 2082 SET_PT_BOTH (BEGV, BEGV_BYTE);
b9145dbb
RS
2083 immediate_quit = 0;
2084 return Qnil;
2085 }
b3cfe0c8 2086
6a140a74 2087 DEC_BOTH (from, from_byte);
f902a008 2088 /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
6a140a74 2089 quoted = char_quoted (from, from_byte);
6a140a74 2090 c = FETCH_CHAR (from_byte);
b3cfe0c8
RS
2091 code = SYNTAX (c);
2092 comstyle = 0;
95ff8dfc 2093 comnested = SYNTAX_COMMENT_NESTED (c);
7fc8191e
RS
2094 if (code == Sendcomment)
2095 comstyle = SYNTAX_COMMENT_STYLE (c);
b3cfe0c8 2096 if (from > stop && SYNTAX_COMEND_SECOND (c)
f902a008 2097 && prev_char_comend_first (from, from_byte)
89c6809a 2098 && !char_quoted (from - 1, dec_bytepos (from_byte)))
b3cfe0c8 2099 {
7fc8191e 2100 /* We must record the comment style encountered so that
b3cfe0c8 2101 later, we can match only the proper comment begin
7fc8191e 2102 sequence of the same style. */
6a140a74 2103 DEC_BOTH (from, from_byte);
f902a008
RS
2104 code = Sendcomment;
2105 /* Calling char_quoted, above, set up global syntax position
2106 at the new value of FROM. */
95ff8dfc
RS
2107 c1 = FETCH_CHAR (from_byte);
2108 comstyle = SYNTAX_COMMENT_STYLE (c1);
2109 comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
b3cfe0c8
RS
2110 }
2111
195d1361
RS
2112 if (code == Scomment_fence)
2113 {
2114 /* Skip until first preceding unquoted comment_fence. */
6a140a74 2115 int found = 0, ini = from, ini_byte = from_byte;
7d0393cf 2116
6a140a74 2117 while (1)
195d1361 2118 {
6a140a74
RS
2119 DEC_BOTH (from, from_byte);
2120 if (from == stop)
2121 break;
195d1361 2122 UPDATE_SYNTAX_TABLE_BACKWARD (from);
6a140a74
RS
2123 c = FETCH_CHAR (from_byte);
2124 if (SYNTAX (c) == Scomment_fence
7d0393cf 2125 && !char_quoted (from, from_byte))
195d1361 2126 {
7d0393cf 2127 found = 1;
195d1361
RS
2128 break;
2129 }
2130 }
2131 if (found == 0)
2132 {
2133 from = ini; /* Set point to ini + 1. */
6a140a74 2134 from_byte = ini_byte;
195d1361
RS
2135 goto leave;
2136 }
2137 }
2138 else if (code == Sendcomment)
b3cfe0c8 2139 {
95ff8dfc 2140 found = back_comment (from, from_byte, stop, comnested, comstyle,
6a140a74 2141 &out_charpos, &out_bytepos);
1aa963c8
SM
2142 if (found == -1)
2143 {
abf8a9ff
SM
2144 if (c == '\n')
2145 /* This end-of-line is not an end-of-comment.
2146 Treat it like a whitespace.
2147 CC-mode (and maybe others) relies on this behavior. */
2148 ;
2149 else
2150 {
2151 /* Failure: we should go back to the end of this
2152 not-quite-endcomment. */
2153 if (SYNTAX(c) != code)
2154 /* It was a two-char Sendcomment. */
2155 INC_BOTH (from, from_byte);
2156 goto leave;
2157 }
1aa963c8 2158 }
2b927d02 2159 else
abf8a9ff
SM
2160 {
2161 /* We have skipped one comment. */
2162 from = out_charpos, from_byte = out_bytepos;
2163 break;
2164 }
b3cfe0c8 2165 }
bb0de084 2166 else if (code != Swhitespace || quoted)
b3cfe0c8 2167 {
195d1361 2168 leave:
b3cfe0c8 2169 immediate_quit = 0;
6a140a74 2170 INC_BOTH (from, from_byte);
ef316cf0 2171 SET_PT_BOTH (from, from_byte);
b3cfe0c8
RS
2172 return Qnil;
2173 }
2174 }
2175
840f481c 2176 count1++;
b3cfe0c8
RS
2177 }
2178
ef316cf0 2179 SET_PT_BOTH (from, from_byte);
b3cfe0c8
RS
2180 immediate_quit = 0;
2181 return Qt;
2182}
2183\f
bd25db08 2184/* Return syntax code of character C if C is a single byte character
db9f48c3 2185 or `multibyte_symbol_p' is zero. Otherwise, return Ssymbol. */
bd25db08
KH
2186
2187#define SYNTAX_WITH_MULTIBYTE_CHECK(c) \
2188 ((SINGLE_BYTE_CHAR_P (c) || !multibyte_symbol_p) \
2189 ? SYNTAX (c) : Ssymbol)
2190
6a140a74 2191static Lisp_Object
8489eb67
RS
2192scan_lists (from, count, depth, sexpflag)
2193 register int from;
2194 int count, depth, sexpflag;
2195{
2196 Lisp_Object val;
195d1361 2197 register int stop = count > 0 ? ZV : BEGV;
93da5fff
KH
2198 register int c, c1;
2199 int stringterm;
8489eb67
RS
2200 int quoted;
2201 int mathexit = 0;
93da5fff 2202 register enum syntaxcode code, temp_code;
195d1361 2203 int min_depth = depth; /* Err out if depth gets less than this. */
e5d4f4dc 2204 int comstyle = 0; /* style of comment encountered */
95ff8dfc 2205 int comnested = 0; /* whether the comment is nestable or not */
93da5fff 2206 int temp_pos;
7bf5e9e4 2207 int last_good = from;
195d1361 2208 int found;
c3907a7e 2209 int from_byte;
6a140a74 2210 int out_bytepos, out_charpos;
95ff8dfc 2211 int temp, dummy;
bd25db08 2212 int multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
8489eb67
RS
2213
2214 if (depth > 0) min_depth = 0;
2215
c3907a7e
RS
2216 if (from > ZV) from = ZV;
2217 if (from < BEGV) from = BEGV;
2218
2219 from_byte = CHAR_TO_BYTE (from);
2220
8489eb67
RS
2221 immediate_quit = 1;
2222 QUIT;
2223
195d1361 2224 SETUP_SYNTAX_TABLE (from, count);
8489eb67
RS
2225 while (count > 0)
2226 {
8489eb67
RS
2227 while (from < stop)
2228 {
f902a008 2229 int comstart_first, prefix;
195d1361 2230 UPDATE_SYNTAX_TABLE_FORWARD (from);
6a140a74 2231 c = FETCH_CHAR (from_byte);
bd25db08 2232 code = SYNTAX_WITH_MULTIBYTE_CHECK (c);
f902a008 2233 comstart_first = SYNTAX_COMSTART_FIRST (c);
95ff8dfc 2234 comnested = SYNTAX_COMMENT_NESTED (c);
e6365855 2235 comstyle = SYNTAX_COMMENT_STYLE (c);
f902a008 2236 prefix = SYNTAX_PREFIX (c);
7bf5e9e4
RS
2237 if (depth == min_depth)
2238 last_good = from;
6a140a74 2239 INC_BOTH (from, from_byte);
195d1361 2240 UPDATE_SYNTAX_TABLE_FORWARD (from);
f902a008 2241 if (from < stop && comstart_first
ab229fdd 2242 && (c = FETCH_CHAR (from_byte), SYNTAX_COMSTART_SECOND (c))
8489eb67 2243 && parse_sexp_ignore_comments)
e5d4f4dc 2244 {
7d0393cf 2245 /* we have encountered a comment start sequence and we
195d1361 2246 are ignoring all text inside comments. We must record
e5d4f4dc
RS
2247 the comment style this sequence begins so that later,
2248 only a comment end of the same style actually ends
2249 the comment section */
2250 code = Scomment;
95ff8dfc
RS
2251 c1 = FETCH_CHAR (from_byte);
2252 comstyle = SYNTAX_COMMENT_STYLE (c1);
2253 comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
6a140a74 2254 INC_BOTH (from, from_byte);
f902a008 2255 UPDATE_SYNTAX_TABLE_FORWARD (from);
e5d4f4dc 2256 }
7d0393cf 2257
f902a008 2258 if (prefix)
8489eb67
RS
2259 continue;
2260
0220c518 2261 switch (SWITCH_ENUM_CAST (code))
8489eb67
RS
2262 {
2263 case Sescape:
2264 case Scharquote:
2265 if (from == stop) goto lose;
6a140a74 2266 INC_BOTH (from, from_byte);
8489eb67
RS
2267 /* treat following character as a word constituent */
2268 case Sword:
2269 case Ssymbol:
2270 if (depth || !sexpflag) break;
195d1361 2271 /* This word counts as a sexp; return at end of it. */
8489eb67
RS
2272 while (from < stop)
2273 {
195d1361 2274 UPDATE_SYNTAX_TABLE_FORWARD (from);
7c7ca3d2
RS
2275
2276 /* Some compilers can't handle this inside the switch. */
bd25db08
KH
2277 c = FETCH_CHAR (from_byte);
2278 temp = SYNTAX_WITH_MULTIBYTE_CHECK (c);
7c7ca3d2 2279 switch (temp)
8489eb67
RS
2280 {
2281 case Scharquote:
2282 case Sescape:
6a140a74 2283 INC_BOTH (from, from_byte);
8489eb67
RS
2284 if (from == stop) goto lose;
2285 break;
2286 case Sword:
2287 case Ssymbol:
2288 case Squote:
2289 break;
2290 default:
2291 goto done;
2292 }
6a140a74 2293 INC_BOTH (from, from_byte);
8489eb67
RS
2294 }
2295 goto done;
2296
195d1361 2297 case Scomment_fence:
95ff8dfc
RS
2298 comstyle = ST_COMMENT_STYLE;
2299 /* FALLTHROUGH */
2300 case Scomment:
8489eb67 2301 if (!parse_sexp_ignore_comments) break;
95ff8dfc
RS
2302 UPDATE_SYNTAX_TABLE_FORWARD (from);
2303 found = forw_comment (from, from_byte, stop,
2304 comnested, comstyle, 0,
2305 &out_charpos, &out_bytepos, &dummy);
2306 from = out_charpos, from_byte = out_bytepos;
2307 if (!found)
8489eb67 2308 {
95ff8dfc
RS
2309 if (depth == 0)
2310 goto done;
2311 goto lose;
8489eb67 2312 }
95ff8dfc
RS
2313 INC_BOTH (from, from_byte);
2314 UPDATE_SYNTAX_TABLE_FORWARD (from);
8489eb67
RS
2315 break;
2316
2317 case Smath:
2318 if (!sexpflag)
2319 break;
6a140a74
RS
2320 if (from != stop && c == FETCH_CHAR (from_byte))
2321 {
2322 INC_BOTH (from, from_byte);
2323 }
8489eb67
RS
2324 if (mathexit)
2325 {
2326 mathexit = 0;
2327 goto close1;
2328 }
2329 mathexit = 1;
2330
2331 case Sopen:
2332 if (!++depth) goto done;
2333 break;
2334
2335 case Sclose:
2336 close1:
2337 if (!--depth) goto done;
2338 if (depth < min_depth)
7bf5e9e4
RS
2339 Fsignal (Qscan_error,
2340 Fcons (build_string ("Containing expression ends prematurely"),
2341 Fcons (make_number (last_good),
2342 Fcons (make_number (from), Qnil))));
8489eb67
RS
2343 break;
2344
2345 case Sstring:
195d1361 2346 case Sstring_fence:
ef316cf0 2347 temp_pos = dec_bytepos (from_byte);
93da5fff 2348 stringterm = FETCH_CHAR (temp_pos);
8489eb67
RS
2349 while (1)
2350 {
2351 if (from >= stop) goto lose;
195d1361 2352 UPDATE_SYNTAX_TABLE_FORWARD (from);
bd25db08 2353 c = FETCH_CHAR (from_byte);
42ebfa31
SM
2354 if (code == Sstring
2355 ? (c == stringterm
2356 && SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring)
bd25db08 2357 : SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring_fence)
195d1361 2358 break;
7c7ca3d2
RS
2359
2360 /* Some compilers can't handle this inside the switch. */
bd25db08 2361 temp = SYNTAX_WITH_MULTIBYTE_CHECK (c);
7c7ca3d2 2362 switch (temp)
8489eb67
RS
2363 {
2364 case Scharquote:
2365 case Sescape:
6a140a74 2366 INC_BOTH (from, from_byte);
8489eb67 2367 }
6a140a74 2368 INC_BOTH (from, from_byte);
8489eb67 2369 }
6a140a74 2370 INC_BOTH (from, from_byte);
8489eb67
RS
2371 if (!depth && sexpflag) goto done;
2372 break;
240c43e8
SM
2373 default:
2374 /* Ignore whitespace, punctuation, quote, endcomment. */
2375 break;
8489eb67
RS
2376 }
2377 }
2378
2379 /* Reached end of buffer. Error if within object, return nil if between */
2380 if (depth) goto lose;
2381
2382 immediate_quit = 0;
2383 return Qnil;
2384
2385 /* End of object reached */
2386 done:
2387 count--;
2388 }
2389
2390 while (count < 0)
2391 {
8489eb67
RS
2392 while (from > stop)
2393 {
6a140a74 2394 DEC_BOTH (from, from_byte);
195d1361 2395 UPDATE_SYNTAX_TABLE_BACKWARD (from);
6a140a74 2396 c = FETCH_CHAR (from_byte);
bd25db08 2397 code = SYNTAX_WITH_MULTIBYTE_CHECK (c);
7bf5e9e4
RS
2398 if (depth == min_depth)
2399 last_good = from;
7fc8191e 2400 comstyle = 0;
95ff8dfc 2401 comnested = SYNTAX_COMMENT_NESTED (c);
7fc8191e
RS
2402 if (code == Sendcomment)
2403 comstyle = SYNTAX_COMMENT_STYLE (c);
8489eb67 2404 if (from > stop && SYNTAX_COMEND_SECOND (c)
1674d9a2 2405 && prev_char_comend_first (from, from_byte)
8489eb67 2406 && parse_sexp_ignore_comments)
e5d4f4dc 2407 {
f902a008 2408 /* We must record the comment style encountered so that
e5d4f4dc 2409 later, we can match only the proper comment begin
f902a008 2410 sequence of the same style. */
6a140a74 2411 DEC_BOTH (from, from_byte);
f902a008
RS
2412 UPDATE_SYNTAX_TABLE_BACKWARD (from);
2413 code = Sendcomment;
95ff8dfc
RS
2414 c1 = FETCH_CHAR (from_byte);
2415 comstyle = SYNTAX_COMMENT_STYLE (c1);
2416 comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
e5d4f4dc 2417 }
7d0393cf 2418
9828a477 2419 /* Quoting turns anything except a comment-ender
e6365855 2420 into a word character. Note that this cannot be true
f902a008 2421 if we decremented FROM in the if-statement above. */
9828a477 2422 if (code != Sendcomment && char_quoted (from, from_byte))
240c43e8
SM
2423 {
2424 DEC_BOTH (from, from_byte);
2425 code = Sword;
2426 }
9828a477 2427 else if (SYNTAX_PREFIX (c))
8489eb67
RS
2428 continue;
2429
9828a477 2430 switch (SWITCH_ENUM_CAST (code))
8489eb67
RS
2431 {
2432 case Sword:
2433 case Ssymbol:
9828a477
KH
2434 case Sescape:
2435 case Scharquote:
8489eb67 2436 if (depth || !sexpflag) break;
195d1361
RS
2437 /* This word counts as a sexp; count object finished
2438 after passing it. */
8489eb67
RS
2439 while (from > stop)
2440 {
6a140a74 2441 temp_pos = from_byte;
ef316cf0
RS
2442 if (! NILP (current_buffer->enable_multibyte_characters))
2443 DEC_POS (temp_pos);
2444 else
2445 temp_pos--;
6a140a74 2446 UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
9828a477 2447 c1 = FETCH_CHAR (temp_pos);
bd25db08 2448 temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1);
9828a477
KH
2449 /* Don't allow comment-end to be quoted. */
2450 if (temp_code == Sendcomment)
2451 goto done2;
6a140a74 2452 quoted = char_quoted (from - 1, temp_pos);
8489eb67 2453 if (quoted)
93da5fff 2454 {
6a140a74 2455 DEC_BOTH (from, from_byte);
ef316cf0 2456 temp_pos = dec_bytepos (temp_pos);
6a140a74 2457 UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
93da5fff
KH
2458 }
2459 c1 = FETCH_CHAR (temp_pos);
bd25db08 2460 temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1);
93da5fff
KH
2461 if (! (quoted || temp_code == Sword
2462 || temp_code == Ssymbol
2463 || temp_code == Squote))
8489eb67 2464 goto done2;
6a140a74 2465 DEC_BOTH (from, from_byte);
8489eb67
RS
2466 }
2467 goto done2;
2468
2469 case Smath:
2470 if (!sexpflag)
2471 break;
ef316cf0 2472 temp_pos = dec_bytepos (from_byte);
6a140a74 2473 UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
93da5fff 2474 if (from != stop && c == FETCH_CHAR (temp_pos))
6a140a74 2475 DEC_BOTH (from, from_byte);
8489eb67
RS
2476 if (mathexit)
2477 {
2478 mathexit = 0;
2479 goto open2;
2480 }
2481 mathexit = 1;
2482
2483 case Sclose:
2484 if (!++depth) goto done2;
2485 break;
2486
2487 case Sopen:
2488 open2:
2489 if (!--depth) goto done2;
2490 if (depth < min_depth)
7bf5e9e4
RS
2491 Fsignal (Qscan_error,
2492 Fcons (build_string ("Containing expression ends prematurely"),
2493 Fcons (make_number (last_good),
2494 Fcons (make_number (from), Qnil))));
8489eb67
RS
2495 break;
2496
2497 case Sendcomment:
2498 if (!parse_sexp_ignore_comments)
2499 break;
95ff8dfc 2500 found = back_comment (from, from_byte, stop, comnested, comstyle,
6a140a74 2501 &out_charpos, &out_bytepos);
1aa963c8
SM
2502 /* FIXME: if found == -1, then it really wasn't a comment-end.
2503 For single-char Sendcomment, we can't do much about it apart
2504 from skipping the char.
2505 For 2-char endcomments, we could try again, taking both
2506 chars as separate entities, but it's a lot of trouble
2507 for very little gain, so we don't bother either. -sm */
6a140a74
RS
2508 if (found != -1)
2509 from = out_charpos, from_byte = out_bytepos;
8489eb67
RS
2510 break;
2511
195d1361
RS
2512 case Scomment_fence:
2513 case Sstring_fence:
2514 while (1)
2515 {
195d1361 2516 if (from == stop) goto lose;
d0abdf7e 2517 DEC_BOTH (from, from_byte);
195d1361 2518 UPDATE_SYNTAX_TABLE_BACKWARD (from);
7d0393cf 2519 if (!char_quoted (from, from_byte)
bd25db08
KH
2520 && (c = FETCH_CHAR (from_byte),
2521 SYNTAX_WITH_MULTIBYTE_CHECK (c) == code))
195d1361
RS
2522 break;
2523 }
2524 if (code == Sstring_fence && !depth && sexpflag) goto done2;
2525 break;
7d0393cf 2526
8489eb67 2527 case Sstring:
6a140a74 2528 stringterm = FETCH_CHAR (from_byte);
8489eb67
RS
2529 while (1)
2530 {
2531 if (from == stop) goto lose;
d0abdf7e
SM
2532 DEC_BOTH (from, from_byte);
2533 UPDATE_SYNTAX_TABLE_BACKWARD (from);
2534 if (!char_quoted (from, from_byte)
2535 && stringterm == (c = FETCH_CHAR (from_byte))
42ebfa31 2536 && SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring)
8489eb67 2537 break;
8489eb67 2538 }
8489eb67
RS
2539 if (!depth && sexpflag) goto done2;
2540 break;
240c43e8
SM
2541 default:
2542 /* Ignore whitespace, punctuation, quote, endcomment. */
2543 break;
8489eb67
RS
2544 }
2545 }
2546
2547 /* Reached start of buffer. Error if within object, return nil if between */
2548 if (depth) goto lose;
2549
2550 immediate_quit = 0;
2551 return Qnil;
2552
2553 done2:
2554 count++;
2555 }
2556
2557
2558 immediate_quit = 0;
1e142fb7 2559 XSETFASTINT (val, from);
8489eb67
RS
2560 return val;
2561
2562 lose:
7bf5e9e4
RS
2563 Fsignal (Qscan_error,
2564 Fcons (build_string ("Unbalanced parentheses"),
2565 Fcons (make_number (last_good),
2566 Fcons (make_number (from), Qnil))));
ab229fdd 2567 abort ();
8489eb67
RS
2568 /* NOTREACHED */
2569}
2570
8489eb67 2571DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0,
fdb82f93
PJ
2572 doc: /* Scan from character number FROM by COUNT lists.
2573Returns the character number of the position thus found.
2574
2575If DEPTH is nonzero, paren depth begins counting from that value,
2576only places where the depth in parentheses becomes zero
2577are candidates for stopping; COUNT such places are counted.
2578Thus, a positive value for DEPTH means go out levels.
2579
2580Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
2581
2582If the beginning or end of (the accessible part of) the buffer is reached
2583and the depth is wrong, an error is signaled.
2584If the depth is right but the count is not used up, nil is returned. */)
2585 (from, count, depth)
8489eb67
RS
2586 Lisp_Object from, count, depth;
2587{
b7826503
PJ
2588 CHECK_NUMBER (from);
2589 CHECK_NUMBER (count);
2590 CHECK_NUMBER (depth);
8489eb67
RS
2591
2592 return scan_lists (XINT (from), XINT (count), XINT (depth), 0);
2593}
2594
2595DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0,
fdb82f93
PJ
2596 doc: /* Scan from character number FROM by COUNT balanced expressions.
2597If COUNT is negative, scan backwards.
2598Returns the character number of the position thus found.
2599
2600Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
2601
2602If the beginning or end of (the accessible part of) the buffer is reached
2603in the middle of a parenthetical grouping, an error is signaled.
2604If the beginning or end is reached between groupings
2605but before count is used up, nil is returned. */)
2606 (from, count)
8489eb67
RS
2607 Lisp_Object from, count;
2608{
b7826503
PJ
2609 CHECK_NUMBER (from);
2610 CHECK_NUMBER (count);
8489eb67
RS
2611
2612 return scan_lists (XINT (from), XINT (count), 0, 1);
2613}
2614
2615DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars,
fdb82f93
PJ
2616 0, 0, 0,
2617 doc: /* Move point backward over any number of chars with prefix syntax.
2618This includes chars with "quote" or "prefix" syntax (' or p). */)
2619 ()
8489eb67
RS
2620{
2621 int beg = BEGV;
6a140a74
RS
2622 int opoint = PT;
2623 int opoint_byte = PT_BYTE;
6ec8bbd2 2624 int pos = PT;
6a140a74 2625 int pos_byte = PT_BYTE;
93da5fff 2626 int c;
93da5fff 2627
7d0393cf 2628 if (pos <= beg)
195d1361 2629 {
f902a008
RS
2630 SET_PT_BOTH (opoint, opoint_byte);
2631
2632 return Qnil;
195d1361 2633 }
8489eb67 2634
f902a008
RS
2635 SETUP_SYNTAX_TABLE (pos, -1);
2636
6a140a74
RS
2637 DEC_BOTH (pos, pos_byte);
2638
1fd3172d 2639 while (!char_quoted (pos, pos_byte)
195d1361 2640 /* Previous statement updates syntax table. */
6a140a74 2641 && ((c = FETCH_CHAR (pos_byte), SYNTAX (c) == Squote)
93da5fff
KH
2642 || SYNTAX_PREFIX (c)))
2643 {
1fd3172d
RS
2644 opoint = pos;
2645 opoint_byte = pos_byte;
2646
2647 if (pos + 1 > beg)
2648 DEC_BOTH (pos, pos_byte);
93da5fff 2649 }
8489eb67 2650
6a140a74 2651 SET_PT_BOTH (opoint, opoint_byte);
8489eb67
RS
2652
2653 return Qnil;
2654}
2655\f
6a140a74 2656/* Parse forward from FROM / FROM_BYTE to END,
e5d4f4dc
RS
2657 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
2658 and return a description of the state of the parse at END.
c81a3712 2659 If STOPBEFORE is nonzero, stop at the start of an atom.
644ea4df
RS
2660 If COMMENTSTOP is 1, stop at the start of a comment.
2661 If COMMENTSTOP is -1, stop at the start or end of a comment,
2662 after the beginning of a string, or after the end of a string. */
8489eb67 2663
340f92b5 2664static void
6a140a74 2665scan_sexps_forward (stateptr, from, from_byte, end, targetdepth,
c81a3712 2666 stopbefore, oldstate, commentstop)
e5d4f4dc 2667 struct lisp_parse_state *stateptr;
8489eb67 2668 register int from;
ddc447fc 2669 int end, targetdepth, stopbefore, from_byte;
8489eb67 2670 Lisp_Object oldstate;
c81a3712 2671 int commentstop;
8489eb67
RS
2672{
2673 struct lisp_parse_state state;
2674
2675 register enum syntaxcode code;
95ff8dfc
RS
2676 int c1;
2677 int comnested;
8489eb67
RS
2678 struct level { int last, prev; };
2679 struct level levelstart[100];
2680 register struct level *curlevel = levelstart;
2681 struct level *endlevel = levelstart + 100;
8489eb67
RS
2682 register int depth; /* Paren depth of current scanning location.
2683 level - levelstart equals this except
2684 when the depth becomes negative. */
2685 int mindepth; /* Lowest DEPTH value seen. */
2686 int start_quoted = 0; /* Nonzero means starting after a char quote */
2687 Lisp_Object tem;
93da5fff 2688 int prev_from; /* Keep one character before FROM. */
6a140a74 2689 int prev_from_byte;
1fd3172d 2690 int prev_from_syntax;
195d1361
RS
2691 int boundary_stop = commentstop == -1;
2692 int nofence;
95ff8dfc
RS
2693 int found;
2694 int out_bytepos, out_charpos;
7c7ca3d2 2695 int temp;
93da5fff
KH
2696
2697 prev_from = from;
6a140a74
RS
2698 prev_from_byte = from_byte;
2699 if (from != BEGV)
2700 DEC_BOTH (prev_from, prev_from_byte);
93da5fff
KH
2701
2702 /* Use this macro instead of `from++'. */
6a140a74
RS
2703#define INC_FROM \
2704do { prev_from = from; \
2705 prev_from_byte = from_byte; \
ab229fdd
AS
2706 temp = FETCH_CHAR (prev_from_byte); \
2707 prev_from_syntax = SYNTAX_WITH_FLAGS (temp); \
ef316cf0 2708 INC_BOTH (from, from_byte); \
3ceb4629
SM
2709 if (from < end) \
2710 UPDATE_SYNTAX_TABLE_FORWARD (from); \
6a140a74 2711 } while (0)
8489eb67
RS
2712
2713 immediate_quit = 1;
2714 QUIT;
2715
265a9e55 2716 if (NILP (oldstate))
8489eb67
RS
2717 {
2718 depth = 0;
2719 state.instring = -1;
2720 state.incomment = 0;
195d1361
RS
2721 state.comstyle = 0; /* comment style a by default. */
2722 state.comstr_start = -1; /* no comment/string seen. */
8489eb67
RS
2723 }
2724 else
2725 {
2726 tem = Fcar (oldstate);
265a9e55 2727 if (!NILP (tem))
8489eb67
RS
2728 depth = XINT (tem);
2729 else
2730 depth = 0;
2731
2732 oldstate = Fcdr (oldstate);
2733 oldstate = Fcdr (oldstate);
2734 oldstate = Fcdr (oldstate);
2735 tem = Fcar (oldstate);
195d1361 2736 /* Check whether we are inside string_fence-style string: */
7d0393cf
JB
2737 state.instring = (!NILP (tem)
2738 ? (INTEGERP (tem) ? XINT (tem) : ST_STRING_STYLE)
e76f1c44 2739 : -1);
8489eb67
RS
2740
2741 oldstate = Fcdr (oldstate);
2742 tem = Fcar (oldstate);
e76f1c44
GM
2743 state.incomment = (!NILP (tem)
2744 ? (INTEGERP (tem) ? XINT (tem) : -1)
95ff8dfc 2745 : 0);
8489eb67
RS
2746
2747 oldstate = Fcdr (oldstate);
2748 tem = Fcar (oldstate);
265a9e55 2749 start_quoted = !NILP (tem);
e5d4f4dc 2750
95ff8dfc 2751 /* if the eighth element of the list is nil, we are in comment
195d1361
RS
2752 style a. If it is non-nil, we are in comment style b */
2753 oldstate = Fcdr (oldstate);
e5d4f4dc 2754 oldstate = Fcdr (oldstate);
195d1361 2755 tem = Fcar (oldstate);
7d0393cf 2756 state.comstyle = NILP (tem) ? 0 : (EQ (tem, Qsyntax_table)
e76f1c44 2757 ? ST_COMMENT_STYLE : 1);
195d1361 2758
e5d4f4dc 2759 oldstate = Fcdr (oldstate);
e5d4f4dc 2760 tem = Fcar (oldstate);
195d1361 2761 state.comstr_start = NILP (tem) ? -1 : XINT (tem) ;
1a102a58
RS
2762 oldstate = Fcdr (oldstate);
2763 tem = Fcar (oldstate);
2764 while (!NILP (tem)) /* >= second enclosing sexps. */
2765 {
2766 /* curlevel++->last ran into compiler bug on Apollo */
2767 curlevel->last = XINT (Fcar (tem));
2768 if (++curlevel == endlevel)
02010917 2769 curlevel--; /* error ("Nesting too deep for parser"); */
1a102a58
RS
2770 curlevel->prev = -1;
2771 curlevel->last = -1;
2772 tem = Fcdr (tem);
2773 }
8489eb67
RS
2774 }
2775 state.quoted = 0;
2776 mindepth = depth;
2777
2778 curlevel->prev = -1;
2779 curlevel->last = -1;
2780
326b283b 2781 SETUP_SYNTAX_TABLE (prev_from, 1);
ab229fdd
AS
2782 temp = FETCH_CHAR (prev_from_byte);
2783 prev_from_syntax = SYNTAX_WITH_FLAGS (temp);
3ceb4629 2784 UPDATE_SYNTAX_TABLE_FORWARD (from);
326b283b 2785
195d1361 2786 /* Enter the loop at a place appropriate for initial state. */
8489eb67 2787
326b283b
RS
2788 if (state.incomment)
2789 goto startincomment;
8489eb67
RS
2790 if (state.instring >= 0)
2791 {
195d1361 2792 nofence = state.instring != ST_STRING_STYLE;
326b283b
RS
2793 if (start_quoted)
2794 goto startquotedinstring;
8489eb67
RS
2795 goto startinstring;
2796 }
326b283b
RS
2797 else if (start_quoted)
2798 goto startquoted;
1fd3172d 2799
8489eb67
RS
2800 while (from < end)
2801 {
93da5fff 2802 INC_FROM;
1fd3172d 2803 code = prev_from_syntax & 0xff;
4c920633 2804
c5d4b96f
SM
2805 if (from < end
2806 && SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
2807 && (c1 = FETCH_CHAR (from_byte),
2808 SYNTAX_COMSTART_SECOND (c1)))
2809 /* Duplicate code to avoid a complex if-expression
2810 which causes trouble for the SGI compiler. */
95ff8dfc 2811 {
c5d4b96f
SM
2812 /* Record the comment style we have entered so that only
2813 the comment-end sequence of the same style actually
2814 terminates the comment section. */
2815 state.comstyle = SYNTAX_COMMENT_STYLE (c1);
2816 comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax);
2817 comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
2818 state.incomment = comnested ? 1 : -1;
95ff8dfc 2819 state.comstr_start = prev_from;
c5d4b96f
SM
2820 INC_FROM;
2821 code = Scomment;
95ff8dfc 2822 }
4c920633 2823 else if (code == Scomment_fence)
e5d4f4dc
RS
2824 {
2825 /* Record the comment style we have entered so that only
2826 the comment-end sequence of the same style actually
2827 terminates the comment section. */
95ff8dfc
RS
2828 state.comstyle = ST_COMMENT_STYLE;
2829 state.incomment = -1;
195d1361 2830 state.comstr_start = prev_from;
e5d4f4dc 2831 code = Scomment;
e5d4f4dc 2832 }
c5d4b96f
SM
2833 else if (code == Scomment)
2834 {
2835 state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax);
2836 state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
2837 1 : -1);
2838 state.comstr_start = prev_from;
2839 }
e5d4f4dc 2840
1fd3172d 2841 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
8489eb67 2842 continue;
0220c518 2843 switch (SWITCH_ENUM_CAST (code))
8489eb67
RS
2844 {
2845 case Sescape:
2846 case Scharquote:
2847 if (stopbefore) goto stop; /* this arg means stop at sexp start */
93da5fff 2848 curlevel->last = prev_from;
8489eb67
RS
2849 startquoted:
2850 if (from == end) goto endquoted;
93da5fff 2851 INC_FROM;
8489eb67
RS
2852 goto symstarted;
2853 /* treat following character as a word constituent */
2854 case Sword:
2855 case Ssymbol:
2856 if (stopbefore) goto stop; /* this arg means stop at sexp start */
93da5fff 2857 curlevel->last = prev_from;
8489eb67
RS
2858 symstarted:
2859 while (from < end)
2860 {
7c7ca3d2 2861 /* Some compilers can't handle this inside the switch. */
ab229fdd
AS
2862 temp = FETCH_CHAR (from_byte);
2863 temp = SYNTAX (temp);
7c7ca3d2 2864 switch (temp)
8489eb67
RS
2865 {
2866 case Scharquote:
2867 case Sescape:
93da5fff 2868 INC_FROM;
8489eb67
RS
2869 if (from == end) goto endquoted;
2870 break;
2871 case Sword:
2872 case Ssymbol:
2873 case Squote:
2874 break;
2875 default:
2876 goto symdone;
2877 }
93da5fff 2878 INC_FROM;
8489eb67
RS
2879 }
2880 symdone:
2881 curlevel->prev = curlevel->last;
2882 break;
2883
240c43e8 2884 case Scomment_fence: /* Can't happen because it's handled above. */
8489eb67 2885 case Scomment:
195d1361 2886 if (commentstop || boundary_stop) goto done;
d355bd8a
SM
2887 startincomment:
2888 /* The (from == BEGV) test was to enter the loop in the middle so
95ff8dfc 2889 that we find a 2-char comment ender even if we start in the
e6365855 2890 middle of it. We don't want to do that if we're just at the
d355bd8a 2891 beginning of the comment (think of (*) ... (*)). */
95ff8dfc
RS
2892 found = forw_comment (from, from_byte, end,
2893 state.incomment, state.comstyle,
e6365855
SM
2894 (from == BEGV || from < state.comstr_start + 3)
2895 ? 0 : prev_from_syntax,
95ff8dfc
RS
2896 &out_charpos, &out_bytepos, &state.incomment);
2897 from = out_charpos; from_byte = out_bytepos;
2898 /* Beware! prev_from and friends are invalid now.
2899 Luckily, the `done' doesn't use them and the INC_FROM
2900 sets them to a sane value without looking at them. */
2901 if (!found) goto done;
d355bd8a 2902 INC_FROM;
8489eb67 2903 state.incomment = 0;
e5d4f4dc 2904 state.comstyle = 0; /* reset the comment style */
195d1361 2905 if (boundary_stop) goto done;
8489eb67
RS
2906 break;
2907
2908 case Sopen:
2909 if (stopbefore) goto stop; /* this arg means stop at sexp start */
2910 depth++;
2911 /* curlevel++->last ran into compiler bug on Apollo */
93da5fff 2912 curlevel->last = prev_from;
8489eb67 2913 if (++curlevel == endlevel)
02010917 2914 curlevel--; /* error ("Nesting too deep for parser"); */
8489eb67
RS
2915 curlevel->prev = -1;
2916 curlevel->last = -1;
30844415 2917 if (targetdepth == depth) goto done;
8489eb67
RS
2918 break;
2919
2920 case Sclose:
2921 depth--;
2922 if (depth < mindepth)
2923 mindepth = depth;
2924 if (curlevel != levelstart)
2925 curlevel--;
2926 curlevel->prev = curlevel->last;
30844415 2927 if (targetdepth == depth) goto done;
8489eb67
RS
2928 break;
2929
2930 case Sstring:
195d1361
RS
2931 case Sstring_fence:
2932 state.comstr_start = from - 1;
8489eb67 2933 if (stopbefore) goto stop; /* this arg means stop at sexp start */
93da5fff 2934 curlevel->last = prev_from;
7d0393cf 2935 state.instring = (code == Sstring
6a140a74 2936 ? (FETCH_CHAR (prev_from_byte))
195d1361
RS
2937 : ST_STRING_STYLE);
2938 if (boundary_stop) goto done;
8489eb67 2939 startinstring:
195d1361 2940 {
644ea4df 2941 nofence = state.instring != ST_STRING_STYLE;
7d0393cf 2942
644ea4df
RS
2943 while (1)
2944 {
2945 int c;
195d1361 2946
644ea4df 2947 if (from >= end) goto done;
6a140a74 2948 c = FETCH_CHAR (from_byte);
7c7ca3d2
RS
2949 /* Some compilers can't handle this inside the switch. */
2950 temp = SYNTAX (c);
ccf89641
KH
2951
2952 /* Check TEMP here so that if the char has
2953 a syntax-table property which says it is NOT
2954 a string character, it does not end the string. */
2955 if (nofence && c == state.instring && temp == Sstring)
2956 break;
2957
7c7ca3d2 2958 switch (temp)
644ea4df
RS
2959 {
2960 case Sstring_fence:
2961 if (!nofence) goto string_end;
2962 break;
2963 case Scharquote:
2964 case Sescape:
2965 INC_FROM;
2966 startquotedinstring:
2967 if (from >= end) goto endquoted;
195d1361 2968 }
644ea4df
RS
2969 INC_FROM;
2970 }
195d1361
RS
2971 }
2972 string_end:
8489eb67
RS
2973 state.instring = -1;
2974 curlevel->prev = curlevel->last;
93da5fff 2975 INC_FROM;
195d1361 2976 if (boundary_stop) goto done;
8489eb67
RS
2977 break;
2978
2979 case Smath:
240c43e8
SM
2980 /* FIXME: We should do something with it. */
2981 break;
2982 default:
2983 /* Ignore whitespace, punctuation, quote, endcomment. */
8489eb67
RS
2984 break;
2985 }
2986 }
2987 goto done;
2988
2989 stop: /* Here if stopping before start of sexp. */
93da5fff 2990 from = prev_from; /* We have just fetched the char that starts it; */
8489eb67
RS
2991 goto done; /* but return the position before it. */
2992
2993 endquoted:
2994 state.quoted = 1;
2995 done:
2996 state.depth = depth;
2997 state.mindepth = mindepth;
2998 state.thislevelstart = curlevel->prev;
2999 state.prevlevelstart
3000 = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
3001 state.location = from;
1a102a58
RS
3002 state.levelstarts = Qnil;
3003 while (--curlevel >= levelstart)
3004 state.levelstarts = Fcons (make_number (curlevel->last),
3005 state.levelstarts);
8489eb67
RS
3006 immediate_quit = 0;
3007
e5d4f4dc 3008 *stateptr = state;
8489eb67
RS
3009}
3010
c81a3712 3011DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0,
fdb82f93
PJ
3012 doc: /* Parse Lisp syntax starting at FROM until TO; return status of parse at TO.
3013Parsing stops at TO or when certain criteria are met;
3014 point is set to where parsing stops.
3015If fifth arg OLDSTATE is omitted or nil,
3016 parsing assumes that FROM is the beginning of a function.
3017Value is a list of ten elements describing final state of parsing:
3018 0. depth in parens.
3019 1. character address of start of innermost containing list; nil if none.
3020 2. character address of start of last complete sexp terminated.
3021 3. non-nil if inside a string.
3022 (it is the character that will terminate the string,
3023 or t if the string should be terminated by a generic string delimiter.)
7d0393cf 3024 4. nil if outside a comment, t if inside a non-nestable comment,
fdb82f93
PJ
3025 else an integer (the current comment nesting).
3026 5. t if following a quote character.
3027 6. the minimum paren-depth encountered during this scan.
3028 7. t if in a comment of style b; symbol `syntax-table' if the comment
3029 should be terminated by a generic comment delimiter.
3030 8. character address of start of comment or string; nil if not in one.
3031 9. Intermediate data for continuation of parsing (subject to change).
3032If third arg TARGETDEPTH is non-nil, parsing stops if the depth
3033in parentheses becomes equal to TARGETDEPTH.
3034Fourth arg STOPBEFORE non-nil means stop when come to
3035 any character that starts a sexp.
3036Fifth arg OLDSTATE is a nine-element list like what this function returns.
3037 It is used to initialize the state of the parse. Elements number 1, 2, 6
3038 and 8 are ignored; you can leave off element 8 (the last) entirely.
3039Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
3040 If it is symbol `syntax-table', stop after the start of a comment or a
3041 string, or after end of a comment or a string. */)
3042 (from, to, targetdepth, stopbefore, oldstate, commentstop)
c81a3712 3043 Lisp_Object from, to, targetdepth, stopbefore, oldstate, commentstop;
8489eb67
RS
3044{
3045 struct lisp_parse_state state;
3046 int target;
3047
265a9e55 3048 if (!NILP (targetdepth))
8489eb67 3049 {
b7826503 3050 CHECK_NUMBER (targetdepth);
8489eb67
RS
3051 target = XINT (targetdepth);
3052 }
3053 else
3054 target = -100000; /* We won't reach this depth */
3055
3056 validate_region (&from, &to);
6a140a74
RS
3057 scan_sexps_forward (&state, XINT (from), CHAR_TO_BYTE (XINT (from)),
3058 XINT (to),
c81a3712 3059 target, !NILP (stopbefore), oldstate,
7d0393cf 3060 (NILP (commentstop)
195d1361 3061 ? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1)));
8489eb67
RS
3062
3063 SET_PT (state.location);
7d0393cf 3064
8489eb67
RS
3065 return Fcons (make_number (state.depth),
3066 Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart),
3067 Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart),
7d0393cf
JB
3068 Fcons (state.instring >= 0
3069 ? (state.instring == ST_STRING_STYLE
195d1361 3070 ? Qt : make_number (state.instring)) : Qnil,
95ff8dfc
RS
3071 Fcons (state.incomment < 0 ? Qt :
3072 (state.incomment == 0 ? Qnil :
3073 make_number (state.incomment)),
8489eb67 3074 Fcons (state.quoted ? Qt : Qnil,
bff37d2a 3075 Fcons (make_number (state.mindepth),
7d0393cf 3076 Fcons ((state.comstyle
bff37d2a
RS
3077 ? (state.comstyle == ST_COMMENT_STYLE
3078 ? Qsyntax_table : Qt) :
3079 Qnil),
0beaf54f
DL
3080 Fcons (((state.incomment
3081 || (state.instring >= 0))
bff37d2a
RS
3082 ? make_number (state.comstr_start)
3083 : Qnil),
1a102a58 3084 Fcons (state.levelstarts, Qnil))))))))));
8489eb67
RS
3085}
3086\f
dfcf069d 3087void
8489eb67
RS
3088init_syntax_once ()
3089{
78f9a1f7 3090 register int i, c;
8ea151b2 3091 Lisp_Object temp;
8489eb67 3092
5ebaddf5
RS
3093 /* This has to be done here, before we call Fmake_char_table. */
3094 Qsyntax_table = intern ("syntax-table");
3095 staticpro (&Qsyntax_table);
3096
3097 /* Intern this now in case it isn't already done.
3098 Setting this variable twice is harmless.
3099 But don't staticpro it here--that is done in alloc.c. */
3100 Qchar_table_extra_slots = intern ("char-table-extra-slots");
3101
93da5fff 3102 /* Create objects which can be shared among syntax tables. */
42ebfa31 3103 Vsyntax_code_object = Fmake_vector (make_number (Smax), Qnil);
93da5fff
KH
3104 for (i = 0; i < XVECTOR (Vsyntax_code_object)->size; i++)
3105 XVECTOR (Vsyntax_code_object)->contents[i]
3106 = Fcons (make_number (i), Qnil);
3107
5ebaddf5
RS
3108 /* Now we are ready to set up this property, so we can
3109 create syntax tables. */
3110 Fput (Qsyntax_table, Qchar_table_extra_slots, make_number (0));
3111
93da5fff 3112 temp = XVECTOR (Vsyntax_code_object)->contents[(int) Swhitespace];
8489eb67 3113
5ebaddf5 3114 Vstandard_syntax_table = Fmake_char_table (Qsyntax_table, temp);
8489eb67 3115
93da5fff 3116 temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword];
8489eb67 3117 for (i = 'a'; i <= 'z'; i++)
8ea151b2 3118 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
8489eb67 3119 for (i = 'A'; i <= 'Z'; i++)
8ea151b2 3120 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
8489eb67 3121 for (i = '0'; i <= '9'; i++)
8ea151b2
RS
3122 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
3123
3124 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '$', temp);
3125 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '%', temp);
3126
3127 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '(',
3128 Fcons (make_number (Sopen), make_number (')')));
3129 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ')',
3130 Fcons (make_number (Sclose), make_number ('(')));
3131 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '[',
3132 Fcons (make_number (Sopen), make_number (']')));
3133 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ']',
3134 Fcons (make_number (Sclose), make_number ('[')));
3135 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '{',
3136 Fcons (make_number (Sopen), make_number ('}')));
3137 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '}',
3138 Fcons (make_number (Sclose), make_number ('{')));
3139 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '"',
3140 Fcons (make_number ((int) Sstring), Qnil));
3141 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\\',
3142 Fcons (make_number ((int) Sescape), Qnil));
3143
93da5fff 3144 temp = XVECTOR (Vsyntax_code_object)->contents[(int) Ssymbol];
8489eb67 3145 for (i = 0; i < 10; i++)
78f9a1f7
KH
3146 {
3147 c = "_-+*/&|<>="[i];
3148 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp);
3149 }
8489eb67 3150
93da5fff 3151 temp = XVECTOR (Vsyntax_code_object)->contents[(int) Spunct];
8489eb67 3152 for (i = 0; i < 12; i++)
78f9a1f7
KH
3153 {
3154 c = ".,;:?!#@~^'`"[i];
3155 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp);
3156 }
bd25db08
KH
3157
3158 /* All multibyte characters have syntax `word' by default. */
3159 temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword];
3160 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
3161 XCHAR_TABLE (Vstandard_syntax_table)->contents[i] = temp;
8489eb67
RS
3162}
3163
dfcf069d 3164void
8489eb67
RS
3165syms_of_syntax ()
3166{
3167 Qsyntax_table_p = intern ("syntax-table-p");
3168 staticpro (&Qsyntax_table_p);
3169
93da5fff
KH
3170 staticpro (&Vsyntax_code_object);
3171
a2994c46
KS
3172 staticpro (&gl_state.object);
3173 staticpro (&gl_state.global_code);
3174 staticpro (&gl_state.current_syntax_table);
3175 staticpro (&gl_state.old_prop);
3176
3177 /* Defined in regex.c */
3178 staticpro (&re_match_object);
3179
7bf5e9e4
RS
3180 Qscan_error = intern ("scan-error");
3181 staticpro (&Qscan_error);
3182 Fput (Qscan_error, Qerror_conditions,
f3be100f 3183 Fcons (Qscan_error, Fcons (Qerror, Qnil)));
7bf5e9e4
RS
3184 Fput (Qscan_error, Qerror_message,
3185 build_string ("Scan error"));
3186
8489eb67 3187 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments,
fdb82f93 3188 doc: /* Non-nil means `forward-sexp', etc., should treat comments as whitespace. */);
8489eb67 3189
195d1361 3190 DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties,
fdb82f93
PJ
3191 doc: /* Non-nil means `forward-sexp', etc., obey `syntax-table' property.
3192Otherwise, that text property is simply ignored.
3193See the info node `(elisp)Syntax Properties' for a description of the
3194`syntax-table' property. */);
195d1361 3195
8489eb67
RS
3196 words_include_escapes = 0;
3197 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes,
fdb82f93 3198 doc: /* Non-nil means `forward-word', etc., should treat escape chars part of words. */);
8489eb67 3199
bd25db08 3200 DEFVAR_BOOL ("multibyte-syntax-as-symbol", &multibyte_syntax_as_symbol,
fdb82f93 3201 doc: /* Non-nil means `scan-sexps' treats all multibyte characters as symbol. */);
bd25db08
KH
3202 multibyte_syntax_as_symbol = 0;
3203
f4ed767f
GM
3204 DEFVAR_BOOL ("open-paren-in-column-0-is-defun-start",
3205 &open_paren_in_column_0_is_defun_start,
b222e415 3206 doc: /* *Non-nil means an open paren in column 0 denotes the start of a defun. */);
f4ed767f
GM
3207 open_paren_in_column_0_is_defun_start = 1;
3208
8489eb67
RS
3209 defsubr (&Ssyntax_table_p);
3210 defsubr (&Ssyntax_table);
3211 defsubr (&Sstandard_syntax_table);
3212 defsubr (&Scopy_syntax_table);
3213 defsubr (&Sset_syntax_table);
3214 defsubr (&Schar_syntax);
beefa22e 3215 defsubr (&Smatching_paren);
c65adb44 3216 defsubr (&Sstring_to_syntax);
8489eb67 3217 defsubr (&Smodify_syntax_entry);
62abe9cb 3218 defsubr (&Sinternal_describe_syntax_value);
8489eb67
RS
3219
3220 defsubr (&Sforward_word);
3221
195d1361
RS
3222 defsubr (&Sskip_chars_forward);
3223 defsubr (&Sskip_chars_backward);
3224 defsubr (&Sskip_syntax_forward);
3225 defsubr (&Sskip_syntax_backward);
3226
b3cfe0c8 3227 defsubr (&Sforward_comment);
8489eb67
RS
3228 defsubr (&Sscan_lists);
3229 defsubr (&Sscan_sexps);
3230 defsubr (&Sbackward_prefix_chars);
3231 defsubr (&Sparse_partial_sexp);
3232}
ab5796a9
MB
3233
3234/* arch-tag: 3e297b9f-088e-4b64-8f4c-fb0b3443e412
3235 (do not change this comment) */