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