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