(Fsyntax_table_p, describe_syntax): Use type test macros.
[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 (VECTORP (obj) && 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 (!INTEGERP (value))
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 from++;
657 if (SYNTAX (c) == Sendcomment
658 && SYNTAX_COMMENT_STYLE (c) == comstyle)
659 /* we have encountered a comment end of the same style
660 as the comment sequence which began this comment
661 section */
662 break;
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 int scanstart = from - 1;
750
751 /* At beginning of range to scan, we're outside of strings;
752 that determines quote parity to the comment-end. */
753 while (from != stop)
754 {
755 /* Move back and examine a character. */
756 from--;
757
758 c = FETCH_CHAR (from);
759 code = SYNTAX (c);
760
761 /* If this char is the second of a 2-char comment sequence,
762 back up and give the pair the appropriate syntax. */
763 if (from > stop && SYNTAX_COMEND_SECOND (c)
764 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1)))
765 {
766 code = Sendcomment;
767 from--;
768 c = FETCH_CHAR (from);
769 }
770
771 /* If this char starts a 2-char comment start sequence,
772 treat it like a 1-char comment starter. */
773 if (from < scanstart && SYNTAX_COMSTART_FIRST (c)
774 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from + 1))
775 && comstyle == SYNTAX_COMMENT_STYLE (FETCH_CHAR (from + 1)))
776 code = Scomment;
777
778 /* Ignore escaped characters. */
779 if (char_quoted (from))
780 continue;
781
782 /* Track parity of quotes. */
783 if (code == Sstring)
784 {
785 parity ^= 1;
786 if (my_stringend == 0)
787 my_stringend = c;
788 /* If we have two kinds of string delimiters.
789 There's no way to grok this scanning backwards. */
790 else if (my_stringend != c)
791 string_lossage = 1;
792 }
793
794 /* Record comment-starters according to that
795 quote-parity to the comment-end. */
796 if (code == Scomment)
797 {
798 comstart_parity = parity;
799 comstart_pos = from;
800 }
801
802 /* If we find another earlier comment-ender,
803 any comment-starts earlier than that don't count
804 (because they go with the earlier comment-ender). */
805 if (code == Sendcomment
806 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from)) == comstyle)
807 break;
808
809 /* Assume a defun-start point is outside of strings. */
810 if (code == Sopen
811 && (from == stop || FETCH_CHAR (from - 1) == '\n'))
812 break;
813 }
814
815 if (comstart_pos == 0)
816 from = comment_end;
817 /* If the earliest comment starter
818 is followed by uniform paired string quotes or none,
819 we know it can't be inside a string
820 since if it were then the comment ender would be inside one.
821 So it does start a comment. Skip back to it. */
822 else if (comstart_parity == 0 && !string_lossage)
823 from = comstart_pos;
824 else
825 {
826 /* We had two kinds of string delimiters mixed up
827 together. Decode this going forwards.
828 Scan fwd from the previous comment ender
829 to the one in question; this records where we
830 last passed a comment starter. */
831 struct lisp_parse_state state;
832 scan_sexps_forward (&state, find_defun_start (comment_end),
833 comment_end - 1, -10000, 0, Qnil, 0);
834 if (state.incomment)
835 from = state.comstart;
836 else
837 /* We can't grok this as a comment; scan it normally. */
838 from = comment_end;
839 }
840 }
841 /* We have skipped one comment. */
842 break;
843 }
844 else if ((code != Swhitespace && code != Scomment) || quoted)
845 {
846 immediate_quit = 0;
847 SET_PT (from + 1);
848 return Qnil;
849 }
850 }
851
852 count1++;
853 }
854
855 SET_PT (from);
856 immediate_quit = 0;
857 return Qt;
858 }
859 \f
860 int parse_sexp_ignore_comments;
861
862 Lisp_Object
863 scan_lists (from, count, depth, sexpflag)
864 register int from;
865 int count, depth, sexpflag;
866 {
867 Lisp_Object val;
868 register int stop;
869 register int c;
870 char stringterm;
871 int quoted;
872 int mathexit = 0;
873 register enum syntaxcode code;
874 int min_depth = depth; /* Err out if depth gets less than this. */
875 int comstyle = 0; /* style of comment encountered */
876
877 if (depth > 0) min_depth = 0;
878
879 immediate_quit = 1;
880 QUIT;
881
882 while (count > 0)
883 {
884 stop = ZV;
885 while (from < stop)
886 {
887 c = FETCH_CHAR (from);
888 code = SYNTAX (c);
889 from++;
890 if (from < stop && SYNTAX_COMSTART_FIRST (c)
891 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from))
892 && parse_sexp_ignore_comments)
893 {
894 /* we have encountered a comment start sequence and we
895 are ignoring all text inside comments. we must record
896 the comment style this sequence begins so that later,
897 only a comment end of the same style actually ends
898 the comment section */
899 code = Scomment;
900 comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from));
901 from++;
902 }
903
904 if (SYNTAX_PREFIX (c))
905 continue;
906
907 #ifdef SWITCH_ENUM_BUG
908 switch ((int) code)
909 #else
910 switch (code)
911 #endif
912 {
913 case Sescape:
914 case Scharquote:
915 if (from == stop) goto lose;
916 from++;
917 /* treat following character as a word constituent */
918 case Sword:
919 case Ssymbol:
920 if (depth || !sexpflag) break;
921 /* This word counts as a sexp; return at end of it. */
922 while (from < stop)
923 {
924 #ifdef SWITCH_ENUM_BUG
925 switch ((int) SYNTAX (FETCH_CHAR (from)))
926 #else
927 switch (SYNTAX (FETCH_CHAR (from)))
928 #endif
929 {
930 case Scharquote:
931 case Sescape:
932 from++;
933 if (from == stop) goto lose;
934 break;
935 case Sword:
936 case Ssymbol:
937 case Squote:
938 break;
939 default:
940 goto done;
941 }
942 from++;
943 }
944 goto done;
945
946 case Scomment:
947 if (!parse_sexp_ignore_comments) break;
948 while (1)
949 {
950 if (from == stop)
951 {
952 if (depth == 0)
953 goto done;
954 goto lose;
955 }
956 c = FETCH_CHAR (from);
957 if (SYNTAX (c) == Sendcomment
958 && SYNTAX_COMMENT_STYLE (c) == comstyle)
959 /* we have encountered a comment end of the same style
960 as the comment sequence which began this comment
961 section */
962 break;
963 from++;
964 if (from < stop && SYNTAX_COMEND_FIRST (c)
965 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from))
966 && SYNTAX_COMMENT_STYLE (c) == comstyle)
967 /* we have encountered a comment end of the same style
968 as the comment sequence which began this comment
969 section */
970 { from++; break; }
971 }
972 break;
973
974 case Smath:
975 if (!sexpflag)
976 break;
977 if (from != stop && c == FETCH_CHAR (from))
978 from++;
979 if (mathexit)
980 {
981 mathexit = 0;
982 goto close1;
983 }
984 mathexit = 1;
985
986 case Sopen:
987 if (!++depth) goto done;
988 break;
989
990 case Sclose:
991 close1:
992 if (!--depth) goto done;
993 if (depth < min_depth)
994 error ("Containing expression ends prematurely");
995 break;
996
997 case Sstring:
998 stringterm = FETCH_CHAR (from - 1);
999 while (1)
1000 {
1001 if (from >= stop) goto lose;
1002 if (FETCH_CHAR (from) == stringterm) break;
1003 #ifdef SWITCH_ENUM_BUG
1004 switch ((int) SYNTAX (FETCH_CHAR (from)))
1005 #else
1006 switch (SYNTAX (FETCH_CHAR (from)))
1007 #endif
1008 {
1009 case Scharquote:
1010 case Sescape:
1011 from++;
1012 }
1013 from++;
1014 }
1015 from++;
1016 if (!depth && sexpflag) goto done;
1017 break;
1018 }
1019 }
1020
1021 /* Reached end of buffer. Error if within object, return nil if between */
1022 if (depth) goto lose;
1023
1024 immediate_quit = 0;
1025 return Qnil;
1026
1027 /* End of object reached */
1028 done:
1029 count--;
1030 }
1031
1032 while (count < 0)
1033 {
1034 stop = BEGV;
1035 while (from > stop)
1036 {
1037 from--;
1038 if (quoted = char_quoted (from))
1039 from--;
1040 c = FETCH_CHAR (from);
1041 code = SYNTAX (c);
1042 comstyle = 0;
1043 if (code == Sendcomment)
1044 comstyle = SYNTAX_COMMENT_STYLE (c);
1045 if (from > stop && SYNTAX_COMEND_SECOND (c)
1046 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1))
1047 && !char_quoted (from - 1)
1048 && parse_sexp_ignore_comments)
1049 {
1050 /* we must record the comment style encountered so that
1051 later, we can match only the proper comment begin
1052 sequence of the same style */
1053 code = Sendcomment;
1054 comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from - 1));
1055 from--;
1056 }
1057
1058 if (SYNTAX_PREFIX (c))
1059 continue;
1060
1061 #ifdef SWITCH_ENUM_BUG
1062 switch ((int) (quoted ? Sword : code))
1063 #else
1064 switch (quoted ? Sword : code)
1065 #endif
1066 {
1067 case Sword:
1068 case Ssymbol:
1069 if (depth || !sexpflag) break;
1070 /* This word counts as a sexp; count object finished after passing it. */
1071 while (from > stop)
1072 {
1073 quoted = char_quoted (from - 1);
1074 if (quoted)
1075 from--;
1076 if (! (quoted || SYNTAX (FETCH_CHAR (from - 1)) == Sword
1077 || SYNTAX (FETCH_CHAR (from - 1)) == Ssymbol
1078 || SYNTAX (FETCH_CHAR (from - 1)) == Squote))
1079 goto done2;
1080 from--;
1081 }
1082 goto done2;
1083
1084 case Smath:
1085 if (!sexpflag)
1086 break;
1087 if (from != stop && c == FETCH_CHAR (from - 1))
1088 from--;
1089 if (mathexit)
1090 {
1091 mathexit = 0;
1092 goto open2;
1093 }
1094 mathexit = 1;
1095
1096 case Sclose:
1097 if (!++depth) goto done2;
1098 break;
1099
1100 case Sopen:
1101 open2:
1102 if (!--depth) goto done2;
1103 if (depth < min_depth)
1104 error ("Containing expression ends prematurely");
1105 break;
1106
1107 case Sendcomment:
1108 if (!parse_sexp_ignore_comments)
1109 break;
1110 #if 0
1111 if (code != SYNTAX (c))
1112 /* For a two-char comment ender, we can assume
1113 it does end a comment. So scan back in a simple way. */
1114 {
1115 if (from != stop) from--;
1116 while (1)
1117 {
1118 if (SYNTAX (c = FETCH_CHAR (from)) == Scomment
1119 && SYNTAX_COMMENT_STYLE (c) == comstyle)
1120 break;
1121 if (from == stop)
1122 {
1123 if (depth == 0)
1124 goto done2;
1125 goto lose;
1126 }
1127 from--;
1128 if (SYNTAX_COMSTART_SECOND (c)
1129 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from))
1130 && SYNTAX_COMMENT_STYLE (c) == comstyle
1131 && !char_quoted (from))
1132 break;
1133 }
1134 break;
1135 }
1136 #endif /* 0 */
1137
1138 /* Look back, counting the parity of string-quotes,
1139 and recording the comment-starters seen.
1140 When we reach a safe place, assume that's not in a string;
1141 then step the main scan to the earliest comment-starter seen
1142 an even number of string quotes away from the safe place.
1143
1144 OFROM[I] is position of the earliest comment-starter seen
1145 which is I+2X quotes from the comment-end.
1146 PARITY is current parity of quotes from the comment end. */
1147 {
1148 int parity = 0;
1149 char my_stringend = 0;
1150 int string_lossage = 0;
1151 int comment_end = from;
1152 int comstart_pos = 0;
1153 int comstart_parity = 0;
1154 int scanstart = from - 1;
1155
1156 /* At beginning of range to scan, we're outside of strings;
1157 that determines quote parity to the comment-end. */
1158 while (from != stop)
1159 {
1160 /* Move back and examine a character. */
1161 from--;
1162
1163 c = FETCH_CHAR (from);
1164 code = SYNTAX (c);
1165
1166 /* If this char is the second of a 2-char comment sequence,
1167 back up and give the pair the appropriate syntax. */
1168 if (from > stop && SYNTAX_COMEND_SECOND (c)
1169 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1)))
1170 {
1171 code = Sendcomment;
1172 from--;
1173 c = FETCH_CHAR (from);
1174 }
1175
1176 /* If this char starts a 2-char comment start sequence,
1177 treat it like a 1-char comment starter. */
1178 if (from < scanstart && SYNTAX_COMSTART_FIRST (c)
1179 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from + 1))
1180 && comstyle == SYNTAX_COMMENT_STYLE (FETCH_CHAR (from + 1)))
1181 code = Scomment;
1182
1183 /* Ignore escaped characters. */
1184 if (char_quoted (from))
1185 continue;
1186
1187 /* Track parity of quotes. */
1188 if (code == Sstring)
1189 {
1190 parity ^= 1;
1191 if (my_stringend == 0)
1192 my_stringend = c;
1193 /* If we have two kinds of string delimiters.
1194 There's no way to grok this scanning backwards. */
1195 else if (my_stringend != c)
1196 string_lossage = 1;
1197 }
1198
1199 /* Record comment-starters according to that
1200 quote-parity to the comment-end. */
1201 if (code == Scomment)
1202 {
1203 comstart_parity = parity;
1204 comstart_pos = from;
1205 }
1206
1207 /* If we find another earlier comment-ender,
1208 any comment-starts earlier than that don't count
1209 (because they go with the earlier comment-ender). */
1210 if (code == Sendcomment
1211 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from)) == comstyle)
1212 break;
1213
1214 /* Assume a defun-start point is outside of strings. */
1215 if (code == Sopen
1216 && (from == stop || FETCH_CHAR (from - 1) == '\n'))
1217 break;
1218 }
1219
1220 if (comstart_pos == 0)
1221 from = comment_end;
1222 /* If the earliest comment starter
1223 is followed by uniform paired string quotes or none,
1224 we know it can't be inside a string
1225 since if it were then the comment ender would be inside one.
1226 So it does start a comment. Skip back to it. */
1227 else if (comstart_parity == 0 && !string_lossage)
1228 from = comstart_pos;
1229 else
1230 {
1231 /* We had two kinds of string delimiters mixed up
1232 together. Decode this going forwards.
1233 Scan fwd from the previous comment ender
1234 to the one in question; this records where we
1235 last passed a comment starter. */
1236 struct lisp_parse_state state;
1237 scan_sexps_forward (&state, find_defun_start (comment_end),
1238 comment_end - 1, -10000, 0, Qnil, 0);
1239 if (state.incomment)
1240 from = state.comstart;
1241 else
1242 /* We can't grok this as a comment; scan it normally. */
1243 from = comment_end;
1244 }
1245 }
1246 break;
1247
1248 case Sstring:
1249 stringterm = FETCH_CHAR (from);
1250 while (1)
1251 {
1252 if (from == stop) goto lose;
1253 if (!char_quoted (from - 1)
1254 && stringterm == FETCH_CHAR (from - 1))
1255 break;
1256 from--;
1257 }
1258 from--;
1259 if (!depth && sexpflag) goto done2;
1260 break;
1261 }
1262 }
1263
1264 /* Reached start of buffer. Error if within object, return nil if between */
1265 if (depth) goto lose;
1266
1267 immediate_quit = 0;
1268 return Qnil;
1269
1270 done2:
1271 count++;
1272 }
1273
1274
1275 immediate_quit = 0;
1276 XFASTINT (val) = from;
1277 return val;
1278
1279 lose:
1280 error ("Unbalanced parentheses");
1281 /* NOTREACHED */
1282 }
1283
1284 static int
1285 char_quoted (pos)
1286 register int pos;
1287 {
1288 register enum syntaxcode code;
1289 register int beg = BEGV;
1290 register int quoted = 0;
1291
1292 while (pos > beg
1293 && ((code = SYNTAX (FETCH_CHAR (pos - 1))) == Scharquote
1294 || code == Sescape))
1295 pos--, quoted = !quoted;
1296 return quoted;
1297 }
1298
1299 DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0,
1300 "Scan from character number FROM by COUNT lists.\n\
1301 Returns the character number of the position thus found.\n\
1302 \n\
1303 If DEPTH is nonzero, paren depth begins counting from that value,\n\
1304 only places where the depth in parentheses becomes zero\n\
1305 are candidates for stopping; COUNT such places are counted.\n\
1306 Thus, a positive value for DEPTH means go out levels.\n\
1307 \n\
1308 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
1309 \n\
1310 If the beginning or end of (the accessible part of) the buffer is reached\n\
1311 and the depth is wrong, an error is signaled.\n\
1312 If the depth is right but the count is not used up, nil is returned.")
1313 (from, count, depth)
1314 Lisp_Object from, count, depth;
1315 {
1316 CHECK_NUMBER (from, 0);
1317 CHECK_NUMBER (count, 1);
1318 CHECK_NUMBER (depth, 2);
1319
1320 return scan_lists (XINT (from), XINT (count), XINT (depth), 0);
1321 }
1322
1323 DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0,
1324 "Scan from character number FROM by COUNT balanced expressions.\n\
1325 If COUNT is negative, scan backwards.\n\
1326 Returns the character number of the position thus found.\n\
1327 \n\
1328 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
1329 \n\
1330 If the beginning or end of (the accessible part of) the buffer is reached\n\
1331 in the middle of a parenthetical grouping, an error is signaled.\n\
1332 If the beginning or end is reached between groupings\n\
1333 but before count is used up, nil is returned.")
1334 (from, count)
1335 Lisp_Object from, count;
1336 {
1337 CHECK_NUMBER (from, 0);
1338 CHECK_NUMBER (count, 1);
1339
1340 return scan_lists (XINT (from), XINT (count), 0, 1);
1341 }
1342
1343 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars,
1344 0, 0, 0,
1345 "Move point backward over any number of chars with prefix syntax.\n\
1346 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
1347 ()
1348 {
1349 int beg = BEGV;
1350 int pos = point;
1351
1352 while (pos > beg && !char_quoted (pos - 1)
1353 && (SYNTAX (FETCH_CHAR (pos - 1)) == Squote
1354 || SYNTAX_PREFIX (FETCH_CHAR (pos - 1))))
1355 pos--;
1356
1357 SET_PT (pos);
1358
1359 return Qnil;
1360 }
1361 \f
1362 /* Parse forward from FROM to END,
1363 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
1364 and return a description of the state of the parse at END.
1365 If STOPBEFORE is nonzero, stop at the start of an atom.
1366 If COMMENTSTOP is nonzero, stop at the start of a comment. */
1367
1368 static void
1369 scan_sexps_forward (stateptr, from, end, targetdepth,
1370 stopbefore, oldstate, commentstop)
1371 struct lisp_parse_state *stateptr;
1372 register int from;
1373 int end, targetdepth, stopbefore;
1374 Lisp_Object oldstate;
1375 int commentstop;
1376 {
1377 struct lisp_parse_state state;
1378
1379 register enum syntaxcode code;
1380 struct level { int last, prev; };
1381 struct level levelstart[100];
1382 register struct level *curlevel = levelstart;
1383 struct level *endlevel = levelstart + 100;
1384 char prev;
1385 register int depth; /* Paren depth of current scanning location.
1386 level - levelstart equals this except
1387 when the depth becomes negative. */
1388 int mindepth; /* Lowest DEPTH value seen. */
1389 int start_quoted = 0; /* Nonzero means starting after a char quote */
1390 Lisp_Object tem;
1391
1392 immediate_quit = 1;
1393 QUIT;
1394
1395 if (NILP (oldstate))
1396 {
1397 depth = 0;
1398 state.instring = -1;
1399 state.incomment = 0;
1400 state.comstyle = 0; /* comment style a by default */
1401 }
1402 else
1403 {
1404 tem = Fcar (oldstate);
1405 if (!NILP (tem))
1406 depth = XINT (tem);
1407 else
1408 depth = 0;
1409
1410 oldstate = Fcdr (oldstate);
1411 oldstate = Fcdr (oldstate);
1412 oldstate = Fcdr (oldstate);
1413 tem = Fcar (oldstate);
1414 state.instring = !NILP (tem) ? XINT (tem) : -1;
1415
1416 oldstate = Fcdr (oldstate);
1417 tem = Fcar (oldstate);
1418 state.incomment = !NILP (tem);
1419
1420 oldstate = Fcdr (oldstate);
1421 tem = Fcar (oldstate);
1422 start_quoted = !NILP (tem);
1423
1424 /* if the eight element of the list is nil, we are in comment
1425 style a. if it is non-nil, we are in comment style b */
1426 oldstate = Fcdr (oldstate);
1427 oldstate = Fcdr (oldstate);
1428 tem = Fcar (oldstate);
1429 state.comstyle = !NILP (tem);
1430 }
1431 state.quoted = 0;
1432 mindepth = depth;
1433
1434 curlevel->prev = -1;
1435 curlevel->last = -1;
1436
1437 /* Enter the loop at a place appropriate for initial state. */
1438
1439 if (state.incomment) goto startincomment;
1440 if (state.instring >= 0)
1441 {
1442 if (start_quoted) goto startquotedinstring;
1443 goto startinstring;
1444 }
1445 if (start_quoted) goto startquoted;
1446
1447 while (from < end)
1448 {
1449 code = SYNTAX (FETCH_CHAR (from));
1450 from++;
1451 if (code == Scomment)
1452 state.comstart = from-1;
1453
1454 else if (from < end && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from - 1))
1455 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from)))
1456 {
1457 /* Record the comment style we have entered so that only
1458 the comment-end sequence of the same style actually
1459 terminates the comment section. */
1460 code = Scomment;
1461 state.comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from));
1462 state.comstart = from-1;
1463 from++;
1464 }
1465
1466 if (SYNTAX_PREFIX (FETCH_CHAR (from - 1)))
1467 continue;
1468 #ifdef SWITCH_ENUM_BUG
1469 switch ((int) code)
1470 #else
1471 switch (code)
1472 #endif
1473 {
1474 case Sescape:
1475 case Scharquote:
1476 if (stopbefore) goto stop; /* this arg means stop at sexp start */
1477 curlevel->last = from - 1;
1478 startquoted:
1479 if (from == end) goto endquoted;
1480 from++;
1481 goto symstarted;
1482 /* treat following character as a word constituent */
1483 case Sword:
1484 case Ssymbol:
1485 if (stopbefore) goto stop; /* this arg means stop at sexp start */
1486 curlevel->last = from - 1;
1487 symstarted:
1488 while (from < end)
1489 {
1490 #ifdef SWITCH_ENUM_BUG
1491 switch ((int) SYNTAX (FETCH_CHAR (from)))
1492 #else
1493 switch (SYNTAX (FETCH_CHAR (from)))
1494 #endif
1495 {
1496 case Scharquote:
1497 case Sescape:
1498 from++;
1499 if (from == end) goto endquoted;
1500 break;
1501 case Sword:
1502 case Ssymbol:
1503 case Squote:
1504 break;
1505 default:
1506 goto symdone;
1507 }
1508 from++;
1509 }
1510 symdone:
1511 curlevel->prev = curlevel->last;
1512 break;
1513
1514 case Scomment:
1515 state.incomment = 1;
1516 startincomment:
1517 if (commentstop)
1518 goto done;
1519 while (1)
1520 {
1521 if (from == end) goto done;
1522 prev = FETCH_CHAR (from);
1523 if (SYNTAX (prev) == Sendcomment
1524 && SYNTAX_COMMENT_STYLE (prev) == state.comstyle)
1525 /* Only terminate the comment section if the endcomment
1526 of the same style as the start sequence has been
1527 encountered. */
1528 break;
1529 from++;
1530 if (from < end && SYNTAX_COMEND_FIRST (prev)
1531 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from))
1532 && SYNTAX_COMMENT_STYLE (prev) == state.comstyle)
1533 /* Only terminate the comment section if the end-comment
1534 sequence of the same style as the start sequence has
1535 been encountered. */
1536 { from++; break; }
1537 }
1538 state.incomment = 0;
1539 state.comstyle = 0; /* reset the comment style */
1540 break;
1541
1542 case Sopen:
1543 if (stopbefore) goto stop; /* this arg means stop at sexp start */
1544 depth++;
1545 /* curlevel++->last ran into compiler bug on Apollo */
1546 curlevel->last = from - 1;
1547 if (++curlevel == endlevel)
1548 error ("Nesting too deep for parser");
1549 curlevel->prev = -1;
1550 curlevel->last = -1;
1551 if (!--targetdepth) goto done;
1552 break;
1553
1554 case Sclose:
1555 depth--;
1556 if (depth < mindepth)
1557 mindepth = depth;
1558 if (curlevel != levelstart)
1559 curlevel--;
1560 curlevel->prev = curlevel->last;
1561 if (!++targetdepth) goto done;
1562 break;
1563
1564 case Sstring:
1565 if (stopbefore) goto stop; /* this arg means stop at sexp start */
1566 curlevel->last = from - 1;
1567 state.instring = FETCH_CHAR (from - 1);
1568 startinstring:
1569 while (1)
1570 {
1571 if (from >= end) goto done;
1572 if (FETCH_CHAR (from) == state.instring) break;
1573 #ifdef SWITCH_ENUM_BUG
1574 switch ((int) SYNTAX (FETCH_CHAR (from)))
1575 #else
1576 switch (SYNTAX (FETCH_CHAR (from)))
1577 #endif
1578 {
1579 case Scharquote:
1580 case Sescape:
1581 from++;
1582 startquotedinstring:
1583 if (from >= end) goto endquoted;
1584 }
1585 from++;
1586 }
1587 state.instring = -1;
1588 curlevel->prev = curlevel->last;
1589 from++;
1590 break;
1591
1592 case Smath:
1593 break;
1594 }
1595 }
1596 goto done;
1597
1598 stop: /* Here if stopping before start of sexp. */
1599 from--; /* We have just fetched the char that starts it; */
1600 goto done; /* but return the position before it. */
1601
1602 endquoted:
1603 state.quoted = 1;
1604 done:
1605 state.depth = depth;
1606 state.mindepth = mindepth;
1607 state.thislevelstart = curlevel->prev;
1608 state.prevlevelstart
1609 = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
1610 state.location = from;
1611 immediate_quit = 0;
1612
1613 *stateptr = state;
1614 }
1615
1616 /* This comment supplies the doc string for parse-partial-sexp,
1617 for make-docfile to see. We cannot put this in the real DEFUN
1618 due to limits in the Unix cpp.
1619
1620 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
1621 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
1622 Parsing stops at TO or when certain criteria are met;\n\
1623 point is set to where parsing stops.\n\
1624 If fifth arg STATE is omitted or nil,\n\
1625 parsing assumes that FROM is the beginning of a function.\n\
1626 Value is a list of eight elements describing final state of parsing:\n\
1627 0. depth in parens.\n\
1628 1. character address of start of innermost containing list; nil if none.\n\
1629 2. character address of start of last complete sexp terminated.\n\
1630 3. non-nil if inside a string.\n\
1631 (it is the character that will terminate the string.)\n\
1632 4. t if inside a comment.\n\
1633 5. t if following a quote character.\n\
1634 6. the minimum paren-depth encountered during this scan.\n\
1635 7. t if in a comment of style `b'.\n\
1636 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
1637 in parentheses becomes equal to TARGETDEPTH.\n\
1638 Fourth arg STOPBEFORE non-nil means stop when come to\n\
1639 any character that starts a sexp.\n\
1640 Fifth arg STATE is an eight-list like what this function returns.\n\
1641 It is used to initialize the state of the parse. Its second and third
1642 elements are ignored.
1643 Sixth args COMMENTSTOP non-nil means stop at the start of a comment.")
1644 (from, to, targetdepth, stopbefore, state, commentstop)
1645 */
1646
1647 DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0,
1648 0 /* See immediately above */)
1649 (from, to, targetdepth, stopbefore, oldstate, commentstop)
1650 Lisp_Object from, to, targetdepth, stopbefore, oldstate, commentstop;
1651 {
1652 struct lisp_parse_state state;
1653 int target;
1654
1655 if (!NILP (targetdepth))
1656 {
1657 CHECK_NUMBER (targetdepth, 3);
1658 target = XINT (targetdepth);
1659 }
1660 else
1661 target = -100000; /* We won't reach this depth */
1662
1663 validate_region (&from, &to);
1664 scan_sexps_forward (&state, XINT (from), XINT (to),
1665 target, !NILP (stopbefore), oldstate,
1666 !NILP (commentstop));
1667
1668 SET_PT (state.location);
1669
1670 return Fcons (make_number (state.depth),
1671 Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart),
1672 Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart),
1673 Fcons (state.instring >= 0 ? make_number (state.instring) : Qnil,
1674 Fcons (state.incomment ? Qt : Qnil,
1675 Fcons (state.quoted ? Qt : Qnil,
1676 Fcons (make_number (state.mindepth),
1677 Fcons (state.comstyle ? Qt : Qnil,
1678 Qnil))))))));
1679 }
1680 \f
1681 init_syntax_once ()
1682 {
1683 register int i;
1684 register struct Lisp_Vector *v;
1685
1686 /* Set this now, so first buffer creation can refer to it. */
1687 /* Make it nil before calling copy-syntax-table
1688 so that copy-syntax-table will know not to try to copy from garbage */
1689 Vstandard_syntax_table = Qnil;
1690 Vstandard_syntax_table = Fcopy_syntax_table (Qnil);
1691
1692 v = XVECTOR (Vstandard_syntax_table);
1693
1694 for (i = 'a'; i <= 'z'; i++)
1695 XFASTINT (v->contents[i]) = (int) Sword;
1696 for (i = 'A'; i <= 'Z'; i++)
1697 XFASTINT (v->contents[i]) = (int) Sword;
1698 for (i = '0'; i <= '9'; i++)
1699 XFASTINT (v->contents[i]) = (int) Sword;
1700 XFASTINT (v->contents['$']) = (int) Sword;
1701 XFASTINT (v->contents['%']) = (int) Sword;
1702
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) Sopen + ('}' << 8);
1708 XFASTINT (v->contents['}']) = (int) Sclose + ('{' << 8);
1709 XFASTINT (v->contents['"']) = (int) Sstring;
1710 XFASTINT (v->contents['\\']) = (int) Sescape;
1711
1712 for (i = 0; i < 10; i++)
1713 XFASTINT (v->contents["_-+*/&|<>="[i]]) = (int) Ssymbol;
1714
1715 for (i = 0; i < 12; i++)
1716 XFASTINT (v->contents[".,;:?!#@~^'`"[i]]) = (int) Spunct;
1717 }
1718
1719 syms_of_syntax ()
1720 {
1721 Qsyntax_table_p = intern ("syntax-table-p");
1722 staticpro (&Qsyntax_table_p);
1723
1724 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments,
1725 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
1726
1727 words_include_escapes = 0;
1728 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes,
1729 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
1730
1731 defsubr (&Ssyntax_table_p);
1732 defsubr (&Ssyntax_table);
1733 defsubr (&Sstandard_syntax_table);
1734 defsubr (&Scopy_syntax_table);
1735 defsubr (&Sset_syntax_table);
1736 defsubr (&Schar_syntax);
1737 defsubr (&Smatching_paren);
1738 defsubr (&Smodify_syntax_entry);
1739 defsubr (&Sdescribe_syntax);
1740
1741 defsubr (&Sforward_word);
1742
1743 defsubr (&Sforward_comment);
1744 defsubr (&Sscan_lists);
1745 defsubr (&Sscan_sexps);
1746 defsubr (&Sbackward_prefix_chars);
1747 defsubr (&Sparse_partial_sexp);
1748 }