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