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