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