(scan_lists): Get error if eob within comment with depth!=0.
[bpt/emacs.git] / src / syntax.c
1 /* GNU Emacs routines to deal with syntax tables; also word and list parsing.
2 Copyright (C) 1985, 1987, 1993, 1994 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21 #include <config.h>
22 #include <ctype.h>
23 #include "lisp.h"
24 #include "commands.h"
25 #include "buffer.h"
26 #include "syntax.h"
27
28 Lisp_Object Qsyntax_table_p;
29
30 static void scan_sexps_forward ();
31 static int char_quoted ();
32
33 int words_include_escapes;
34
35 /* This is the internal form of the parse state used in parse-partial-sexp. */
36
37 struct lisp_parse_state
38 {
39 int depth; /* Depth at end of parsing */
40 int instring; /* -1 if not within string, else desired terminator. */
41 int incomment; /* Nonzero if within a comment at end of parsing */
42 int comstyle; /* comment style a=0, or b=1 */
43 int quoted; /* Nonzero if just after an escape char at end of parsing */
44 int thislevelstart; /* Char number of most recent start-of-expression at current level */
45 int prevlevelstart; /* Char number of start of containing expression */
46 int location; /* Char number at which parsing stopped. */
47 int mindepth; /* Minimum depth seen while scanning. */
48 int comstart; /* Position just after last comment starter. */
49 };
50 \f
51 /* These variables are a cache for finding the start of a defun.
52 find_start_pos is the place for which the defun start was found.
53 find_start_value is the defun start position found for it.
54 find_start_buffer is the buffer it was found in.
55 find_start_begv is the BEGV value when it was found.
56 find_start_modiff is the value of MODIFF when it was found. */
57
58 static int find_start_pos;
59 static int find_start_value;
60 static struct buffer *find_start_buffer;
61 static int find_start_begv;
62 static int find_start_modiff;
63
64 /* Find a defun-start that is the last one before POS (or nearly the last).
65 We record what we find, so that another call in the same area
66 can return the same value right away. */
67
68 static int
69 find_defun_start (pos)
70 int pos;
71 {
72 int tem;
73 int shortage;
74
75 /* Use previous finding, if it's valid and applies to this inquiry. */
76 if (current_buffer == find_start_buffer
77 /* Reuse the defun-start even if POS is a little farther on.
78 POS might be in the next defun, but that's ok.
79 Our value may not be the best possible, but will still be usable. */
80 && pos <= find_start_pos + 1000
81 && pos >= find_start_value
82 && BEGV == find_start_begv
83 && MODIFF == find_start_modiff)
84 return find_start_value;
85
86 /* Back up to start of line. */
87 tem = scan_buffer ('\n', pos, -1, &shortage, 1);
88
89 while (tem > BEGV)
90 {
91 /* Open-paren at start of line means we found our defun-start. */
92 if (SYNTAX (FETCH_CHAR (tem)) == Sopen)
93 break;
94 /* Move to beg of previous line. */
95 tem = scan_buffer ('\n', tem, -2, &shortage, 1);
96 }
97
98 /* Record what we found, for the next try. */
99 find_start_value = tem;
100 find_start_buffer = current_buffer;
101 find_start_modiff = MODIFF;
102 find_start_begv = BEGV;
103 find_start_pos = pos;
104
105 return find_start_value;
106 }
107 \f
108 DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0,
109 "Return t if ARG is a syntax table.\n\
110 Any vector of 256 elements will do.")
111 (obj)
112 Lisp_Object obj;
113 {
114 if (XTYPE (obj) == Lisp_Vector && XVECTOR (obj)->size == 0400)
115 return Qt;
116 return Qnil;
117 }
118
119 Lisp_Object
120 check_syntax_table (obj)
121 Lisp_Object obj;
122 {
123 register Lisp_Object tem;
124 while (tem = Fsyntax_table_p (obj),
125 NILP (tem))
126 obj = wrong_type_argument (Qsyntax_table_p, obj);
127 return obj;
128 }
129
130
131 DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0,
132 "Return the current syntax table.\n\
133 This is the one specified by the current buffer.")
134 ()
135 {
136 return current_buffer->syntax_table;
137 }
138
139 DEFUN ("standard-syntax-table", Fstandard_syntax_table,
140 Sstandard_syntax_table, 0, 0, 0,
141 "Return the standard syntax table.\n\
142 This is the one used for new buffers.")
143 ()
144 {
145 return Vstandard_syntax_table;
146 }
147
148 DEFUN ("copy-syntax-table", Fcopy_syntax_table, Scopy_syntax_table, 0, 1, 0,
149 "Construct a new syntax table and return it.\n\
150 It is a copy of the TABLE, which defaults to the standard syntax table.")
151 (table)
152 Lisp_Object table;
153 {
154 Lisp_Object size, val;
155 XFASTINT (size) = 0400;
156 XFASTINT (val) = 0;
157 val = Fmake_vector (size, val);
158 if (!NILP (table))
159 table = check_syntax_table (table);
160 else if (NILP (Vstandard_syntax_table))
161 /* Can only be null during initialization */
162 return val;
163 else table = Vstandard_syntax_table;
164
165 bcopy (XVECTOR (table)->contents,
166 XVECTOR (val)->contents, 0400 * sizeof (Lisp_Object));
167 return val;
168 }
169
170 DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 1, 0,
171 "Select a new syntax table for the current buffer.\n\
172 One argument, a syntax table.")
173 (table)
174 Lisp_Object table;
175 {
176 table = check_syntax_table (table);
177 current_buffer->syntax_table = table;
178 /* Indicate that this buffer now has a specified syntax table. */
179 current_buffer->local_var_flags
180 |= XFASTINT (buffer_local_flags.syntax_table);
181 return table;
182 }
183 \f
184 /* Convert a letter which signifies a syntax code
185 into the code it signifies.
186 This is used by modify-syntax-entry, and other things. */
187
188 unsigned char syntax_spec_code[0400] =
189 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
190 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
191 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
192 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
193 (char) Swhitespace, 0377, (char) Sstring, 0377,
194 (char) Smath, 0377, 0377, (char) Squote,
195 (char) Sopen, (char) Sclose, 0377, 0377,
196 0377, (char) Swhitespace, (char) Spunct, (char) Scharquote,
197 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
198 0377, 0377, 0377, 0377,
199 (char) Scomment, 0377, (char) Sendcomment, 0377,
200 (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */
201 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
202 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
203 0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol,
204 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
205 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
206 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
207 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377
208 };
209
210 /* Indexed by syntax code, give the letter that describes it. */
211
212 char syntax_code_spec[14] =
213 {
214 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@'
215 };
216 \f
217 DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0,
218 "Return the syntax code of CHAR, described by a character.\n\
219 For example, if CHAR is a word constituent, the character `?w' is returned.\n\
220 The characters that correspond to various syntax codes\n\
221 are listed in the documentation of `modify-syntax-entry'.")
222 (ch)
223 Lisp_Object ch;
224 {
225 CHECK_NUMBER (ch, 0);
226 return make_number (syntax_code_spec[(int) SYNTAX (0xFF & XINT (ch))]);
227 }
228
229 /* This comment supplies the doc string for modify-syntax-entry,
230 for make-docfile to see. We cannot put this in the real DEFUN
231 due to limits in the Unix cpp.
232
233 DEFUN ("modify-syntax-entry", foo, bar, 2, 3, 0,
234 "Set syntax for character CHAR according to string S.\n\
235 The syntax is changed only for table TABLE, which defaults to\n\
236 the current buffer's syntax table.\n\
237 The first character of S should be one of the following:\n\
238 Space or - whitespace syntax. w word constituent.\n\
239 _ symbol constituent. . punctuation.\n\
240 ( open-parenthesis. ) close-parenthesis.\n\
241 \" string quote. \\ escape.\n\
242 $ paired delimiter. ' expression quote or prefix operator.\n\
243 < comment starter. > comment ender.\n\
244 / character-quote. @ inherit from `standard-syntax-table'.\n\
245 \n\
246 Only single-character comment start and end sequences are represented thus.\n\
247 Two-character sequences are represented as described below.\n\
248 The second character of S is the matching parenthesis,\n\
249 used only if the first character is `(' or `)'.\n\
250 Any additional characters are flags.\n\
251 Defined flags are the characters 1, 2, 3, 4, b, and p.\n\
252 1 means C is the start of a two-char comment start sequence.\n\
253 2 means C is the second character of such a sequence.\n\
254 3 means C is the start of a two-char comment end sequence.\n\
255 4 means C is the second character of such a sequence.\n\
256 \n\
257 There can be up to two orthogonal comment sequences. This is to support\n\
258 language modes such as C++. By default, all comment sequences are of style\n\
259 a, but you can set the comment sequence style to b (on the second character\n\
260 of a comment-start, or the first character of a comment-end sequence) using\n\
261 this flag:\n\
262 b means C is part of comment sequence b.\n\
263 \n\
264 p means C is a prefix character for `backward-prefix-chars';\n\
265 such characters are treated as whitespace when they occur\n\
266 between expressions.")
267 (char, s, table)
268 */
269
270 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3,
271 /* I really don't know why this is interactive
272 help-form should at least be made useful whilst reading the second arg
273 */
274 "cSet syntax for character: \nsSet syntax for %s to: ",
275 0 /* See immediately above */)
276 (c, newentry, syntax_table)
277 Lisp_Object c, newentry, syntax_table;
278 {
279 register unsigned char *p, match;
280 register enum syntaxcode code;
281 Lisp_Object val;
282
283 CHECK_NUMBER (c, 0);
284 CHECK_STRING (newentry, 1);
285 if (NILP (syntax_table))
286 syntax_table = current_buffer->syntax_table;
287 else
288 syntax_table = check_syntax_table (syntax_table);
289
290 p = XSTRING (newentry)->data;
291 code = (enum syntaxcode) syntax_spec_code[*p++];
292 if (((int) code & 0377) == 0377)
293 error ("invalid syntax description letter: %c", c);
294
295 match = *p;
296 if (match) p++;
297 if (match == ' ') match = 0;
298
299 XFASTINT (val) = (match << 8) + (int) code;
300 while (*p)
301 switch (*p++)
302 {
303 case '1':
304 XFASTINT (val) |= 1 << 16;
305 break;
306
307 case '2':
308 XFASTINT (val) |= 1 << 17;
309 break;
310
311 case '3':
312 XFASTINT (val) |= 1 << 18;
313 break;
314
315 case '4':
316 XFASTINT (val) |= 1 << 19;
317 break;
318
319 case 'p':
320 XFASTINT (val) |= 1 << 20;
321 break;
322
323 case 'b':
324 XFASTINT (val) |= 1 << 21;
325 break;
326 }
327
328 XVECTOR (syntax_table)->contents[0xFF & XINT (c)] = val;
329
330 return Qnil;
331 }
332 \f
333 /* Dump syntax table to buffer in human-readable format */
334
335 static void
336 describe_syntax (value)
337 Lisp_Object value;
338 {
339 register enum syntaxcode code;
340 char desc, match, start1, start2, end1, end2, prefix, comstyle;
341 char str[2];
342
343 Findent_to (make_number (16), make_number (1));
344
345 if (XTYPE (value) != Lisp_Int)
346 {
347 insert_string ("invalid");
348 return;
349 }
350
351 code = (enum syntaxcode) (XINT (value) & 0377);
352 match = (XINT (value) >> 8) & 0377;
353 start1 = (XINT (value) >> 16) & 1;
354 start2 = (XINT (value) >> 17) & 1;
355 end1 = (XINT (value) >> 18) & 1;
356 end2 = (XINT (value) >> 19) & 1;
357 prefix = (XINT (value) >> 20) & 1;
358 comstyle = (XINT (value) >> 21) & 1;
359
360 if ((int) code < 0 || (int) code >= (int) Smax)
361 {
362 insert_string ("invalid");
363 return;
364 }
365 desc = syntax_code_spec[(int) code];
366
367 str[0] = desc, str[1] = 0;
368 insert (str, 1);
369
370 str[0] = match ? match : ' ';
371 insert (str, 1);
372
373
374 if (start1)
375 insert ("1", 1);
376 if (start2)
377 insert ("2", 1);
378
379 if (end1)
380 insert ("3", 1);
381 if (end2)
382 insert ("4", 1);
383
384 if (prefix)
385 insert ("p", 1);
386 if (comstyle)
387 insert ("b", 1);
388
389 insert_string ("\twhich means: ");
390
391 #ifdef SWITCH_ENUM_BUG
392 switch ((int) code)
393 #else
394 switch (code)
395 #endif
396 {
397 case Swhitespace:
398 insert_string ("whitespace"); break;
399 case Spunct:
400 insert_string ("punctuation"); break;
401 case Sword:
402 insert_string ("word"); break;
403 case Ssymbol:
404 insert_string ("symbol"); break;
405 case Sopen:
406 insert_string ("open"); break;
407 case Sclose:
408 insert_string ("close"); break;
409 case Squote:
410 insert_string ("quote"); break;
411 case Sstring:
412 insert_string ("string"); break;
413 case Smath:
414 insert_string ("math"); break;
415 case Sescape:
416 insert_string ("escape"); break;
417 case Scharquote:
418 insert_string ("charquote"); break;
419 case Scomment:
420 insert_string ("comment"); break;
421 case Sendcomment:
422 insert_string ("endcomment"); break;
423 case Sinherit:
424 insert_string ("inherit"); break;
425 default:
426 insert_string ("invalid");
427 return;
428 }
429
430 if (match)
431 {
432 insert_string (", matches ");
433 insert_char (match);
434 }
435
436 if (start1)
437 insert_string (",\n\t is the first character of a comment-start sequence");
438 if (start2)
439 insert_string (",\n\t is the second character of a comment-start sequence");
440
441 if (end1)
442 insert_string (",\n\t is the first character of a comment-end sequence");
443 if (end2)
444 insert_string (",\n\t is the second character of a comment-end sequence");
445 if (comstyle)
446 insert_string (" (comment style b)");
447
448 if (prefix)
449 insert_string (",\n\t is a prefix character for `backward-prefix-chars'");
450
451 insert_string ("\n");
452 }
453
454 static Lisp_Object
455 describe_syntax_1 (vector)
456 Lisp_Object vector;
457 {
458 struct buffer *old = current_buffer;
459 set_buffer_internal (XBUFFER (Vstandard_output));
460 describe_vector (vector, Qnil, describe_syntax, 0, Qnil);
461 set_buffer_internal (old);
462 return Qnil;
463 }
464
465 DEFUN ("describe-syntax", Fdescribe_syntax, Sdescribe_syntax, 0, 0, "",
466 "Describe the syntax specifications in the syntax table.\n\
467 The descriptions are inserted in a buffer, which is then displayed.")
468 ()
469 {
470 internal_with_output_to_temp_buffer
471 ("*Help*", describe_syntax_1, current_buffer->syntax_table);
472
473 return Qnil;
474 }
475 \f
476 /* Return the position across COUNT words from FROM.
477 If that many words cannot be found before the end of the buffer, return 0.
478 COUNT negative means scan backward and stop at word beginning. */
479
480 scan_words (from, count)
481 register int from, count;
482 {
483 register int beg = BEGV;
484 register int end = ZV;
485 register int code;
486
487 immediate_quit = 1;
488 QUIT;
489
490 while (count > 0)
491 {
492 while (1)
493 {
494 if (from == end)
495 {
496 immediate_quit = 0;
497 return 0;
498 }
499 code = SYNTAX (FETCH_CHAR (from));
500 if (words_include_escapes
501 && (code == Sescape || code == Scharquote))
502 break;
503 if (code == Sword)
504 break;
505 from++;
506 }
507 while (1)
508 {
509 if (from == end) break;
510 code = SYNTAX (FETCH_CHAR (from));
511 if (!(words_include_escapes
512 && (code == Sescape || code == Scharquote)))
513 if (code != Sword)
514 break;
515 from++;
516 }
517 count--;
518 }
519 while (count < 0)
520 {
521 while (1)
522 {
523 if (from == beg)
524 {
525 immediate_quit = 0;
526 return 0;
527 }
528 code = SYNTAX (FETCH_CHAR (from - 1));
529 if (words_include_escapes
530 && (code == Sescape || code == Scharquote))
531 break;
532 if (code == Sword)
533 break;
534 from--;
535 }
536 while (1)
537 {
538 if (from == beg) break;
539 code = SYNTAX (FETCH_CHAR (from - 1));
540 if (!(words_include_escapes
541 && (code == Sescape || code == Scharquote)))
542 if (code != Sword)
543 break;
544 from--;
545 }
546 count++;
547 }
548
549 immediate_quit = 0;
550
551 return from;
552 }
553
554 DEFUN ("forward-word", Fforward_word, Sforward_word, 1, 1, "p",
555 "Move point forward ARG words (backward if ARG is negative).\n\
556 Normally returns t.\n\
557 If an edge of the buffer is reached, point is left there\n\
558 and nil is returned.")
559 (count)
560 Lisp_Object count;
561 {
562 int val;
563 CHECK_NUMBER (count, 0);
564
565 if (!(val = scan_words (point, XINT (count))))
566 {
567 SET_PT (XINT (count) > 0 ? ZV : BEGV);
568 return Qnil;
569 }
570 SET_PT (val);
571 return Qt;
572 }
573 \f
574 DEFUN ("forward-comment", Fforward_comment, Sforward_comment, 1, 1, 0,
575 "Move forward across up to N comments. If N is negative, move backward.\n\
576 Stop scanning if we find something other than a comment or whitespace.\n\
577 Set point to where scanning stops.\n\
578 If N comments are found as expected, with nothing except whitespace\n\
579 between them, return t; otherwise return nil.")
580 (count)
581 Lisp_Object count;
582 {
583 register int from;
584 register int stop;
585 register int c;
586 register enum syntaxcode code;
587 int comstyle = 0; /* style of comment encountered */
588 int found;
589 int count1;
590
591 CHECK_NUMBER (count, 0);
592 count1 = XINT (count);
593
594 immediate_quit = 1;
595 QUIT;
596
597 from = PT;
598
599 while (count1 > 0)
600 {
601 stop = ZV;
602 do
603 {
604 if (from == stop)
605 {
606 SET_PT (from);
607 return Qnil;
608 }
609 c = FETCH_CHAR (from);
610 code = SYNTAX (c);
611 from++;
612 comstyle = 0;
613 if (from < stop && SYNTAX_COMSTART_FIRST (c)
614 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from)))
615 {
616 /* We have encountered a comment start sequence and we
617 are ignoring all text inside comments. We must record
618 the comment style this sequence begins so that later,
619 only a comment end of the same style actually ends
620 the comment section. */
621 code = Scomment;
622 comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from));
623 from++;
624 }
625 }
626 while (code == Swhitespace || code == Sendcomment);
627 if (code != Scomment)
628 {
629 immediate_quit = 0;
630 SET_PT (from - 1);
631 return Qnil;
632 }
633 /* We're at the start of a comment. */
634 while (1)
635 {
636 if (from == stop)
637 {
638 immediate_quit = 0;
639 SET_PT (from);
640 return Qnil;
641 }
642 c = FETCH_CHAR (from);
643 if (SYNTAX (c) == Sendcomment
644 && SYNTAX_COMMENT_STYLE (c) == comstyle)
645 /* we have encountered a comment end of the same style
646 as the comment sequence which began this comment
647 section */
648 break;
649 from++;
650 if (from < stop && SYNTAX_COMEND_FIRST (c)
651 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from))
652 && SYNTAX_COMMENT_STYLE (c) == comstyle)
653 /* we have encountered a comment end of the same style
654 as the comment sequence which began this comment
655 section */
656 { from++; break; }
657 }
658 /* We have skipped one comment. */
659 count1--;
660 }
661
662 while (count1 < 0)
663 {
664 stop = BEGV;
665 while (from > stop)
666 {
667 int quoted;
668
669 from--;
670 quoted = char_quoted (from);
671 if (quoted)
672 from--;
673 c = FETCH_CHAR (from);
674 code = SYNTAX (c);
675 comstyle = 0;
676 if (code == Sendcomment)
677 comstyle = SYNTAX_COMMENT_STYLE (c);
678 if (from > stop && SYNTAX_COMEND_SECOND (c)
679 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1))
680 && !char_quoted (from - 1))
681 {
682 /* We must record the comment style encountered so that
683 later, we can match only the proper comment begin
684 sequence of the same style. */
685 code = Sendcomment;
686 comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from - 1));
687 from--;
688 }
689
690 if (code == Sendcomment && !quoted)
691 {
692 #if 0
693 if (code != SYNTAX (c))
694 /* For a two-char comment ender, we can assume
695 it does end a comment. So scan back in a simple way. */
696 {
697 if (from != stop) from--;
698 while (1)
699 {
700 if (SYNTAX (c = FETCH_CHAR (from)) == Scomment
701 && SYNTAX_COMMENT_STYLE (c) == comstyle)
702 break;
703 if (from == stop)
704 {
705 immediate_quit = 0;
706 SET_PT (from);
707 return Qnil;
708 }
709 from--;
710 if (SYNTAX_COMSTART_SECOND (c)
711 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from))
712 && SYNTAX_COMMENT_STYLE (c) == comstyle
713 && !char_quoted (from))
714 break;
715 }
716 break;
717 }
718 #endif /* 0 */
719
720 /* Look back, counting the parity of string-quotes,
721 and recording the comment-starters seen.
722 When we reach a safe place, assume that's not in a string;
723 then step the main scan to the earliest comment-starter seen
724 an even number of string quotes away from the safe place.
725
726 OFROM[I] is position of the earliest comment-starter seen
727 which is I+2X quotes from the comment-end.
728 PARITY is current parity of quotes from the comment end. */
729 {
730 int parity = 0;
731 char my_stringend = 0;
732 int string_lossage = 0;
733 int comment_end = from;
734 int comstart_pos = 0;
735 int comstart_parity = 0;
736
737 /* At beginning of range to scan, we're outside of strings;
738 that determines quote parity to the comment-end. */
739 while (from != stop)
740 {
741 /* Move back and examine a character. */
742 from--;
743
744 c = FETCH_CHAR (from);
745 code = SYNTAX (c);
746
747 /* If this char is the second of a 2-char comment sequence,
748 back up and give the pair the appropriate syntax. */
749 if (from > stop && SYNTAX_COMEND_SECOND (c)
750 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1)))
751 {
752 code = Sendcomment;
753 from--;
754 }
755
756 else if (from > stop && SYNTAX_COMSTART_SECOND (c)
757 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from - 1))
758 && comstyle == SYNTAX_COMMENT_STYLE (c))
759 {
760 code = Scomment;
761 from--;
762 }
763
764 /* Ignore escaped characters. */
765 if (char_quoted (from))
766 continue;
767
768 /* Track parity of quotes. */
769 if (code == Sstring)
770 {
771 parity ^= 1;
772 if (my_stringend == 0)
773 my_stringend = c;
774 /* If we have two kinds of string delimiters.
775 There's no way to grok this scanning backwards. */
776 else if (my_stringend != c)
777 string_lossage = 1;
778 }
779
780 /* Record comment-starters according to that
781 quote-parity to the comment-end. */
782 if (code == Scomment)
783 {
784 comstart_parity = parity;
785 comstart_pos = from;
786 }
787
788 /* If we find another earlier comment-ender,
789 any comment-starts earlier than that don't count
790 (because they go with the earlier comment-ender). */
791 if (code == Sendcomment
792 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from)) == comstyle)
793 break;
794
795 /* Assume a defun-start point is outside of strings. */
796 if (code == Sopen
797 && (from == stop || FETCH_CHAR (from - 1) == '\n'))
798 break;
799 }
800
801 if (comstart_pos == 0)
802 from = comment_end;
803 /* If the earliest comment starter
804 is followed by uniform paired string quotes or none,
805 we know it can't be inside a string
806 since if it were then the comment ender would be inside one.
807 So it does start a comment. Skip back to it. */
808 else if (comstart_parity == 0 && !string_lossage)
809 from = comstart_pos;
810 else
811 {
812 /* We had two kinds of string delimiters mixed up
813 together. Decode this going forwards.
814 Scan fwd from the previous comment ender
815 to the one in question; this records where we
816 last passed a comment starter. */
817 struct lisp_parse_state state;
818 scan_sexps_forward (&state, find_defun_start (comment_end),
819 comment_end - 1, -10000, 0, Qnil, 0);
820 if (state.incomment)
821 from = state.comstart;
822 else
823 /* We can't grok this as a comment; scan it normally. */
824 from = comment_end;
825 }
826 }
827 /* We have skipped one comment. */
828 break;
829 }
830 else if ((code != Swhitespace && code != Scomment) || quoted)
831 {
832 immediate_quit = 0;
833 SET_PT (from + 1);
834 return Qnil;
835 }
836 }
837
838 count1++;
839 }
840
841 SET_PT (from);
842 immediate_quit = 0;
843 return Qt;
844 }
845 \f
846 int parse_sexp_ignore_comments;
847
848 Lisp_Object
849 scan_lists (from, count, depth, sexpflag)
850 register int from;
851 int count, depth, sexpflag;
852 {
853 Lisp_Object val;
854 register int stop;
855 register int c;
856 char stringterm;
857 int quoted;
858 int mathexit = 0;
859 register enum syntaxcode code;
860 int min_depth = depth; /* Err out if depth gets less than this. */
861 int comstyle = 0; /* style of comment encountered */
862
863 if (depth > 0) min_depth = 0;
864
865 immediate_quit = 1;
866 QUIT;
867
868 while (count > 0)
869 {
870 stop = ZV;
871 while (from < stop)
872 {
873 c = FETCH_CHAR (from);
874 code = SYNTAX (c);
875 from++;
876 if (from < stop && SYNTAX_COMSTART_FIRST (c)
877 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from))
878 && parse_sexp_ignore_comments)
879 {
880 /* we have encountered a comment start sequence and we
881 are ignoring all text inside comments. we must record
882 the comment style this sequence begins so that later,
883 only a comment end of the same style actually ends
884 the comment section */
885 code = Scomment;
886 comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from));
887 from++;
888 }
889
890 if (SYNTAX_PREFIX (c))
891 continue;
892
893 #ifdef SWITCH_ENUM_BUG
894 switch ((int) code)
895 #else
896 switch (code)
897 #endif
898 {
899 case Sescape:
900 case Scharquote:
901 if (from == stop) goto lose;
902 from++;
903 /* treat following character as a word constituent */
904 case Sword:
905 case Ssymbol:
906 if (depth || !sexpflag) break;
907 /* This word counts as a sexp; return at end of it. */
908 while (from < stop)
909 {
910 #ifdef SWITCH_ENUM_BUG
911 switch ((int) SYNTAX (FETCH_CHAR (from)))
912 #else
913 switch (SYNTAX (FETCH_CHAR (from)))
914 #endif
915 {
916 case Scharquote:
917 case Sescape:
918 from++;
919 if (from == stop) goto lose;
920 break;
921 case Sword:
922 case Ssymbol:
923 case Squote:
924 break;
925 default:
926 goto done;
927 }
928 from++;
929 }
930 goto done;
931
932 case Scomment:
933 if (!parse_sexp_ignore_comments) break;
934 while (1)
935 {
936 if (from == stop)
937 {
938 if (depth == 0)
939 goto done;
940 goto lose;
941 }
942 c = FETCH_CHAR (from);
943 if (SYNTAX (c) == Sendcomment
944 && SYNTAX_COMMENT_STYLE (c) == comstyle)
945 /* we have encountered a comment end of the same style
946 as the comment sequence which began this comment
947 section */
948 break;
949 from++;
950 if (from < stop && SYNTAX_COMEND_FIRST (c)
951 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from))
952 && SYNTAX_COMMENT_STYLE (c) == comstyle)
953 /* we have encountered a comment end of the same style
954 as the comment sequence which began this comment
955 section */
956 { from++; break; }
957 }
958 break;
959
960 case Smath:
961 if (!sexpflag)
962 break;
963 if (from != stop && c == FETCH_CHAR (from))
964 from++;
965 if (mathexit)
966 {
967 mathexit = 0;
968 goto close1;
969 }
970 mathexit = 1;
971
972 case Sopen:
973 if (!++depth) goto done;
974 break;
975
976 case Sclose:
977 close1:
978 if (!--depth) goto done;
979 if (depth < min_depth)
980 error ("Containing expression ends prematurely");
981 break;
982
983 case Sstring:
984 stringterm = FETCH_CHAR (from - 1);
985 while (1)
986 {
987 if (from >= stop) goto lose;
988 if (FETCH_CHAR (from) == stringterm) break;
989 #ifdef SWITCH_ENUM_BUG
990 switch ((int) SYNTAX (FETCH_CHAR (from)))
991 #else
992 switch (SYNTAX (FETCH_CHAR (from)))
993 #endif
994 {
995 case Scharquote:
996 case Sescape:
997 from++;
998 }
999 from++;
1000 }
1001 from++;
1002 if (!depth && sexpflag) goto done;
1003 break;
1004 }
1005 }
1006
1007 /* Reached end of buffer. Error if within object, return nil if between */
1008 if (depth) goto lose;
1009
1010 immediate_quit = 0;
1011 return Qnil;
1012
1013 /* End of object reached */
1014 done:
1015 count--;
1016 }
1017
1018 while (count < 0)
1019 {
1020 stop = BEGV;
1021 while (from > stop)
1022 {
1023 from--;
1024 if (quoted = char_quoted (from))
1025 from--;
1026 c = FETCH_CHAR (from);
1027 code = SYNTAX (c);
1028 comstyle = 0;
1029 if (code == Sendcomment)
1030 comstyle = SYNTAX_COMMENT_STYLE (c);
1031 if (from > stop && SYNTAX_COMEND_SECOND (c)
1032 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1))
1033 && !char_quoted (from - 1)
1034 && parse_sexp_ignore_comments)
1035 {
1036 /* we must record the comment style encountered so that
1037 later, we can match only the proper comment begin
1038 sequence of the same style */
1039 code = Sendcomment;
1040 comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from - 1));
1041 from--;
1042 }
1043
1044 if (SYNTAX_PREFIX (c))
1045 continue;
1046
1047 #ifdef SWITCH_ENUM_BUG
1048 switch ((int) (quoted ? Sword : code))
1049 #else
1050 switch (quoted ? Sword : code)
1051 #endif
1052 {
1053 case Sword:
1054 case Ssymbol:
1055 if (depth || !sexpflag) break;
1056 /* This word counts as a sexp; count object finished after passing it. */
1057 while (from > stop)
1058 {
1059 quoted = char_quoted (from - 1);
1060 if (quoted)
1061 from--;
1062 if (! (quoted || SYNTAX (FETCH_CHAR (from - 1)) == Sword
1063 || SYNTAX (FETCH_CHAR (from - 1)) == Ssymbol
1064 || SYNTAX (FETCH_CHAR (from - 1)) == Squote))
1065 goto done2;
1066 from--;
1067 }
1068 goto done2;
1069
1070 case Smath:
1071 if (!sexpflag)
1072 break;
1073 if (from != stop && c == FETCH_CHAR (from - 1))
1074 from--;
1075 if (mathexit)
1076 {
1077 mathexit = 0;
1078 goto open2;
1079 }
1080 mathexit = 1;
1081
1082 case Sclose:
1083 if (!++depth) goto done2;
1084 break;
1085
1086 case Sopen:
1087 open2:
1088 if (!--depth) goto done2;
1089 if (depth < min_depth)
1090 error ("Containing expression ends prematurely");
1091 break;
1092
1093 case Sendcomment:
1094 if (!parse_sexp_ignore_comments)
1095 break;
1096 #if 0
1097 if (code != SYNTAX (c))
1098 /* For a two-char comment ender, we can assume
1099 it does end a comment. So scan back in a simple way. */
1100 {
1101 if (from != stop) from--;
1102 while (1)
1103 {
1104 if (SYNTAX (c = FETCH_CHAR (from)) == Scomment
1105 && SYNTAX_COMMENT_STYLE (c) == comstyle)
1106 break;
1107 if (from == stop)
1108 {
1109 if (depth == 0)
1110 goto done2;
1111 goto lose;
1112 }
1113 from--;
1114 if (SYNTAX_COMSTART_SECOND (c)
1115 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from))
1116 && SYNTAX_COMMENT_STYLE (c) == comstyle
1117 && !char_quoted (from))
1118 break;
1119 }
1120 break;
1121 }
1122 #endif /* 0 */
1123
1124 /* Look back, counting the parity of string-quotes,
1125 and recording the comment-starters seen.
1126 When we reach a safe place, assume that's not in a string;
1127 then step the main scan to the earliest comment-starter seen
1128 an even number of string quotes away from the safe place.
1129
1130 OFROM[I] is position of the earliest comment-starter seen
1131 which is I+2X quotes from the comment-end.
1132 PARITY is current parity of quotes from the comment end. */
1133 {
1134 int parity = 0;
1135 char my_stringend = 0;
1136 int string_lossage = 0;
1137 int comment_end = from;
1138 int comstart_pos = 0;
1139 int comstart_parity = 0;
1140
1141 /* At beginning of range to scan, we're outside of strings;
1142 that determines quote parity to the comment-end. */
1143 while (from != stop)
1144 {
1145 /* Move back and examine a character. */
1146 from--;
1147
1148 c = FETCH_CHAR (from);
1149 code = SYNTAX (c);
1150
1151 /* If this char is the second of a 2-char comment sequence,
1152 back up and give the pair the appropriate syntax. */
1153 if (from > stop && SYNTAX_COMEND_SECOND (c)
1154 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1)))
1155 {
1156 code = Sendcomment;
1157 from--;
1158 }
1159
1160 else if (from > stop && SYNTAX_COMSTART_SECOND (c)
1161 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from - 1))
1162 && comstyle == SYNTAX_COMMENT_STYLE (c))
1163 {
1164 code = Scomment;
1165 from--;
1166 }
1167
1168 /* Ignore escaped characters. */
1169 if (char_quoted (from))
1170 continue;
1171
1172 /* Track parity of quotes. */
1173 if (code == Sstring)
1174 {
1175 parity ^= 1;
1176 if (my_stringend == 0)
1177 my_stringend = c;
1178 /* If we have two kinds of string delimiters.
1179 There's no way to grok this scanning backwards. */
1180 else if (my_stringend != c)
1181 string_lossage = 1;
1182 }
1183
1184 /* Record comment-starters according to that
1185 quote-parity to the comment-end. */
1186 if (code == Scomment)
1187 {
1188 comstart_parity = parity;
1189 comstart_pos = from;
1190 }
1191
1192 /* If we find another earlier comment-ender,
1193 any comment-starts earlier than that don't count
1194 (because they go with the earlier comment-ender). */
1195 if (code == Sendcomment
1196 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from)) == comstyle)
1197 break;
1198
1199 /* Assume a defun-start point is outside of strings. */
1200 if (code == Sopen
1201 && (from == stop || FETCH_CHAR (from - 1) == '\n'))
1202 break;
1203 }
1204
1205 if (comstart_pos == 0)
1206 from = comment_end;
1207 /* If the earliest comment starter
1208 is followed by uniform paired string quotes or none,
1209 we know it can't be inside a string
1210 since if it were then the comment ender would be inside one.
1211 So it does start a comment. Skip back to it. */
1212 else if (comstart_parity == 0 && !string_lossage)
1213 from = comstart_pos;
1214 else
1215 {
1216 /* We had two kinds of string delimiters mixed up
1217 together. Decode this going forwards.
1218 Scan fwd from the previous comment ender
1219 to the one in question; this records where we
1220 last passed a comment starter. */
1221 struct lisp_parse_state state;
1222 scan_sexps_forward (&state, find_defun_start (comment_end),
1223 comment_end - 1, -10000, 0, Qnil, 0);
1224 if (state.incomment)
1225 from = state.comstart;
1226 else
1227 /* We can't grok this as a comment; scan it normally. */
1228 from = comment_end;
1229 }
1230 }
1231 break;
1232
1233 case Sstring:
1234 stringterm = FETCH_CHAR (from);
1235 while (1)
1236 {
1237 if (from == stop) goto lose;
1238 if (!char_quoted (from - 1)
1239 && stringterm == FETCH_CHAR (from - 1))
1240 break;
1241 from--;
1242 }
1243 from--;
1244 if (!depth && sexpflag) goto done2;
1245 break;
1246 }
1247 }
1248
1249 /* Reached start of buffer. Error if within object, return nil if between */
1250 if (depth) goto lose;
1251
1252 immediate_quit = 0;
1253 return Qnil;
1254
1255 done2:
1256 count++;
1257 }
1258
1259
1260 immediate_quit = 0;
1261 XFASTINT (val) = from;
1262 return val;
1263
1264 lose:
1265 error ("Unbalanced parentheses");
1266 /* NOTREACHED */
1267 }
1268
1269 static int
1270 char_quoted (pos)
1271 register int pos;
1272 {
1273 register enum syntaxcode code;
1274 register int beg = BEGV;
1275 register int quoted = 0;
1276
1277 while (pos > beg
1278 && ((code = SYNTAX (FETCH_CHAR (pos - 1))) == Scharquote
1279 || code == Sescape))
1280 pos--, quoted = !quoted;
1281 return quoted;
1282 }
1283
1284 DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0,
1285 "Scan from character number FROM by COUNT lists.\n\
1286 Returns the character number of the position thus found.\n\
1287 \n\
1288 If DEPTH is nonzero, paren depth begins counting from that value,\n\
1289 only places where the depth in parentheses becomes zero\n\
1290 are candidates for stopping; COUNT such places are counted.\n\
1291 Thus, a positive value for DEPTH means go out levels.\n\
1292 \n\
1293 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
1294 \n\
1295 If the beginning or end of (the accessible part of) the buffer is reached\n\
1296 and the depth is wrong, an error is signaled.\n\
1297 If the depth is right but the count is not used up, nil is returned.")
1298 (from, count, depth)
1299 Lisp_Object from, count, depth;
1300 {
1301 CHECK_NUMBER (from, 0);
1302 CHECK_NUMBER (count, 1);
1303 CHECK_NUMBER (depth, 2);
1304
1305 return scan_lists (XINT (from), XINT (count), XINT (depth), 0);
1306 }
1307
1308 DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0,
1309 "Scan from character number FROM by COUNT balanced expressions.\n\
1310 If COUNT is negative, scan backwards.\n\
1311 Returns the character number of the position thus found.\n\
1312 \n\
1313 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
1314 \n\
1315 If the beginning or end of (the accessible part of) the buffer is reached\n\
1316 in the middle of a parenthetical grouping, an error is signaled.\n\
1317 If the beginning or end is reached between groupings\n\
1318 but before count is used up, nil is returned.")
1319 (from, count)
1320 Lisp_Object from, count;
1321 {
1322 CHECK_NUMBER (from, 0);
1323 CHECK_NUMBER (count, 1);
1324
1325 return scan_lists (XINT (from), XINT (count), 0, 1);
1326 }
1327
1328 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars,
1329 0, 0, 0,
1330 "Move point backward over any number of chars with prefix syntax.\n\
1331 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
1332 ()
1333 {
1334 int beg = BEGV;
1335 int pos = point;
1336
1337 while (pos > beg && !char_quoted (pos - 1)
1338 && (SYNTAX (FETCH_CHAR (pos - 1)) == Squote
1339 || SYNTAX_PREFIX (FETCH_CHAR (pos - 1))))
1340 pos--;
1341
1342 SET_PT (pos);
1343
1344 return Qnil;
1345 }
1346 \f
1347 /* Parse forward from FROM to END,
1348 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
1349 and return a description of the state of the parse at END.
1350 If STOPBEFORE is nonzero, stop at the start of an atom.
1351 If COMMENTSTOP is nonzero, stop at the start of a comment. */
1352
1353 static void
1354 scan_sexps_forward (stateptr, from, end, targetdepth,
1355 stopbefore, oldstate, commentstop)
1356 struct lisp_parse_state *stateptr;
1357 register int from;
1358 int end, targetdepth, stopbefore;
1359 Lisp_Object oldstate;
1360 int commentstop;
1361 {
1362 struct lisp_parse_state state;
1363
1364 register enum syntaxcode code;
1365 struct level { int last, prev; };
1366 struct level levelstart[100];
1367 register struct level *curlevel = levelstart;
1368 struct level *endlevel = levelstart + 100;
1369 char prev;
1370 register int depth; /* Paren depth of current scanning location.
1371 level - levelstart equals this except
1372 when the depth becomes negative. */
1373 int mindepth; /* Lowest DEPTH value seen. */
1374 int start_quoted = 0; /* Nonzero means starting after a char quote */
1375 Lisp_Object tem;
1376
1377 immediate_quit = 1;
1378 QUIT;
1379
1380 if (NILP (oldstate))
1381 {
1382 depth = 0;
1383 state.instring = -1;
1384 state.incomment = 0;
1385 state.comstyle = 0; /* comment style a by default */
1386 }
1387 else
1388 {
1389 tem = Fcar (oldstate);
1390 if (!NILP (tem))
1391 depth = XINT (tem);
1392 else
1393 depth = 0;
1394
1395 oldstate = Fcdr (oldstate);
1396 oldstate = Fcdr (oldstate);
1397 oldstate = Fcdr (oldstate);
1398 tem = Fcar (oldstate);
1399 state.instring = !NILP (tem) ? XINT (tem) : -1;
1400
1401 oldstate = Fcdr (oldstate);
1402 tem = Fcar (oldstate);
1403 state.incomment = !NILP (tem);
1404
1405 oldstate = Fcdr (oldstate);
1406 tem = Fcar (oldstate);
1407 start_quoted = !NILP (tem);
1408
1409 /* if the eight element of the list is nil, we are in comment
1410 style a. if it is non-nil, we are in comment style b */
1411 oldstate = Fcdr (oldstate);
1412 oldstate = Fcdr (oldstate);
1413 tem = Fcar (oldstate);
1414 state.comstyle = !NILP (tem);
1415 }
1416 state.quoted = 0;
1417 mindepth = depth;
1418
1419 curlevel->prev = -1;
1420 curlevel->last = -1;
1421
1422 /* Enter the loop at a place appropriate for initial state. */
1423
1424 if (state.incomment) goto startincomment;
1425 if (state.instring >= 0)
1426 {
1427 if (start_quoted) goto startquotedinstring;
1428 goto startinstring;
1429 }
1430 if (start_quoted) goto startquoted;
1431
1432 while (from < end)
1433 {
1434 code = SYNTAX (FETCH_CHAR (from));
1435 from++;
1436 if (code == Scomment)
1437 state.comstart = from-1;
1438
1439 else if (from < end && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from - 1))
1440 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from)))
1441 {
1442 /* Record the comment style we have entered so that only
1443 the comment-end sequence of the same style actually
1444 terminates the comment section. */
1445 code = Scomment;
1446 state.comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from));
1447 state.comstart = from-1;
1448 from++;
1449 }
1450
1451 if (SYNTAX_PREFIX (FETCH_CHAR (from - 1)))
1452 continue;
1453 #ifdef SWITCH_ENUM_BUG
1454 switch ((int) code)
1455 #else
1456 switch (code)
1457 #endif
1458 {
1459 case Sescape:
1460 case Scharquote:
1461 if (stopbefore) goto stop; /* this arg means stop at sexp start */
1462 curlevel->last = from - 1;
1463 startquoted:
1464 if (from == end) goto endquoted;
1465 from++;
1466 goto symstarted;
1467 /* treat following character as a word constituent */
1468 case Sword:
1469 case Ssymbol:
1470 if (stopbefore) goto stop; /* this arg means stop at sexp start */
1471 curlevel->last = from - 1;
1472 symstarted:
1473 while (from < end)
1474 {
1475 #ifdef SWITCH_ENUM_BUG
1476 switch ((int) SYNTAX (FETCH_CHAR (from)))
1477 #else
1478 switch (SYNTAX (FETCH_CHAR (from)))
1479 #endif
1480 {
1481 case Scharquote:
1482 case Sescape:
1483 from++;
1484 if (from == end) goto endquoted;
1485 break;
1486 case Sword:
1487 case Ssymbol:
1488 case Squote:
1489 break;
1490 default:
1491 goto symdone;
1492 }
1493 from++;
1494 }
1495 symdone:
1496 curlevel->prev = curlevel->last;
1497 break;
1498
1499 case Scomment:
1500 state.incomment = 1;
1501 startincomment:
1502 if (commentstop)
1503 goto done;
1504 while (1)
1505 {
1506 if (from == end) goto done;
1507 prev = FETCH_CHAR (from);
1508 if (SYNTAX (prev) == Sendcomment
1509 && SYNTAX_COMMENT_STYLE (prev) == state.comstyle)
1510 /* Only terminate the comment section if the endcomment
1511 of the same style as the start sequence has been
1512 encountered. */
1513 break;
1514 from++;
1515 if (from < end && SYNTAX_COMEND_FIRST (prev)
1516 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from))
1517 && SYNTAX_COMMENT_STYLE (prev) == state.comstyle)
1518 /* Only terminate the comment section if the end-comment
1519 sequence of the same style as the start sequence has
1520 been encountered. */
1521 { from++; break; }
1522 }
1523 state.incomment = 0;
1524 state.comstyle = 0; /* reset the comment style */
1525 break;
1526
1527 case Sopen:
1528 if (stopbefore) goto stop; /* this arg means stop at sexp start */
1529 depth++;
1530 /* curlevel++->last ran into compiler bug on Apollo */
1531 curlevel->last = from - 1;
1532 if (++curlevel == endlevel)
1533 error ("Nesting too deep for parser");
1534 curlevel->prev = -1;
1535 curlevel->last = -1;
1536 if (!--targetdepth) goto done;
1537 break;
1538
1539 case Sclose:
1540 depth--;
1541 if (depth < mindepth)
1542 mindepth = depth;
1543 if (curlevel != levelstart)
1544 curlevel--;
1545 curlevel->prev = curlevel->last;
1546 if (!++targetdepth) goto done;
1547 break;
1548
1549 case Sstring:
1550 if (stopbefore) goto stop; /* this arg means stop at sexp start */
1551 curlevel->last = from - 1;
1552 state.instring = FETCH_CHAR (from - 1);
1553 startinstring:
1554 while (1)
1555 {
1556 if (from >= end) goto done;
1557 if (FETCH_CHAR (from) == state.instring) break;
1558 #ifdef SWITCH_ENUM_BUG
1559 switch ((int) SYNTAX (FETCH_CHAR (from)))
1560 #else
1561 switch (SYNTAX (FETCH_CHAR (from)))
1562 #endif
1563 {
1564 case Scharquote:
1565 case Sescape:
1566 from++;
1567 startquotedinstring:
1568 if (from >= end) goto endquoted;
1569 }
1570 from++;
1571 }
1572 state.instring = -1;
1573 curlevel->prev = curlevel->last;
1574 from++;
1575 break;
1576
1577 case Smath:
1578 break;
1579 }
1580 }
1581 goto done;
1582
1583 stop: /* Here if stopping before start of sexp. */
1584 from--; /* We have just fetched the char that starts it; */
1585 goto done; /* but return the position before it. */
1586
1587 endquoted:
1588 state.quoted = 1;
1589 done:
1590 state.depth = depth;
1591 state.mindepth = mindepth;
1592 state.thislevelstart = curlevel->prev;
1593 state.prevlevelstart
1594 = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
1595 state.location = from;
1596 immediate_quit = 0;
1597
1598 *stateptr = state;
1599 }
1600
1601 /* This comment supplies the doc string for parse-partial-sexp,
1602 for make-docfile to see. We cannot put this in the real DEFUN
1603 due to limits in the Unix cpp.
1604
1605 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
1606 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
1607 Parsing stops at TO or when certain criteria are met;\n\
1608 point is set to where parsing stops.\n\
1609 If fifth arg STATE is omitted or nil,\n\
1610 parsing assumes that FROM is the beginning of a function.\n\
1611 Value is a list of eight elements describing final state of parsing:\n\
1612 0. depth in parens.\n\
1613 1. character address of start of innermost containing list; nil if none.\n\
1614 2. character address of start of last complete sexp terminated.\n\
1615 3. non-nil if inside a string.\n\
1616 (it is the character that will terminate the string.)\n\
1617 4. t if inside a comment.\n\
1618 5. t if following a quote character.\n\
1619 6. the minimum paren-depth encountered during this scan.\n\
1620 7. t if in a comment of style `b'.\n\
1621 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
1622 in parentheses becomes equal to TARGETDEPTH.\n\
1623 Fourth arg STOPBEFORE non-nil means stop when come to\n\
1624 any character that starts a sexp.\n\
1625 Fifth arg STATE is an eight-list like what this function returns.\n\
1626 It is used to initialize the state of the parse. Its second and third
1627 elements are ignored.
1628 Sixth args COMMENTSTOP non-nil means stop at the start of a comment.")
1629 (from, to, targetdepth, stopbefore, state, commentstop)
1630 */
1631
1632 DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0,
1633 0 /* See immediately above */)
1634 (from, to, targetdepth, stopbefore, oldstate, commentstop)
1635 Lisp_Object from, to, targetdepth, stopbefore, oldstate, commentstop;
1636 {
1637 struct lisp_parse_state state;
1638 int target;
1639
1640 if (!NILP (targetdepth))
1641 {
1642 CHECK_NUMBER (targetdepth, 3);
1643 target = XINT (targetdepth);
1644 }
1645 else
1646 target = -100000; /* We won't reach this depth */
1647
1648 validate_region (&from, &to);
1649 scan_sexps_forward (&state, XINT (from), XINT (to),
1650 target, !NILP (stopbefore), oldstate,
1651 !NILP (commentstop));
1652
1653 SET_PT (state.location);
1654
1655 return Fcons (make_number (state.depth),
1656 Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart),
1657 Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart),
1658 Fcons (state.instring >= 0 ? make_number (state.instring) : Qnil,
1659 Fcons (state.incomment ? Qt : Qnil,
1660 Fcons (state.quoted ? Qt : Qnil,
1661 Fcons (make_number (state.mindepth),
1662 Fcons (state.comstyle ? Qt : Qnil,
1663 Qnil))))))));
1664 }
1665 \f
1666 init_syntax_once ()
1667 {
1668 register int i;
1669 register struct Lisp_Vector *v;
1670
1671 /* Set this now, so first buffer creation can refer to it. */
1672 /* Make it nil before calling copy-syntax-table
1673 so that copy-syntax-table will know not to try to copy from garbage */
1674 Vstandard_syntax_table = Qnil;
1675 Vstandard_syntax_table = Fcopy_syntax_table (Qnil);
1676
1677 v = XVECTOR (Vstandard_syntax_table);
1678
1679 for (i = 'a'; i <= 'z'; i++)
1680 XFASTINT (v->contents[i]) = (int) Sword;
1681 for (i = 'A'; i <= 'Z'; i++)
1682 XFASTINT (v->contents[i]) = (int) Sword;
1683 for (i = '0'; i <= '9'; i++)
1684 XFASTINT (v->contents[i]) = (int) Sword;
1685 XFASTINT (v->contents['$']) = (int) Sword;
1686 XFASTINT (v->contents['%']) = (int) Sword;
1687
1688 XFASTINT (v->contents['(']) = (int) Sopen + (')' << 8);
1689 XFASTINT (v->contents[')']) = (int) Sclose + ('(' << 8);
1690 XFASTINT (v->contents['[']) = (int) Sopen + (']' << 8);
1691 XFASTINT (v->contents[']']) = (int) Sclose + ('[' << 8);
1692 XFASTINT (v->contents['{']) = (int) Sopen + ('}' << 8);
1693 XFASTINT (v->contents['}']) = (int) Sclose + ('{' << 8);
1694 XFASTINT (v->contents['"']) = (int) Sstring;
1695 XFASTINT (v->contents['\\']) = (int) Sescape;
1696
1697 for (i = 0; i < 10; i++)
1698 XFASTINT (v->contents["_-+*/&|<>="[i]]) = (int) Ssymbol;
1699
1700 for (i = 0; i < 12; i++)
1701 XFASTINT (v->contents[".,;:?!#@~^'`"[i]]) = (int) Spunct;
1702 }
1703
1704 syms_of_syntax ()
1705 {
1706 Qsyntax_table_p = intern ("syntax-table-p");
1707 staticpro (&Qsyntax_table_p);
1708
1709 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments,
1710 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
1711
1712 words_include_escapes = 0;
1713 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes,
1714 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
1715
1716 defsubr (&Ssyntax_table_p);
1717 defsubr (&Ssyntax_table);
1718 defsubr (&Sstandard_syntax_table);
1719 defsubr (&Scopy_syntax_table);
1720 defsubr (&Sset_syntax_table);
1721 defsubr (&Schar_syntax);
1722 defsubr (&Smodify_syntax_entry);
1723 defsubr (&Sdescribe_syntax);
1724
1725 defsubr (&Sforward_word);
1726
1727 defsubr (&Sforward_comment);
1728 defsubr (&Sscan_lists);
1729 defsubr (&Sscan_sexps);
1730 defsubr (&Sbackward_prefix_chars);
1731 defsubr (&Sparse_partial_sexp);
1732 }