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