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