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 static void scan_sexps_forward ();
31 static int char_quoted ();
33 int words_include_escapes
;
35 /* This is the internal form of the parse state used in parse-partial-sexp. */
37 struct lisp_parse_state
39 int depth
; /* Depth at end of parsing */
40 int instring
; /* -1 if not within string, else desired terminator. */
41 int incomment
; /* Nonzero if within a comment at end of parsing */
42 int comstyle
; /* comment style a=0, or b=1 */
43 int quoted
; /* Nonzero if just after an escape char at end of parsing */
44 int thislevelstart
; /* Char number of most recent start-of-expression at current level */
45 int prevlevelstart
; /* Char number of start of containing expression */
46 int location
; /* Char number at which parsing stopped. */
47 int mindepth
; /* Minimum depth seen while scanning. */
48 int comstart
; /* Position just after last comment starter. */
51 /* These variables are a cache for finding the start of a defun.
52 find_start_pos is the place for which the defun start was found.
53 find_start_value is the defun start position found for it.
54 find_start_buffer is the buffer it was found in.
55 find_start_begv is the BEGV value when it was found.
56 find_start_modiff is the value of MODIFF when it was found. */
58 static int find_start_pos
;
59 static int find_start_value
;
60 static struct buffer
*find_start_buffer
;
61 static int find_start_begv
;
62 static int find_start_modiff
;
64 /* Find a defun-start that is the last one before POS (or nearly the last).
65 We record what we find, so that another call in the same area
66 can return the same value right away. */
69 find_defun_start (pos
)
75 /* Use previous finding, if it's valid and applies to this inquiry. */
76 if (current_buffer
== find_start_buffer
77 /* Reuse the defun-start even if POS is a little farther on.
78 POS might be in the next defun, but that's ok.
79 Our value may not be the best possible, but will still be usable. */
80 && pos
<= find_start_pos
+ 1000
81 && pos
>= find_start_value
82 && BEGV
== find_start_begv
83 && MODIFF
== find_start_modiff
)
84 return find_start_value
;
86 /* Back up to start of line. */
87 tem
= scan_buffer ('\n', pos
, -1, &shortage
);
91 /* Open-paren at start of line means we found our defun-start. */
92 if (SYNTAX (FETCH_CHAR (tem
)) == Sopen
)
94 /* Move to beg of previous line. */
95 tem
= scan_buffer ('\n', tem
, -2, &shortage
);
98 /* Record what we found, for the next try. */
99 find_start_value
= tem
;
100 find_start_buffer
= current_buffer
;
101 find_start_modiff
= MODIFF
;
102 find_start_begv
= BEGV
;
103 find_start_pos
= pos
;
105 return find_start_value
;
108 DEFUN ("syntax-table-p", Fsyntax_table_p
, Ssyntax_table_p
, 1, 1, 0,
109 "Return t if ARG is a syntax table.\n\
110 Any vector of 256 elements will do.")
114 if (XTYPE (obj
) == Lisp_Vector
&& XVECTOR (obj
)->size
== 0400)
120 check_syntax_table (obj
)
123 register Lisp_Object tem
;
124 while (tem
= Fsyntax_table_p (obj
),
126 obj
= wrong_type_argument (Qsyntax_table_p
, obj
);
131 DEFUN ("syntax-table", Fsyntax_table
, Ssyntax_table
, 0, 0, 0,
132 "Return the current syntax table.\n\
133 This is the one specified by the current buffer.")
136 return current_buffer
->syntax_table
;
139 DEFUN ("standard-syntax-table", Fstandard_syntax_table
,
140 Sstandard_syntax_table
, 0, 0, 0,
141 "Return the standard syntax table.\n\
142 This is the one used for new buffers.")
145 return Vstandard_syntax_table
;
148 DEFUN ("copy-syntax-table", Fcopy_syntax_table
, Scopy_syntax_table
, 0, 1, 0,
149 "Construct a new syntax table and return it.\n\
150 It is a copy of the TABLE, which defaults to the standard syntax table.")
154 Lisp_Object size
, val
;
155 XFASTINT (size
) = 0400;
157 val
= Fmake_vector (size
, val
);
159 table
= check_syntax_table (table
);
160 else if (NILP (Vstandard_syntax_table
))
161 /* Can only be null during initialization */
163 else table
= Vstandard_syntax_table
;
165 bcopy (XVECTOR (table
)->contents
,
166 XVECTOR (val
)->contents
, 0400 * sizeof (Lisp_Object
));
170 DEFUN ("set-syntax-table", Fset_syntax_table
, Sset_syntax_table
, 1, 1, 0,
171 "Select a new syntax table for the current buffer.\n\
172 One argument, a syntax table.")
176 table
= check_syntax_table (table
);
177 current_buffer
->syntax_table
= table
;
178 /* Indicate that this buffer now has a specified syntax table. */
179 current_buffer
->local_var_flags
180 |= XFASTINT (buffer_local_flags
.syntax_table
);
184 /* Convert a letter which signifies a syntax code
185 into the code it signifies.
186 This is used by modify-syntax-entry, and other things. */
188 unsigned char syntax_spec_code
[0400] =
189 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
190 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
191 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
192 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
193 (char) Swhitespace
, 0377, (char) Sstring
, 0377,
194 (char) Smath
, 0377, 0377, (char) Squote
,
195 (char) Sopen
, (char) Sclose
, 0377, 0377,
196 0377, (char) Swhitespace
, (char) Spunct
, (char) Scharquote
,
197 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
198 0377, 0377, 0377, 0377,
199 (char) Scomment
, 0377, (char) Sendcomment
, 0377,
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, (char) Sescape
, 0377, 0377, (char) Ssymbol
,
204 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
205 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
206 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
207 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377
210 /* Indexed by syntax code, give the letter that describes it. */
212 char syntax_code_spec
[13] =
214 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>'
217 DEFUN ("char-syntax", Fchar_syntax
, Schar_syntax
, 1, 1, 0,
218 "Return the syntax code of CHAR, described by a character.\n\
219 For example, if CHAR is a word constituent, the character `?w' is returned.\n\
220 The characters that correspond to various syntax codes\n\
221 are listed in the documentation of `modify-syntax-entry'.")
225 CHECK_NUMBER (ch
, 0);
226 return make_number (syntax_code_spec
[(int) SYNTAX (0xFF & XINT (ch
))]);
229 /* This comment supplies the doc string for modify-syntax-entry,
230 for make-docfile to see. We cannot put this in the real DEFUN
231 due to limits in the Unix cpp.
233 DEFUN ("modify-syntax-entry", foo, bar, 2, 3, 0,
234 "Set syntax for character CHAR according to string S.\n\
235 The syntax is changed only for table TABLE, which defaults to\n\
236 the current buffer's syntax table.\n\
237 The first character of S should be one of the following:\n\
238 Space or - whitespace syntax. w word constituent.\n\
239 _ symbol constituent. . punctuation.\n\
240 ( open-parenthesis. ) close-parenthesis.\n\
241 \" string quote. \\ escape.\n\
242 $ paired delimiter. ' expression quote or prefix operator.\n\
243 < comment starter. > comment ender.\n\
244 / character-quote.\n\
246 Only single-character comment start and end sequences are represented thus.\n\
247 Two-character sequences are represented as described below.\n\
248 The second character of S is the matching parenthesis,\n\
249 used only if the first character is `(' or `)'.\n\
250 Any additional characters are flags.\n\
251 Defined flags are the characters 1, 2, 3, 4, b, and p.\n\
252 1 means C is the start of a two-char comment start sequence.\n\
253 2 means C is the second character of such a sequence.\n\
254 3 means C is the start of a two-char comment end sequence.\n\
255 4 means C is the second character of such a sequence.\n\
257 There can be up to two orthogonal comment sequences. This is to support\n\
258 language modes such as C++. By default, all comment sequences are of style\n\
259 a, but you can set the comment sequence style to b (on the second character\n\
260 of a comment-start, or the first character of a comment-end sequence) using\n\
262 b means C is part of comment sequence b.\n\
264 p means C is a prefix character for `backward-prefix-chars';\n\
265 such characters are treated as whitespace when they occur\n\
266 between expressions.")
270 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry
, Smodify_syntax_entry
, 2, 3,
271 /* I really don't know why this is interactive
272 help-form should at least be made useful whilst reading the second arg
274 "cSet syntax for character: \nsSet syntax for %s to: ",
275 0 /* See immediately above */)
276 (c
, newentry
, syntax_table
)
277 Lisp_Object c
, newentry
, syntax_table
;
279 register unsigned char *p
, match
;
280 register enum syntaxcode code
;
284 CHECK_STRING (newentry
, 1);
285 if (NILP (syntax_table
))
286 syntax_table
= current_buffer
->syntax_table
;
288 syntax_table
= check_syntax_table (syntax_table
);
290 p
= XSTRING (newentry
)->data
;
291 code
= (enum syntaxcode
) syntax_spec_code
[*p
++];
292 if (((int) code
& 0377) == 0377)
293 error ("invalid syntax description letter: %c", c
);
297 if (match
== ' ') match
= 0;
299 XFASTINT (val
) = (match
<< 8) + (int) code
;
304 XFASTINT (val
) |= 1 << 16;
308 XFASTINT (val
) |= 1 << 17;
312 XFASTINT (val
) |= 1 << 18;
316 XFASTINT (val
) |= 1 << 19;
320 XFASTINT (val
) |= 1 << 20;
324 XFASTINT (val
) |= 1 << 21;
328 XVECTOR (syntax_table
)->contents
[0xFF & XINT (c
)] = val
;
333 /* Dump syntax table to buffer in human-readable format */
336 describe_syntax (value
)
339 register enum syntaxcode code
;
340 char desc
, match
, start1
, start2
, end1
, end2
, prefix
, comstyle
;
343 Findent_to (make_number (16), make_number (1));
345 if (XTYPE (value
) != Lisp_Int
)
347 insert_string ("invalid");
351 code
= (enum syntaxcode
) (XINT (value
) & 0377);
352 match
= (XINT (value
) >> 8) & 0377;
353 start1
= (XINT (value
) >> 16) & 1;
354 start2
= (XINT (value
) >> 17) & 1;
355 end1
= (XINT (value
) >> 18) & 1;
356 end2
= (XINT (value
) >> 19) & 1;
357 prefix
= (XINT (value
) >> 20) & 1;
358 comstyle
= (XINT (value
) >> 21) & 1;
360 if ((int) code
< 0 || (int) code
>= (int) Smax
)
362 insert_string ("invalid");
365 desc
= syntax_code_spec
[(int) code
];
367 str
[0] = desc
, str
[1] = 0;
370 str
[0] = match
? match
: ' ';
389 insert_string ("\twhich means: ");
391 #ifdef SWITCH_ENUM_BUG
398 insert_string ("whitespace"); break;
400 insert_string ("punctuation"); break;
402 insert_string ("word"); break;
404 insert_string ("symbol"); break;
406 insert_string ("open"); break;
408 insert_string ("close"); break;
410 insert_string ("quote"); break;
412 insert_string ("string"); break;
414 insert_string ("math"); break;
416 insert_string ("escape"); break;
418 insert_string ("charquote"); break;
420 insert_string ("comment"); break;
422 insert_string ("endcomment"); break;
424 insert_string ("invalid");
430 insert_string (", matches ");
435 insert_string (",\n\t is the first character of a comment-start sequence");
437 insert_string (",\n\t is the second character of a comment-start sequence");
440 insert_string (",\n\t is the first character of a comment-end sequence");
442 insert_string (",\n\t is the second character of a comment-end sequence");
444 insert_string (" (comment style b)");
447 insert_string (",\n\t is a prefix character for `backward-prefix-chars'");
449 insert_string ("\n");
453 describe_syntax_1 (vector
)
456 struct buffer
*old
= current_buffer
;
457 set_buffer_internal (XBUFFER (Vstandard_output
));
458 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
);
459 set_buffer_internal (old
);
463 DEFUN ("describe-syntax", Fdescribe_syntax
, Sdescribe_syntax
, 0, 0, "",
464 "Describe the syntax specifications in the syntax table.\n\
465 The descriptions are inserted in a buffer, which is then displayed.")
468 internal_with_output_to_temp_buffer
469 ("*Help*", describe_syntax_1
, current_buffer
->syntax_table
);
474 /* Return the position across COUNT words from FROM.
475 If that many words cannot be found before the end of the buffer, return 0.
476 COUNT negative means scan backward and stop at word beginning. */
478 scan_words (from
, count
)
479 register int from
, count
;
481 register int beg
= BEGV
;
482 register int end
= ZV
;
497 code
= SYNTAX (FETCH_CHAR (from
));
498 if (words_include_escapes
499 && (code
== Sescape
|| code
== Scharquote
))
507 if (from
== end
) break;
508 code
= SYNTAX (FETCH_CHAR (from
));
509 if (!(words_include_escapes
510 && (code
== Sescape
|| code
== Scharquote
)))
526 code
= SYNTAX (FETCH_CHAR (from
- 1));
527 if (words_include_escapes
528 && (code
== Sescape
|| code
== Scharquote
))
536 if (from
== beg
) break;
537 code
= SYNTAX (FETCH_CHAR (from
- 1));
538 if (!(words_include_escapes
539 && (code
== Sescape
|| code
== Scharquote
)))
552 DEFUN ("forward-word", Fforward_word
, Sforward_word
, 1, 1, "p",
553 "Move point forward ARG words (backward if ARG is negative).\n\
554 Normally returns t.\n\
555 If an edge of the buffer is reached, point is left there\n\
556 and nil is returned.")
561 CHECK_NUMBER (count
, 0);
563 if (!(val
= scan_words (point
, XINT (count
))))
565 SET_PT (XINT (count
) > 0 ? ZV
: BEGV
);
572 DEFUN ("forward-comment", Fforward_comment
, Sforward_comment
, 1, 1, 0,
573 "Move forward across up to N comments. If N is negative, move backward.\n\
574 Stop scanning if we find something other than a comment or whitespace.\n\
575 Set point to where scanning stops.\n\
576 If N comments are found as expected, with nothing except whitespace\n\
577 between them, return t; otherwise return nil.")
584 register enum syntaxcode code
;
585 int comstyle
= 0; /* style of comment encountered */
589 CHECK_NUMBER (count
, 0);
590 count1
= XINT (count
);
602 c
= FETCH_CHAR (from
);
606 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
607 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
)))
609 /* We have encountered a comment start sequence and we
610 are ignoring all text inside comments. We must record
611 the comment style this sequence begins so that later,
612 only a comment end of the same style actually ends
613 the comment section. */
615 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
));
619 if (code
== Scomment
)
629 c
= FETCH_CHAR (from
);
630 if (SYNTAX (c
) == Sendcomment
631 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
632 /* we have encountered a comment end of the same style
633 as the comment sequence which began this comment
637 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
638 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
))
639 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
640 /* we have encountered a comment end of the same style
641 as the comment sequence which began this comment
645 /* We have skipped one comment. */
648 else if (code
!= Swhitespace
&& code
!= Sendcomment
)
656 /* End of comment reached */
668 quoted
= char_quoted (from
);
671 c
= FETCH_CHAR (from
);
674 if (code
== Sendcomment
)
675 comstyle
= SYNTAX_COMMENT_STYLE (c
);
676 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
677 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1))
678 && !char_quoted (from
- 1))
680 /* We must record the comment style encountered so that
681 later, we can match only the proper comment begin
682 sequence of the same style. */
684 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
- 1));
688 if (code
== Sendcomment
&& !quoted
)
691 if (code
!= SYNTAX (c
))
692 /* For a two-char comment ender, we can assume
693 it does end a comment. So scan back in a simple way. */
695 if (from
!= stop
) from
--;
698 if (SYNTAX (c
= FETCH_CHAR (from
)) == Scomment
699 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
708 if (SYNTAX_COMSTART_SECOND (c
)
709 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
))
710 && SYNTAX_COMMENT_STYLE (c
) == comstyle
711 && !char_quoted (from
))
718 /* Look back, counting the parity of string-quotes,
719 and recording the comment-starters seen.
720 When we reach a safe place, assume that's not in a string;
721 then step the main scan to the earliest comment-starter seen
722 an even number of string quotes away from the safe place.
724 OFROM[I] is position of the earliest comment-starter seen
725 which is I+2X quotes from the comment-end.
726 PARITY is current parity of quotes from the comment end. */
729 char my_stringend
= 0;
730 int string_lossage
= 0;
731 int comment_end
= from
;
732 int comstart_pos
= 0;
733 int comstart_parity
= 0;
735 /* At beginning of range to scan, we're outside of strings;
736 that determines quote parity to the comment-end. */
739 /* Move back and examine a character. */
742 c
= FETCH_CHAR (from
);
745 /* If this char is the second of a 2-char comment sequence,
746 back up and give the pair the appropriate syntax. */
747 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
748 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1)))
754 else if (from
> stop
&& SYNTAX_COMSTART_SECOND (c
)
755 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
- 1))
756 && comstyle
== SYNTAX_COMMENT_STYLE (c
))
762 /* Ignore escaped characters. */
763 if (char_quoted (from
))
766 /* Track parity of quotes. */
770 if (my_stringend
== 0)
772 /* If we have two kinds of string delimiters.
773 There's no way to grok this scanning backwards. */
774 else if (my_stringend
!= c
)
778 /* Record comment-starters according to that
779 quote-parity to the comment-end. */
780 if (code
== Scomment
)
782 comstart_parity
= parity
;
786 /* If we find another earlier comment-ender,
787 any comment-starts earlier than that don't count
788 (because they go with the earlier comment-ender). */
789 if (code
== Sendcomment
790 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
)) == comstyle
)
793 /* Assume a defun-start point is outside of strings. */
795 && (from
== stop
|| FETCH_CHAR (from
- 1) == '\n'))
799 if (comstart_pos
== 0)
801 /* If the earliest comment starter
802 is followed by uniform paired string quotes or none,
803 we know it can't be inside a string
804 since if it were then the comment ender would be inside one.
805 So it does start a comment. Skip back to it. */
806 else if (comstart_parity
== 0 && !string_lossage
)
810 /* We had two kinds of string delimiters mixed up
811 together. Decode this going forwards.
812 Scan fwd from the previous comment ender
813 to the one in question; this records where we
814 last passed a comment starter. */
815 struct lisp_parse_state state
;
816 scan_sexps_forward (&state
, find_defun_start (comment_end
),
817 comment_end
- 1, -10000, 0, Qnil
, 0);
819 from
= state
.comstart
;
821 /* We can't grok this as a comment; scan it normally. */
825 /* We have skipped one comment. */
828 else if ((code
!= Swhitespace
&& code
!= Scomment
) || quoted
)
844 int parse_sexp_ignore_comments
;
847 scan_lists (from
, count
, depth
, sexpflag
)
849 int count
, depth
, sexpflag
;
857 register enum syntaxcode code
;
858 int min_depth
= depth
; /* Err out if depth gets less than this. */
859 int comstyle
= 0; /* style of comment encountered */
861 if (depth
> 0) min_depth
= 0;
871 c
= FETCH_CHAR (from
);
874 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
875 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
))
876 && parse_sexp_ignore_comments
)
878 /* we have encountered a comment start sequence and we
879 are ignoring all text inside comments. we must record
880 the comment style this sequence begins so that later,
881 only a comment end of the same style actually ends
882 the comment section */
884 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
));
888 if (SYNTAX_PREFIX (c
))
891 #ifdef SWITCH_ENUM_BUG
899 if (from
== stop
) goto lose
;
901 /* treat following character as a word constituent */
904 if (depth
|| !sexpflag
) break;
905 /* This word counts as a sexp; return at end of it. */
908 #ifdef SWITCH_ENUM_BUG
909 switch ((int) SYNTAX (FETCH_CHAR (from
)))
911 switch (SYNTAX (FETCH_CHAR (from
)))
917 if (from
== stop
) goto lose
;
931 if (!parse_sexp_ignore_comments
) break;
934 if (from
== stop
) goto done
;
935 c
= FETCH_CHAR (from
);
936 if (SYNTAX (c
) == Sendcomment
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
943 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
944 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
))
945 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
946 /* we have encountered a comment end of the same style
947 as the comment sequence which began this comment
956 if (from
!= stop
&& c
== FETCH_CHAR (from
))
966 if (!++depth
) goto done
;
971 if (!--depth
) goto done
;
972 if (depth
< min_depth
)
973 error ("Containing expression ends prematurely");
977 stringterm
= FETCH_CHAR (from
- 1);
980 if (from
>= stop
) goto lose
;
981 if (FETCH_CHAR (from
) == stringterm
) break;
982 #ifdef SWITCH_ENUM_BUG
983 switch ((int) SYNTAX (FETCH_CHAR (from
)))
985 switch (SYNTAX (FETCH_CHAR (from
)))
995 if (!depth
&& sexpflag
) goto done
;
1000 /* Reached end of buffer. Error if within object, return nil if between */
1001 if (depth
) goto lose
;
1006 /* End of object reached */
1017 if (quoted
= char_quoted (from
))
1019 c
= FETCH_CHAR (from
);
1022 if (code
== Sendcomment
)
1023 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1024 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1025 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1))
1026 && !char_quoted (from
- 1)
1027 && parse_sexp_ignore_comments
)
1029 /* we must record the comment style encountered so that
1030 later, we can match only the proper comment begin
1031 sequence of the same style */
1033 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
- 1));
1037 if (SYNTAX_PREFIX (c
))
1040 #ifdef SWITCH_ENUM_BUG
1041 switch ((int) (quoted
? Sword
: code
))
1043 switch (quoted
? Sword
: code
)
1048 if (depth
|| !sexpflag
) break;
1049 /* This word counts as a sexp; count object finished after passing it. */
1052 quoted
= char_quoted (from
- 1);
1055 if (! (quoted
|| SYNTAX (FETCH_CHAR (from
- 1)) == Sword
1056 || SYNTAX (FETCH_CHAR (from
- 1)) == Ssymbol
1057 || SYNTAX (FETCH_CHAR (from
- 1)) == Squote
))
1066 if (from
!= stop
&& c
== FETCH_CHAR (from
- 1))
1076 if (!++depth
) goto done2
;
1081 if (!--depth
) goto done2
;
1082 if (depth
< min_depth
)
1083 error ("Containing expression ends prematurely");
1087 if (!parse_sexp_ignore_comments
)
1090 if (code
!= SYNTAX (c
))
1091 /* For a two-char comment ender, we can assume
1092 it does end a comment. So scan back in a simple way. */
1094 if (from
!= stop
) from
--;
1097 if (SYNTAX (c
= FETCH_CHAR (from
)) == Scomment
1098 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1100 if (from
== stop
) goto done
;
1102 if (SYNTAX_COMSTART_SECOND (c
)
1103 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
))
1104 && SYNTAX_COMMENT_STYLE (c
) == comstyle
1105 && !char_quoted (from
))
1112 /* Look back, counting the parity of string-quotes,
1113 and recording the comment-starters seen.
1114 When we reach a safe place, assume that's not in a string;
1115 then step the main scan to the earliest comment-starter seen
1116 an even number of string quotes away from the safe place.
1118 OFROM[I] is position of the earliest comment-starter seen
1119 which is I+2X quotes from the comment-end.
1120 PARITY is current parity of quotes from the comment end. */
1123 char my_stringend
= 0;
1124 int string_lossage
= 0;
1125 int comment_end
= from
;
1126 int comstart_pos
= 0;
1127 int comstart_parity
= 0;
1129 /* At beginning of range to scan, we're outside of strings;
1130 that determines quote parity to the comment-end. */
1131 while (from
!= stop
)
1133 /* Move back and examine a character. */
1136 c
= FETCH_CHAR (from
);
1139 /* If this char is the second of a 2-char comment sequence,
1140 back up and give the pair the appropriate syntax. */
1141 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1142 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1)))
1148 else if (from
> stop
&& SYNTAX_COMSTART_SECOND (c
)
1149 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
- 1))
1150 && comstyle
== SYNTAX_COMMENT_STYLE (c
))
1156 /* Ignore escaped characters. */
1157 if (char_quoted (from
))
1160 /* Track parity of quotes. */
1161 if (code
== Sstring
)
1164 if (my_stringend
== 0)
1166 /* If we have two kinds of string delimiters.
1167 There's no way to grok this scanning backwards. */
1168 else if (my_stringend
!= c
)
1172 /* Record comment-starters according to that
1173 quote-parity to the comment-end. */
1174 if (code
== Scomment
)
1176 comstart_parity
= parity
;
1177 comstart_pos
= from
;
1180 /* If we find another earlier comment-ender,
1181 any comment-starts earlier than that don't count
1182 (because they go with the earlier comment-ender). */
1183 if (code
== Sendcomment
1184 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
)) == comstyle
)
1187 /* Assume a defun-start point is outside of strings. */
1189 && (from
== stop
|| FETCH_CHAR (from
- 1) == '\n'))
1193 if (comstart_pos
== 0)
1195 /* If the earliest comment starter
1196 is followed by uniform paired string quotes or none,
1197 we know it can't be inside a string
1198 since if it were then the comment ender would be inside one.
1199 So it does start a comment. Skip back to it. */
1200 else if (comstart_parity
== 0 && !string_lossage
)
1201 from
= comstart_pos
;
1204 /* We had two kinds of string delimiters mixed up
1205 together. Decode this going forwards.
1206 Scan fwd from the previous comment ender
1207 to the one in question; this records where we
1208 last passed a comment starter. */
1209 struct lisp_parse_state state
;
1210 scan_sexps_forward (&state
, find_defun_start (comment_end
),
1211 comment_end
- 1, -10000, 0, Qnil
, 0);
1212 if (state
.incomment
)
1213 from
= state
.comstart
;
1215 /* We can't grok this as a comment; scan it normally. */
1222 stringterm
= FETCH_CHAR (from
);
1225 if (from
== stop
) goto lose
;
1226 if (!char_quoted (from
- 1)
1227 && stringterm
== FETCH_CHAR (from
- 1))
1232 if (!depth
&& sexpflag
) goto done2
;
1237 /* Reached start of buffer. Error if within object, return nil if between */
1238 if (depth
) goto lose
;
1249 XFASTINT (val
) = from
;
1253 error ("Unbalanced parentheses");
1261 register enum syntaxcode code
;
1262 register int beg
= BEGV
;
1263 register int quoted
= 0;
1266 && ((code
= SYNTAX (FETCH_CHAR (pos
- 1))) == Scharquote
1267 || code
== Sescape
))
1268 pos
--, quoted
= !quoted
;
1272 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
1273 "Scan from character number FROM by COUNT lists.\n\
1274 Returns the character number of the position thus found.\n\
1276 If DEPTH is nonzero, paren depth begins counting from that value,\n\
1277 only places where the depth in parentheses becomes zero\n\
1278 are candidates for stopping; COUNT such places are counted.\n\
1279 Thus, a positive value for DEPTH means go out levels.\n\
1281 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
1283 If the beginning or end of (the accessible part of) the buffer is reached\n\
1284 and the depth is wrong, an error is signaled.\n\
1285 If the depth is right but the count is not used up, nil is returned.")
1286 (from
, count
, depth
)
1287 Lisp_Object from
, count
, depth
;
1289 CHECK_NUMBER (from
, 0);
1290 CHECK_NUMBER (count
, 1);
1291 CHECK_NUMBER (depth
, 2);
1293 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
1296 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
1297 "Scan from character number FROM by COUNT balanced expressions.\n\
1298 If COUNT is negative, scan backwards.\n\
1299 Returns the character number of the position thus found.\n\
1301 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
1303 If the beginning or end of (the accessible part of) the buffer is reached\n\
1304 in the middle of a parenthetical grouping, an error is signaled.\n\
1305 If the beginning or end is reached between groupings\n\
1306 but before count is used up, nil is returned.")
1308 Lisp_Object from
, count
;
1310 CHECK_NUMBER (from
, 0);
1311 CHECK_NUMBER (count
, 1);
1313 return scan_lists (XINT (from
), XINT (count
), 0, 1);
1316 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
1318 "Move point backward over any number of chars with prefix syntax.\n\
1319 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
1325 while (pos
> beg
&& !char_quoted (pos
- 1)
1326 && (SYNTAX (FETCH_CHAR (pos
- 1)) == Squote
1327 || SYNTAX_PREFIX (FETCH_CHAR (pos
- 1))))
1335 /* Parse forward from FROM to END,
1336 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
1337 and return a description of the state of the parse at END.
1338 If STOPBEFORE is nonzero, stop at the start of an atom.
1339 If COMMENTSTOP is nonzero, stop at the start of a comment. */
1342 scan_sexps_forward (stateptr
, from
, end
, targetdepth
,
1343 stopbefore
, oldstate
, commentstop
)
1344 struct lisp_parse_state
*stateptr
;
1346 int end
, targetdepth
, stopbefore
;
1347 Lisp_Object oldstate
;
1350 struct lisp_parse_state state
;
1352 register enum syntaxcode code
;
1353 struct level
{ int last
, prev
; };
1354 struct level levelstart
[100];
1355 register struct level
*curlevel
= levelstart
;
1356 struct level
*endlevel
= levelstart
+ 100;
1358 register int depth
; /* Paren depth of current scanning location.
1359 level - levelstart equals this except
1360 when the depth becomes negative. */
1361 int mindepth
; /* Lowest DEPTH value seen. */
1362 int start_quoted
= 0; /* Nonzero means starting after a char quote */
1368 if (NILP (oldstate
))
1371 state
.instring
= -1;
1372 state
.incomment
= 0;
1373 state
.comstyle
= 0; /* comment style a by default */
1377 tem
= Fcar (oldstate
);
1383 oldstate
= Fcdr (oldstate
);
1384 oldstate
= Fcdr (oldstate
);
1385 oldstate
= Fcdr (oldstate
);
1386 tem
= Fcar (oldstate
);
1387 state
.instring
= !NILP (tem
) ? XINT (tem
) : -1;
1389 oldstate
= Fcdr (oldstate
);
1390 tem
= Fcar (oldstate
);
1391 state
.incomment
= !NILP (tem
);
1393 oldstate
= Fcdr (oldstate
);
1394 tem
= Fcar (oldstate
);
1395 start_quoted
= !NILP (tem
);
1397 /* if the eight element of the list is nil, we are in comment
1398 style a. if it is non-nil, we are in comment style b */
1399 oldstate
= Fcdr (oldstate
);
1400 oldstate
= Fcdr (oldstate
);
1401 tem
= Fcar (oldstate
);
1402 state
.comstyle
= !NILP (tem
);
1407 curlevel
->prev
= -1;
1408 curlevel
->last
= -1;
1410 /* Enter the loop at a place appropriate for initial state. */
1412 if (state
.incomment
) goto startincomment
;
1413 if (state
.instring
>= 0)
1415 if (start_quoted
) goto startquotedinstring
;
1418 if (start_quoted
) goto startquoted
;
1422 code
= SYNTAX (FETCH_CHAR (from
));
1424 if (code
== Scomment
)
1425 state
.comstart
= from
-1;
1427 else if (from
< end
&& SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
- 1))
1428 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
)))
1430 /* Record the comment style we have entered so that only
1431 the comment-end sequence of the same style actually
1432 terminates the comment section. */
1434 state
.comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
));
1435 state
.comstart
= from
-1;
1439 if (SYNTAX_PREFIX (FETCH_CHAR (from
- 1)))
1441 #ifdef SWITCH_ENUM_BUG
1449 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1450 curlevel
->last
= from
- 1;
1452 if (from
== end
) goto endquoted
;
1455 /* treat following character as a word constituent */
1458 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1459 curlevel
->last
= from
- 1;
1463 #ifdef SWITCH_ENUM_BUG
1464 switch ((int) SYNTAX (FETCH_CHAR (from
)))
1466 switch (SYNTAX (FETCH_CHAR (from
)))
1472 if (from
== end
) goto endquoted
;
1484 curlevel
->prev
= curlevel
->last
;
1488 state
.incomment
= 1;
1494 if (from
== end
) goto done
;
1495 prev
= FETCH_CHAR (from
);
1496 if (SYNTAX (prev
) == Sendcomment
1497 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
1498 /* Only terminate the comment section if the endcomment
1499 of the same style as the start sequence has been
1503 if (from
< end
&& SYNTAX_COMEND_FIRST (prev
)
1504 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
))
1505 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
1506 /* Only terminate the comment section if the end-comment
1507 sequence of the same style as the start sequence has
1508 been encountered. */
1511 state
.incomment
= 0;
1512 state
.comstyle
= 0; /* reset the comment style */
1516 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1518 /* curlevel++->last ran into compiler bug on Apollo */
1519 curlevel
->last
= from
- 1;
1520 if (++curlevel
== endlevel
)
1521 error ("Nesting too deep for parser");
1522 curlevel
->prev
= -1;
1523 curlevel
->last
= -1;
1524 if (!--targetdepth
) goto done
;
1529 if (depth
< mindepth
)
1531 if (curlevel
!= levelstart
)
1533 curlevel
->prev
= curlevel
->last
;
1534 if (!++targetdepth
) goto done
;
1538 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1539 curlevel
->last
= from
- 1;
1540 state
.instring
= FETCH_CHAR (from
- 1);
1544 if (from
>= end
) goto done
;
1545 if (FETCH_CHAR (from
) == state
.instring
) break;
1546 #ifdef SWITCH_ENUM_BUG
1547 switch ((int) SYNTAX (FETCH_CHAR (from
)))
1549 switch (SYNTAX (FETCH_CHAR (from
)))
1555 startquotedinstring
:
1556 if (from
>= end
) goto endquoted
;
1560 state
.instring
= -1;
1561 curlevel
->prev
= curlevel
->last
;
1571 stop
: /* Here if stopping before start of sexp. */
1572 from
--; /* We have just fetched the char that starts it; */
1573 goto done
; /* but return the position before it. */
1578 state
.depth
= depth
;
1579 state
.mindepth
= mindepth
;
1580 state
.thislevelstart
= curlevel
->prev
;
1581 state
.prevlevelstart
1582 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
1583 state
.location
= from
;
1589 /* This comment supplies the doc string for parse-partial-sexp,
1590 for make-docfile to see. We cannot put this in the real DEFUN
1591 due to limits in the Unix cpp.
1593 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
1594 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
1595 Parsing stops at TO or when certain criteria are met;\n\
1596 point is set to where parsing stops.\n\
1597 If fifth arg STATE is omitted or nil,\n\
1598 parsing assumes that FROM is the beginning of a function.\n\
1599 Value is a list of eight elements describing final state of parsing:\n\
1600 0. depth in parens.\n\
1601 1. character address of start of innermost containing list; nil if none.\n\
1602 2. character address of start of last complete sexp terminated.\n\
1603 3. non-nil if inside a string.\n\
1604 (it is the character that will terminate the string.)\n\
1605 4. t if inside a comment.\n\
1606 5. t if following a quote character.\n\
1607 6. the minimum paren-depth encountered during this scan.\n\
1608 7. t if in a comment of style `b'.\n\
1609 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
1610 in parentheses becomes equal to TARGETDEPTH.\n\
1611 Fourth arg STOPBEFORE non-nil means stop when come to\n\
1612 any character that starts a sexp.\n\
1613 Fifth arg STATE is an eight-list like what this function returns.\n\
1614 It is used to initialize the state of the parse. Its second and third
1615 elements are ignored.
1616 Sixth args COMMENTSTOP non-nil means stop at the start of a comment.")
1617 (from, to, targetdepth, stopbefore, state, commentstop)
1620 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 6, 0,
1621 0 /* See immediately above */)
1622 (from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
)
1623 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
;
1625 struct lisp_parse_state state
;
1628 if (!NILP (targetdepth
))
1630 CHECK_NUMBER (targetdepth
, 3);
1631 target
= XINT (targetdepth
);
1634 target
= -100000; /* We won't reach this depth */
1636 validate_region (&from
, &to
);
1637 scan_sexps_forward (&state
, XINT (from
), XINT (to
),
1638 target
, !NILP (stopbefore
), oldstate
,
1639 !NILP (commentstop
));
1641 SET_PT (state
.location
);
1643 return Fcons (make_number (state
.depth
),
1644 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
1645 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
1646 Fcons (state
.instring
>= 0 ? make_number (state
.instring
) : Qnil
,
1647 Fcons (state
.incomment
? Qt
: Qnil
,
1648 Fcons (state
.quoted
? Qt
: Qnil
,
1649 Fcons (make_number (state
.mindepth
),
1650 Fcons (state
.comstyle
? Qt
: Qnil
,
1657 register struct Lisp_Vector
*v
;
1659 /* Set this now, so first buffer creation can refer to it. */
1660 /* Make it nil before calling copy-syntax-table
1661 so that copy-syntax-table will know not to try to copy from garbage */
1662 Vstandard_syntax_table
= Qnil
;
1663 Vstandard_syntax_table
= Fcopy_syntax_table (Qnil
);
1665 v
= XVECTOR (Vstandard_syntax_table
);
1667 for (i
= 'a'; i
<= 'z'; i
++)
1668 XFASTINT (v
->contents
[i
]) = (int) Sword
;
1669 for (i
= 'A'; i
<= 'Z'; i
++)
1670 XFASTINT (v
->contents
[i
]) = (int) Sword
;
1671 for (i
= '0'; i
<= '9'; i
++)
1672 XFASTINT (v
->contents
[i
]) = (int) Sword
;
1673 XFASTINT (v
->contents
['$']) = (int) Sword
;
1674 XFASTINT (v
->contents
['%']) = (int) Sword
;
1676 XFASTINT (v
->contents
['(']) = (int) Sopen
+ (')' << 8);
1677 XFASTINT (v
->contents
[')']) = (int) Sclose
+ ('(' << 8);
1678 XFASTINT (v
->contents
['[']) = (int) Sopen
+ (']' << 8);
1679 XFASTINT (v
->contents
[']']) = (int) Sclose
+ ('[' << 8);
1680 XFASTINT (v
->contents
['{']) = (int) Sopen
+ ('}' << 8);
1681 XFASTINT (v
->contents
['}']) = (int) Sclose
+ ('{' << 8);
1682 XFASTINT (v
->contents
['"']) = (int) Sstring
;
1683 XFASTINT (v
->contents
['\\']) = (int) Sescape
;
1685 for (i
= 0; i
< 10; i
++)
1686 XFASTINT (v
->contents
["_-+*/&|<>="[i
]]) = (int) Ssymbol
;
1688 for (i
= 0; i
< 12; i
++)
1689 XFASTINT (v
->contents
[".,;:?!#@~^'`"[i
]]) = (int) Spunct
;
1694 Qsyntax_table_p
= intern ("syntax-table-p");
1695 staticpro (&Qsyntax_table_p
);
1697 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
1698 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
1700 words_include_escapes
= 0;
1701 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
1702 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
1704 defsubr (&Ssyntax_table_p
);
1705 defsubr (&Ssyntax_table
);
1706 defsubr (&Sstandard_syntax_table
);
1707 defsubr (&Scopy_syntax_table
);
1708 defsubr (&Sset_syntax_table
);
1709 defsubr (&Schar_syntax
);
1710 defsubr (&Smodify_syntax_entry
);
1711 defsubr (&Sdescribe_syntax
);
1713 defsubr (&Sforward_word
);
1715 defsubr (&Sforward_comment
);
1716 defsubr (&Sscan_lists
);
1717 defsubr (&Sscan_sexps
);
1718 defsubr (&Sbackward_prefix_chars
);
1719 defsubr (&Sparse_partial_sexp
);