Contents in release-21-2 at 1999-06-30-19.
[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 Lisp_Object Vstandard_syntax_table;
78
79 Lisp_Object Vsyntax_designator_chars_string;
80
81 /* This is the internal form of the parse state used in parse-partial-sexp.  */
82
83 struct lisp_parse_state
84 {
85   int depth;            /* Depth at end of parsing */
86   Emchar instring;      /* -1 if not within string, else desired terminator */
87   int incomment;        /* Nonzero if within a comment at end of parsing */
88   int comstyle;         /* comment style a=0, or b=1 */
89   int quoted;           /* Nonzero if just after an escape char at end of
90                            parsing */
91   Bufpos thislevelstart;/* Char number of most recent start-of-expression
92                            at current level */
93   Bufpos prevlevelstart;/* Char number of start of containing expression */
94   Bufpos location;      /* Char number at which parsing stopped */
95   int mindepth;         /* Minimum depth seen while scanning  */
96   Bufpos comstart;      /* Position just after last comment starter  */
97 };
98 \f
99 /* These variables are a cache for finding the start of a defun.
100    find_start_pos    is the place for which the defun start was found.
101    find_start_value  is the defun start position found for it.
102    find_start_buffer is the buffer it was found in.
103    find_start_begv   is the BEGV value when it was found.
104    find_start_modiff is the value of MODIFF when it was found.  */
105
106 static Bufpos find_start_pos;
107 static Bufpos find_start_value;
108 static struct buffer *find_start_buffer;
109 static Bufpos find_start_begv;
110 static int find_start_modiff;
111
112 /* Find a defun-start that is the last one before POS (or nearly the last).
113    We record what we find, so that another call in the same area
114    can return the same value right away.  */
115
116 static Bufpos
117 find_defun_start (struct buffer *buf, Bufpos pos)
118 {
119   Bufpos tem;
120   struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
121
122   /* Use previous finding, if it's valid and applies to this inquiry.  */
123   if (buf == find_start_buffer
124       /* Reuse the defun-start even if POS is a little farther on.
125          POS might be in the next defun, but that's ok.
126          Our value may not be the best possible, but will still be usable.  */
127       && pos <= find_start_pos + 1000
128       && pos >= find_start_value
129       && BUF_BEGV (buf) == find_start_begv
130       && BUF_MODIFF (buf) == find_start_modiff)
131     return find_start_value;
132
133   /* Back up to start of line.  */
134   tem = find_next_newline (buf, pos, -1);
135
136   while (tem > BUF_BEGV (buf))
137     {
138       /* Open-paren at start of line means we found our defun-start.  */
139       if (SYNTAX (mirrortab, BUF_FETCH_CHAR (buf, tem)) == Sopen)
140         break;
141       /* Move to beg of previous line.  */
142       tem = find_next_newline (buf, tem, -2);
143     }
144
145   /* Record what we found, for the next try.  */
146   find_start_value  = tem;
147   find_start_buffer = buf;
148   find_start_modiff = BUF_MODIFF (buf);
149   find_start_begv   = BUF_BEGV (buf);
150   find_start_pos    = pos;
151
152   return find_start_value;
153 }
154 \f
155 DEFUN ("syntax-table-p", Fsyntax_table_p, 1, 1, 0, /*
156 Return t if ARG is a syntax table.
157 Any vector of 256 elements will do.
158 */
159        (obj))
160 {
161   return CHAR_TABLEP (obj) && XCHAR_TABLE_TYPE (obj) == CHAR_TABLE_TYPE_SYNTAX
162     ? Qt : Qnil;
163 }
164
165 static Lisp_Object
166 check_syntax_table (Lisp_Object obj, Lisp_Object default_)
167 {
168   if (NILP (obj))
169     obj = default_;
170   while (NILP (Fsyntax_table_p (obj)))
171     obj = wrong_type_argument (Qsyntax_table_p, obj);
172   return obj;
173 }
174
175 DEFUN ("syntax-table", Fsyntax_table, 0, 1, 0, /*
176 Return the current syntax table.
177 This is the one specified by the current buffer, or by BUFFER if it
178 is non-nil.
179 */
180        (buffer))
181 {
182   return decode_buffer (buffer, 0)->syntax_table;
183 }
184
185 DEFUN ("standard-syntax-table", Fstandard_syntax_table, 0, 0, 0, /*
186 Return the standard syntax table.
187 This is the one used for new buffers.
188 */
189        ())
190 {
191   return Vstandard_syntax_table;
192 }
193
194 DEFUN ("copy-syntax-table", Fcopy_syntax_table, 0, 1, 0, /*
195 Construct a new syntax table and return it.
196 It is a copy of the TABLE, which defaults to the standard syntax table.
197 */
198        (table))
199 {
200   if (NILP (Vstandard_syntax_table))
201     return Fmake_char_table (Qsyntax);
202
203   table = check_syntax_table (table, Vstandard_syntax_table);
204   return Fcopy_char_table (table);
205 }
206
207 DEFUN ("set-syntax-table", Fset_syntax_table, 1, 2, 0, /*
208 Select a new syntax table for BUFFER.
209 One argument, a syntax table.
210 BUFFER defaults to the current buffer if omitted.
211 */
212        (table, buffer))
213 {
214   struct buffer *buf = decode_buffer (buffer, 0);
215   table = check_syntax_table (table, Qnil);
216   buf->syntax_table = table;
217   buf->mirror_syntax_table = XCHAR_TABLE (table)->mirror_table;
218   /* Indicate that this buffer now has a specified syntax table.  */
219   buf->local_var_flags |= XINT (buffer_local_flags.syntax_table);
220   return table;
221 }
222 \f
223 /* Convert a letter which signifies a syntax code
224    into the code it signifies.
225    This is used by modify-syntax-entry, and other things. */
226
227 CONST unsigned char syntax_spec_code[0400] =
228 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
229   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
230   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
231   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
232   (char) Swhitespace, 0377, (char) Sstring, 0377,
233       (char) Smath, 0377, 0377, (char) Squote,
234   (char) Sopen, (char) Sclose, 0377, 0377,
235         0377, (char) Swhitespace, (char) Spunct, (char) Scharquote,
236   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
237   0377, 0377, 0377, 0377,
238         (char) Scomment, 0377, (char) Sendcomment, 0377,
239   (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377,   /* @, A ... */
240   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
241   0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
242   0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol,
243   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,   /* `, a, ... */
244   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
245   0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
246   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377
247 };
248
249 CONST unsigned char syntax_code_spec[] =  " .w_()'\"$\\/<>@";
250
251 DEFUN ("syntax-designator-chars", Fsyntax_designator_chars, 0, 0, 0, /*
252 Return a string of the recognized syntax designator chars.
253 The chars are ordered by their internal syntax codes, which are
254 numbered starting at 0.
255 */
256        ())
257 {
258   return Vsyntax_designator_chars_string;
259 }
260
261 DEFUN ("char-syntax", Fchar_syntax, 1, 2, 0, /*
262 Return the syntax code of CHAR, described by a character.
263 For example, if CHAR is a word constituent, the character `?w' is returned.
264 The characters that correspond to various syntax codes
265 are listed in the documentation of `modify-syntax-entry'.
266 Optional second argument TABLE defaults to the current buffer's
267 syntax table.
268 */
269        (ch, table))
270 {
271   struct Lisp_Char_Table *mirrortab;
272
273   if (NILP(ch))
274     {
275       ch = make_char('\000');
276     }
277   CHECK_CHAR_COERCE_INT (ch);
278   table = check_syntax_table (table, current_buffer->syntax_table);
279   mirrortab = XCHAR_TABLE (XCHAR_TABLE (table)->mirror_table);
280   return make_char (syntax_code_spec[(int) SYNTAX (mirrortab, XCHAR (ch))]);
281 }
282
283 #ifdef MULE
284
285 enum syntaxcode
286 charset_syntax (struct buffer *buf, Lisp_Object charset, int *multi_p_out)
287 {
288   *multi_p_out = 1;
289   /* #### get this right */
290   return Spunct;
291 }
292
293 #endif
294
295 Lisp_Object
296 syntax_match (Lisp_Object table, Emchar ch)
297 {
298   Lisp_Object code = CHAR_TABLE_VALUE_UNSAFE (XCHAR_TABLE (table), ch);
299   Lisp_Object code2 = code;
300
301   if (CONSP (code))
302     code2 = XCAR (code);
303   if (SYNTAX_FROM_CODE (XINT (code2)) == Sinherit)
304     code = CHAR_TABLE_VALUE_UNSAFE (XCHAR_TABLE (Vstandard_syntax_table),
305                                     ch);
306
307   return CONSP (code) ? XCDR (code) : Qnil;
308 }
309
310 DEFUN ("matching-paren", Fmatching_paren, 1, 2, 0, /*
311 Return the matching parenthesis of CHAR, or nil if none.
312 Optional second argument TABLE defaults to the current buffer's
313 syntax table.
314 */
315        (ch, table))
316 {
317   struct Lisp_Char_Table *mirrortab;
318   int code;
319
320   CHECK_CHAR_COERCE_INT (ch);
321   table = check_syntax_table (table, current_buffer->syntax_table);
322   mirrortab = XCHAR_TABLE (XCHAR_TABLE (table)->mirror_table);
323   code = SYNTAX (mirrortab, XCHAR (ch));
324   if (code == Sopen || code == Sclose || code == Sstring)
325     return syntax_match (table, XCHAR (ch));
326   return Qnil;
327 }
328
329 \f
330 #ifdef MULE
331 /* Return 1 if there is a word boundary between two word-constituent
332    characters C1 and C2 if they appear in this order, else return 0.
333    There is no word boundary between two word-constituent ASCII
334    characters.  */
335 #define WORD_BOUNDARY_P(c1, c2)                 \
336   (!(CHAR_ASCII_P (c1) && CHAR_ASCII_P (c2))    \
337    && word_boundary_p (c1, c2))
338
339 extern int word_boundary_p (Emchar c1, Emchar c2);
340 #else
341 static int
342 word_constituent_p (struct buffer *buf, Bufpos pos,
343                     struct Lisp_Char_Table *tab)
344 {
345   enum syntaxcode code = SYNTAX_UNSAFE (tab, BUF_FETCH_CHAR (buf, pos));
346   return ((words_include_escapes &&
347            (code == Sescape || code == Scharquote))
348           || (code == Sword));
349 }
350 #endif
351
352 /* Return the position across COUNT words from FROM.
353    If that many words cannot be found before the end of the buffer, return 0.
354    COUNT negative means scan backward and stop at word beginning.  */
355
356 Bufpos
357 scan_words (struct buffer *buf, Bufpos from, int count)
358 {
359   Bufpos limit = count > 0 ? BUF_ZV (buf) : BUF_BEGV (buf);
360   struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
361 #ifdef MULE
362   Emchar ch0, ch1;
363   enum syntaxcode code;
364 #endif
365
366   while (count > 0)
367     {
368       QUIT;
369
370       while (1)
371         {
372           if (from == limit)
373             return 0;
374 #ifdef MULE
375           ch0 = BUF_FETCH_CHAR (buf, from);
376           code = SYNTAX_UNSAFE (mirrortab, ch0);
377 #else
378           if (word_constituent_p (buf, from, mirrortab))
379             break;
380 #endif
381           from++;
382 #ifdef MULE
383           if (words_include_escapes
384               && (code == Sescape || code == Scharquote))
385             break;
386           if (code == Sword)
387             break;
388 #endif
389         }
390
391       QUIT;
392
393       while ((from != limit)
394 #ifndef MULE
395              && word_constituent_p (buf, from, mirrortab)
396 #endif
397              )
398         {
399 #ifdef MULE
400           ch1 = BUF_FETCH_CHAR (buf, from);
401           code = SYNTAX_UNSAFE (mirrortab, ch1);
402           if (!(words_include_escapes
403                 && (code == Sescape || code == Scharquote)))
404             if (code != Sword || WORD_BOUNDARY_P (ch0, ch1))
405               break;
406           ch0 = ch1;
407 #endif
408           from++;
409         }
410       count--;
411     }
412
413   while (count < 0)
414     {
415       QUIT;
416
417       while (1)
418         {
419           if (from == limit)
420             return 0;
421 #ifndef MULE
422           if (word_constituent_p (buf, from - 1, mirrortab))
423             break;
424 #endif
425           from--;
426 #ifdef MULE
427           ch1 = BUF_FETCH_CHAR (buf, from - 1);
428           code = SYNTAX_UNSAFE (mirrortab, ch1);
429           if (words_include_escapes
430               && (code == Sescape || code == Scharquote))
431             break;
432           if (code == Sword)
433             break;
434 #endif
435         }
436
437       QUIT;
438
439       while ((from != limit)
440 #ifndef MULE
441              && word_constituent_p (buf, from - 1, mirrortab)
442 #endif
443              )
444         {
445 #ifdef MULE
446           ch0 = BUF_FETCH_CHAR (buf, from - 1);
447           code = SYNTAX_UNSAFE (mirrortab, ch0);
448           if (!(words_include_escapes
449                 && (code == Sescape || code == Scharquote)))
450             if (code != Sword || WORD_BOUNDARY_P (ch0, ch1))
451               break;
452           ch1 = ch0;
453 #endif
454           from--;
455         }
456       count++;
457     }
458
459   return from;
460 }
461
462 DEFUN ("forward-word", Fforward_word, 1, 2, "_p", /*
463 Move point forward COUNT words (backward if COUNT is negative).
464 Normally returns t.
465 If an edge of the buffer is reached, point is left there
466 and nil is returned.
467
468 Optional argument BUFFER defaults to the current buffer.
469 */
470        (count, buffer))
471 {
472   Bufpos val;
473   struct buffer *buf = decode_buffer (buffer, 0);
474   CHECK_INT (count);
475
476   if (!(val = scan_words (buf, BUF_PT (buf), XINT (count))))
477     {
478       BUF_SET_PT (buf, XINT (count) > 0 ? BUF_ZV (buf) : BUF_BEGV (buf));
479       return Qnil;
480     }
481   BUF_SET_PT (buf, val);
482   return Qt;
483 }
484 \f
485 static void scan_sexps_forward (struct buffer *buf,
486                                 struct lisp_parse_state *,
487                                 Bufpos from, Bufpos end,
488                                 int targetdepth, int stopbefore,
489                                 Lisp_Object oldstate,
490                                 int commentstop);
491
492 static int
493 find_start_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int mask)
494 {
495   Emchar c;
496   enum syntaxcode code;
497   struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
498
499   /* Look back, counting the parity of string-quotes,
500      and recording the comment-starters seen.
501      When we reach a safe place, assume that's not in a string;
502      then step the main scan to the earliest comment-starter seen
503      an even number of string quotes away from the safe place.
504
505      OFROM[I] is position of the earliest comment-starter seen
506      which is I+2X quotes from the comment-end.
507      PARITY is current parity of quotes from the comment end.  */
508   int parity = 0;
509   Emchar my_stringend = 0;
510   int string_lossage = 0;
511   Bufpos comment_end = from;
512   Bufpos comstart_pos = 0;
513   int comstart_parity = 0;
514   int styles_match_p = 0;
515
516   /* At beginning of range to scan, we're outside of strings;
517      that determines quote parity to the comment-end.  */
518   while (from != stop)
519     {
520       /* Move back and examine a character.  */
521       from--;
522
523       c = BUF_FETCH_CHAR (buf, from);
524       code = SYNTAX_UNSAFE (mirrortab, c);
525
526       /* is this a 1-char comment end sequence? if so, try
527          to see if style matches previously extracted mask */
528       if (code == Sendcomment)
529         {
530           styles_match_p = SYNTAX_STYLES_MATCH_1CHAR_P (mirrortab, c, mask);
531         }
532
533       /* otherwise, is this a 2-char comment end sequence? */
534       else if (from >= stop
535                && SYNTAX_END_P (mirrortab, c, BUF_FETCH_CHAR (buf, from+1)))
536         {
537           code = Sendcomment;
538           styles_match_p =
539             SYNTAX_STYLES_MATCH_END_P (mirrortab, c,
540                                        BUF_FETCH_CHAR (buf, from+1),
541                                        mask);
542         }
543
544       /* or are we looking at a 1-char comment start sequence
545          of the style matching mask? */
546       else if (code == Scomment
547                && SYNTAX_STYLES_MATCH_1CHAR_P (mirrortab, c, mask))
548         {
549           styles_match_p = 1;
550         }
551
552       /* or possibly, a 2-char comment start sequence */
553       else if (from >= stop
554                && SYNTAX_STYLES_MATCH_START_P (mirrortab, c,
555                                                BUF_FETCH_CHAR (buf, from+1),
556                                                mask))
557         {
558           code = Scomment;
559           styles_match_p = 1;
560         }
561
562       /* Ignore escaped characters.  */
563       if (char_quoted (buf, from))
564         continue;
565
566       /* Track parity of quotes.  */
567       if (code == Sstring)
568         {
569           parity ^= 1;
570           if (my_stringend == 0)
571             my_stringend = c;
572           /* If we have two kinds of string delimiters.
573              There's no way to grok this scanning backwards.  */
574           else if (my_stringend != c)
575             string_lossage = 1;
576         }
577
578       /* Record comment-starters according to that
579          quote-parity to the comment-end.  */
580       if (code == Scomment && styles_match_p)
581         {
582           comstart_parity = parity;
583           comstart_pos = from;
584         }
585
586       /* If we find another earlier comment-ender,
587          any comment-starts earlier than that don't count
588          (because they go with the earlier comment-ender).  */
589       if (code == Sendcomment && styles_match_p)
590         break;
591
592       /* Assume a defun-start point is outside of strings.  */
593       if (code == Sopen
594           && (from == stop || BUF_FETCH_CHAR (buf, from - 1) == '\n'))
595         break;
596     }
597
598   if (comstart_pos == 0)
599     from = comment_end;
600   /* If the earliest comment starter
601      is followed by uniform paired string quotes or none,
602      we know it can't be inside a string
603      since if it were then the comment ender would be inside one.
604      So it does start a comment.  Skip back to it.  */
605   else if (comstart_parity == 0 && !string_lossage)
606     from = comstart_pos;
607   else
608     {
609       /* We had two kinds of string delimiters mixed up
610          together.  Decode this going forwards.
611          Scan fwd from the previous comment ender
612          to the one in question; this records where we
613          last passed a comment starter.  */
614
615       struct lisp_parse_state state;
616       scan_sexps_forward (buf, &state, find_defun_start (buf, comment_end),
617                           comment_end - 1, -10000, 0, Qnil, 0);
618       if (state.incomment)
619         from = state.comstart;
620       else
621         /* We can't grok this as a comment; scan it normally.  */
622         from = comment_end;
623     }
624   return from;
625 }
626
627 static Bufpos
628 find_end_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int mask)
629 {
630   int c;
631   struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
632
633   while (1)
634     {
635       if (from == stop)
636         {
637           return -1;
638         }
639       c = BUF_FETCH_CHAR (buf, from);
640       if (SYNTAX_UNSAFE (mirrortab, c) == Sendcomment
641           && SYNTAX_STYLES_MATCH_1CHAR_P (mirrortab, c, mask))
642         /* we have encountered a comment end of the same style
643            as the comment sequence which began this comment
644            section */
645         break;
646
647       from++;
648       if (from < stop
649           && SYNTAX_STYLES_MATCH_END_P (mirrortab, c,
650                                         BUF_FETCH_CHAR (buf, from), mask))
651         /* we have encountered a comment end of the same style
652            as the comment sequence which began this comment
653            section */
654         { from++; break; }
655     }
656   return from;
657 }
658
659 \f
660 /* #### between FSF 19.23 and 19.28 there are some changes to the logic
661    in this function (and minor changes to find_start_of_comment(),
662    above, which is part of Fforward_comment() in FSF).  Attempts to port
663    that logic made this function break, so I'm leaving it out.  If anyone
664    ever complains about this function not working properly, take a look
665    at those changes.  --ben */
666
667 DEFUN ("forward-comment", Fforward_comment, 1, 2, 0, /*
668 Move forward across up to N comments.  If N is negative, move backward.
669 Stop scanning if we find something other than a comment or whitespace.
670 Set point to where scanning stops.
671 If N comments are found as expected, with nothing except whitespace
672 between them, return t; otherwise return nil.
673 Point is set in either case.
674 Optional argument BUFFER defaults to the current buffer.
675 */
676        (n, buffer))
677 {
678   Bufpos from;
679   Bufpos stop;
680   Emchar c;
681   enum syntaxcode code;
682   int count;
683   struct buffer *buf = decode_buffer (buffer, 0);
684   struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
685
686   CHECK_INT (n);
687   count = XINT (n);
688
689   from = BUF_PT (buf);
690
691   while (count > 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       count--;
761     }
762
763   while (count < 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       count++;
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 no_error)
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   struct 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 (no_error)
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 (no_error)
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 (!no_error)
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   struct 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, no_error))
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 (no_error));
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, no_error))
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 (no_error));
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   struct 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   struct 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 STATE 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 STATE 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 (struct 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 (struct 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
1703   words_include_escapes = 0;
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
1708   no_quit_in_re_search = 0;
1709 }
1710
1711 void
1712 complex_vars_of_syntax (void)
1713 {
1714   /* Set this now, so first buffer creation can refer to it. */
1715   /* Make it nil before calling copy-syntax-table
1716      so that copy-syntax-table will know not to try to copy from garbage */
1717   Vstandard_syntax_table = Qnil;
1718   Vstandard_syntax_table = Fcopy_syntax_table (Qnil);
1719   staticpro (&Vstandard_syntax_table);
1720
1721   Vsyntax_designator_chars_string = make_string_nocopy (syntax_code_spec,
1722                                                         Smax);
1723   staticpro (&Vsyntax_designator_chars_string);
1724
1725   fill_char_table (XCHAR_TABLE (Vstandard_syntax_table),
1726                    make_int (Spunct));
1727
1728   {
1729     Emchar i;
1730
1731     for (i = 0; i <= 32; i++)
1732       Fput_char_table (make_char (i), make_int ((int) Swhitespace),
1733                        Vstandard_syntax_table);
1734     for (i = 127; i <= 159; i++)
1735       Fput_char_table (make_char (i), make_int ((int) Swhitespace),
1736                        Vstandard_syntax_table);
1737
1738     for (i = 'a'; i <= 'z'; i++)
1739       Fput_char_table (make_char (i), make_int ((int) Sword),
1740                        Vstandard_syntax_table);
1741     for (i = 'A'; i <= 'Z'; i++)
1742       Fput_char_table (make_char (i), make_int ((int) Sword),
1743                        Vstandard_syntax_table);
1744     for (i = '0'; i <= '9'; i++)
1745       Fput_char_table (make_char (i), make_int ((int) Sword),
1746                        Vstandard_syntax_table);
1747     Fput_char_table (make_char ('$'), make_int ((int) Sword),
1748                      Vstandard_syntax_table);
1749     Fput_char_table (make_char ('%'), make_int ((int) Sword),
1750                      Vstandard_syntax_table);
1751
1752     {
1753       Fput_char_table (make_char ('('), Fcons (make_int ((int) Sopen),
1754                                                make_char (')')),
1755                        Vstandard_syntax_table);
1756       Fput_char_table (make_char (')'), Fcons (make_int ((int) Sclose),
1757                                                make_char ('(')),
1758                        Vstandard_syntax_table);
1759       Fput_char_table (make_char ('['), Fcons (make_int ((int) Sopen),
1760                                                make_char (']')),
1761                        Vstandard_syntax_table);
1762       Fput_char_table (make_char (']'), Fcons (make_int ((int) Sclose),
1763                                                make_char ('[')),
1764                        Vstandard_syntax_table);
1765       Fput_char_table (make_char ('{'), Fcons (make_int ((int) Sopen),
1766                                                make_char ('}')),
1767                        Vstandard_syntax_table);
1768       Fput_char_table (make_char ('}'), Fcons (make_int ((int) Sclose),
1769                                                make_char ('{')),
1770                        Vstandard_syntax_table);
1771     }
1772
1773     Fput_char_table (make_char ('"'), make_int ((int) Sstring),
1774                      Vstandard_syntax_table);
1775     Fput_char_table (make_char ('\\'), make_int ((int) Sescape),
1776                      Vstandard_syntax_table);
1777
1778     {
1779       CONST char *p;
1780       for (p = "_-+*/&|<>="; *p; p++)
1781         Fput_char_table (make_char (*p), make_int ((int) Ssymbol),
1782                          Vstandard_syntax_table);
1783
1784       for (p = ".,;:?!#@~^'`"; *p; p++)
1785         Fput_char_table (make_char (*p), make_int ((int) Spunct),
1786                          Vstandard_syntax_table);
1787     }
1788   }
1789 }