1 /* GNU Emacs routines to deal with syntax tables; also word and list parsing.
2 Copyright (C) 1985, 1987, 1993, 1994 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
, 1);
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
, 1);
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 (char) Sinherit
, 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
[14] =
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 (XINT (ch
))]);
229 DEFUN ("matching-paren", Fmatching_paren
, Smatching_paren
, 1, 1, 0,
230 "Return the matching parenthesis of CHAR, or nil if none.")
235 CHECK_NUMBER (ch
, 0);
236 code
= SYNTAX (XINT (ch
));
237 if (code
== Sopen
&& code
== Sclose
)
238 return make_number (SYNTAX_MATCH (XINT (ch
)));
242 /* This comment supplies the doc string for modify-syntax-entry,
243 for make-docfile to see. We cannot put this in the real DEFUN
244 due to limits in the Unix cpp.
246 DEFUN ("modify-syntax-entry", foo, bar, 2, 3, 0,
247 "Set syntax for character CHAR according to string S.\n\
248 The syntax is changed only for table TABLE, which defaults to\n\
249 the current buffer's syntax table.\n\
250 The first character of S should be one of the following:\n\
251 Space or - whitespace syntax. w word constituent.\n\
252 _ symbol constituent. . punctuation.\n\
253 ( open-parenthesis. ) close-parenthesis.\n\
254 \" string quote. \\ escape.\n\
255 $ paired delimiter. ' expression quote or prefix operator.\n\
256 < comment starter. > comment ender.\n\
257 / character-quote. @ inherit from `standard-syntax-table'.\n\
259 Only single-character comment start and end sequences are represented thus.\n\
260 Two-character sequences are represented as described below.\n\
261 The second character of S is the matching parenthesis,\n\
262 used only if the first character is `(' or `)'.\n\
263 Any additional characters are flags.\n\
264 Defined flags are the characters 1, 2, 3, 4, b, and p.\n\
265 1 means C is the start of a two-char comment start sequence.\n\
266 2 means C is the second character of such a sequence.\n\
267 3 means C is the start of a two-char comment end sequence.\n\
268 4 means C is the second character of such a sequence.\n\
270 There can be up to two orthogonal comment sequences. This is to support\n\
271 language modes such as C++. By default, all comment sequences are of style\n\
272 a, but you can set the comment sequence style to b (on the second character\n\
273 of a comment-start, or the first character of a comment-end sequence) using\n\
275 b means C is part of comment sequence b.\n\
277 p means C is a prefix character for `backward-prefix-chars';\n\
278 such characters are treated as whitespace when they occur\n\
279 between expressions.")
283 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry
, Smodify_syntax_entry
, 2, 3,
284 /* I really don't know why this is interactive
285 help-form should at least be made useful whilst reading the second arg
287 "cSet syntax for character: \nsSet syntax for %s to: ",
288 0 /* See immediately above */)
289 (c
, newentry
, syntax_table
)
290 Lisp_Object c
, newentry
, syntax_table
;
292 register unsigned char *p
, match
;
293 register enum syntaxcode code
;
297 CHECK_STRING (newentry
, 1);
298 if (NILP (syntax_table
))
299 syntax_table
= current_buffer
->syntax_table
;
301 syntax_table
= check_syntax_table (syntax_table
);
303 p
= XSTRING (newentry
)->data
;
304 code
= (enum syntaxcode
) syntax_spec_code
[*p
++];
305 if (((int) code
& 0377) == 0377)
306 error ("invalid syntax description letter: %c", c
);
310 if (match
== ' ') match
= 0;
312 XFASTINT (val
) = (match
<< 8) + (int) code
;
317 XFASTINT (val
) |= 1 << 16;
321 XFASTINT (val
) |= 1 << 17;
325 XFASTINT (val
) |= 1 << 18;
329 XFASTINT (val
) |= 1 << 19;
333 XFASTINT (val
) |= 1 << 20;
337 XFASTINT (val
) |= 1 << 21;
341 XVECTOR (syntax_table
)->contents
[0xFF & XINT (c
)] = val
;
346 /* Dump syntax table to buffer in human-readable format */
349 describe_syntax (value
)
352 register enum syntaxcode code
;
353 char desc
, match
, start1
, start2
, end1
, end2
, prefix
, comstyle
;
356 Findent_to (make_number (16), make_number (1));
358 if (XTYPE (value
) != Lisp_Int
)
360 insert_string ("invalid");
364 code
= (enum syntaxcode
) (XINT (value
) & 0377);
365 match
= (XINT (value
) >> 8) & 0377;
366 start1
= (XINT (value
) >> 16) & 1;
367 start2
= (XINT (value
) >> 17) & 1;
368 end1
= (XINT (value
) >> 18) & 1;
369 end2
= (XINT (value
) >> 19) & 1;
370 prefix
= (XINT (value
) >> 20) & 1;
371 comstyle
= (XINT (value
) >> 21) & 1;
373 if ((int) code
< 0 || (int) code
>= (int) Smax
)
375 insert_string ("invalid");
378 desc
= syntax_code_spec
[(int) code
];
380 str
[0] = desc
, str
[1] = 0;
383 str
[0] = match
? match
: ' ';
402 insert_string ("\twhich means: ");
404 #ifdef SWITCH_ENUM_BUG
411 insert_string ("whitespace"); break;
413 insert_string ("punctuation"); break;
415 insert_string ("word"); break;
417 insert_string ("symbol"); break;
419 insert_string ("open"); break;
421 insert_string ("close"); break;
423 insert_string ("quote"); break;
425 insert_string ("string"); break;
427 insert_string ("math"); break;
429 insert_string ("escape"); break;
431 insert_string ("charquote"); break;
433 insert_string ("comment"); break;
435 insert_string ("endcomment"); break;
437 insert_string ("inherit"); break;
439 insert_string ("invalid");
445 insert_string (", matches ");
450 insert_string (",\n\t is the first character of a comment-start sequence");
452 insert_string (",\n\t is the second character of a comment-start sequence");
455 insert_string (",\n\t is the first character of a comment-end sequence");
457 insert_string (",\n\t is the second character of a comment-end sequence");
459 insert_string (" (comment style b)");
462 insert_string (",\n\t is a prefix character for `backward-prefix-chars'");
464 insert_string ("\n");
468 describe_syntax_1 (vector
)
471 struct buffer
*old
= current_buffer
;
472 set_buffer_internal (XBUFFER (Vstandard_output
));
473 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
);
474 set_buffer_internal (old
);
478 DEFUN ("describe-syntax", Fdescribe_syntax
, Sdescribe_syntax
, 0, 0, "",
479 "Describe the syntax specifications in the syntax table.\n\
480 The descriptions are inserted in a buffer, which is then displayed.")
483 internal_with_output_to_temp_buffer
484 ("*Help*", describe_syntax_1
, current_buffer
->syntax_table
);
489 /* Return the position across COUNT words from FROM.
490 If that many words cannot be found before the end of the buffer, return 0.
491 COUNT negative means scan backward and stop at word beginning. */
493 scan_words (from
, count
)
494 register int from
, count
;
496 register int beg
= BEGV
;
497 register int end
= ZV
;
512 code
= SYNTAX (FETCH_CHAR (from
));
513 if (words_include_escapes
514 && (code
== Sescape
|| code
== Scharquote
))
522 if (from
== end
) break;
523 code
= SYNTAX (FETCH_CHAR (from
));
524 if (!(words_include_escapes
525 && (code
== Sescape
|| code
== Scharquote
)))
541 code
= SYNTAX (FETCH_CHAR (from
- 1));
542 if (words_include_escapes
543 && (code
== Sescape
|| code
== Scharquote
))
551 if (from
== beg
) break;
552 code
= SYNTAX (FETCH_CHAR (from
- 1));
553 if (!(words_include_escapes
554 && (code
== Sescape
|| code
== Scharquote
)))
567 DEFUN ("forward-word", Fforward_word
, Sforward_word
, 1, 1, "p",
568 "Move point forward ARG words (backward if ARG is negative).\n\
569 Normally returns t.\n\
570 If an edge of the buffer is reached, point is left there\n\
571 and nil is returned.")
576 CHECK_NUMBER (count
, 0);
578 if (!(val
= scan_words (point
, XINT (count
))))
580 SET_PT (XINT (count
) > 0 ? ZV
: BEGV
);
587 DEFUN ("forward-comment", Fforward_comment
, Sforward_comment
, 1, 1, 0,
588 "Move forward across up to N comments. If N is negative, move backward.\n\
589 Stop scanning if we find something other than a comment or whitespace.\n\
590 Set point to where scanning stops.\n\
591 If N comments are found as expected, with nothing except whitespace\n\
592 between them, return t; otherwise return nil.")
599 register enum syntaxcode code
;
600 int comstyle
= 0; /* style of comment encountered */
604 CHECK_NUMBER (count
, 0);
605 count1
= XINT (count
);
622 c
= FETCH_CHAR (from
);
626 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
627 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
)))
629 /* We have encountered a comment start sequence and we
630 are ignoring all text inside comments. We must record
631 the comment style this sequence begins so that later,
632 only a comment end of the same style actually ends
633 the comment section. */
635 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
));
639 while (code
== Swhitespace
|| code
== Sendcomment
);
640 if (code
!= Scomment
)
646 /* We're at the start of a comment. */
655 c
= FETCH_CHAR (from
);
656 if (SYNTAX (c
) == Sendcomment
657 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
658 /* we have encountered a comment end of the same style
659 as the comment sequence which began this comment
663 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
664 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
))
665 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
666 /* we have encountered a comment end of the same style
667 as the comment sequence which began this comment
671 /* We have skipped one comment. */
683 quoted
= char_quoted (from
);
686 c
= FETCH_CHAR (from
);
689 if (code
== Sendcomment
)
690 comstyle
= SYNTAX_COMMENT_STYLE (c
);
691 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
692 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1))
693 && !char_quoted (from
- 1))
695 /* We must record the comment style encountered so that
696 later, we can match only the proper comment begin
697 sequence of the same style. */
699 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
- 1));
703 if (code
== Sendcomment
&& !quoted
)
706 if (code
!= SYNTAX (c
))
707 /* For a two-char comment ender, we can assume
708 it does end a comment. So scan back in a simple way. */
710 if (from
!= stop
) from
--;
713 if (SYNTAX (c
= FETCH_CHAR (from
)) == Scomment
714 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
723 if (SYNTAX_COMSTART_SECOND (c
)
724 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
))
725 && SYNTAX_COMMENT_STYLE (c
) == comstyle
726 && !char_quoted (from
))
733 /* Look back, counting the parity of string-quotes,
734 and recording the comment-starters seen.
735 When we reach a safe place, assume that's not in a string;
736 then step the main scan to the earliest comment-starter seen
737 an even number of string quotes away from the safe place.
739 OFROM[I] is position of the earliest comment-starter seen
740 which is I+2X quotes from the comment-end.
741 PARITY is current parity of quotes from the comment end. */
744 char my_stringend
= 0;
745 int string_lossage
= 0;
746 int comment_end
= from
;
747 int comstart_pos
= 0;
748 int comstart_parity
= 0;
750 /* At beginning of range to scan, we're outside of strings;
751 that determines quote parity to the comment-end. */
754 /* Move back and examine a character. */
757 c
= FETCH_CHAR (from
);
760 /* If this char is the second of a 2-char comment sequence,
761 back up and give the pair the appropriate syntax. */
762 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
763 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1)))
769 else if (from
> stop
&& SYNTAX_COMSTART_SECOND (c
)
770 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
- 1))
771 && comstyle
== SYNTAX_COMMENT_STYLE (c
))
777 /* Ignore escaped characters. */
778 if (char_quoted (from
))
781 /* Track parity of quotes. */
785 if (my_stringend
== 0)
787 /* If we have two kinds of string delimiters.
788 There's no way to grok this scanning backwards. */
789 else if (my_stringend
!= c
)
793 /* Record comment-starters according to that
794 quote-parity to the comment-end. */
795 if (code
== Scomment
)
797 comstart_parity
= parity
;
801 /* If we find another earlier comment-ender,
802 any comment-starts earlier than that don't count
803 (because they go with the earlier comment-ender). */
804 if (code
== Sendcomment
805 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
)) == comstyle
)
808 /* Assume a defun-start point is outside of strings. */
810 && (from
== stop
|| FETCH_CHAR (from
- 1) == '\n'))
814 if (comstart_pos
== 0)
816 /* If the earliest comment starter
817 is followed by uniform paired string quotes or none,
818 we know it can't be inside a string
819 since if it were then the comment ender would be inside one.
820 So it does start a comment. Skip back to it. */
821 else if (comstart_parity
== 0 && !string_lossage
)
825 /* We had two kinds of string delimiters mixed up
826 together. Decode this going forwards.
827 Scan fwd from the previous comment ender
828 to the one in question; this records where we
829 last passed a comment starter. */
830 struct lisp_parse_state state
;
831 scan_sexps_forward (&state
, find_defun_start (comment_end
),
832 comment_end
- 1, -10000, 0, Qnil
, 0);
834 from
= state
.comstart
;
836 /* We can't grok this as a comment; scan it normally. */
840 /* We have skipped one comment. */
843 else if ((code
!= Swhitespace
&& code
!= Scomment
) || quoted
)
859 int parse_sexp_ignore_comments
;
862 scan_lists (from
, count
, depth
, sexpflag
)
864 int count
, depth
, sexpflag
;
872 register enum syntaxcode code
;
873 int min_depth
= depth
; /* Err out if depth gets less than this. */
874 int comstyle
= 0; /* style of comment encountered */
876 if (depth
> 0) min_depth
= 0;
886 c
= FETCH_CHAR (from
);
889 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
890 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
))
891 && parse_sexp_ignore_comments
)
893 /* we have encountered a comment start sequence and we
894 are ignoring all text inside comments. we must record
895 the comment style this sequence begins so that later,
896 only a comment end of the same style actually ends
897 the comment section */
899 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
));
903 if (SYNTAX_PREFIX (c
))
906 #ifdef SWITCH_ENUM_BUG
914 if (from
== stop
) goto lose
;
916 /* treat following character as a word constituent */
919 if (depth
|| !sexpflag
) break;
920 /* This word counts as a sexp; return at end of it. */
923 #ifdef SWITCH_ENUM_BUG
924 switch ((int) SYNTAX (FETCH_CHAR (from
)))
926 switch (SYNTAX (FETCH_CHAR (from
)))
932 if (from
== stop
) goto lose
;
946 if (!parse_sexp_ignore_comments
) break;
955 c
= FETCH_CHAR (from
);
956 if (SYNTAX (c
) == Sendcomment
957 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
958 /* we have encountered a comment end of the same style
959 as the comment sequence which began this comment
963 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
964 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
))
965 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
966 /* we have encountered a comment end of the same style
967 as the comment sequence which began this comment
976 if (from
!= stop
&& c
== FETCH_CHAR (from
))
986 if (!++depth
) goto done
;
991 if (!--depth
) goto done
;
992 if (depth
< min_depth
)
993 error ("Containing expression ends prematurely");
997 stringterm
= FETCH_CHAR (from
- 1);
1000 if (from
>= stop
) goto lose
;
1001 if (FETCH_CHAR (from
) == stringterm
) break;
1002 #ifdef SWITCH_ENUM_BUG
1003 switch ((int) SYNTAX (FETCH_CHAR (from
)))
1005 switch (SYNTAX (FETCH_CHAR (from
)))
1015 if (!depth
&& sexpflag
) goto done
;
1020 /* Reached end of buffer. Error if within object, return nil if between */
1021 if (depth
) goto lose
;
1026 /* End of object reached */
1037 if (quoted
= char_quoted (from
))
1039 c
= FETCH_CHAR (from
);
1042 if (code
== Sendcomment
)
1043 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1044 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1045 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1))
1046 && !char_quoted (from
- 1)
1047 && parse_sexp_ignore_comments
)
1049 /* we must record the comment style encountered so that
1050 later, we can match only the proper comment begin
1051 sequence of the same style */
1053 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
- 1));
1057 if (SYNTAX_PREFIX (c
))
1060 #ifdef SWITCH_ENUM_BUG
1061 switch ((int) (quoted
? Sword
: code
))
1063 switch (quoted
? Sword
: code
)
1068 if (depth
|| !sexpflag
) break;
1069 /* This word counts as a sexp; count object finished after passing it. */
1072 quoted
= char_quoted (from
- 1);
1075 if (! (quoted
|| SYNTAX (FETCH_CHAR (from
- 1)) == Sword
1076 || SYNTAX (FETCH_CHAR (from
- 1)) == Ssymbol
1077 || SYNTAX (FETCH_CHAR (from
- 1)) == Squote
))
1086 if (from
!= stop
&& c
== FETCH_CHAR (from
- 1))
1096 if (!++depth
) goto done2
;
1101 if (!--depth
) goto done2
;
1102 if (depth
< min_depth
)
1103 error ("Containing expression ends prematurely");
1107 if (!parse_sexp_ignore_comments
)
1110 if (code
!= SYNTAX (c
))
1111 /* For a two-char comment ender, we can assume
1112 it does end a comment. So scan back in a simple way. */
1114 if (from
!= stop
) from
--;
1117 if (SYNTAX (c
= FETCH_CHAR (from
)) == Scomment
1118 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1127 if (SYNTAX_COMSTART_SECOND (c
)
1128 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
))
1129 && SYNTAX_COMMENT_STYLE (c
) == comstyle
1130 && !char_quoted (from
))
1137 /* Look back, counting the parity of string-quotes,
1138 and recording the comment-starters seen.
1139 When we reach a safe place, assume that's not in a string;
1140 then step the main scan to the earliest comment-starter seen
1141 an even number of string quotes away from the safe place.
1143 OFROM[I] is position of the earliest comment-starter seen
1144 which is I+2X quotes from the comment-end.
1145 PARITY is current parity of quotes from the comment end. */
1148 char my_stringend
= 0;
1149 int string_lossage
= 0;
1150 int comment_end
= from
;
1151 int comstart_pos
= 0;
1152 int comstart_parity
= 0;
1154 /* At beginning of range to scan, we're outside of strings;
1155 that determines quote parity to the comment-end. */
1156 while (from
!= stop
)
1158 /* Move back and examine a character. */
1161 c
= FETCH_CHAR (from
);
1164 /* If this char is the second of a 2-char comment sequence,
1165 back up and give the pair the appropriate syntax. */
1166 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1167 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1)))
1173 else if (from
> stop
&& SYNTAX_COMSTART_SECOND (c
)
1174 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
- 1))
1175 && comstyle
== SYNTAX_COMMENT_STYLE (c
))
1181 /* Ignore escaped characters. */
1182 if (char_quoted (from
))
1185 /* Track parity of quotes. */
1186 if (code
== Sstring
)
1189 if (my_stringend
== 0)
1191 /* If we have two kinds of string delimiters.
1192 There's no way to grok this scanning backwards. */
1193 else if (my_stringend
!= c
)
1197 /* Record comment-starters according to that
1198 quote-parity to the comment-end. */
1199 if (code
== Scomment
)
1201 comstart_parity
= parity
;
1202 comstart_pos
= from
;
1205 /* If we find another earlier comment-ender,
1206 any comment-starts earlier than that don't count
1207 (because they go with the earlier comment-ender). */
1208 if (code
== Sendcomment
1209 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
)) == comstyle
)
1212 /* Assume a defun-start point is outside of strings. */
1214 && (from
== stop
|| FETCH_CHAR (from
- 1) == '\n'))
1218 if (comstart_pos
== 0)
1220 /* If the earliest comment starter
1221 is followed by uniform paired string quotes or none,
1222 we know it can't be inside a string
1223 since if it were then the comment ender would be inside one.
1224 So it does start a comment. Skip back to it. */
1225 else if (comstart_parity
== 0 && !string_lossage
)
1226 from
= comstart_pos
;
1229 /* We had two kinds of string delimiters mixed up
1230 together. Decode this going forwards.
1231 Scan fwd from the previous comment ender
1232 to the one in question; this records where we
1233 last passed a comment starter. */
1234 struct lisp_parse_state state
;
1235 scan_sexps_forward (&state
, find_defun_start (comment_end
),
1236 comment_end
- 1, -10000, 0, Qnil
, 0);
1237 if (state
.incomment
)
1238 from
= state
.comstart
;
1240 /* We can't grok this as a comment; scan it normally. */
1247 stringterm
= FETCH_CHAR (from
);
1250 if (from
== stop
) goto lose
;
1251 if (!char_quoted (from
- 1)
1252 && stringterm
== FETCH_CHAR (from
- 1))
1257 if (!depth
&& sexpflag
) goto done2
;
1262 /* Reached start of buffer. Error if within object, return nil if between */
1263 if (depth
) goto lose
;
1274 XFASTINT (val
) = from
;
1278 error ("Unbalanced parentheses");
1286 register enum syntaxcode code
;
1287 register int beg
= BEGV
;
1288 register int quoted
= 0;
1291 && ((code
= SYNTAX (FETCH_CHAR (pos
- 1))) == Scharquote
1292 || code
== Sescape
))
1293 pos
--, quoted
= !quoted
;
1297 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
1298 "Scan from character number FROM by COUNT lists.\n\
1299 Returns the character number of the position thus found.\n\
1301 If DEPTH is nonzero, paren depth begins counting from that value,\n\
1302 only places where the depth in parentheses becomes zero\n\
1303 are candidates for stopping; COUNT such places are counted.\n\
1304 Thus, a positive value for DEPTH means go out levels.\n\
1306 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
1308 If the beginning or end of (the accessible part of) the buffer is reached\n\
1309 and the depth is wrong, an error is signaled.\n\
1310 If the depth is right but the count is not used up, nil is returned.")
1311 (from
, count
, depth
)
1312 Lisp_Object from
, count
, depth
;
1314 CHECK_NUMBER (from
, 0);
1315 CHECK_NUMBER (count
, 1);
1316 CHECK_NUMBER (depth
, 2);
1318 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
1321 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
1322 "Scan from character number FROM by COUNT balanced expressions.\n\
1323 If COUNT is negative, scan backwards.\n\
1324 Returns the character number of the position thus found.\n\
1326 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
1328 If the beginning or end of (the accessible part of) the buffer is reached\n\
1329 in the middle of a parenthetical grouping, an error is signaled.\n\
1330 If the beginning or end is reached between groupings\n\
1331 but before count is used up, nil is returned.")
1333 Lisp_Object from
, count
;
1335 CHECK_NUMBER (from
, 0);
1336 CHECK_NUMBER (count
, 1);
1338 return scan_lists (XINT (from
), XINT (count
), 0, 1);
1341 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
1343 "Move point backward over any number of chars with prefix syntax.\n\
1344 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
1350 while (pos
> beg
&& !char_quoted (pos
- 1)
1351 && (SYNTAX (FETCH_CHAR (pos
- 1)) == Squote
1352 || SYNTAX_PREFIX (FETCH_CHAR (pos
- 1))))
1360 /* Parse forward from FROM to END,
1361 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
1362 and return a description of the state of the parse at END.
1363 If STOPBEFORE is nonzero, stop at the start of an atom.
1364 If COMMENTSTOP is nonzero, stop at the start of a comment. */
1367 scan_sexps_forward (stateptr
, from
, end
, targetdepth
,
1368 stopbefore
, oldstate
, commentstop
)
1369 struct lisp_parse_state
*stateptr
;
1371 int end
, targetdepth
, stopbefore
;
1372 Lisp_Object oldstate
;
1375 struct lisp_parse_state state
;
1377 register enum syntaxcode code
;
1378 struct level
{ int last
, prev
; };
1379 struct level levelstart
[100];
1380 register struct level
*curlevel
= levelstart
;
1381 struct level
*endlevel
= levelstart
+ 100;
1383 register int depth
; /* Paren depth of current scanning location.
1384 level - levelstart equals this except
1385 when the depth becomes negative. */
1386 int mindepth
; /* Lowest DEPTH value seen. */
1387 int start_quoted
= 0; /* Nonzero means starting after a char quote */
1393 if (NILP (oldstate
))
1396 state
.instring
= -1;
1397 state
.incomment
= 0;
1398 state
.comstyle
= 0; /* comment style a by default */
1402 tem
= Fcar (oldstate
);
1408 oldstate
= Fcdr (oldstate
);
1409 oldstate
= Fcdr (oldstate
);
1410 oldstate
= Fcdr (oldstate
);
1411 tem
= Fcar (oldstate
);
1412 state
.instring
= !NILP (tem
) ? XINT (tem
) : -1;
1414 oldstate
= Fcdr (oldstate
);
1415 tem
= Fcar (oldstate
);
1416 state
.incomment
= !NILP (tem
);
1418 oldstate
= Fcdr (oldstate
);
1419 tem
= Fcar (oldstate
);
1420 start_quoted
= !NILP (tem
);
1422 /* if the eight element of the list is nil, we are in comment
1423 style a. if it is non-nil, we are in comment style b */
1424 oldstate
= Fcdr (oldstate
);
1425 oldstate
= Fcdr (oldstate
);
1426 tem
= Fcar (oldstate
);
1427 state
.comstyle
= !NILP (tem
);
1432 curlevel
->prev
= -1;
1433 curlevel
->last
= -1;
1435 /* Enter the loop at a place appropriate for initial state. */
1437 if (state
.incomment
) goto startincomment
;
1438 if (state
.instring
>= 0)
1440 if (start_quoted
) goto startquotedinstring
;
1443 if (start_quoted
) goto startquoted
;
1447 code
= SYNTAX (FETCH_CHAR (from
));
1449 if (code
== Scomment
)
1450 state
.comstart
= from
-1;
1452 else if (from
< end
&& SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
- 1))
1453 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
)))
1455 /* Record the comment style we have entered so that only
1456 the comment-end sequence of the same style actually
1457 terminates the comment section. */
1459 state
.comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
));
1460 state
.comstart
= from
-1;
1464 if (SYNTAX_PREFIX (FETCH_CHAR (from
- 1)))
1466 #ifdef SWITCH_ENUM_BUG
1474 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1475 curlevel
->last
= from
- 1;
1477 if (from
== end
) goto endquoted
;
1480 /* treat following character as a word constituent */
1483 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1484 curlevel
->last
= from
- 1;
1488 #ifdef SWITCH_ENUM_BUG
1489 switch ((int) SYNTAX (FETCH_CHAR (from
)))
1491 switch (SYNTAX (FETCH_CHAR (from
)))
1497 if (from
== end
) goto endquoted
;
1509 curlevel
->prev
= curlevel
->last
;
1513 state
.incomment
= 1;
1519 if (from
== end
) goto done
;
1520 prev
= FETCH_CHAR (from
);
1521 if (SYNTAX (prev
) == Sendcomment
1522 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
1523 /* Only terminate the comment section if the endcomment
1524 of the same style as the start sequence has been
1528 if (from
< end
&& SYNTAX_COMEND_FIRST (prev
)
1529 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
))
1530 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
1531 /* Only terminate the comment section if the end-comment
1532 sequence of the same style as the start sequence has
1533 been encountered. */
1536 state
.incomment
= 0;
1537 state
.comstyle
= 0; /* reset the comment style */
1541 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1543 /* curlevel++->last ran into compiler bug on Apollo */
1544 curlevel
->last
= from
- 1;
1545 if (++curlevel
== endlevel
)
1546 error ("Nesting too deep for parser");
1547 curlevel
->prev
= -1;
1548 curlevel
->last
= -1;
1549 if (!--targetdepth
) goto done
;
1554 if (depth
< mindepth
)
1556 if (curlevel
!= levelstart
)
1558 curlevel
->prev
= curlevel
->last
;
1559 if (!++targetdepth
) goto done
;
1563 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1564 curlevel
->last
= from
- 1;
1565 state
.instring
= FETCH_CHAR (from
- 1);
1569 if (from
>= end
) goto done
;
1570 if (FETCH_CHAR (from
) == state
.instring
) break;
1571 #ifdef SWITCH_ENUM_BUG
1572 switch ((int) SYNTAX (FETCH_CHAR (from
)))
1574 switch (SYNTAX (FETCH_CHAR (from
)))
1580 startquotedinstring
:
1581 if (from
>= end
) goto endquoted
;
1585 state
.instring
= -1;
1586 curlevel
->prev
= curlevel
->last
;
1596 stop
: /* Here if stopping before start of sexp. */
1597 from
--; /* We have just fetched the char that starts it; */
1598 goto done
; /* but return the position before it. */
1603 state
.depth
= depth
;
1604 state
.mindepth
= mindepth
;
1605 state
.thislevelstart
= curlevel
->prev
;
1606 state
.prevlevelstart
1607 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
1608 state
.location
= from
;
1614 /* This comment supplies the doc string for parse-partial-sexp,
1615 for make-docfile to see. We cannot put this in the real DEFUN
1616 due to limits in the Unix cpp.
1618 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
1619 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
1620 Parsing stops at TO or when certain criteria are met;\n\
1621 point is set to where parsing stops.\n\
1622 If fifth arg STATE is omitted or nil,\n\
1623 parsing assumes that FROM is the beginning of a function.\n\
1624 Value is a list of eight elements describing final state of parsing:\n\
1625 0. depth in parens.\n\
1626 1. character address of start of innermost containing list; nil if none.\n\
1627 2. character address of start of last complete sexp terminated.\n\
1628 3. non-nil if inside a string.\n\
1629 (it is the character that will terminate the string.)\n\
1630 4. t if inside a comment.\n\
1631 5. t if following a quote character.\n\
1632 6. the minimum paren-depth encountered during this scan.\n\
1633 7. t if in a comment of style `b'.\n\
1634 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
1635 in parentheses becomes equal to TARGETDEPTH.\n\
1636 Fourth arg STOPBEFORE non-nil means stop when come to\n\
1637 any character that starts a sexp.\n\
1638 Fifth arg STATE is an eight-list like what this function returns.\n\
1639 It is used to initialize the state of the parse. Its second and third
1640 elements are ignored.
1641 Sixth args COMMENTSTOP non-nil means stop at the start of a comment.")
1642 (from, to, targetdepth, stopbefore, state, commentstop)
1645 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 6, 0,
1646 0 /* See immediately above */)
1647 (from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
)
1648 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
;
1650 struct lisp_parse_state state
;
1653 if (!NILP (targetdepth
))
1655 CHECK_NUMBER (targetdepth
, 3);
1656 target
= XINT (targetdepth
);
1659 target
= -100000; /* We won't reach this depth */
1661 validate_region (&from
, &to
);
1662 scan_sexps_forward (&state
, XINT (from
), XINT (to
),
1663 target
, !NILP (stopbefore
), oldstate
,
1664 !NILP (commentstop
));
1666 SET_PT (state
.location
);
1668 return Fcons (make_number (state
.depth
),
1669 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
1670 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
1671 Fcons (state
.instring
>= 0 ? make_number (state
.instring
) : Qnil
,
1672 Fcons (state
.incomment
? Qt
: Qnil
,
1673 Fcons (state
.quoted
? Qt
: Qnil
,
1674 Fcons (make_number (state
.mindepth
),
1675 Fcons (state
.comstyle
? Qt
: Qnil
,
1682 register struct Lisp_Vector
*v
;
1684 /* Set this now, so first buffer creation can refer to it. */
1685 /* Make it nil before calling copy-syntax-table
1686 so that copy-syntax-table will know not to try to copy from garbage */
1687 Vstandard_syntax_table
= Qnil
;
1688 Vstandard_syntax_table
= Fcopy_syntax_table (Qnil
);
1690 v
= XVECTOR (Vstandard_syntax_table
);
1692 for (i
= 'a'; i
<= 'z'; i
++)
1693 XFASTINT (v
->contents
[i
]) = (int) Sword
;
1694 for (i
= 'A'; i
<= 'Z'; i
++)
1695 XFASTINT (v
->contents
[i
]) = (int) Sword
;
1696 for (i
= '0'; i
<= '9'; i
++)
1697 XFASTINT (v
->contents
[i
]) = (int) Sword
;
1698 XFASTINT (v
->contents
['$']) = (int) Sword
;
1699 XFASTINT (v
->contents
['%']) = (int) Sword
;
1701 XFASTINT (v
->contents
['(']) = (int) Sopen
+ (')' << 8);
1702 XFASTINT (v
->contents
[')']) = (int) Sclose
+ ('(' << 8);
1703 XFASTINT (v
->contents
['[']) = (int) Sopen
+ (']' << 8);
1704 XFASTINT (v
->contents
[']']) = (int) Sclose
+ ('[' << 8);
1705 XFASTINT (v
->contents
['{']) = (int) Sopen
+ ('}' << 8);
1706 XFASTINT (v
->contents
['}']) = (int) Sclose
+ ('{' << 8);
1707 XFASTINT (v
->contents
['"']) = (int) Sstring
;
1708 XFASTINT (v
->contents
['\\']) = (int) Sescape
;
1710 for (i
= 0; i
< 10; i
++)
1711 XFASTINT (v
->contents
["_-+*/&|<>="[i
]]) = (int) Ssymbol
;
1713 for (i
= 0; i
< 12; i
++)
1714 XFASTINT (v
->contents
[".,;:?!#@~^'`"[i
]]) = (int) Spunct
;
1719 Qsyntax_table_p
= intern ("syntax-table-p");
1720 staticpro (&Qsyntax_table_p
);
1722 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
1723 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
1725 words_include_escapes
= 0;
1726 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
1727 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
1729 defsubr (&Ssyntax_table_p
);
1730 defsubr (&Ssyntax_table
);
1731 defsubr (&Sstandard_syntax_table
);
1732 defsubr (&Scopy_syntax_table
);
1733 defsubr (&Sset_syntax_table
);
1734 defsubr (&Schar_syntax
);
1735 defsubr (&Smatching_paren
);
1736 defsubr (&Smodify_syntax_entry
);
1737 defsubr (&Sdescribe_syntax
);
1739 defsubr (&Sforward_word
);
1741 defsubr (&Sforward_comment
);
1742 defsubr (&Sscan_lists
);
1743 defsubr (&Sscan_sexps
);
1744 defsubr (&Sbackward_prefix_chars
);
1745 defsubr (&Sparse_partial_sexp
);