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.
5 This file is part of XEmacs.
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
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
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. */
22 /* Synched up with: FSF 19.28. */
24 /* This file has been Mule-ized. */
33 /* Here is a comment from Ken'ichi HANDA <handa@etl.go.jp>
34 explaining the purpose of the Sextword syntax category:
36 Japanese words are not separated by spaces, which makes finding word
37 boundaries very difficult. Theoretically it's impossible without
38 using natural language processing techniques. But, by defining
39 pseudo-words as below (much simplified for letting you understand it
40 easily) for Japanese, we can have a convenient forward-word function
43 A Japanese word is a sequence of characters that consists of
44 zero or more Kanji characters followed by zero or more
47 Then, the problem is that now we can't say that a sequence of
48 word-constituents makes up a WORD. For instance, both Hiragana "A"
49 and Kanji "KAN" are word-constituents but the sequence of these two
50 letters can't be a single word.
52 So, we introduced Sextword for Japanese letters. A character of
53 Sextword is a word-constituent but a word boundary may exist between
54 two such characters. */
56 /* Mule 2.4 doesn't seem to have Sextword - I'm removing it -- mrb */
57 /* Recovered by tomo */
59 #define ST_COMMENT_STYLE 0x101
60 #define ST_STRING_STYLE 0x102
62 Lisp_Object Qsyntax_table;
63 int lookup_syntax_properties;
65 Lisp_Object Qsyntax_table_p;
67 int words_include_escapes;
69 int parse_sexp_ignore_comments;
71 /* The following two variables are provided to tell additional information
72 to the regex routines. We do it this way rather than change the
73 arguments to re_search_2() in an attempt to maintain some call
74 compatibility with other versions of the regex code. */
76 /* Tell the regex routines not to QUIT. Normally there is a QUIT
77 each iteration in re_search_2(). */
78 int no_quit_in_re_search;
80 /* Tell the regex routines which buffer to access for SYNTAX() lookups
82 struct buffer *regex_emacs_buffer;
84 /* In Emacs, this is the string or buffer in which we
85 are matching. It is used for looking up syntax properties. */
86 Lisp_Object regex_match_object;
88 Lisp_Object Vstandard_syntax_table;
90 Lisp_Object Vsyntax_designator_chars_string;
92 /* This is the internal form of the parse state used in parse-partial-sexp. */
94 struct lisp_parse_state
96 int depth; /* Depth at end of parsing */
97 Emchar instring; /* -1 if not within string, else desired terminator */
98 int incomment; /* Nonzero if within a comment at end of parsing */
99 int comstyle; /* comment style a=0, or b=1, or ST_COMMENT_STYLE */
100 int quoted; /* Nonzero if just after an escape char at end of
102 Bufpos thislevelstart;/* Char number of most recent start-of-expression
104 Bufpos prevlevelstart;/* Char number of start of containing expression */
105 Bufpos location; /* Char number at which parsing stopped */
106 int mindepth; /* Minimum depth seen while scanning */
107 Bufpos comstr_start; /* Position just after last comment/string starter */
108 Lisp_Object levelstarts; /* Char numbers of starts-of-expression
109 of levels (starting from outermost). */
112 /* These variables are a cache for finding the start of a defun.
113 find_start_pos is the place for which the defun start was found.
114 find_start_value is the defun start position found for it.
115 find_start_buffer is the buffer it was found in.
116 find_start_begv is the BEGV value when it was found.
117 find_start_modiff is the value of MODIFF when it was found. */
119 static Bufpos find_start_pos;
120 static Bufpos find_start_value;
121 static struct buffer *find_start_buffer;
122 static Bufpos find_start_begv;
123 static int find_start_modiff;
125 /* Find a defun-start that is the last one before POS (or nearly the last).
126 We record what we find, so that another call in the same area
127 can return the same value right away. */
130 find_defun_start (struct buffer *buf, Bufpos pos)
134 /* Use previous finding, if it's valid and applies to this inquiry. */
135 if (buf == find_start_buffer
136 /* Reuse the defun-start even if POS is a little farther on.
137 POS might be in the next defun, but that's ok.
138 Our value may not be the best possible, but will still be usable. */
139 && pos <= find_start_pos + 1000
140 && pos >= find_start_value
141 && BUF_BEGV (buf) == find_start_begv
142 && BUF_MODIFF (buf) == find_start_modiff)
143 return find_start_value;
145 /* Back up to start of line. */
146 tem = find_next_newline (buf, pos, -1);
148 SETUP_SYNTAX_CACHE (tem, 1);
149 while (tem > BUF_BEGV (buf))
151 UPDATE_SYNTAX_CACHE_BACKWARD(tem);
153 /* Open-paren at start of line means we found our defun-start. */
154 if (SYNTAX_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, tem)) == Sopen)
156 /* Move to beg of previous line. */
157 tem = find_next_newline (buf, tem, -2);
160 /* Record what we found, for the next try. */
161 find_start_value = tem;
162 find_start_buffer = buf;
163 find_start_modiff = BUF_MODIFF (buf);
164 find_start_begv = BUF_BEGV (buf);
165 find_start_pos = pos;
167 return find_start_value;
170 DEFUN ("syntax-table-p", Fsyntax_table_p, 1, 1, 0, /*
171 Return t if OBJECT is a syntax table.
172 Any vector of 256 elements will do.
176 return (CHAR_TABLEP (object)
177 && XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_SYNTAX)
182 check_syntax_table (Lisp_Object obj, Lisp_Object default_)
186 while (NILP (Fsyntax_table_p (obj)))
187 obj = wrong_type_argument (Qsyntax_table_p, obj);
191 DEFUN ("syntax-table", Fsyntax_table, 0, 1, 0, /*
192 Return the current syntax table.
193 This is the one specified by the current buffer, or by BUFFER if it
198 return decode_buffer (buffer, 0)->syntax_table;
201 DEFUN ("standard-syntax-table", Fstandard_syntax_table, 0, 0, 0, /*
202 Return the standard syntax table.
203 This is the one used for new buffers.
207 return Vstandard_syntax_table;
210 DEFUN ("copy-syntax-table", Fcopy_syntax_table, 0, 1, 0, /*
211 Return a new syntax table which is a copy of SYNTAX-TABLE.
212 SYNTAX-TABLE defaults to the standard syntax table.
216 if (NILP (Vstandard_syntax_table))
217 return Fmake_char_table (Qsyntax);
219 syntax_table = check_syntax_table (syntax_table, Vstandard_syntax_table);
220 return Fcopy_char_table (syntax_table);
223 DEFUN ("set-syntax-table", Fset_syntax_table, 1, 2, 0, /*
224 Select SYNTAX-TABLE as the new syntax table for BUFFER.
225 BUFFER defaults to the current buffer if omitted.
227 (syntax_table, buffer))
229 struct buffer *buf = decode_buffer (buffer, 0);
230 syntax_table = check_syntax_table (syntax_table, Qnil);
231 buf->syntax_table = syntax_table;
232 buf->mirror_syntax_table = XCHAR_TABLE (syntax_table)->mirror_table;
233 /* Indicate that this buffer now has a specified syntax table. */
234 buf->local_var_flags |= XINT (buffer_local_flags.syntax_table);
238 /* The current syntax state */
239 struct syntax_cache syntax_cache;
243 Update syntax_cache to an appropriate setting for position POS
245 The sign of COUNT gives the relative position of POS wrt the
246 previously valid interval. (not currently used)
248 `syntax_cache.*_change' are the next and previous positions at
249 which syntax_code and c_s_t will need to be recalculated.
251 #### Currently this code uses 'get-char-property', which will
252 return the "last smallest" extent at a given position. In cases
253 where overlapping extents are defined, this code will simply use
254 whatever is returned by get-char-property.
256 It might be worth it at some point to merge provided syntax tables
257 outward to the current buffer. */
260 update_syntax_cache (int pos, int count, int init)
262 Lisp_Object tmp_table;
266 syntax_cache.prev_change = -1;
267 syntax_cache.next_change = -1;
270 if (pos > syntax_cache.prev_change &&
271 pos < syntax_cache.next_change)
277 if (NILP (syntax_cache.object) || EQ (syntax_cache.object, Qt))
279 int get_change_before = pos + 1;
281 tmp_table = Fget_char_property (make_int(pos), Qsyntax_table,
282 make_buffer (syntax_cache.buffer), Qnil);
283 syntax_cache.next_change =
284 XINT (Fnext_extent_change (make_int (pos > 0 ? pos : 1),
285 make_buffer (syntax_cache.buffer)));
287 if (get_change_before < 1)
288 get_change_before = 1;
289 else if (get_change_before > BUF_ZV (syntax_cache.buffer))
290 get_change_before = BUF_ZV (syntax_cache.buffer);
292 syntax_cache.prev_change =
293 XINT (Fprevious_extent_change (make_int (get_change_before),
294 make_buffer (syntax_cache.buffer)));
298 int get_change_before = pos + 1;
300 tmp_table = Fget_char_property (make_int(pos), Qsyntax_table,
301 syntax_cache.object, Qnil);
302 syntax_cache.next_change =
303 XINT (Fnext_extent_change (make_int (pos >= 0 ? pos : 0),
304 syntax_cache.object));
306 if (get_change_before < 0)
307 get_change_before = 0;
308 else if (get_change_before > XSTRING_LENGTH(syntax_cache.object))
309 get_change_before = XSTRING_LENGTH(syntax_cache.object);
311 syntax_cache.prev_change =
312 XINT (Fprevious_extent_change (make_int (pos >= 0 ? pos : 0),
313 syntax_cache.object));
316 if (EQ (Fsyntax_table_p (tmp_table), Qt))
318 syntax_cache.use_code = 0;
319 syntax_cache.current_syntax_table =
320 XCHAR_TABLE (tmp_table)->mirror_table;
322 else if (CONSP (tmp_table) && INTP (XCAR (tmp_table)))
324 syntax_cache.use_code = 1;
325 syntax_cache.syntax_code = XINT (XCAR(tmp_table));
329 syntax_cache.use_code = 0;
330 syntax_cache.current_syntax_table =
331 syntax_cache.buffer->mirror_syntax_table;
336 /* Convert a letter which signifies a syntax code
337 into the code it signifies.
338 This is used by modify-syntax-entry, and other things. */
340 const unsigned char syntax_spec_code[0400] =
341 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
342 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
343 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
344 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
345 (char) Swhitespace, 0377, (char) Sstring, 0377,
346 (char) Smath, 0377, 0377, (char) Squote,
347 (char) Sopen, (char) Sclose, 0377, 0377,
348 0377, (char) Swhitespace, (char) Spunct, (char) Scharquote,
349 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
350 0377, 0377, 0377, 0377,
351 (char) Scomment, 0377, (char) Sendcomment, 0377,
352 (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */
353 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
354 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
355 0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol,
356 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
357 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
358 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
359 0377, 0377, 0377, 0377, (char) Sstring_fence, 0377, 0377, 0377
362 const unsigned char syntax_code_spec[] = " .w_()'\"$\\/<>@!|";
364 DEFUN ("syntax-designator-chars", Fsyntax_designator_chars, 0, 0, 0, /*
365 Return a string of the recognized syntax designator chars.
366 The chars are ordered by their internal syntax codes, which are
367 numbered starting at 0.
371 return Vsyntax_designator_chars_string;
374 DEFUN ("char-syntax", Fchar_syntax, 1, 2, 0, /*
375 Return the syntax code of CHARACTER, described by a character.
376 For example, if CHARACTER is a word constituent,
377 the character `?w' is returned.
378 The characters that correspond to various syntax codes
379 are listed in the documentation of `modify-syntax-entry'.
380 Optional second argument SYNTAX-TABLE defaults to the current buffer's
383 (character, syntax_table))
385 Lisp_Char_Table *mirrortab;
387 if (NILP (character))
389 character = make_char ('\000');
391 CHECK_CHAR_COERCE_INT (character);
392 syntax_table = check_syntax_table (syntax_table, current_buffer->syntax_table);
393 mirrortab = XCHAR_TABLE (XCHAR_TABLE (syntax_table)->mirror_table);
394 return make_char (syntax_code_spec[(int) SYNTAX (mirrortab, XCHAR (character))]);
400 charset_syntax (struct buffer *buf, Lisp_Object charset, int *multi_p_out)
403 /* #### get this right */
410 syntax_match (Lisp_Object syntax_table, Emchar ch)
412 Lisp_Object code = XCHAR_TABLE_VALUE_UNSAFE (syntax_table, ch);
413 Lisp_Object code2 = code;
417 if (SYNTAX_FROM_CODE (XINT (code2)) == Sinherit)
418 code = XCHAR_TABLE_VALUE_UNSAFE (Vstandard_syntax_table, ch);
420 return CONSP (code) ? XCDR (code) : Qnil;
423 DEFUN ("matching-paren", Fmatching_paren, 1, 2, 0, /*
424 Return the matching parenthesis of CHARACTER, or nil if none.
425 Optional second argument SYNTAX-TABLE defaults to the current buffer's
428 (character, syntax_table))
430 Lisp_Char_Table *mirrortab;
433 CHECK_CHAR_COERCE_INT (character);
434 syntax_table = check_syntax_table (syntax_table, current_buffer->syntax_table);
435 mirrortab = XCHAR_TABLE (XCHAR_TABLE (syntax_table)->mirror_table);
436 code = SYNTAX (mirrortab, XCHAR (character));
437 if (code == Sopen || code == Sclose || code == Sstring)
438 return syntax_match (syntax_table, XCHAR (character));
445 /* Return 1 if there is a word boundary between two word-constituent
446 characters C1 and C2 if they appear in this order, else return 0.
447 There is no word boundary between two word-constituent ASCII
449 #define WORD_BOUNDARY_P(c1, c2) \
450 (!(CHAR_ASCII_P (c1) && CHAR_ASCII_P (c2)) \
451 && word_boundary_p (c1, c2))
453 extern int word_boundary_p (Emchar c1, Emchar c2);
456 /* Return the position across COUNT words from FROM.
457 If that many words cannot be found before the end of the buffer, return 0.
458 COUNT negative means scan backward and stop at word beginning. */
461 scan_words (struct buffer *buf, Bufpos from, int count)
463 Bufpos limit = count > 0 ? BUF_ZV (buf) : BUF_BEGV (buf);
465 enum syntaxcode code;
467 SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, from, count);
469 /* #### is it really worth it to hand expand both cases? JV */
479 UPDATE_SYNTAX_CACHE_FORWARD (from);
480 ch0 = BUF_FETCH_CHAR (buf, from);
481 code = SYNTAX_FROM_CACHE (mirrortab, ch0);
484 if (words_include_escapes
485 && (code == Sescape || code == Scharquote))
493 while (from != limit)
495 UPDATE_SYNTAX_CACHE_FORWARD (from);
496 ch1 = BUF_FETCH_CHAR (buf, from);
497 code = SYNTAX_FROM_CACHE (mirrortab, ch1);
498 if (!(words_include_escapes
499 && (code == Sescape || code == Scharquote)))
502 || WORD_BOUNDARY_P (ch0, ch1)
523 UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
524 ch1 = BUF_FETCH_CHAR (buf, from - 1);
525 code = SYNTAX_FROM_CACHE (mirrortab, ch1);
528 if (words_include_escapes
529 && (code == Sescape || code == Scharquote))
537 while (from != limit)
539 UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
540 ch0 = BUF_FETCH_CHAR (buf, from - 1);
541 code = SYNTAX_FROM_CACHE (mirrortab, ch0);
543 if (!(words_include_escapes
544 && (code == Sescape || code == Scharquote)))
547 || WORD_BOUNDARY_P (ch0, ch1)
562 DEFUN ("forward-word", Fforward_word, 0, 2, "_p", /*
563 Move point forward COUNT words (backward if COUNT is negative).
564 Normally t is returned, but if an edge of the buffer is reached,
565 point is left there and nil is returned.
567 The characters that are moved over may be added to the current selection
568 \(i.e. active region) if the Shift key is held down, a motion key is used
569 to invoke this command, and `shifted-motion-keys-select-region' is t; see
570 the documentation for this variable for more details.
572 COUNT defaults to 1, and BUFFER defaults to the current buffer.
577 struct buffer *buf = decode_buffer (buffer, 0);
588 val = scan_words (buf, BUF_PT (buf), n);
591 BUF_SET_PT (buf, val);
596 BUF_SET_PT (buf, n > 0 ? BUF_ZV (buf) : BUF_BEGV (buf));
601 static void scan_sexps_forward (struct buffer *buf,
602 struct lisp_parse_state *,
603 Bufpos from, Bufpos end,
604 int targetdepth, int stopbefore,
605 Lisp_Object oldstate,
609 find_start_of_comment (struct buffer *buf, Bufpos from, Bufpos stop,
613 enum syntaxcode code;
615 /* Look back, counting the parity of string-quotes,
616 and recording the comment-starters seen.
617 When we reach a safe place, assume that's not in a string;
618 then step the main scan to the earliest comment-starter seen
619 an even number of string quotes away from the safe place.
621 OFROM[I] is position of the earliest comment-starter seen
622 which is I+2X quotes from the comment-end.
623 PARITY is current parity of quotes from the comment end. */
625 Emchar my_stringend = 0;
626 int string_lossage = 0;
627 Bufpos comment_end = from;
628 Bufpos comstart_pos = 0;
629 int comstart_parity = 0;
630 int styles_match_p = 0;
631 /* mask to match comment styles against; for ST_COMMENT_STYLE, this
632 will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */
633 int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A;
635 /* At beginning of range to scan, we're outside of strings;
636 that determines quote parity to the comment-end. */
641 /* Move back and examine a character. */
643 UPDATE_SYNTAX_CACHE_BACKWARD (from);
645 c = BUF_FETCH_CHAR (buf, from);
646 code = SYNTAX_FROM_CACHE (mirrortab, c);
647 syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
649 /* is this a 1-char comment end sequence? if so, try
650 to see if style matches previously extracted mask */
651 if (code == Sendcomment)
654 SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask;
657 /* or are we looking at a 1-char comment start sequence
658 of the style matching mask? */
659 else if (code == Scomment)
662 SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask;
665 /* otherwise, is this a 2-char comment end or start sequence? */
666 else if (from > stop)
669 /* 2-char comment end sequence? */
670 if (SYNTAX_CODE_END_SECOND_P (syncode))
673 UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
675 SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from - 1));
677 if (SYNTAX_CODES_END_P (prev_syncode, syncode))
681 SYNTAX_CODES_COMMENT_MASK_END (prev_syncode, syncode)
684 UPDATE_SYNTAX_CACHE_BACKWARD (from);
685 c = BUF_FETCH_CHAR (buf, from);
687 /* Found a comment-end sequence, so skip past the
688 check for a comment-start */
693 /* 2-char comment start sequence? */
694 if (SYNTAX_CODE_START_SECOND_P (syncode))
697 UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
699 SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from - 1));
701 if (SYNTAX_CODES_START_P (prev_syncode, syncode))
705 SYNTAX_CODES_COMMENT_MASK_START (prev_syncode, syncode)
708 UPDATE_SYNTAX_CACHE_BACKWARD (from);
709 c = BUF_FETCH_CHAR (buf, from);
714 /* Ignore escaped characters. */
715 if (char_quoted (buf, from))
718 /* Track parity of quotes. */
722 if (my_stringend == 0)
724 /* If we have two kinds of string delimiters.
725 There's no way to grok this scanning backwards. */
726 else if (my_stringend != c)
730 if (code == Sstring_fence || code == Scomment_fence)
733 if (my_stringend == 0)
735 code == Sstring_fence ? ST_STRING_STYLE : ST_COMMENT_STYLE;
736 /* If we have two kinds of string delimiters.
737 There's no way to grok this scanning backwards. */
738 else if (my_stringend != (code == Sstring_fence
739 ? ST_STRING_STYLE : ST_COMMENT_STYLE))
743 /* Record comment-starters according to that
744 quote-parity to the comment-end. */
745 if (code == Scomment && styles_match_p)
747 comstart_parity = parity;
751 /* If we find another earlier comment-ender,
752 any comment-starts earlier than that don't count
753 (because they go with the earlier comment-ender). */
754 if (code == Sendcomment && styles_match_p)
757 /* Assume a defun-start point is outside of strings. */
759 && (from == stop || BUF_FETCH_CHAR (buf, from - 1) == '\n'))
763 if (comstart_pos == 0)
765 /* If the earliest comment starter
766 is followed by uniform paired string quotes or none,
767 we know it can't be inside a string
768 since if it were then the comment ender would be inside one.
769 So it does start a comment. Skip back to it. */
770 else if (comstart_parity == 0 && !string_lossage)
774 /* We had two kinds of string delimiters mixed up
775 together. Decode this going forwards.
776 Scan fwd from the previous comment ender
777 to the one in question; this records where we
778 last passed a comment starter. */
780 struct lisp_parse_state state;
781 scan_sexps_forward (buf, &state, find_defun_start (buf, comment_end),
782 comment_end - 1, -10000, 0, Qnil, 0);
784 from = state.comstr_start;
786 /* We can't grok this as a comment; scan it normally. */
788 UPDATE_SYNTAX_CACHE_FORWARD (from - 1);
794 find_end_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int comstyle)
798 /* mask to match comment styles against; for ST_COMMENT_STYLE, this
799 will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */
800 int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A;
802 /* This is only called by functions which have already set up the
803 syntax_cache and are keeping it up-to-date */
811 UPDATE_SYNTAX_CACHE_FORWARD (from);
812 c = BUF_FETCH_CHAR (buf, from);
814 /* Test for generic comments */
815 if (comstyle == ST_COMMENT_STYLE)
817 if (SYNTAX_FROM_CACHE (mirrortab, c) == Scomment_fence)
820 UPDATE_SYNTAX_CACHE_FORWARD (from);
824 continue; /* No need to test other comment styles in a
829 if (SYNTAX_FROM_CACHE (mirrortab, c) == Sendcomment
830 && SYNTAX_CODE_MATCHES_1CHAR_P
831 (SYNTAX_CODE_FROM_CACHE (mirrortab, c), mask))
832 /* we have encountered a comment end of the same style
833 as the comment sequence which began this comment
837 UPDATE_SYNTAX_CACHE_FORWARD (from);
841 prev_code = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
843 UPDATE_SYNTAX_CACHE_FORWARD (from);
845 && SYNTAX_CODES_MATCH_END_P
847 SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from)),
851 /* we have encountered a comment end of the same style
852 as the comment sequence which began this comment
856 UPDATE_SYNTAX_CACHE_FORWARD (from);
864 /* #### between FSF 19.23 and 19.28 there are some changes to the logic
865 in this function (and minor changes to find_start_of_comment(),
866 above, which is part of Fforward_comment() in FSF). Attempts to port
867 that logic made this function break, so I'm leaving it out. If anyone
868 ever complains about this function not working properly, take a look
869 at those changes. --ben */
871 DEFUN ("forward-comment", Fforward_comment, 0, 2, 0, /*
872 Move forward across up to COUNT comments, or backwards if COUNT is negative.
873 Stop scanning if we find something other than a comment or whitespace.
874 Set point to where scanning stops.
875 If COUNT comments are found as expected, with nothing except whitespace
876 between them, return t; otherwise return nil.
877 Point is set in either case.
878 COUNT defaults to 1, and BUFFER defaults to the current buffer.
885 enum syntaxcode code;
888 struct buffer *buf = decode_buffer (buffer, 0);
900 SETUP_SYNTAX_CACHE (from, n);
908 int comstyle = 0; /* mask for finding matching comment style */
910 if (char_quoted (buf, from))
916 UPDATE_SYNTAX_CACHE_FORWARD (from);
917 c = BUF_FETCH_CHAR (buf, from);
918 code = SYNTAX_FROM_CACHE (mirrortab, c);
919 syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
921 if (code == Scomment)
923 /* we have encountered a single character comment start
924 sequence, and we are ignoring all text inside comments.
925 we must record the comment style this character begins
926 so that later, only a comment end of the same style actually
927 ends the comment section */
928 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
929 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
932 else if (code == Scomment_fence)
936 comstyle = ST_COMMENT_STYLE;
940 && SYNTAX_CODE_START_FIRST_P (syncode))
943 UPDATE_SYNTAX_CACHE_FORWARD (from + 1);
945 SYNTAX_CODE_FROM_CACHE (mirrortab,
946 BUF_FETCH_CHAR (buf, from + 1));
948 if (SYNTAX_CODES_START_P (syncode, next_syncode))
950 /* we have encountered a 2char comment start sequence and we
951 are ignoring all text inside comments. we must record
952 the comment style this sequence begins so that later,
953 only a comment end of the same style actually ends
954 the comment section */
957 SYNTAX_CODES_COMMENT_MASK_START (syncode, next_syncode)
958 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
963 if (code == Scomment)
965 Bufpos newfrom = find_end_of_comment (buf, from, stop, comstyle);
968 /* we stopped because from==stop */
969 BUF_SET_PT (buf, stop);
974 /* We have skipped one comment. */
977 else if (code != Swhitespace
978 && code != Sendcomment
979 && code != Scomment )
981 BUF_SET_PT (buf, from);
987 /* End of comment reached */
995 stop = BUF_BEGV (buf);
998 int comstyle = 0; /* mask for finding matching comment style */
1001 if (char_quoted (buf, from))
1007 c = BUF_FETCH_CHAR (buf, from);
1008 code = SYNTAX_FROM_CACHE (mirrortab, c);
1009 syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
1011 if (code == Sendcomment)
1013 /* we have found a single char end comment. we must record
1014 the comment style encountered so that later, we can match
1015 only the proper comment begin sequence of the same style */
1016 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
1017 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1020 else if (code == Scomment_fence)
1023 comstyle = ST_COMMENT_STYLE;
1026 else if (from > stop
1027 && SYNTAX_CODE_END_SECOND_P (syncode))
1030 UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
1032 SYNTAX_CODE_FROM_CACHE (mirrortab,
1033 BUF_FETCH_CHAR (buf, from - 1));
1034 if (SYNTAX_CODES_END_P (prev_syncode, syncode))
1036 /* We must record the comment style encountered so that
1037 later, we can match only the proper comment begin
1038 sequence of the same style. */
1040 comstyle = SYNTAX_CODES_COMMENT_MASK_END
1041 (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1046 if (code == Sendcomment)
1048 from = find_start_of_comment (buf, from, stop, comstyle);
1052 else if (code != Swhitespace
1054 && code != Sendcomment)
1056 BUF_SET_PT (buf, from + 1);
1064 BUF_SET_PT (buf, from);
1070 scan_lists (struct buffer *buf, Bufpos from, int count, int depth,
1071 int sexpflag, int noerror)
1077 enum syntaxcode code;
1079 int min_depth = depth; /* Err out if depth gets less than this. */
1081 if (depth > 0) min_depth = 0;
1083 SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, from, count);
1088 stop = BUF_ZV (buf);
1091 int comstyle = 0; /* mask for finding matching comment style */
1093 UPDATE_SYNTAX_CACHE_FORWARD (from);
1094 c = BUF_FETCH_CHAR (buf, from);
1095 code = SYNTAX_FROM_CACHE (mirrortab, c);
1096 syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
1099 /* a 1-char comment start sequence */
1100 if (code == Scomment && parse_sexp_ignore_comments)
1102 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) ==
1103 SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1106 /* else, a 2-char comment start sequence? */
1107 else if (from < stop
1108 && SYNTAX_CODE_START_FIRST_P (syncode)
1109 && parse_sexp_ignore_comments)
1112 UPDATE_SYNTAX_CACHE_FORWARD (from);
1114 SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from));
1116 if (SYNTAX_CODES_START_P (syncode, next_syncode))
1118 /* we have encountered a comment start sequence and we
1119 are ignoring all text inside comments. we must record
1120 the comment style this sequence begins so that later,
1121 only a comment end of the same style actually ends
1122 the comment section */
1124 comstyle = SYNTAX_CODES_COMMENT_MASK_START
1125 (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1129 UPDATE_SYNTAX_CACHE_FORWARD (from);
1131 if (SYNTAX_CODE_PREFIX (syncode))
1138 if (from == stop) goto lose;
1140 /* treat following character as a word constituent */
1143 if (depth || !sexpflag) break;
1144 /* This word counts as a sexp; return at end of it. */
1147 UPDATE_SYNTAX_CACHE_FORWARD (from);
1148 switch (SYNTAX_FROM_CACHE (mirrortab,
1149 BUF_FETCH_CHAR (buf, from)))
1154 if (from == stop) goto lose;
1167 case Scomment_fence:
1168 comstyle = ST_COMMENT_STYLE;
1170 if (!parse_sexp_ignore_comments)
1172 UPDATE_SYNTAX_CACHE_FORWARD (from);
1175 find_end_of_comment (buf, from, stop, comstyle);
1178 /* we stopped because from == stop in search forward */
1191 if (from != stop && c == BUF_FETCH_CHAR (buf, from))
1201 if (!++depth) goto done;
1206 if (!--depth) goto done;
1207 if (depth < min_depth)
1211 error ("Containing expression ends prematurely");
1220 if (code != Sstring_fence)
1222 /* XEmacs change: call syntax_match on character */
1223 Emchar ch = BUF_FETCH_CHAR (buf, from - 1);
1224 Lisp_Object stermobj =
1225 syntax_match (syntax_cache.current_syntax_table, ch);
1227 if (CHARP (stermobj))
1228 stringterm = XCHAR (stermobj);
1233 stringterm = '\0'; /* avoid compiler warnings */
1239 UPDATE_SYNTAX_CACHE_FORWARD (from);
1240 c = BUF_FETCH_CHAR (buf, from);
1243 : SYNTAX_FROM_CACHE (mirrortab, c) == Sstring_fence)
1246 switch (SYNTAX_FROM_CACHE (mirrortab, c))
1258 if (!depth && sexpflag) goto done;
1267 /* Reached end of buffer. Error if within object,
1268 return nil if between */
1269 if (depth) goto lose;
1273 /* End of object reached */
1282 stop = BUF_BEGV (buf);
1285 int comstyle = 0; /* mask for finding matching comment style */
1288 UPDATE_SYNTAX_CACHE_BACKWARD (from);
1289 quoted = char_quoted (buf, from);
1293 UPDATE_SYNTAX_CACHE_BACKWARD (from);
1296 c = BUF_FETCH_CHAR (buf, from);
1297 code = SYNTAX_FROM_CACHE (mirrortab, c);
1298 syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
1300 if (code == Sendcomment && parse_sexp_ignore_comments)
1302 /* we have found a single char end comment. we must record
1303 the comment style encountered so that later, we can match
1304 only the proper comment begin sequence of the same style */
1305 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
1306 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1309 else if (from > stop
1310 && SYNTAX_CODE_END_SECOND_P (syncode)
1311 && !char_quoted (buf, from - 1)
1312 && parse_sexp_ignore_comments)
1315 UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
1316 prev_syncode = SYNTAX_CODE_FROM_CACHE
1317 (mirrortab, BUF_FETCH_CHAR (buf, from - 1));
1319 if (SYNTAX_CODES_END_P (prev_syncode, syncode))
1321 /* we must record the comment style encountered so that
1322 later, we can match only the proper comment begin
1323 sequence of the same style */
1325 comstyle = SYNTAX_CODES_COMMENT_MASK_END
1326 (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1331 if (SYNTAX_CODE_PREFIX (syncode))
1334 switch (quoted ? Sword : code)
1338 if (depth || !sexpflag) break;
1339 /* This word counts as a sexp; count object finished after
1343 UPDATE_SYNTAX_CACHE_BACKWARD (from);
1344 quoted = char_quoted (buf, from - 1);
1350 SYNTAX_FROM_CACHE (mirrortab,
1351 BUF_FETCH_CHAR (buf, from - 1)))
1353 || syncode == Ssymbol
1354 || syncode == Squote))
1363 if (from != stop && c == BUF_FETCH_CHAR (buf, from - 1))
1373 if (!++depth) goto done2;
1378 if (!--depth) goto done2;
1379 if (depth < min_depth)
1383 error ("Containing expression ends prematurely");
1387 case Scomment_fence:
1388 comstyle = ST_COMMENT_STYLE;
1390 if (parse_sexp_ignore_comments)
1391 from = find_start_of_comment (buf, from, stop, comstyle);
1399 if (code != Sstring_fence)
1401 /* XEmacs change: call syntax_match() on character */
1402 Emchar ch = BUF_FETCH_CHAR (buf, from);
1403 Lisp_Object stermobj =
1404 syntax_match (syntax_cache.current_syntax_table, ch);
1406 if (CHARP (stermobj))
1407 stringterm = XCHAR (stermobj);
1412 stringterm = '\0'; /* avoid compiler warnings */
1416 if (from == stop) goto lose;
1418 UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
1419 c = BUF_FETCH_CHAR (buf, from - 1);
1421 if ((code == Sstring
1423 : SYNTAX_FROM_CACHE (mirrortab, c) == Sstring_fence)
1424 && !char_quoted (buf, from - 1))
1432 if (!depth && sexpflag) goto done2;
1438 /* Reached start of buffer. Error if within object,
1439 return nil if between */
1440 if (depth) goto lose;
1449 return (make_int (from));
1453 error ("Unbalanced parentheses");
1458 char_quoted (struct buffer *buf, Bufpos pos)
1460 enum syntaxcode code;
1461 Bufpos beg = BUF_BEGV (buf);
1463 Bufpos startpos = pos;
1467 UPDATE_SYNTAX_CACHE_BACKWARD (pos - 1);
1468 code = SYNTAX_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, pos - 1));
1470 if (code != Scharquote && code != Sescape)
1476 UPDATE_SYNTAX_CACHE (startpos);
1480 DEFUN ("scan-lists", Fscan_lists, 3, 5, 0, /*
1481 Scan from character number FROM by COUNT lists.
1482 Returns the character number of the position thus found.
1484 If DEPTH is nonzero, paren depth begins counting from that value,
1485 only places where the depth in parentheses becomes zero
1486 are candidates for stopping; COUNT such places are counted.
1487 Thus, a positive value for DEPTH means go out levels.
1489 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
1491 If the beginning or end of (the accessible part of) the buffer is reached
1492 and the depth is wrong, an error is signaled.
1493 If the depth is right but the count is not used up, nil is returned.
1495 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead
1496 of in the current buffer.
1498 If optional arg NOERROR is non-nil, scan-lists will return nil instead of
1499 signalling an error.
1501 (from, count, depth, buffer, noerror))
1508 buf = decode_buffer (buffer, 0);
1510 return scan_lists (buf, XINT (from), XINT (count), XINT (depth), 0,
1514 DEFUN ("scan-sexps", Fscan_sexps, 2, 4, 0, /*
1515 Scan from character number FROM by COUNT balanced expressions.
1516 If COUNT is negative, scan backwards.
1517 Returns the character number of the position thus found.
1519 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
1521 If the beginning or end of (the accessible part of) the buffer is reached
1522 in the middle of a parenthetical grouping, an error is signaled.
1523 If the beginning or end is reached between groupings
1524 but before count is used up, nil is returned.
1526 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead
1527 of in the current buffer.
1529 If optional arg NOERROR is non-nil, scan-sexps will return nil instead of
1530 signalling an error.
1532 (from, count, buffer, noerror))
1534 struct buffer *buf = decode_buffer (buffer, 0);
1538 return scan_lists (buf, XINT (from), XINT (count), 0, 1, !NILP (noerror));
1541 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, 0, 1, 0, /*
1542 Move point backward over any number of chars with prefix syntax.
1543 This includes chars with "quote" or "prefix" syntax (' or p).
1545 Optional arg BUFFER defaults to the current buffer.
1549 struct buffer *buf = decode_buffer (buffer, 0);
1550 Bufpos beg = BUF_BEGV (buf);
1551 Bufpos pos = BUF_PT (buf);
1553 Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
1555 Emchar c = '\0'; /* initialize to avoid compiler warnings */
1558 SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, pos, -1);
1560 while (pos > beg && !char_quoted (buf, pos - 1)
1561 /* Previous statement updates syntax table. */
1562 && (SYNTAX_FROM_CACHE (mirrortab, c = BUF_FETCH_CHAR (buf, pos - 1)) == Squote
1563 || SYNTAX_CODE_PREFIX (SYNTAX_CODE_FROM_CACHE (mirrortab, c))))
1566 BUF_SET_PT (buf, pos);
1571 /* Parse forward from FROM to END,
1572 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
1573 and return a description of the state of the parse at END.
1574 If STOPBEFORE is nonzero, stop at the start of an atom.
1575 If COMMENTSTOP is nonzero, stop at the start of a comment. */
1578 scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr,
1579 Bufpos from, Bufpos end,
1580 int targetdepth, int stopbefore,
1581 Lisp_Object oldstate,
1584 struct lisp_parse_state state;
1586 enum syntaxcode code;
1587 struct level { int last, prev; };
1588 struct level levelstart[100];
1589 struct level *curlevel = levelstart;
1590 struct level *endlevel = levelstart + 100;
1591 int depth; /* Paren depth of current scanning location.
1592 level - levelstart equals this except
1593 when the depth becomes negative. */
1594 int mindepth; /* Lowest DEPTH value seen. */
1595 int start_quoted = 0; /* Nonzero means starting after a char quote */
1596 int boundary_stop = commentstop == -1;
1599 SETUP_SYNTAX_CACHE (from, 1);
1600 if (NILP (oldstate))
1603 state.instring = -1;
1604 state.incomment = 0;
1605 state.comstyle = 0; /* comment style a by default */
1606 state.comstr_start = -1; /* no comment/string seen. */
1610 tem = Fcar (oldstate); /* elt 0, depth */
1616 oldstate = Fcdr (oldstate);
1617 oldstate = Fcdr (oldstate);
1618 oldstate = Fcdr (oldstate);
1619 tem = Fcar (oldstate); /* elt 3, instring */
1620 state.instring = ( !NILP (tem)
1621 ? ( INTP (tem) ? XINT (tem) : ST_STRING_STYLE)
1624 oldstate = Fcdr (oldstate);
1625 tem = Fcar (oldstate); /* elt 4, incomment */
1626 state.incomment = !NILP (tem);
1628 oldstate = Fcdr (oldstate);
1629 tem = Fcar (oldstate); /* elt 5, follows-quote */
1630 start_quoted = !NILP (tem);
1632 /* if the eighth element of the list is nil, we are in comment style
1633 a; if it is t, we are in comment style b; if it is 'syntax-table,
1634 we are in a generic comment */
1635 oldstate = Fcdr (oldstate);
1636 oldstate = Fcdr (oldstate);
1637 tem = Fcar (oldstate); /* elt 7, comment style a/b/fence */
1638 state.comstyle = NILP (tem) ? 0 : ( EQ (tem, Qsyntax_table)
1639 ? ST_COMMENT_STYLE : 1 );
1641 oldstate = Fcdr (oldstate); /* elt 8, start of last comment/string */
1642 tem = Fcar (oldstate);
1643 state.comstr_start = NILP (tem) ? -1 : XINT (tem);
1645 /* elt 9, char numbers of starts-of-expression of levels
1646 (starting from outermost). */
1647 oldstate = Fcdr (oldstate);
1648 tem = Fcar (oldstate); /* elt 9, intermediate data for
1649 continuation of parsing (subject
1651 while (!NILP (tem)) /* >= second enclosing sexps. */
1653 curlevel->last = XINT (Fcar (tem));
1654 if (++curlevel == endlevel)
1655 error ("Nesting too deep for parser");
1656 curlevel->prev = -1;
1657 curlevel->last = -1;
1664 curlevel->prev = -1;
1665 curlevel->last = -1;
1667 /* Enter the loop at a place appropriate for initial state. */
1669 if (state.incomment) goto startincomment;
1670 if (state.instring >= 0)
1672 if (start_quoted) goto startquotedinstring;
1675 if (start_quoted) goto startquoted;
1684 UPDATE_SYNTAX_CACHE_FORWARD (from);
1685 c = BUF_FETCH_CHAR (buf, from);
1686 code = SYNTAX_FROM_CACHE (mirrortab, c);
1687 syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
1690 /* record the comment style we have entered so that only the
1691 comment-ender sequence (or single char) of the same style
1692 actually terminates the comment section. */
1693 if (code == Scomment)
1696 SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
1697 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1698 state.comstr_start = from - 1;
1701 /* a generic comment delimiter? */
1702 else if (code == Scomment_fence)
1704 state.comstyle = ST_COMMENT_STYLE;
1705 state.comstr_start = from - 1;
1709 else if (from < end &&
1710 SYNTAX_CODE_START_FIRST_P (syncode))
1713 UPDATE_SYNTAX_CACHE_FORWARD (from);
1715 SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from));
1717 if (SYNTAX_CODES_START_P (syncode, next_syncode))
1720 state.comstyle = SYNTAX_CODES_COMMENT_MASK_START
1721 (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1722 state.comstr_start = from - 1;
1724 UPDATE_SYNTAX_CACHE_FORWARD (from);
1728 if (SYNTAX_CODE_PREFIX (syncode))
1734 if (stopbefore) goto stop; /* this arg means stop at sexp start */
1735 curlevel->last = from - 1;
1737 if (from == end) goto endquoted;
1740 /* treat following character as a word constituent */
1743 if (stopbefore) goto stop; /* this arg means stop at sexp start */
1744 curlevel->last = from - 1;
1748 UPDATE_SYNTAX_CACHE_FORWARD (from);
1749 switch (SYNTAX_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from)))
1754 if (from == end) goto endquoted;
1766 curlevel->prev = curlevel->last;
1770 state.incomment = 1;
1771 if (commentstop || boundary_stop) goto done;
1773 if (commentstop == 1)
1775 UPDATE_SYNTAX_CACHE_FORWARD (from);
1777 Bufpos newfrom = find_end_of_comment (buf, from, end, state.comstyle);
1780 /* we terminated search because from == end */
1786 state.incomment = 0;
1787 state.comstyle = 0; /* reset the comment style */
1788 if (boundary_stop) goto done;
1792 if (stopbefore) goto stop; /* this arg means stop at sexp start */
1794 /* curlevel++->last ran into compiler bug on Apollo */
1795 curlevel->last = from - 1;
1796 if (++curlevel == endlevel)
1797 error ("Nesting too deep for parser");
1798 curlevel->prev = -1;
1799 curlevel->last = -1;
1800 if (targetdepth == depth) goto done;
1805 if (depth < mindepth)
1807 if (curlevel != levelstart)
1809 curlevel->prev = curlevel->last;
1810 if (targetdepth == depth) goto done;
1815 state.comstr_start = from - 1;
1816 if (stopbefore) goto stop; /* this arg means stop at sexp start */
1817 curlevel->last = from - 1;
1818 if (code == Sstring_fence)
1820 state.instring = ST_STRING_STYLE;
1824 /* XEmacs change: call syntax_match() on character */
1825 Emchar ch = BUF_FETCH_CHAR (buf, from - 1);
1826 Lisp_Object stermobj =
1827 syntax_match (syntax_cache.current_syntax_table, ch);
1829 if (CHARP (stermobj))
1830 state.instring = XCHAR (stermobj);
1832 state.instring = ch;
1834 if (boundary_stop) goto done;
1838 enum syntaxcode temp_code;
1840 if (from >= end) goto done;
1842 UPDATE_SYNTAX_CACHE_FORWARD (from);
1843 c = BUF_FETCH_CHAR (buf, from);
1844 temp_code = SYNTAX_FROM_CACHE (mirrortab, c);
1847 state.instring != ST_STRING_STYLE &&
1848 temp_code == Sstring &&
1849 c == state.instring) break;
1854 if (state.instring == ST_STRING_STYLE)
1861 startquotedinstring:
1862 if (from >= end) goto endquoted;
1871 state.instring = -1;
1872 curlevel->prev = curlevel->last;
1874 if (boundary_stop) goto done;
1884 case Scomment_fence:
1892 stop: /* Here if stopping before start of sexp. */
1893 from--; /* We have just fetched the char that starts it; */
1894 goto done; /* but return the position before it. */
1899 state.depth = depth;
1900 state.mindepth = mindepth;
1901 state.thislevelstart = curlevel->prev;
1902 state.prevlevelstart
1903 = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
1904 state.location = from;
1905 state.levelstarts = Qnil;
1906 while (--curlevel >= levelstart)
1907 state.levelstarts = Fcons (make_int (curlevel->last),
1913 DEFUN ("parse-partial-sexp", Fparse_partial_sexp, 2, 7, 0, /*
1914 Parse Lisp syntax starting at FROM until TO; return status of parse at TO.
1915 Parsing stops at TO or when certain criteria are met;
1916 point is set to where parsing stops.
1917 If fifth arg OLDSTATE is omitted or nil,
1918 parsing assumes that FROM is the beginning of a function.
1919 Value is a list of nine elements describing final state of parsing:
1921 1. character address of start of innermost containing list; nil if none.
1922 2. character address of start of last complete sexp terminated.
1923 3. non-nil if inside a string.
1924 (It is the character that will terminate the string,
1925 or t if the string should be terminated by an explicit
1926 `syntax-table' property.)
1927 4. t if inside a comment.
1928 5. t if following a quote character.
1929 6. the minimum paren-depth encountered during this scan.
1930 7. nil if in comment style a, or not in a comment; t if in comment style b;
1931 `syntax-table' if given by an explicit `syntax-table' property.
1932 8. character address of start of last comment or string; nil if none.
1933 9. Intermediate data for continuation of parsing (subject to change).
1934 If third arg TARGETDEPTH is non-nil, parsing stops if the depth
1935 in parentheses becomes equal to TARGETDEPTH.
1936 Fourth arg STOPBEFORE non-nil means stop when come to
1937 any character that starts a sexp.
1938 Fifth arg OLDSTATE is a nine-element list like what this function returns.
1939 It is used to initialize the state of the parse. Its second and third
1940 elements are ignored.
1941 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. If it
1942 is `syntax-table', stop after the start of a comment or a string, or after
1943 the end of a comment or string.
1945 (from, to, targetdepth, stopbefore, oldstate, commentstop, buffer))
1947 struct lisp_parse_state state;
1950 struct buffer *buf = decode_buffer (buffer, 0);
1953 if (!NILP (targetdepth))
1955 CHECK_INT (targetdepth);
1956 target = XINT (targetdepth);
1959 target = -100000; /* We won't reach this depth */
1961 get_buffer_range_char (buf, from, to, &start, &end, 0);
1962 scan_sexps_forward (buf, &state, start, end,
1963 target, !NILP (stopbefore), oldstate,
1965 ? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1)));
1966 BUF_SET_PT (buf, state.location);
1970 val = Fcons (state.levelstarts, val);
1971 val = Fcons ((state.incomment || (state.instring >= 0))
1972 ? make_int (state.comstr_start) : Qnil, val);
1973 val = Fcons (state.comstyle ? (state.comstyle == ST_COMMENT_STYLE
1974 ? Qsyntax_table : Qt) : Qnil, val);
1975 val = Fcons (make_int (state.mindepth), val);
1976 val = Fcons (state.quoted ? Qt : Qnil, val);
1977 val = Fcons (state.incomment ? Qt : Qnil, val);
1978 val = Fcons (state.instring < 0
1980 : (state.instring == ST_STRING_STYLE
1981 ? Qt : make_int (state.instring)), val);
1982 val = Fcons (state.thislevelstart < 0 ? Qnil : make_int (state.thislevelstart), val);
1983 val = Fcons (state.prevlevelstart < 0 ? Qnil : make_int (state.prevlevelstart), val);
1984 val = Fcons (make_int (state.depth), val);
1990 /* Updating of the mirror syntax table.
1992 Each syntax table has a corresponding mirror table in it.
1993 Whenever we make a change to a syntax table, we call
1994 update_syntax_table() on it.
1996 #### We really only need to map over the changed range.
1998 If we change the standard syntax table, we need to map over
1999 all tables because any of them could be inheriting from the
2000 standard syntax table.
2002 When `set-syntax-table' is called, we set the buffer's mirror
2003 syntax table as well.
2008 Lisp_Object mirrortab;
2013 cmst_mapfun (struct chartab_range *range, Lisp_Object val, void *arg)
2015 struct cmst_arg *closure = (struct cmst_arg *) arg;
2019 if (SYNTAX_FROM_CODE (XINT (val)) == Sinherit
2020 && closure->check_inherit)
2022 struct cmst_arg recursive;
2024 recursive.mirrortab = closure->mirrortab;
2025 recursive.check_inherit = 0;
2026 map_char_table (XCHAR_TABLE (Vstandard_syntax_table), range,
2027 cmst_mapfun, &recursive);
2030 put_char_table (XCHAR_TABLE (closure->mirrortab), range, val);
2035 update_just_this_syntax_table (Lisp_Char_Table *ct)
2037 struct chartab_range range;
2038 struct cmst_arg arg;
2040 arg.mirrortab = ct->mirror_table;
2041 arg.check_inherit = (CHAR_TABLEP (Vstandard_syntax_table)
2042 && ct != XCHAR_TABLE (Vstandard_syntax_table));
2043 range.type = CHARTAB_RANGE_ALL;
2044 map_char_table (ct, &range, cmst_mapfun, &arg);
2047 /* Called from chartab.c when a change is made to a syntax table.
2048 If this is the standard syntax table, we need to recompute
2049 *all* syntax tables (yuck). Otherwise we just recompute this
2053 update_syntax_table (Lisp_Char_Table *ct)
2055 /* Don't be stymied at startup. */
2056 if (CHAR_TABLEP (Vstandard_syntax_table)
2057 && ct == XCHAR_TABLE (Vstandard_syntax_table))
2061 for (syntab = Vall_syntax_tables; !NILP (syntab);
2062 syntab = XCHAR_TABLE (syntab)->next_table)
2063 update_just_this_syntax_table (XCHAR_TABLE (syntab));
2066 update_just_this_syntax_table (ct);
2070 /************************************************************************/
2071 /* initialization */
2072 /************************************************************************/
2075 syms_of_syntax (void)
2077 defsymbol (&Qsyntax_table_p, "syntax-table-p");
2078 defsymbol (&Qsyntax_table, "syntax-table");
2080 DEFSUBR (Fsyntax_table_p);
2081 DEFSUBR (Fsyntax_table);
2082 DEFSUBR (Fstandard_syntax_table);
2083 DEFSUBR (Fcopy_syntax_table);
2084 DEFSUBR (Fset_syntax_table);
2085 DEFSUBR (Fsyntax_designator_chars);
2086 DEFSUBR (Fchar_syntax);
2087 DEFSUBR (Fmatching_paren);
2088 /* DEFSUBR (Fmodify_syntax_entry); now in Lisp. */
2089 /* DEFSUBR (Fdescribe_syntax); now in Lisp. */
2091 DEFSUBR (Fforward_word);
2093 DEFSUBR (Fforward_comment);
2094 DEFSUBR (Fscan_lists);
2095 DEFSUBR (Fscan_sexps);
2096 DEFSUBR (Fbackward_prefix_chars);
2097 DEFSUBR (Fparse_partial_sexp);
2101 vars_of_syntax (void)
2103 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments /*
2104 Non-nil means `forward-sexp', etc., should treat comments as whitespace.
2106 parse_sexp_ignore_comments = 0;
2108 DEFVAR_BOOL ("lookup-syntax-properties", &lookup_syntax_properties /*
2109 Non-nil means `forward-sexp', etc., grant `syntax-table' property.
2110 The value of this property should be either a syntax table, or a cons
2111 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric
2112 syntax code, MATCHCHAR being nil or the character to match (which is
2113 relevant only for open/close type.
2115 lookup_syntax_properties = 1;
2117 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes /*
2118 Non-nil means `forward-word', etc., should treat escape chars part of words.
2120 words_include_escapes = 0;
2122 no_quit_in_re_search = 0;
2126 define_standard_syntax (const char *p, enum syntaxcode syn)
2129 Fput_char_table (make_char (*p), make_int (syn), Vstandard_syntax_table);
2133 complex_vars_of_syntax (void)
2137 /* Set this now, so first buffer creation can refer to it. */
2138 /* Make it nil before calling copy-syntax-table
2139 so that copy-syntax-table will know not to try to copy from garbage */
2140 Vstandard_syntax_table = Qnil;
2141 Vstandard_syntax_table = Fcopy_syntax_table (Qnil);
2142 staticpro (&Vstandard_syntax_table);
2144 Vsyntax_designator_chars_string = make_string_nocopy (syntax_code_spec,
2146 staticpro (&Vsyntax_designator_chars_string);
2148 fill_char_table (XCHAR_TABLE (Vstandard_syntax_table), make_int (Spunct));
2150 for (i = 0; i <= 32; i++) /* Control 0 plus SPACE */
2151 Fput_char_table (make_char (i), make_int (Swhitespace),
2152 Vstandard_syntax_table);
2153 for (i = 127; i <= 159; i++) /* DEL plus Control 1 */
2154 Fput_char_table (make_char (i), make_int (Swhitespace),
2155 Vstandard_syntax_table);
2157 define_standard_syntax ("abcdefghijklmnopqrstuvwxyz"
2158 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
2161 define_standard_syntax ("\"", Sstring);
2162 define_standard_syntax ("\\", Sescape);
2163 define_standard_syntax ("_-+*/&|<>=", Ssymbol);
2164 define_standard_syntax (".,;:?!#@~^'`", Spunct);
2166 for (p = "()[]{}"; *p; p+=2)
2168 Fput_char_table (make_char (p[0]),
2169 Fcons (make_int (Sopen), make_char (p[1])),
2170 Vstandard_syntax_table);
2171 Fput_char_table (make_char (p[1]),
2172 Fcons (make_int (Sclose), make_char (p[0])),
2173 Vstandard_syntax_table);