1 /* GNU Emacs routines to deal with syntax tables; also word and list parsing.
2 Copyright (C) 1985, 1987 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 1, 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 DEFUN ("syntax-table-p", Fsyntax_table_p
, Ssyntax_table_p
, 1, 1, 0,
33 "Return t if ARG is a syntax table.\n\
34 Any vector of 256 elements will do.")
38 if (XTYPE (obj
) == Lisp_Vector
&& XVECTOR (obj
)->size
== 0400)
44 check_syntax_table (obj
)
47 register Lisp_Object tem
;
48 while (tem
= Fsyntax_table_p (obj
),
50 obj
= wrong_type_argument (Qsyntax_table_p
, obj
, 0);
55 DEFUN ("syntax-table", Fsyntax_table
, Ssyntax_table
, 0, 0, 0,
56 "Return the current syntax table.\n\
57 This is the one specified by the current buffer.")
60 return current_buffer
->syntax_table
;
63 DEFUN ("standard-syntax-table", Fstandard_syntax_table
,
64 Sstandard_syntax_table
, 0, 0, 0,
65 "Return the standard syntax table.\n\
66 This is the one used for new buffers.")
69 return Vstandard_syntax_table
;
72 DEFUN ("copy-syntax-table", Fcopy_syntax_table
, Scopy_syntax_table
, 0, 1, 0,
73 "Construct a new syntax table and return it.\n\
74 It is a copy of the TABLE, which defaults to the standard syntax table.")
78 Lisp_Object size
, val
;
79 XFASTINT (size
) = 0400;
81 val
= Fmake_vector (size
, val
);
83 table
= check_syntax_table (table
);
84 else if (NILP (Vstandard_syntax_table
))
85 /* Can only be null during initialization */
87 else table
= Vstandard_syntax_table
;
89 bcopy (XVECTOR (table
)->contents
,
90 XVECTOR (val
)->contents
, 0400 * sizeof (Lisp_Object
));
94 DEFUN ("set-syntax-table", Fset_syntax_table
, Sset_syntax_table
, 1, 1, 0,
95 "Select a new syntax table for the current buffer.\n\
96 One argument, a syntax table.")
100 table
= check_syntax_table (table
);
101 current_buffer
->syntax_table
= table
;
102 /* Indicate that this buffer now has a specified syntax table. */
103 current_buffer
->local_var_flags
|= buffer_local_flags
.syntax_table
;
107 /* Convert a letter which signifies a syntax code
108 into the code it signifies.
109 This is used by modify-syntax-entry, and other things. */
111 unsigned char syntax_spec_code
[0400] =
112 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
113 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
114 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
115 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
116 (char) Swhitespace
, 0377, (char) Sstring
, 0377,
117 (char) Smath
, 0377, 0377, (char) Squote
,
118 (char) Sopen
, (char) Sclose
, 0377, 0377,
119 0377, (char) Swhitespace
, (char) Spunct
, (char) Scharquote
,
120 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
121 0377, 0377, 0377, 0377,
122 (char) Scomment
, 0377, (char) Sendcomment
, 0377,
123 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A, ... */
124 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
125 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
126 0377, 0377, 0377, 0377, (char) Sescape
, 0377, 0377, (char) Ssymbol
,
127 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
128 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
129 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
130 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377
133 /* Indexed by syntax code, give the letter that describes it. */
135 char syntax_code_spec
[13] =
137 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>'
140 DEFUN ("char-syntax", Fchar_syntax
, Schar_syntax
, 1, 1, 0,
141 "Return the syntax code of CHAR, described by a character.\n\
142 For example, if CHAR is a word constituent, the character `?w' is returned.\n\
143 The characters that correspond to various syntax codes\n\
144 are listed in the documentation of `modify-syntax-entry'.")
148 CHECK_NUMBER (ch
, 0);
149 return make_number (syntax_code_spec
[(int) SYNTAX (0xFF & XINT (ch
))]);
152 /* This comment supplies the doc string for modify-syntax-entry,
153 for make-docfile to see. We cannot put this in the real DEFUN
154 due to limits in the Unix cpp.
156 DEFUN ("modify-syntax-entry", foo, bar, 0, 0, 0,
157 "Set syntax for character CHAR according to string S.\n\
158 The syntax is changed only for table TABLE, which defaults to\n\
159 the current buffer's syntax table.\n\
160 The first character of S should be one of the following:\n\
161 Space or - whitespace syntax. w word constituent.\n\
162 _ symbol constituent. . punctuation.\n\
163 ( open-parenthesis. ) close-parenthesis.\n\
164 \" string quote. \\ escape.\n\
165 $ paired delimiter. ' expression quote or prefix operator.\n\
166 < comment starter. > comment ender.\n\
167 / character-quote.\n\
168 Only single-character comment start and end sequences are represented thus.\n\
169 Two-character sequences are represented as described below.\n\
170 The second character of S is the matching parenthesis,\n\
171 used only if the first character is `(' or `)'.\n\
172 Any additional characters are flags.\n\
173 Defined flags are the characters 1, 2, 3, 4, and p.\n\
174 1 means C is the start of a two-char comment start sequence.\n\
175 2 means C is the second character of such a sequence.\n\
176 3 means C is the start of a two-char comment end sequence.\n\
177 4 means C is the second character of such a sequence.\n\
178 p means C is a prefix character for `backward-prefix-chars';
179 such characters are treated as whitespace when they occur
180 between expressions.")
184 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry
, Smodify_syntax_entry
, 2, 3,
185 /* I really don't know why this is interactive
186 help-form should at least be made useful whilst reading the second arg
188 "cSet syntax for character: \nsSet syntax for %s to: ",
189 0 /* See immediately above */)
190 (c
, newentry
, syntax_table
)
191 Lisp_Object c
, newentry
, syntax_table
;
193 register unsigned char *p
, match
;
194 register enum syntaxcode code
;
198 CHECK_STRING (newentry
, 1);
199 if (NILP (syntax_table
))
200 syntax_table
= current_buffer
->syntax_table
;
202 syntax_table
= check_syntax_table (syntax_table
);
204 p
= XSTRING (newentry
)->data
;
205 code
= (enum syntaxcode
) syntax_spec_code
[*p
++];
206 if (((int) code
& 0377) == 0377)
207 error ("invalid syntax description letter: %c", c
);
211 if (match
== ' ') match
= 0;
213 XFASTINT (val
) = (match
<< 8) + (int) code
;
218 XFASTINT (val
) |= 1 << 16;
222 XFASTINT (val
) |= 1 << 17;
226 XFASTINT (val
) |= 1 << 18;
230 XFASTINT (val
) |= 1 << 19;
234 XFASTINT (val
) |= 1 << 20;
238 XVECTOR (syntax_table
)->contents
[0xFF & XINT (c
)] = val
;
243 /* Dump syntax table to buffer in human-readable format */
245 describe_syntax (value
)
248 register enum syntaxcode code
;
249 char desc
, match
, start1
, start2
, end1
, end2
, prefix
;
252 Findent_to (make_number (16), make_number (1));
254 if (XTYPE (value
) != Lisp_Int
)
256 insert_string ("invalid");
260 code
= (enum syntaxcode
) (XINT (value
) & 0377);
261 match
= (XINT (value
) >> 8) & 0377;
262 start1
= (XINT (value
) >> 16) & 1;
263 start2
= (XINT (value
) >> 17) & 1;
264 end1
= (XINT (value
) >> 18) & 1;
265 end2
= (XINT (value
) >> 19) & 1;
266 prefix
= (XINT (value
) >> 20) & 1;
268 if ((int) code
< 0 || (int) code
>= (int) Smax
)
270 insert_string ("invalid");
273 desc
= syntax_code_spec
[(int) code
];
275 str
[0] = desc
, str
[1] = 0;
278 str
[0] = match
? match
: ' ';
295 insert_string ("\twhich means: ");
297 #ifdef SWITCH_ENUM_BUG
304 insert_string ("whitespace"); break;
306 insert_string ("punctuation"); break;
308 insert_string ("word"); break;
310 insert_string ("symbol"); break;
312 insert_string ("open"); break;
314 insert_string ("close"); break;
316 insert_string ("quote"); break;
318 insert_string ("string"); break;
320 insert_string ("math"); break;
322 insert_string ("escape"); break;
324 insert_string ("charquote"); break;
326 insert_string ("comment"); break;
328 insert_string ("endcomment"); break;
330 insert_string ("invalid");
336 insert_string (", matches ");
338 str
[0] = match
, str
[1] = 0;
343 insert_string (",\n\t is the first character of a comment-start sequence");
345 insert_string (",\n\t is the second character of a comment-start sequence");
348 insert_string (",\n\t is the first character of a comment-end sequence");
350 insert_string (",\n\t is the second character of a comment-end sequence");
352 insert_string (",\n\t is a prefix character for `backward-prefix-chars'");
354 insert_string ("\n");
358 describe_syntax_1 (vector
)
361 struct buffer
*old
= current_buffer
;
362 set_buffer_internal (XBUFFER (Vstandard_output
));
363 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
);
364 set_buffer_internal (old
);
368 DEFUN ("describe-syntax", Fdescribe_syntax
, Sdescribe_syntax
, 0, 0, "",
369 "Describe the syntax specifications in the syntax table.\n\
370 The descriptions are inserted in a buffer, which is then displayed.")
373 internal_with_output_to_temp_buffer
374 ("*Help*", describe_syntax_1
, current_buffer
->syntax_table
);
379 /* Return the position across COUNT words from FROM.
380 If that many words cannot be found before the end of the buffer, return 0.
381 COUNT negative means scan backward and stop at word beginning. */
383 scan_words (from
, count
)
384 register int from
, count
;
386 register int beg
= BEGV
;
387 register int end
= ZV
;
402 code
= SYNTAX (FETCH_CHAR (from
));
403 if (words_include_escapes
404 && (code
== Sescape
|| code
== Scharquote
))
412 if (from
== end
) break;
413 code
= SYNTAX (FETCH_CHAR (from
));
414 if (!(words_include_escapes
415 && (code
== Sescape
|| code
== Scharquote
)))
431 code
= SYNTAX (FETCH_CHAR (from
- 1));
432 if (words_include_escapes
433 && (code
== Sescape
|| code
== Scharquote
))
441 if (from
== beg
) break;
442 code
= SYNTAX (FETCH_CHAR (from
- 1));
443 if (!(words_include_escapes
444 && (code
== Sescape
|| code
== Scharquote
)))
457 DEFUN ("forward-word", Fforward_word
, Sforward_word
, 1, 1, "p",
458 "Move point forward ARG words (backward if ARG is negative).\n\
459 Normally returns t.\n\
460 If an edge of the buffer is reached, point is left there\n\
461 and nil is returned.")
466 CHECK_NUMBER (count
, 0);
468 if (!(val
= scan_words (point
, XINT (count
))))
470 SET_PT (XINT (count
) > 0 ? ZV
: BEGV
);
477 int parse_sexp_ignore_comments
;
480 scan_lists (from
, count
, depth
, sexpflag
)
482 int count
, depth
, sexpflag
;
490 register enum syntaxcode code
;
491 int min_depth
= depth
; /* Err out if depth gets less than this. */
493 if (depth
> 0) min_depth
= 0;
503 c
= FETCH_CHAR (from
);
506 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
507 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
))
508 && parse_sexp_ignore_comments
)
509 code
= Scomment
, from
++;
510 if (SYNTAX_PREFIX (c
))
513 #ifdef SWITCH_ENUM_BUG
521 if (from
== stop
) goto lose
;
523 /* treat following character as a word constituent */
526 if (depth
|| !sexpflag
) break;
527 /* This word counts as a sexp; return at end of it. */
530 #ifdef SWITCH_ENUM_BUG
531 switch ((int) SYNTAX(FETCH_CHAR (from
)))
533 switch (SYNTAX(FETCH_CHAR (from
)))
539 if (from
== stop
) goto lose
;
553 if (!parse_sexp_ignore_comments
) break;
556 if (from
== stop
) goto done
;
557 if (SYNTAX (c
= FETCH_CHAR (from
)) == Sendcomment
)
560 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
561 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
)))
569 if (from
!= stop
&& c
== FETCH_CHAR (from
))
579 if (!++depth
) goto done
;
584 if (!--depth
) goto done
;
585 if (depth
< min_depth
)
586 error ("Containing expression ends prematurely");
590 stringterm
= FETCH_CHAR (from
- 1);
593 if (from
>= stop
) goto lose
;
594 if (FETCH_CHAR (from
) == stringterm
) break;
595 #ifdef SWITCH_ENUM_BUG
596 switch ((int) SYNTAX(FETCH_CHAR (from
)))
598 switch (SYNTAX(FETCH_CHAR (from
)))
608 if (!depth
&& sexpflag
) goto done
;
613 /* Reached end of buffer. Error if within object, return nil if between */
614 if (depth
) goto lose
;
619 /* End of object reached */
630 if (quoted
= char_quoted (from
))
632 c
= FETCH_CHAR (from
);
634 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
635 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1))
636 && !char_quoted (from
- 1)
637 && parse_sexp_ignore_comments
)
638 code
= Sendcomment
, from
--;
639 if (SYNTAX_PREFIX (c
))
642 #ifdef SWITCH_ENUM_BUG
643 switch ((int) (quoted
? Sword
: code
))
645 switch (quoted
? Sword
: code
)
650 if (depth
|| !sexpflag
) break;
651 /* This word counts as a sexp; count object finished after passing it. */
654 quoted
= char_quoted (from
- 1);
657 if (! (quoted
|| SYNTAX(FETCH_CHAR (from
- 1)) == Sword
658 || SYNTAX(FETCH_CHAR (from
- 1)) == Ssymbol
659 || SYNTAX(FETCH_CHAR (from
- 1)) == Squote
))
668 if (from
!= stop
&& c
== FETCH_CHAR (from
- 1))
678 if (!++depth
) goto done2
;
683 if (!--depth
) goto done2
;
684 if (depth
< min_depth
)
685 error ("Containing expression ends prematurely");
689 if (!parse_sexp_ignore_comments
)
691 /* Look back, counting the parity of string-quotes,
692 and recording the comment-starters seen.
693 When we reach a safe place, assume that's not in a string;
694 then step the main scan to the earliest comment-starter seen
695 an even number of string quotes away from the safe place.
697 OFROM[I] is position of the earliest comment-starter seen
698 which is I+2X quotes from the comment-end.
699 PARITY is current parity of quotes from the comment end. */
704 ofrom
[0] = ofrom
[1] = from
;
706 /* At beginning of range to scan, we're outside of strings;
707 that determines quote parity to the comment-end. */
710 /* Move back and examine a character. */
713 c
= FETCH_CHAR (from
);
716 /* If this char is the second of a 2-char comment sequence,
717 back up and give the pair the appropriate syntax. */
718 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
719 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1)))
720 code
= Sendcomment
, from
--;
721 else if (from
> stop
&& SYNTAX_COMSTART_SECOND (c
)
722 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
- 1)))
723 code
= Scomment
, from
--;
725 /* Ignore escaped characters. */
726 if (char_quoted (from
))
729 /* Track parity of quotes between here and comment-end. */
733 /* Record comment-starters according to that
734 quote-parity to the comment-end. */
735 if (code
== Scomment
)
736 ofrom
[parity
] = from
;
738 /* If we come to another comment-end,
739 assume it's not inside a string.
740 That determines the quote parity to the comment-end. */
741 if (code
== Sendcomment
)
744 from
= ofrom
[parity
];
749 stringterm
= FETCH_CHAR (from
);
752 if (from
== stop
) goto lose
;
753 if (!char_quoted (from
- 1)
754 && stringterm
== FETCH_CHAR (from
- 1))
759 if (!depth
&& sexpflag
) goto done2
;
764 /* Reached start of buffer. Error if within object, return nil if between */
765 if (depth
) goto lose
;
776 XFASTINT (val
) = from
;
780 error ("Unbalanced parentheses");
787 register enum syntaxcode code
;
788 register int beg
= BEGV
;
789 register int quoted
= 0;
792 && ((code
= SYNTAX (FETCH_CHAR (pos
- 1))) == Scharquote
794 pos
--, quoted
= !quoted
;
798 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
799 "Scan from character number FROM by COUNT lists.\n\
800 Returns the character number of the position thus found.\n\
802 If DEPTH is nonzero, paren depth begins counting from that value,\n\
803 only places where the depth in parentheses becomes zero\n\
804 are candidates for stopping; COUNT such places are counted.\n\
805 Thus, a positive value for DEPTH means go out levels.\n\
807 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
809 If the beginning or end of (the accessible part of) the buffer is reached\n\
810 and the depth is wrong, an error is signaled.\n\
811 If the depth is right but the count is not used up, nil is returned.")
813 Lisp_Object from
, count
, depth
;
815 CHECK_NUMBER (from
, 0);
816 CHECK_NUMBER (count
, 1);
817 CHECK_NUMBER (depth
, 2);
819 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
822 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
823 "Scan from character number FROM by COUNT balanced expressions.\n\
824 If COUNT is negative, scan backwards.\n\
825 Returns the character number of the position thus found.\n\
827 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
829 If the beginning or end of (the accessible part of) the buffer is reached\n\
830 in the middle of a parenthetical grouping, an error is signaled.\n\
831 If the beginning or end is reached between groupings\n\
832 but before count is used up, nil is returned.")
834 Lisp_Object from
, count
;
836 CHECK_NUMBER (from
, 0);
837 CHECK_NUMBER (count
, 1);
839 return scan_lists (XINT (from
), XINT (count
), 0, 1);
842 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
844 "Move point backward over any number of chars with prefix syntax.\n\
845 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
851 while (pos
> beg
&& !char_quoted (pos
- 1)
852 && (SYNTAX (FETCH_CHAR (pos
- 1)) == Squote
853 || SYNTAX_PREFIX (FETCH_CHAR (pos
- 1))))
861 struct lisp_parse_state
863 int depth
; /* Depth at end of parsing */
864 int instring
; /* -1 if not within string, else desired terminator. */
865 int incomment
; /* Nonzero if within a comment at end of parsing */
866 int quoted
; /* Nonzero if just after an escape char at end of parsing */
867 int thislevelstart
; /* Char number of most recent start-of-expression at current level */
868 int prevlevelstart
; /* Char number of start of containing expression */
869 int location
; /* Char number at which parsing stopped. */
870 int mindepth
; /* Minimum depth seen while scanning. */
873 /* Parse forward from FROM to END,
874 assuming that FROM is the start of a function,
875 and return a description of the state of the parse at END. */
877 struct lisp_parse_state val_scan_sexps_forward
;
879 struct lisp_parse_state
*
880 scan_sexps_forward (from
, end
, targetdepth
, stopbefore
, oldstate
)
882 int end
, targetdepth
, stopbefore
;
883 Lisp_Object oldstate
;
885 struct lisp_parse_state state
;
887 register enum syntaxcode code
;
888 struct level
{ int last
, prev
; };
889 struct level levelstart
[100];
890 register struct level
*curlevel
= levelstart
;
891 struct level
*endlevel
= levelstart
+ 100;
893 register int depth
; /* Paren depth of current scanning location.
894 level - levelstart equals this except
895 when the depth becomes negative. */
896 int mindepth
; /* Lowest DEPTH value seen. */
897 int start_quoted
= 0; /* Nonzero means starting after a char quote */
911 tem
= Fcar (oldstate
);
917 oldstate
= Fcdr (oldstate
);
918 oldstate
= Fcdr (oldstate
);
919 oldstate
= Fcdr (oldstate
);
920 tem
= Fcar (oldstate
);
921 state
.instring
= !NILP (tem
) ? XINT (tem
) : -1;
923 oldstate
= Fcdr (oldstate
);
924 tem
= Fcar (oldstate
);
925 state
.incomment
= !NILP (tem
);
927 oldstate
= Fcdr (oldstate
);
928 tem
= Fcar (oldstate
);
929 start_quoted
= !NILP (tem
);
937 /* Enter the loop at a place appropriate for initial state. */
939 if (state
.incomment
) goto startincomment
;
940 if (state
.instring
>= 0)
942 if (start_quoted
) goto startquotedinstring
;
945 if (start_quoted
) goto startquoted
;
949 code
= SYNTAX(FETCH_CHAR (from
));
951 if (from
< end
&& SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
- 1))
952 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
)))
953 code
= Scomment
, from
++;
954 if (SYNTAX_PREFIX (FETCH_CHAR (from
- 1)))
956 #ifdef SWITCH_ENUM_BUG
964 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
965 curlevel
->last
= from
- 1;
967 if (from
== end
) goto endquoted
;
970 /* treat following character as a word constituent */
973 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
974 curlevel
->last
= from
- 1;
978 #ifdef SWITCH_ENUM_BUG
979 switch ((int) SYNTAX(FETCH_CHAR (from
)))
981 switch (SYNTAX(FETCH_CHAR (from
)))
987 if (from
== end
) goto endquoted
;
999 curlevel
->prev
= curlevel
->last
;
1003 state
.incomment
= 1;
1007 if (from
== end
) goto done
;
1008 if (SYNTAX (prev
= FETCH_CHAR (from
)) == Sendcomment
)
1011 if (from
< end
&& SYNTAX_COMEND_FIRST (prev
)
1012 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
)))
1015 state
.incomment
= 0;
1019 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1021 /* curlevel++->last ran into compiler bug on Apollo */
1022 curlevel
->last
= from
- 1;
1023 if (++curlevel
== endlevel
)
1024 error ("Nesting too deep for parser");
1025 curlevel
->prev
= -1;
1026 curlevel
->last
= -1;
1027 if (!--targetdepth
) goto done
;
1032 if (depth
< mindepth
)
1034 if (curlevel
!= levelstart
)
1036 curlevel
->prev
= curlevel
->last
;
1037 if (!++targetdepth
) goto done
;
1041 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
1042 curlevel
->last
= from
- 1;
1043 state
.instring
= FETCH_CHAR (from
- 1);
1047 if (from
>= end
) goto done
;
1048 if (FETCH_CHAR (from
) == state
.instring
) break;
1049 #ifdef SWITCH_ENUM_BUG
1050 switch ((int) SYNTAX(FETCH_CHAR (from
)))
1052 switch (SYNTAX(FETCH_CHAR (from
)))
1058 startquotedinstring
:
1059 if (from
>= end
) goto endquoted
;
1063 state
.instring
= -1;
1064 curlevel
->prev
= curlevel
->last
;
1074 stop
: /* Here if stopping before start of sexp. */
1075 from
--; /* We have just fetched the char that starts it; */
1076 goto done
; /* but return the position before it. */
1081 state
.depth
= depth
;
1082 state
.mindepth
= mindepth
;
1083 state
.thislevelstart
= curlevel
->prev
;
1084 state
.prevlevelstart
1085 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
1086 state
.location
= from
;
1089 val_scan_sexps_forward
= state
;
1090 return &val_scan_sexps_forward
;
1093 /* This comment supplies the doc string for parse-partial-sexp,
1094 for make-docfile to see. We cannot put this in the real DEFUN
1095 due to limits in the Unix cpp.
1097 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 0, 0, 0,
1098 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
1099 Parsing stops at TO or when certain criteria are met;\n\
1100 point is set to where parsing stops.\n\
1101 If fifth arg STATE is omitted or nil,\n\
1102 parsing assumes that FROM is the beginning of a function.\n\
1103 Value is a list of seven elements describing final state of parsing:\n\
1104 1. depth in parens.\n\
1105 2. character address of start of innermost containing list; nil if none.\n\
1106 3. character address of start of last complete sexp terminated.\n\
1107 4. non-nil if inside a string.\n\
1108 (it is the character that will terminate the string.)\n\
1109 5. t if inside a comment.\n\
1110 6. t if following a quote character.\n\
1111 7. the minimum paren-depth encountered during this scan.\n\
1112 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
1113 in parentheses becomes equal to TARGETDEPTH.\n\
1114 Fourth arg STOPBEFORE non-nil means stop when come to\n\
1115 any character that starts a sexp.\n\
1116 Fifth arg STATE is a seven-list like what this function returns.\n\
1117 It is used to initialize the state of the parse.")
1121 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 5, 0,
1122 0 /* See immediately above */)
1123 (from
, to
, targetdepth
, stopbefore
, oldstate
)
1124 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
;
1126 struct lisp_parse_state state
;
1129 if (!NILP (targetdepth
))
1131 CHECK_NUMBER (targetdepth
, 3);
1132 target
= XINT (targetdepth
);
1135 target
= -100000; /* We won't reach this depth */
1137 validate_region (&from
, &to
);
1138 state
= *scan_sexps_forward (XINT (from
), XINT (to
),
1139 target
, !NILP (stopbefore
), oldstate
);
1141 SET_PT (state
.location
);
1143 return Fcons (make_number (state
.depth
),
1144 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
1145 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
1146 Fcons (state
.instring
>= 0 ? make_number (state
.instring
) : Qnil
,
1147 Fcons (state
.incomment
? Qt
: Qnil
,
1148 Fcons (state
.quoted
? Qt
: Qnil
,
1149 Fcons (make_number (state
.mindepth
), Qnil
)))))));
1155 register struct Lisp_Vector
*v
;
1157 /* Set this now, so first buffer creation can refer to it. */
1158 /* Make it nil before calling copy-syntax-table
1159 so that copy-syntax-table will know not to try to copy from garbage */
1160 Vstandard_syntax_table
= Qnil
;
1161 Vstandard_syntax_table
= Fcopy_syntax_table (Qnil
);
1163 v
= XVECTOR (Vstandard_syntax_table
);
1165 for (i
= 'a'; i
<= 'z'; i
++)
1166 XFASTINT (v
->contents
[i
]) = (int) Sword
;
1167 for (i
= 'A'; i
<= 'Z'; i
++)
1168 XFASTINT (v
->contents
[i
]) = (int) Sword
;
1169 for (i
= '0'; i
<= '9'; i
++)
1170 XFASTINT (v
->contents
[i
]) = (int) Sword
;
1171 XFASTINT (v
->contents
['$']) = (int) Sword
;
1172 XFASTINT (v
->contents
['%']) = (int) Sword
;
1174 XFASTINT (v
->contents
['(']) = (int) Sopen
+ (')' << 8);
1175 XFASTINT (v
->contents
[')']) = (int) Sclose
+ ('(' << 8);
1176 XFASTINT (v
->contents
['[']) = (int) Sopen
+ (']' << 8);
1177 XFASTINT (v
->contents
[']']) = (int) Sclose
+ ('[' << 8);
1178 XFASTINT (v
->contents
['{']) = (int) Sopen
+ ('}' << 8);
1179 XFASTINT (v
->contents
['}']) = (int) Sclose
+ ('{' << 8);
1180 XFASTINT (v
->contents
['"']) = (int) Sstring
;
1181 XFASTINT (v
->contents
['\\']) = (int) Sescape
;
1183 for (i
= 0; i
< 10; i
++)
1184 XFASTINT (v
->contents
["_-+*/&|<>="[i
]]) = (int) Ssymbol
;
1186 for (i
= 0; i
< 12; i
++)
1187 XFASTINT (v
->contents
[".,;:?!#@~^'`"[i
]]) = (int) Spunct
;
1192 Qsyntax_table_p
= intern ("syntax-table-p");
1193 staticpro (&Qsyntax_table_p
);
1195 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
1196 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
1198 words_include_escapes
= 0;
1199 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
1200 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
1202 defsubr (&Ssyntax_table_p
);
1203 defsubr (&Ssyntax_table
);
1204 defsubr (&Sstandard_syntax_table
);
1205 defsubr (&Scopy_syntax_table
);
1206 defsubr (&Sset_syntax_table
);
1207 defsubr (&Schar_syntax
);
1208 defsubr (&Smodify_syntax_entry
);
1209 defsubr (&Sdescribe_syntax
);
1211 defsubr (&Sforward_word
);
1213 defsubr (&Sscan_lists
);
1214 defsubr (&Sscan_sexps
);
1215 defsubr (&Sbackward_prefix_chars
);
1216 defsubr (&Sparse_partial_sexp
);