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