Mercurial > hg > xemacs-beta

comparison src/syntax.c @ 0:376386a54a3c r19-14

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