1 /* GNU Emacs routines to deal with syntax tables; also word and list parsing.
2 Copyright (C) 1985, 1987, 1993 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
28 Lisp_Object Qsyntax_table_p
;
30 int words_include_escapes
;
32 /* This is the internal form of the parse state used in parse-partial-sexp. */
34 struct lisp_parse_state
36 int depth
; /* Depth at end of parsing */
37 int instring
; /* -1 if not within string, else desired terminator. */
38 int incomment
; /* Nonzero if within a comment at end of parsing */
39 int comstyle
; /* comment style a=0, or b=1 */
40 int quoted
; /* Nonzero if just after an escape char at end of parsing */
41 int thislevelstart
; /* Char number of most recent start-of-expression at current level */
42 int prevlevelstart
; /* Char number of start of containing expression */
43 int location
; /* Char number at which parsing stopped. */
44 int mindepth
; /* Minimum depth seen while scanning. */
45 int comstart
; /* Position just after last comment starter. */
48 /* These variables are a cache for finding the start of a defun.
49 find_start_pos is the place for which the defun start was found.
50 find_start_value is the defun start position found for it.
51 find_start_buffer is the buffer it was found in.
52 find_start_begv is the BEGV value when it was found.
53 find_start_modiff is the value of MODIFF when it was found. */
55 static int find_start_pos
;
56 static int find_start_value
;
57 static struct buffer
*find_start_buffer
;
58 static int find_start_begv
;
59 static int find_start_modiff
;
61 /* Find a defun-start that is the last one before POS (or nearly the last).
62 We record what we find, so that another call in the same area
63 can return the same value right away. */
66 find_defun_start (pos
)
72 /* Use previous finding, if it's valid and applies to this inquiry. */
73 if (current_buffer
== find_start_buffer
74 /* Reuse the defun-start even if POS is a little farther on.
75 POS might be in the next defun, but that's ok.
76 Our value may not be the best possible, but will still be usable. */
77 && pos
<= find_start_pos
+ 1000
78 && pos
>= find_start_value
79 && BEGV
== find_start_begv
80 && MODIFF
== find_start_modiff
)
81 return find_start_value
;
83 /* Back up to start of line. */
84 tem
= scan_buffer ('\n', pos
, -1, &shortage
);
88 /* Open-paren at start of line means we found our defun-start. */
89 if (SYNTAX (FETCH_CHAR (tem
)) == Sopen
)
91 /* Move to beg of previous line. */
92 tem
= scan_buffer ('\n', tem
, -2, &shortage
);
95 /* Record what we found, for the next try. */
96 find_start_value
= tem
;
97 find_start_buffer
= current_buffer
;
98 find_start_modiff
= MODIFF
;
99 find_start_begv
= BEGV
;
100 find_start_pos
= pos
;
102 return find_start_value
;
105 DEFUN ("syntax-table-p", Fsyntax_table_p
, Ssyntax_table_p
, 1, 1, 0,
106 "Return t if ARG is a syntax table.\n\
107 Any vector of 256 elements will do.")
111 if (XTYPE (obj
) == Lisp_Vector
&& XVECTOR (obj
)->size
== 0400)
117 check_syntax_table (obj
)
120 register Lisp_Object tem
;
121 while (tem
= Fsyntax_table_p (obj
),
123 obj
= wrong_type_argument (Qsyntax_table_p
, obj
);
128 DEFUN ("syntax-table", Fsyntax_table
, Ssyntax_table
, 0, 0, 0,
129 "Return the current syntax table.\n\
130 This is the one specified by the current buffer.")
133 return current_buffer
->syntax_table
;
136 DEFUN ("standard-syntax-table", Fstandard_syntax_table
,
137 Sstandard_syntax_table
, 0, 0, 0,
138 "Return the standard syntax table.\n\
139 This is the one used for new buffers.")
142 return Vstandard_syntax_table
;
145 DEFUN ("copy-syntax-table", Fcopy_syntax_table
, Scopy_syntax_table
, 0, 1, 0,
146 "Construct a new syntax table and return it.\n\
147 It is a copy of the TABLE, which defaults to the standard syntax table.")
151 Lisp_Object size
, val
;
152 XFASTINT (size
) = 0400;
154 val
= Fmake_vector (size
, val
);
156 table
= check_syntax_table (table
);
157 else if (NILP (Vstandard_syntax_table
))
158 /* Can only be null during initialization */
160 else table
= Vstandard_syntax_table
;
162 bcopy (XVECTOR (table
)->contents
,
163 XVECTOR (val
)->contents
, 0400 * sizeof (Lisp_Object
));
167 DEFUN ("set-syntax-table", Fset_syntax_table
, Sset_syntax_table
, 1, 1, 0,
168 "Select a new syntax table for the current buffer.\n\
169 One argument, a syntax table.")
173 table
= check_syntax_table (table
);
174 current_buffer
->syntax_table
= table
;
175 /* Indicate that this buffer now has a specified syntax table. */
176 current_buffer
->local_var_flags
|= buffer_local_flags
.syntax_table
;
180 /* Convert a letter which signifies a syntax code
181 into the code it signifies.
182 This is used by modify-syntax-entry, and other things. */
184 unsigned char syntax_spec_code
[0400] =
185 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
186 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
187 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
188 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
189 (char) Swhitespace
, 0377, (char) Sstring
, 0377,
190 (char) Smath
, 0377, 0377, (char) Squote
,
191 (char) Sopen
, (char) Sclose
, 0377, 0377,
192 0377, (char) Swhitespace
, (char) Spunct
, (char) Scharquote
,
193 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
194 0377, 0377, 0377, 0377,
195 (char) Scomment
, 0377, (char) Sendcomment
, 0377,
196 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A, ... */
197 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
198 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
199 0377, 0377, 0377, 0377, (char) Sescape
, 0377, 0377, (char) Ssymbol
,
200 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
201 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
202 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
203 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377
206 /* Indexed by syntax code, give the letter that describes it. */
208 char syntax_code_spec
[13] =
210 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>'
213 DEFUN ("char-syntax", Fchar_syntax
, Schar_syntax
, 1, 1, 0,
214 "Return the syntax code of CHAR, described by a character.\n\
215 For example, if CHAR is a word constituent, the character `?w' is returned.\n\
216 The characters that correspond to various syntax codes\n\
217 are listed in the documentation of `modify-syntax-entry'.")
221 CHECK_NUMBER (ch
, 0);
222 return make_number (syntax_code_spec
[(int) SYNTAX (0xFF & XINT (ch
))]);
225 /* This comment supplies the doc string for modify-syntax-entry,
226 for make-docfile to see. We cannot put this in the real DEFUN
227 due to limits in the Unix cpp.
229 DEFUN ("modify-syntax-entry", foo, bar, 0, 0, 0,
230 "Set syntax for character CHAR according to string S.\n\
231 The syntax is changed only for table TABLE, which defaults to\n\
232 the current buffer's syntax table.\n\
233 The first character of S should be one of the following:\n\
234 Space or - whitespace syntax. w word constituent.\n\
235 _ symbol constituent. . punctuation.\n\
236 ( open-parenthesis. ) close-parenthesis.\n\
237 \" string quote. \\ escape.\n\
238 $ paired delimiter. ' expression quote or prefix operator.\n\
239 < comment starter. > comment ender.\n\
240 / character-quote.\n\
241 Only single-character comment start and end sequences are represented thus.\n\
242 Two-character sequences are represented as described below.\n\
243 The second character of S is the matching parenthesis,\n\
244 used only if the first character is `(' or `)'.\n\
245 Any additional characters are flags.\n\
246 Defined flags are the characters 1, 2, 3, 4, b, and p.\n\
247 1 means C is the start of a two-char comment start sequence.\n\
248 2 means C is the second character of such a sequence.\n\
249 3 means C is the start of a two-char comment end sequence.\n\
250 4 means C is the second character of such a sequence.\n\
252 There can be up to two orthogonal comment sequences. This is to support\n\
253 language modes such as C++. By default, all comment sequences are of style\n\
254 a, but you can set the comment sequence style to b (on the second character of a\n\
255 comment-start, or the first character of a comment-end sequence) by using\n\
257 b means C is part of comment sequence b.\n\
259 p means C is a prefix character for `backward-prefix-chars';\n\
260 such characters are treated as whitespace when they occur\n\
261 between expressions.")
265 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry
, Smodify_syntax_entry
, 2, 3,
266 /* I really don't know why this is interactive
267 help-form should at least be made useful whilst reading the second arg
269 "cSet syntax for character: \nsSet syntax for %s to: ",
270 0 /* See immediately above */)
271 (c
, newentry
, syntax_table
)
272 Lisp_Object c
, newentry
, syntax_table
;
274 register unsigned char *p
, match
;
275 register enum syntaxcode code
;
279 CHECK_STRING (newentry
, 1);
280 if (NILP (syntax_table
))
281 syntax_table
= current_buffer
->syntax_table
;
283 syntax_table
= check_syntax_table (syntax_table
);
285 p
= XSTRING (newentry
)->data
;
286 code
= (enum syntaxcode
) syntax_spec_code
[*p
++];
287 if (((int) code
& 0377) == 0377)
288 error ("invalid syntax description letter: %c", c
);
292 if (match
== ' ') match
= 0;
294 XFASTINT (val
) = (match
<< 8) + (int) code
;
299 XFASTINT (val
) |= 1 << 16;
303 XFASTINT (val
) |= 1 << 17;
307 XFASTINT (val
) |= 1 << 18;
311 XFASTINT (val
) |= 1 << 19;
315 XFASTINT (val
) |= 1 << 20;
319 XFASTINT (val
) |= 1 << 21;
323 XVECTOR (syntax_table
)->contents
[0xFF & XINT (c
)] = val
;
328 /* Dump syntax table to buffer in human-readable format */
330 describe_syntax (value
)
333 register enum syntaxcode code
;
334 char desc
, match
, start1
, start2
, end1
, end2
, prefix
, comstyle
;
337 Findent_to (make_number (16), make_number (1));
339 if (XTYPE (value
) != Lisp_Int
)
341 insert_string ("invalid");
345 code
= (enum syntaxcode
) (XINT (value
) & 0377);
346 match
= (XINT (value
) >> 8) & 0377;
347 start1
= (XINT (value
) >> 16) & 1;
348 start2
= (XINT (value
) >> 17) & 1;
349 end1
= (XINT (value
) >> 18) & 1;
350 end2
= (XINT (value
) >> 19) & 1;
351 prefix
= (XINT (value
) >> 20) & 1;
352 comstyle
= (XINT (value
) >> 21) & 1;
354 if ((int) code
< 0 || (int) code
>= (int) Smax
)
356 insert_string ("invalid");
359 desc
= syntax_code_spec
[(int) code
];
361 str
[0] = desc
, str
[1] = 0;
364 str
[0] = match
? match
: ' ';
383 insert_string ("\twhich means: ");
385 #ifdef SWITCH_ENUM_BUG
392 insert_string ("whitespace"); break;
394 insert_string ("punctuation"); break;
396 insert_string ("word"); break;
398 insert_string ("symbol"); break;
400 insert_string ("open"); break;
402 insert_string ("close"); break;
404 insert_string ("quote"); break;
406 insert_string ("string"); break;
408 insert_string ("math"); break;
410 insert_string ("escape"); break;
412 insert_string ("charquote"); break;
414 insert_string ("comment"); break;
416 insert_string ("endcomment"); break;
418 insert_string ("invalid");
424 insert_string (", matches ");
429 insert_string (",\n\t is the first character of a comment-start sequence");
431 insert_string (",\n\t is the second character of a comment-start sequence");
434 insert_string (",\n\t is the first character of a comment-end sequence");
436 insert_string (",\n\t is the second character of a comment-end sequence");
438 insert_string (" (comment style b)");
441 insert_string (",\n\t is a prefix character for `backward-prefix-chars'");
443 insert_string ("\n");
447 describe_syntax_1 (vector
)
450 struct buffer
*old
= current_buffer
;
451 set_buffer_internal (XBUFFER (Vstandard_output
));
452 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
);
453 set_buffer_internal (old
);
457 DEFUN ("describe-syntax", Fdescribe_syntax
, Sdescribe_syntax
, 0, 0, "",
458 "Describe the syntax specifications in the syntax table.\n\
459 The descriptions are inserted in a buffer, which is then displayed.")
462 internal_with_output_to_temp_buffer
463 ("*Help*", describe_syntax_1
, current_buffer
->syntax_table
);
468 /* Return the position across COUNT words from FROM.
469 If that many words cannot be found before the end of the buffer, return 0.
470 COUNT negative means scan backward and stop at word beginning. */
472 scan_words (from
, count
)
473 register int from
, count
;
475 register int beg
= BEGV
;
476 register int end
= ZV
;
491 code
= SYNTAX (FETCH_CHAR (from
));
492 if (words_include_escapes
493 && (code
== Sescape
|| code
== Scharquote
))
501 if (from
== end
) break;
502 code
= SYNTAX (FETCH_CHAR (from
));
503 if (!(words_include_escapes
504 && (code
== Sescape
|| code
== Scharquote
)))
520 code
= SYNTAX (FETCH_CHAR (from
- 1));
521 if (words_include_escapes
522 && (code
== Sescape
|| code
== Scharquote
))
530 if (from
== beg
) break;
531 code
= SYNTAX (FETCH_CHAR (from
- 1));
532 if (!(words_include_escapes
533 && (code
== Sescape
|| code
== Scharquote
)))
546 DEFUN ("forward-word", Fforward_word
, Sforward_word
, 1, 1, "p",
547 "Move point forward ARG words (backward if ARG is negative).\n\
548 Normally returns t.\n\
549 If an edge of the buffer is reached, point is left there\n\
550 and nil is returned.")
555 CHECK_NUMBER (count
, 0);
557 if (!(val
= scan_words (point
, XINT (count
))))
559 SET_PT (XINT (count
) > 0 ? ZV
: BEGV
);
566 DEFUN ("forward-comment", Fforward_comment
, Sforward_comment
, 1, 1, 0,
567 "Move forward across up to N comments. If N is negative, move backward.\n\
568 Set point to the far end of the last comment found.\n\
569 Stop scanning if we find something other than a comment or whitespace.\n\
570 If N comments are found as expected, with nothing except whitespace\n\
571 between them, return t; otherwise return nil.")
578 register enum syntaxcode code
;
579 int comstyle
= 0; /* style of comment encountered */
583 CHECK_NUMBER (count
, 0);
584 count1
= XINT (count
);
598 c
= FETCH_CHAR (from
);
602 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
603 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
)))
605 /* we have encountered a comment start sequence and we
606 are ignoring all text inside comments. we must record
607 the comment style this sequence begins so that later,
608 only a comment end of the same style actually ends
609 the comment section */
611 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
));
615 if (code
== Scomment
)
625 c
= FETCH_CHAR (from
);
626 if (SYNTAX (c
) == Sendcomment
627 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
628 /* we have encountered a comment end of the same style
629 as the comment sequence which began this comment
633 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
634 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
))
635 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
636 /* we have encountered a comment end of the same style
637 as the comment sequence which began this comment
641 /* We have skipped one comment. */
644 else if (code
!= Swhitespace
)
652 /* End of comment reached */
666 quoted
= char_quoted (from
);
669 c
= FETCH_CHAR (from
);
672 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
673 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1))
674 && !char_quoted (from
- 1))
676 /* we must record the comment style encountered so that
677 later, we can match only the proper comment begin
678 sequence of the same style */
680 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
- 1));
684 if (code
== Sendcomment
&& !quoted
)
686 if (code
!= SYNTAX (c
))
687 /* For a two-char comment ender, we can assume
688 it does end a comment. So scan back in a simple way. */
690 if (from
!= stop
) from
--;
693 if (SYNTAX (c
= FETCH_CHAR (from
)) == Scomment
694 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
703 if (SYNTAX_COMSTART_SECOND (c
)
704 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
))
705 && SYNTAX_COMMENT_STYLE (c
) == comstyle
706 && !char_quoted (from
))
712 /* Look back, counting the parity of string-quotes,
713 and recording the comment-starters seen.
714 When we reach a safe place, assume that's not in a string;
715 then step the main scan to the earliest comment-starter seen
716 an even number of string quotes away from the safe place.
718 OFROM[I] is position of the earliest comment-starter seen
719 which is I+2X quotes from the comment-end.
720 PARITY is current parity of quotes from the comment end. */
723 char my_stringend
= 0;
724 int string_lossage
= 0;
725 int comment_end
= from
;
726 int comstart_pos
= 0;
727 int comstart_parity
= 0;
729 /* At beginning of range to scan, we're outside of strings;
730 that determines quote parity to the comment-end. */
733 /* Move back and examine a character. */
736 c
= FETCH_CHAR (from
);
739 /* If this char is the second of a 2-char comment sequence,
740 back up and give the pair the appropriate syntax. */
741 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
742 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1)))
748 else if (from
> stop
&& SYNTAX_COMSTART_SECOND (c
)
749 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
- 1))
750 && comstyle
== SYNTAX_COMMENT_STYLE (c
))
756 /* Ignore escaped characters. */
757 if (char_quoted (from
))
760 /* Track parity of quotes. */
764 if (my_stringend
== 0)
766 /* If we have two kinds of string delimiters.
767 There's no way to grok this scanning backwards. */
768 else if (my_stringend
!= c
)
772 /* Record comment-starters according to that
773 quote-parity to the comment-end. */
774 if (code
== Scomment
)
776 comstart_parity
= parity
;
780 /* If we find another earlier comment-ender,
781 any comment-starts earier than that don't count
782 (because they go with the earlier comment-ender). */
783 if (code
== Sendcomment
784 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
)) == comstyle
)
787 /* Assume a defun-start point is outside of strings. */
789 && (from
== stop
|| FETCH_CHAR (from
- 1) == '\n'))
793 if (comstart_pos
== 0)
795 /* If the earliest comment starter
796 is followed by uniform paired string quotes or none,
797 we know it can't be inside a string
798 since if it were then the comment ender would be inside one.
799 So it does start a comment. Skip back to it. */
800 else if (comstart_parity
== 0 && !string_lossage
)
804 /* We had two kinds of string delimiters mixed up
805 together. Decode this going forwards.
806 Scan fwd from the previous comment ender
807 to the one in question; this records where we
808 last passed a comment starter. */
809 struct lisp_parse_state state
;
810 scan_sexps_forward (&state
, find_defun_start (comment_end
),
811 comment_end
- 1, -10000, 0, Qnil
);
813 from
= state
.comstart
;
815 /* We can't grok this as a comment; scan it normally. */
820 else if (code
!= Swhitespace
|| quoted
)
836 int parse_sexp_ignore_comments
;
839 scan_lists (from
, count
, depth
, sexpflag
)
841 int count
, depth
, sexpflag
;
849 register enum syntaxcode code
;
850 int min_depth
= depth
; /* Err out if depth gets less than this. */
851 int comstyle
= 0; /* style of comment encountered */
853 if (depth
> 0) min_depth
= 0;
863 c
= FETCH_CHAR (from
);
866 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
867 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
))
868 && parse_sexp_ignore_comments
)
870 /* we have encountered a comment start sequence and we
871 are ignoring all text inside comments. we must record
872 the comment style this sequence begins so that later,
873 only a comment end of the same style actually ends
874 the comment section */
876 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
));
880 if (SYNTAX_PREFIX (c
))
883 #ifdef SWITCH_ENUM_BUG
891 if (from
== stop
) goto lose
;
893 /* treat following character as a word constituent */
896 if (depth
|| !sexpflag
) break;
897 /* This word counts as a sexp; return at end of it. */
900 #ifdef SWITCH_ENUM_BUG
901 switch ((int) SYNTAX (FETCH_CHAR (from
)))
903 switch (SYNTAX (FETCH_CHAR (from
)))
909 if (from
== stop
) goto lose
;
923 if (!parse_sexp_ignore_comments
) break;
926 if (from
== stop
) goto done
;
927 c
= FETCH_CHAR (from
);
928 if (SYNTAX (c
) == Sendcomment
929 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
930 /* we have encountered a comment end of the same style
931 as the comment sequence which began this comment
935 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
936 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
))
937 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
938 /* we have encountered a comment end of the same style
939 as the comment sequence which began this comment
948 if (from
!= stop
&& c
== FETCH_CHAR (from
))
958 if (!++depth
) goto done
;
963 if (!--depth
) goto done
;
964 if (depth
< min_depth
)
965 error ("Containing expression ends prematurely");
969 stringterm
= FETCH_CHAR (from
- 1);
972 if (from
>= stop
) goto lose
;
973 if (FETCH_CHAR (from
) == stringterm
) break;
974 #ifdef SWITCH_ENUM_BUG
975 switch ((int) SYNTAX (FETCH_CHAR (from
)))
977 switch (SYNTAX (FETCH_CHAR (from
)))
987 if (!depth
&& sexpflag
) goto done
;
992 /* Reached end of buffer. Error if within object, return nil if between */
993 if (depth
) goto lose
;
998 /* End of object reached */
1009 if (quoted
= char_quoted (from
))
1011 c
= FETCH_CHAR (from
);
1013 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1014 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1))
1015 && !char_quoted (from
- 1)
1016 && parse_sexp_ignore_comments
)
1018 /* we must record the comment style encountered so that
1019 later, we can match only the proper comment begin
1020 sequence of the same style */
1022 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
- 1));
1026 if (SYNTAX_PREFIX (c
))
1029 #ifdef SWITCH_ENUM_BUG
1030 switch ((int) (quoted
? Sword
: code
))
1032 switch (quoted
? Sword
: code
)
1037 if (depth
|| !sexpflag
) break;
1038 /* This word counts as a sexp; count object finished after passing it. */
1041 quoted
= char_quoted (from
- 1);
1044 if (! (quoted
|| SYNTAX (FETCH_CHAR (from
- 1)) == Sword
1045 || SYNTAX (FETCH_CHAR (from
- 1)) == Ssymbol
1046 || SYNTAX (FETCH_CHAR (from
- 1)) == Squote
))
1055 if (from
!= stop
&& c
== FETCH_CHAR (from
- 1))
1065 if (!++depth
) goto done2
;
1070 if (!--depth
) goto done2
;
1071 if (depth
< min_depth
)
1072 error ("Containing expression ends prematurely");
1076 if (!parse_sexp_ignore_comments
)
1078 if (code
!= SYNTAX (c
))
1079 /* For a two-char comment ender, we can assume
1080 it does end a comment. So scan back in a simple way. */
1082 if (from
!= stop
) from
--;
1085 if (SYNTAX (c
= FETCH_CHAR (from
)) == Scomment
1086 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1088 if (from
== stop
) goto done
;
1090 if (SYNTAX_COMSTART_SECOND (c
)
1091 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
))
1092 && SYNTAX_COMMENT_STYLE (c
) == comstyle
1093 && !char_quoted (from
))
1099 /* Look back, counting the parity of string-quotes,
1100 and recording the comment-starters seen.
1101 When we reach a safe place, assume that's not in a string;
1102 then step the main scan to the earliest comment-starter seen
1103 an even number of string quotes away from the safe place.
1105 OFROM[I] is position of the earliest comment-starter seen
1106 which is I+2X quotes from the comment-end.
1107 PARITY is current parity of quotes from the comment end. */
1110 char my_stringend
= 0;
1111 int string_lossage
= 0;
1112 int comment_end
= from
;
1113 int comstart_pos
= 0;
1114 int comstart_parity
= 0;
1116 /* At beginning of range to scan, we're outside of strings;
1117 that determines quote parity to the comment-end. */
1118 while (from
!= stop
)
1120 /* Move back and examine a character. */
1123 c
= FETCH_CHAR (from
);
1126 /* If this char is the second of a 2-char comment sequence,
1127 back up and give the pair the appropriate syntax. */
1128 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1129 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1)))
1135 else if (from
> stop
&& SYNTAX_COMSTART_SECOND (c
)
1136 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
- 1))
1137 && comstyle
== SYNTAX_COMMENT_STYLE (c
))
1143 /* Ignore escaped characters. */
1144 if (char_quoted (from
))
1147 /* Track parity of quotes. */
1148 if (code
== Sstring
)
1151 if (my_stringend
== 0)
1153 /* If we have two kinds of string delimiters.
1154 There's no way to grok this scanning backwards. */
1155 else if (my_stringend
!= c
)
1159 /* Record comment-starters according to that
1160 quote-parity to the comment-end. */
1161 if (code
== Scomment
)
1163 comstart_parity
= parity
;
1164 comstart_pos
= from
;
1167 /* If we find another earlier comment-ender,
1168 any comment-starts earier than that don't count
1169 (because they go with the earlier comment-ender). */
1170 if (code
== Sendcomment
1171 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
)) == comstyle
)
1174 /* Assume a defun-start point is outside of strings. */
1176 && (from
== stop
|| FETCH_CHAR (from
- 1) == '\n'))
1180 if (comstart_pos
== 0)
1182 /* If the earliest comment starter
1183 is followed by uniform paired string quotes or none,
1184 we know it can't be inside a string
1185 since if it were then the comment ender would be inside one.
1186 So it does start a comment. Skip back to it. */
1187 else if (comstart_parity
== 0 && !string_lossage
)
1188 from
= comstart_pos
;
1191 /* We had two kinds of string delimiters mixed up
1192 together. Decode this going forwards.
1193 Scan fwd from the previous comment ender
1194 to the one in question; this records where we
1195 last passed a comment starter. */
1196 struct lisp_parse_state state
;
1197 scan_sexps_forward (&state
, find_defun_start (comment_end
),
1198 comment_end
- 1, -10000, 0, Qnil
);
1199 if (state
.incomment
)
1200 from
= state
.comstart
;
1202 /* We can't grok this as a comment; scan it normally. */
1209 stringterm
= FETCH_CHAR (from
);
1212 if (from
== stop
) goto lose
;
1213 if (!char_quoted (from
- 1)
1214 && stringterm
== FETCH_CHAR (from
- 1))
1219 if (!depth
&& sexpflag
) goto done2
;
1224 /* Reached start of buffer. Error if within object, return nil if between */
1225 if (depth
) goto lose
;
1236 XFASTINT (val
) = from
;
1240 error ("Unbalanced parentheses");
1247 register enum syntaxcode code
;
1248 register int beg
= BEGV
;
1249 register int quoted
= 0;
1252 && ((code
= SYNTAX (FETCH_CHAR (pos
- 1))) == Scharquote
1253 || code
== Sescape
))
1254 pos
--, quoted
= !quoted
;
1258 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
1259 "Scan from character number FROM by COUNT lists.\n\
1260 Returns the character number of the position thus found.\n\
1262 If DEPTH is nonzero, paren depth begins counting from that value,\n\
1263 only places where the depth in parentheses becomes zero\n\
1264 are candidates for stopping; COUNT such places are counted.\n\
1265 Thus, a positive value for DEPTH means go out levels.\n\
1267 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
1269 If the beginning or end of (the accessible part of) the buffer is reached\n\
1270 and the depth is wrong, an error is signaled.\n\
1271 If the depth is right but the count is not used up, nil is returned.")
1272 (from
, count
, depth
)
1273 Lisp_Object from
, count
, depth
;
1275 CHECK_NUMBER (from
, 0);
1276 CHECK_NUMBER (count
, 1);
1277 CHECK_NUMBER (depth
, 2);
1279 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
1282 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
1283 "Scan from character number FROM by COUNT balanced expressions.\n\
1284 If COUNT is negative, scan backwards.\n\
1285 Returns the character number of the position thus found.\n\
1287 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
1289 If the beginning or end of (the accessible part of) the buffer is reached\n\
1290 in the middle of a parenthetical grouping, an error is signaled.\n\
1291 If the beginning or end is reached between groupings\n\
1292 but before count is used up, nil is returned.")
1294 Lisp_Object from
, count
;
1296 CHECK_NUMBER (from
, 0);
1297 CHECK_NUMBER (count
, 1);
1299 return scan_lists (XINT (from
), XINT (count
), 0, 1);
1302 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
1304 "Move point backward over any number of chars with prefix syntax.\n\
1305 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
1311 while (pos
> beg
&& !char_quoted (pos
- 1)
1312 && (SYNTAX (FETCH_CHAR (pos
- 1)) == Squote
1313 || SYNTAX_PREFIX (FETCH_CHAR (pos
- 1))))
1321 /* Parse forward from FROM to END,
1322 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
1323 and return a description of the state of the parse at END.
1324 If STOPBEFORE is nonzero, stop at the start of an atom. */
1326 scan_sexps_forward (stateptr
, from
, end
, targetdepth
, stopbefore
, oldstate
)
1327 struct lisp_parse_state
*stateptr
;
1329 int end
, targetdepth
, stopbefore
;
1330 Lisp_Object oldstate
;
1332 struct lisp_parse_state state
;
1334 register enum syntaxcode code
;
1335 struct level
{ int last
, prev
; };
1336 struct level levelstart
[100];
1337 register struct level
*curlevel
= levelstart
;
1338 struct level
*endlevel
= levelstart
+ 100;
1340 register int depth
; /* Paren depth of current scanning location.
1341 level - levelstart equals this except
1342 when the depth becomes negative. */
1343 int mindepth
; /* Lowest DEPTH value seen. */
1344 int start_quoted
= 0; /* Nonzero means starting after a char quote */
1350 if (NILP (oldstate
))
1353 state
.instring
= -1;
1354 state
.incomment
= 0;
1355 state
.comstyle
= 0; /* comment style a by default */
1359 tem
= Fcar (oldstate
);
1365 oldstate
= Fcdr (oldstate
);
1366 oldstate
= Fcdr (oldstate
);
1367 oldstate
= Fcdr (oldstate
);
1368 tem
= Fcar (oldstate
);
1369 state
.instring
= !NILP (tem
) ? XINT (tem
) : -1;
1371 oldstate
= Fcdr (oldstate
);
1372 tem
= Fcar (oldstate
);
1373 state
.incomment
= !NILP (tem
);
1375 oldstate
= Fcdr (oldstate
);
1376 tem
= Fcar (oldstate
);
1377 start_quoted
= !NILP (tem
);
1379 /* if the eight element of the list is nil, we are in comment
1380 style a. if it is non-nil, we are in comment style b */
1381 oldstate
= Fcdr (oldstate
);
1382 oldstate
= Fcdr (oldstate
);
1383 oldstate
= Fcdr (oldstate
);
1384 tem
= Fcar (oldstate
);
1385 state
.comstyle
= !NILP (tem
);
1390 curlevel
->prev
= -1;
1391 curlevel
->last
= -1;
1393 /* Enter the loop at a place appropriate for initial state. */
1395 if (state
.incomment
) goto startincomment
;
1396 if (state
.instring
>= 0)
1398 if (start_quoted
) goto startquotedinstring
;
1401 if (start_quoted
) goto startquoted
;
1405 code
= SYNTAX (FETCH_CHAR (from
));
1407 if (from
< end
&& SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
- 1))
1408 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
)))
1410 /* Record the comment style we have entered so that only
1411 the comment-end sequence of the same style actually
1412 terminates the comment section. */
1414 state
.comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
));
1418 if (SYNTAX_PREFIX (FETCH_CHAR (from
- 1)))
1420 #ifdef SWITCH_ENUM_BUG
1428 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1429 curlevel
->last
= from
- 1;
1431 if (from
== end
) goto endquoted
;
1434 /* treat following character as a word constituent */
1437 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1438 curlevel
->last
= from
- 1;
1442 #ifdef SWITCH_ENUM_BUG
1443 switch ((int) SYNTAX (FETCH_CHAR (from
)))
1445 switch (SYNTAX (FETCH_CHAR (from
)))
1451 if (from
== end
) goto endquoted
;
1463 curlevel
->prev
= curlevel
->last
;
1467 state
.incomment
= 1;
1468 state
.comstart
= from
;
1472 if (from
== end
) goto done
;
1473 prev
= FETCH_CHAR (from
);
1474 if (SYNTAX (prev
) == Sendcomment
1475 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
1476 /* Only terminate the comment section if the endcomment
1477 of the same style as the start sequence has been
1481 if (from
< end
&& SYNTAX_COMEND_FIRST (prev
)
1482 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
))
1483 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
1484 /* Only terminate the comment section if the end-comment
1485 sequence of the same style as the start sequence has
1486 been encountered. */
1489 state
.incomment
= 0;
1490 state
.comstyle
= 0; /* reset the comment style */
1494 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1496 /* curlevel++->last ran into compiler bug on Apollo */
1497 curlevel
->last
= from
- 1;
1498 if (++curlevel
== endlevel
)
1499 error ("Nesting too deep for parser");
1500 curlevel
->prev
= -1;
1501 curlevel
->last
= -1;
1502 if (!--targetdepth
) goto done
;
1507 if (depth
< mindepth
)
1509 if (curlevel
!= levelstart
)
1511 curlevel
->prev
= curlevel
->last
;
1512 if (!++targetdepth
) goto done
;
1516 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1517 curlevel
->last
= from
- 1;
1518 state
.instring
= FETCH_CHAR (from
- 1);
1522 if (from
>= end
) goto done
;
1523 if (FETCH_CHAR (from
) == state
.instring
) break;
1524 #ifdef SWITCH_ENUM_BUG
1525 switch ((int) SYNTAX (FETCH_CHAR (from
)))
1527 switch (SYNTAX (FETCH_CHAR (from
)))
1533 startquotedinstring
:
1534 if (from
>= end
) goto endquoted
;
1538 state
.instring
= -1;
1539 curlevel
->prev
= curlevel
->last
;
1549 stop
: /* Here if stopping before start of sexp. */
1550 from
--; /* We have just fetched the char that starts it; */
1551 goto done
; /* but return the position before it. */
1556 state
.depth
= depth
;
1557 state
.mindepth
= mindepth
;
1558 state
.thislevelstart
= curlevel
->prev
;
1559 state
.prevlevelstart
1560 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
1561 state
.location
= from
;
1567 /* This comment supplies the doc string for parse-partial-sexp,
1568 for make-docfile to see. We cannot put this in the real DEFUN
1569 due to limits in the Unix cpp.
1571 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 5, 0,
1572 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
1573 Parsing stops at TO or when certain criteria are met;\n\
1574 point is set to where parsing stops.\n\
1575 If fifth arg STATE is omitted or nil,\n\
1576 parsing assumes that FROM is the beginning of a function.\n\
1577 Value is a list of eight elements describing final state of parsing:\n\
1578 1. depth in parens.\n\
1579 2. character address of start of innermost containing list; nil if none.\n\
1580 3. character address of start of last complete sexp terminated.\n\
1581 4. non-nil if inside a string.\n\
1582 (it is the character that will terminate the string.)\n\
1583 5. t if inside a comment.\n\
1584 6. t if following a quote character.\n\
1585 7. the minimum paren-depth encountered during this scan.\n\
1586 8. t if in a comment of style `b'.\n\
1587 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
1588 in parentheses becomes equal to TARGETDEPTH.\n\
1589 Fourth arg STOPBEFORE non-nil means stop when come to\n\
1590 any character that starts a sexp.\n\
1591 Fifth arg STATE is a seven-list like what this function returns.\n\
1592 It is used to initialize the state of the parse. Its second and third
1593 elements are ignored.")
1594 (from, to, targetdepth, stopbefore, state)
1597 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 5, 0,
1598 0 /* See immediately above */)
1599 (from
, to
, targetdepth
, stopbefore
, oldstate
)
1600 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
;
1602 struct lisp_parse_state state
;
1605 if (!NILP (targetdepth
))
1607 CHECK_NUMBER (targetdepth
, 3);
1608 target
= XINT (targetdepth
);
1611 target
= -100000; /* We won't reach this depth */
1613 validate_region (&from
, &to
);
1614 scan_sexps_forward (&state
, XINT (from
), XINT (to
),
1615 target
, !NILP (stopbefore
), oldstate
);
1617 SET_PT (state
.location
);
1619 return Fcons (make_number (state
.depth
),
1620 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
1621 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
1622 Fcons (state
.instring
>= 0 ? make_number (state
.instring
) : Qnil
,
1623 Fcons (state
.incomment
? Qt
: Qnil
,
1624 Fcons (state
.quoted
? Qt
: Qnil
,
1625 Fcons (make_number (state
.mindepth
),
1626 Fcons (state
.comstyle
? Qt
: Qnil
,
1633 register struct Lisp_Vector
*v
;
1635 /* Set this now, so first buffer creation can refer to it. */
1636 /* Make it nil before calling copy-syntax-table
1637 so that copy-syntax-table will know not to try to copy from garbage */
1638 Vstandard_syntax_table
= Qnil
;
1639 Vstandard_syntax_table
= Fcopy_syntax_table (Qnil
);
1641 v
= XVECTOR (Vstandard_syntax_table
);
1643 for (i
= 'a'; i
<= 'z'; i
++)
1644 XFASTINT (v
->contents
[i
]) = (int) Sword
;
1645 for (i
= 'A'; i
<= 'Z'; i
++)
1646 XFASTINT (v
->contents
[i
]) = (int) Sword
;
1647 for (i
= '0'; i
<= '9'; i
++)
1648 XFASTINT (v
->contents
[i
]) = (int) Sword
;
1649 XFASTINT (v
->contents
['$']) = (int) Sword
;
1650 XFASTINT (v
->contents
['%']) = (int) Sword
;
1652 XFASTINT (v
->contents
['(']) = (int) Sopen
+ (')' << 8);
1653 XFASTINT (v
->contents
[')']) = (int) Sclose
+ ('(' << 8);
1654 XFASTINT (v
->contents
['[']) = (int) Sopen
+ (']' << 8);
1655 XFASTINT (v
->contents
[']']) = (int) Sclose
+ ('[' << 8);
1656 XFASTINT (v
->contents
['{']) = (int) Sopen
+ ('}' << 8);
1657 XFASTINT (v
->contents
['}']) = (int) Sclose
+ ('{' << 8);
1658 XFASTINT (v
->contents
['"']) = (int) Sstring
;
1659 XFASTINT (v
->contents
['\\']) = (int) Sescape
;
1661 for (i
= 0; i
< 10; i
++)
1662 XFASTINT (v
->contents
["_-+*/&|<>="[i
]]) = (int) Ssymbol
;
1664 for (i
= 0; i
< 12; i
++)
1665 XFASTINT (v
->contents
[".,;:?!#@~^'`"[i
]]) = (int) Spunct
;
1670 Qsyntax_table_p
= intern ("syntax-table-p");
1671 staticpro (&Qsyntax_table_p
);
1673 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
1674 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
1676 words_include_escapes
= 0;
1677 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
1678 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
1680 defsubr (&Ssyntax_table_p
);
1681 defsubr (&Ssyntax_table
);
1682 defsubr (&Sstandard_syntax_table
);
1683 defsubr (&Scopy_syntax_table
);
1684 defsubr (&Sset_syntax_table
);
1685 defsubr (&Schar_syntax
);
1686 defsubr (&Smodify_syntax_entry
);
1687 defsubr (&Sdescribe_syntax
);
1689 defsubr (&Sforward_word
);
1691 defsubr (&Sforward_comment
);
1692 defsubr (&Sscan_lists
);
1693 defsubr (&Sscan_sexps
);
1694 defsubr (&Sbackward_prefix_chars
);
1695 defsubr (&Sparse_partial_sexp
);