1 /* GNU Emacs routines to deal with syntax tables; also word and list parsing.
2 Copyright (C) 1985, 87, 93, 94, 95, 97, 1998 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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
29 /* Make syntax table lookup grant data in gl_state. */
30 #define SYNTAX_ENTRY_VIA_PROPERTY
33 #include "intervals.h"
35 /* We use these constants in place for comment-style and
36 string-ender-char to distinguish comments/strings started by
37 comment_fence and string_fence codes. */
39 #define ST_COMMENT_STYLE (256 + 1)
40 #define ST_STRING_STYLE (256 + 2)
43 Lisp_Object Qsyntax_table_p
, Qsyntax_table
, Qscan_error
;
45 int words_include_escapes
;
46 int parse_sexp_lookup_properties
;
48 /* Used as a temporary in SYNTAX_ENTRY and other macros in syntax.h,
49 if not compiled with GCC. No need to mark it, since it is used
50 only very temporarily. */
51 Lisp_Object syntax_temp
;
53 /* This is the internal form of the parse state used in parse-partial-sexp. */
55 struct lisp_parse_state
57 int depth
; /* Depth at end of parsing. */
58 int instring
; /* -1 if not within string, else desired terminator. */
59 int incomment
; /* Nonzero if within a comment at end of parsing. */
60 int comstyle
; /* comment style a=0, or b=1, or ST_COMMENT_STYLE. */
61 int quoted
; /* Nonzero if just after an escape char at end of parsing */
62 int thislevelstart
; /* Char number of most recent start-of-expression at current level */
63 int prevlevelstart
; /* Char number of start of containing expression */
64 int location
; /* Char number at which parsing stopped. */
65 int mindepth
; /* Minimum depth seen while scanning. */
66 int comstr_start
; /* Position just after last comment/string starter. */
69 /* These variables are a cache for finding the start of a defun.
70 find_start_pos is the place for which the defun start was found.
71 find_start_value is the defun start position found for it.
72 find_start_value_byte is the corresponding byte position.
73 find_start_buffer is the buffer it was found in.
74 find_start_begv is the BEGV value when it was found.
75 find_start_modiff is the value of MODIFF when it was found. */
77 static int find_start_pos
;
78 static int find_start_value
;
79 static int find_start_value_byte
;
80 static struct buffer
*find_start_buffer
;
81 static int find_start_begv
;
82 static int find_start_modiff
;
85 static int find_defun_start
P_ ((int, int));
86 static int back_comment
P_ ((int, int, int, int, int *, int *));
87 static int char_quoted
P_ ((int, int));
88 static Lisp_Object skip_chars
P_ ((int, int, Lisp_Object
, Lisp_Object
));
89 static Lisp_Object scan_lists
P_ ((int, int, int, int));
90 static void scan_sexps_forward
P_ ((struct lisp_parse_state
*,
92 int, Lisp_Object
, int));
95 struct gl_state_s gl_state
; /* Global state of syntax parser. */
97 INTERVAL
interval_of ();
98 #define INTERVALS_AT_ONCE 10 /* 1 + max-number of intervals
99 to scan to property-change. */
101 /* Update gl_state to an appropriate interval which contains CHARPOS. The
102 sign of COUNT give the relative position of CHARPOS wrt the previously
103 valid interval. If INIT, only [be]_property fields of gl_state are
104 valid at start, the rest is filled basing on OBJECT.
106 `gl_state.*_i' are the intervals, and CHARPOS is further in the search
107 direction than the intervals - or in an interval. We update the
108 current syntax-table basing on the property of this interval, and
109 update the interval to start further than CHARPOS - or be
110 NULL_INTERVAL. We also update lim_property to be the next value of
111 charpos to call this subroutine again - or be before/after the
112 start/end of OBJECT. */
115 update_syntax_table (charpos
, count
, init
, object
)
116 int charpos
, count
, init
;
119 Lisp_Object tmp_table
;
120 int cnt
= 0, doing_extra
= 0, invalidate
= 1;
125 gl_state
.start
= gl_state
.b_property
;
126 gl_state
.stop
= gl_state
.e_property
;
127 gl_state
.forward_i
= interval_of (charpos
, object
);
128 i
= gl_state
.backward_i
= gl_state
.forward_i
;
129 gl_state
.left_ok
= gl_state
.right_ok
= 1;
131 if (NULL_INTERVAL_P (i
))
133 /* interval_of () updates only ->position of the return value,
134 update the parents manually to speed up update_interval. */
135 while (!NULL_PARENT (i
))
137 if (AM_RIGHT_CHILD (i
))
138 i
->parent
->position
= i
->position
139 - LEFT_TOTAL_LENGTH (i
) + TOTAL_LENGTH (i
) /* right end */
140 - TOTAL_LENGTH (i
->parent
)
141 + LEFT_TOTAL_LENGTH (i
->parent
);
143 i
->parent
->position
= i
->position
- LEFT_TOTAL_LENGTH (i
)
147 i
= gl_state
.forward_i
;
148 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
149 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
152 oldi
= i
= count
> 0 ? gl_state
.forward_i
: gl_state
.backward_i
;
154 /* We are guarantied to be called with CHARPOS either in i,
156 if (NULL_INTERVAL_P (i
))
157 error ("Error in syntax_table logic for to-the-end intervals");
158 else if (charpos
< i
->position
) /* Move left. */
161 error ("Error in syntax_table logic for intervals <-.");
162 /* Update the interval. */
163 i
= update_interval (i
, charpos
);
164 if (oldi
->position
!= INTERVAL_LAST_POS (i
))
167 gl_state
.right_ok
= 1; /* Invalidate the other end. */
168 gl_state
.forward_i
= i
;
169 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
172 else if (charpos
>= INTERVAL_LAST_POS (i
)) /* Move right. */
175 error ("Error in syntax_table logic for intervals ->.");
176 /* Update the interval. */
177 i
= update_interval (i
, charpos
);
178 if (i
->position
!= INTERVAL_LAST_POS (oldi
))
181 gl_state
.left_ok
= 1; /* Invalidate the other end. */
182 gl_state
.backward_i
= i
;
183 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
186 else if (count
> 0 ? gl_state
.right_ok
: gl_state
.left_ok
)
188 /* We do not need to recalculate tmp_table. */
189 tmp_table
= gl_state
.old_prop
;
193 tmp_table
= textget (i
->plist
, Qsyntax_table
);
196 invalidate
= !EQ (tmp_table
, gl_state
.old_prop
); /* Need to invalidate? */
198 if (invalidate
) /* Did not get to adjacent interval. */
199 { /* with the same table => */
200 /* invalidate the old range. */
203 gl_state
.backward_i
= i
;
204 gl_state
.left_ok
= 1; /* Invalidate the other end. */
205 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
209 gl_state
.forward_i
= i
;
210 gl_state
.right_ok
= 1; /* Invalidate the other end. */
211 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
215 gl_state
.current_syntax_table
= tmp_table
;
216 gl_state
.old_prop
= tmp_table
;
217 if (EQ (Fsyntax_table_p (tmp_table
), Qt
))
219 gl_state
.use_global
= 0;
221 else if (CONSP (tmp_table
))
223 gl_state
.use_global
= 1;
224 gl_state
.global_code
= tmp_table
;
228 gl_state
.use_global
= 0;
229 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
232 while (!NULL_INTERVAL_P (i
))
234 if (cnt
&& !EQ (tmp_table
, textget (i
->plist
, Qsyntax_table
)))
237 gl_state
.right_ok
= 0;
239 gl_state
.left_ok
= 0;
242 else if (cnt
== INTERVALS_AT_ONCE
)
245 gl_state
.right_ok
= 1;
247 gl_state
.left_ok
= 1;
251 i
= count
> 0 ? next_interval (i
) : previous_interval (i
);
253 if (NULL_INTERVAL_P (i
))
254 { /* This property goes to the end. */
256 gl_state
.e_property
= gl_state
.stop
;
258 gl_state
.b_property
= gl_state
.start
;
264 gl_state
.e_property
= i
->position
- gl_state
.offset
;
265 gl_state
.forward_i
= i
;
269 gl_state
.b_property
= i
->position
+ LENGTH (i
) - 1 - gl_state
.offset
;
270 gl_state
.backward_i
= i
;
275 /* Returns TRUE if char at CHARPOS is quoted.
276 Global syntax-table data should be set up already to be good at CHARPOS
277 or after. On return global syntax data is good for lookup at CHARPOS. */
280 char_quoted (charpos
, bytepos
)
281 register int charpos
, bytepos
;
283 register enum syntaxcode code
;
284 register int beg
= BEGV
;
285 register int quoted
= 0;
288 DEC_BOTH (charpos
, bytepos
);
290 while (bytepos
>= beg
)
292 UPDATE_SYNTAX_TABLE_BACKWARD (charpos
);
293 code
= SYNTAX (FETCH_CHAR (bytepos
));
294 if (! (code
== Scharquote
|| code
== Sescape
))
297 DEC_BOTH (charpos
, bytepos
);
301 UPDATE_SYNTAX_TABLE (orig
);
305 /* Return the bytepos one character after BYTEPOS.
306 We assume that BYTEPOS is not at the end of the buffer. */
309 inc_bytepos (bytepos
)
312 if (NILP (current_buffer
->enable_multibyte_characters
))
319 /* Return the bytepos one character before BYTEPOS.
320 We assume that BYTEPOS is not at the start of the buffer. */
323 dec_bytepos (bytepos
)
326 if (NILP (current_buffer
->enable_multibyte_characters
))
333 /* Find a defun-start that is the last one before POS (or nearly the last).
334 We record what we find, so that another call in the same area
335 can return the same value right away.
337 There is no promise at which position the global syntax data is
338 valid on return from the subroutine, so the caller should explicitly
339 update the global data. */
342 find_defun_start (pos
, pos_byte
)
347 int opoint
= PT
, opoint_byte
= PT_BYTE
;
349 /* Use previous finding, if it's valid and applies to this inquiry. */
350 if (current_buffer
== find_start_buffer
351 /* Reuse the defun-start even if POS is a little farther on.
352 POS might be in the next defun, but that's ok.
353 Our value may not be the best possible, but will still be usable. */
354 && pos
<= find_start_pos
+ 1000
355 && pos
>= find_start_value
356 && BEGV
== find_start_begv
357 && MODIFF
== find_start_modiff
)
358 return find_start_value
;
360 /* Back up to start of line. */
361 scan_newline (pos
, pos_byte
, BEGV
, BEGV_BYTE
, -1, 1);
363 /* We optimize syntax-table lookup for rare updates. Thus we accept
364 only those `^\s(' which are good in global _and_ text-property
366 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
367 gl_state
.use_global
= 0;
370 /* Open-paren at start of line means we found our defun-start. */
371 if (SYNTAX (FETCH_CHAR (PT_BYTE
)) == Sopen
)
373 SETUP_SYNTAX_TABLE (PT
+ 1, -1); /* Try again... */
374 if (SYNTAX (FETCH_CHAR (PT_BYTE
)) == Sopen
)
376 /* Now fallback to the default value. */
377 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
378 gl_state
.use_global
= 0;
380 /* Move to beg of previous line. */
381 scan_newline (PT
, PT_BYTE
, BEGV
, BEGV_BYTE
, -2, 1);
384 /* Record what we found, for the next try. */
385 find_start_value
= PT
;
386 find_start_value_byte
= PT_BYTE
;
387 find_start_buffer
= current_buffer
;
388 find_start_modiff
= MODIFF
;
389 find_start_begv
= BEGV
;
390 find_start_pos
= pos
;
392 TEMP_SET_PT_BOTH (opoint
, opoint_byte
);
394 return find_start_value
;
397 /* Checks whether charpos FROM is at the end of a comment.
398 FROM_BYTE is the bytepos corresponding to FROM.
399 Do not move back before STOP.
401 Return a positive value if we find a comment ending at FROM/FROM_BYTE;
404 If successful, store the charpos of the comment's beginning
405 into *CHARPOS_PTR, and the bytepos into *BYTEPOS_PTR.
407 Global syntax data remains valid for backward search starting at
408 the returned value (or at FROM, if the search was not successful). */
411 back_comment (from
, from_byte
, stop
, comstyle
, charpos_ptr
, bytepos_ptr
)
412 int from
, from_byte
, stop
;
414 int *charpos_ptr
, *bytepos_ptr
;
416 /* Look back, counting the parity of string-quotes,
417 and recording the comment-starters seen.
418 When we reach a safe place, assume that's not in a string;
419 then step the main scan to the earliest comment-starter seen
420 an even number of string quotes away from the safe place.
422 OFROM[I] is position of the earliest comment-starter seen
423 which is I+2X quotes from the comment-end.
424 PARITY is current parity of quotes from the comment end. */
426 int my_stringend
= 0;
427 int string_lossage
= 0;
428 int comment_end
= from
;
429 int comment_end_byte
= from_byte
;
430 int comstart_pos
= 0;
432 /* Value that PARITY had, when we reached the position
434 int comstart_parity
= 0;
435 int scanstart
= from
- 1;
436 /* Place where the containing defun starts,
437 or 0 if we didn't come across it yet. */
439 int defun_start_byte
= 0;
440 register enum syntaxcode code
;
443 /* At beginning of range to scan, we're outside of strings;
444 that determines quote parity to the comment-end. */
449 /* Move back and examine a character. */
450 DEC_BOTH (from
, from_byte
);
451 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
453 c
= FETCH_CHAR (from_byte
);
456 /* If this char is the second of a 2-char comment end sequence,
457 back up and give the pair the appropriate syntax. */
458 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
459 && (temp_byte
= dec_bytepos (from_byte
),
460 SYNTAX_COMEND_FIRST (FETCH_CHAR (temp_byte
))))
463 DEC_BOTH (from
, from_byte
);
464 /* This is apparently the best we can do: */
465 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
466 c
= FETCH_CHAR (from_byte
);
469 /* If this char starts a 2-char comment start sequence,
470 treat it like a 1-char comment starter. */
471 if (from
< scanstart
&& SYNTAX_COMSTART_FIRST (c
)
472 && (temp_byte
= inc_bytepos (from_byte
),
473 (SYNTAX_COMSTART_SECOND (FETCH_CHAR (temp_byte
))
474 && comstyle
== SYNTAX_COMMENT_STYLE (FETCH_CHAR (temp_byte
)))))
477 /* Ignore escaped characters, except comment-enders. */
478 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
481 /* Track parity of quotes. */
485 if (my_stringend
== 0)
487 /* If we have two kinds of string delimiters.
488 There's no way to grok this scanning backwards. */
489 else if (my_stringend
!= c
)
493 if (code
== Sstring_fence
|| code
== Scomment_fence
)
496 if (my_stringend
== 0)
498 = code
== Sstring_fence
? ST_STRING_STYLE
: ST_COMMENT_STYLE
;
499 /* If we have two kinds of string delimiters.
500 There's no way to grok this scanning backwards. */
501 else if (my_stringend
!= (code
== Sstring_fence
502 ? ST_STRING_STYLE
: ST_COMMENT_STYLE
))
506 /* Record comment-starters according to that
507 quote-parity to the comment-end. */
508 if (code
== Scomment
)
510 comstart_parity
= parity
;
512 comstart_byte
= from_byte
;
515 /* If we find another earlier comment-ender,
516 any comment-starts earlier than that don't count
517 (because they go with the earlier comment-ender). */
518 if (code
== Sendcomment
519 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)) == comstyle
)
522 /* Assume a defun-start point is outside of strings. */
525 || (temp_byte
= dec_bytepos (from_byte
),
526 FETCH_CHAR (temp_byte
) == '\n')))
529 defun_start_byte
= from_byte
;
534 if (comstart_pos
== 0)
537 from_byte
= comment_end_byte
;
538 UPDATE_SYNTAX_TABLE_FORWARD (comment_end
- 1);
540 /* If the earliest comment starter
541 is followed by uniform paired string quotes or none,
542 we know it can't be inside a string
543 since if it were then the comment ender would be inside one.
544 So it does start a comment. Skip back to it. */
545 else if (comstart_parity
== 0 && !string_lossage
)
548 from_byte
= comstart_byte
;
549 /* Globals are correct now. */
553 /* We had two kinds of string delimiters mixed up
554 together. Decode this going forwards.
555 Scan fwd from the previous comment ender
556 to the one in question; this records where we
557 last passed a comment starter. */
558 struct lisp_parse_state state
;
559 /* If we did not already find the defun start, find it now. */
560 if (defun_start
== 0)
562 defun_start
= find_defun_start (comment_end
, comment_end_byte
);
563 defun_start_byte
= find_start_value_byte
;
565 scan_sexps_forward (&state
,
566 defun_start
, defun_start_byte
,
567 comment_end
- 1, -10000, 0, Qnil
, 0);
570 /* scan_sexps_forward changed the direction of search in
571 global variables, so we need to update it completely. */
573 from
= state
.comstr_start
;
579 from_byte
= CHAR_TO_BYTE (from
);
580 UPDATE_SYNTAX_TABLE_FORWARD (from
- 1);
584 *bytepos_ptr
= from_byte
;
589 DEFUN ("syntax-table-p", Fsyntax_table_p
, Ssyntax_table_p
, 1, 1, 0,
590 "Return t if OBJECT is a syntax table.\n\
591 Currently, any char-table counts as a syntax table.")
595 if (CHAR_TABLE_P (object
)
596 && EQ (XCHAR_TABLE (object
)->purpose
, Qsyntax_table
))
602 check_syntax_table (obj
)
605 if (!(CHAR_TABLE_P (obj
)
606 && EQ (XCHAR_TABLE (obj
)->purpose
, Qsyntax_table
)))
607 wrong_type_argument (Qsyntax_table_p
, obj
);
610 DEFUN ("syntax-table", Fsyntax_table
, Ssyntax_table
, 0, 0, 0,
611 "Return the current syntax table.\n\
612 This is the one specified by the current buffer.")
615 return current_buffer
->syntax_table
;
618 DEFUN ("standard-syntax-table", Fstandard_syntax_table
,
619 Sstandard_syntax_table
, 0, 0, 0,
620 "Return the standard syntax table.\n\
621 This is the one used for new buffers.")
624 return Vstandard_syntax_table
;
627 DEFUN ("copy-syntax-table", Fcopy_syntax_table
, Scopy_syntax_table
, 0, 1, 0,
628 "Construct a new syntax table and return it.\n\
629 It is a copy of the TABLE, which defaults to the standard syntax table.")
636 check_syntax_table (table
);
638 table
= Vstandard_syntax_table
;
640 copy
= Fcopy_sequence (table
);
642 /* Only the standard syntax table should have a default element.
643 Other syntax tables should inherit from parents instead. */
644 XCHAR_TABLE (copy
)->defalt
= Qnil
;
646 /* Copied syntax tables should all have parents.
647 If we copied one with no parent, such as the standard syntax table,
648 use the standard syntax table as the copy's parent. */
649 if (NILP (XCHAR_TABLE (copy
)->parent
))
650 Fset_char_table_parent (copy
, Vstandard_syntax_table
);
654 DEFUN ("set-syntax-table", Fset_syntax_table
, Sset_syntax_table
, 1, 1, 0,
655 "Select a new syntax table for the current buffer.\n\
656 One argument, a syntax table.")
660 check_syntax_table (table
);
661 current_buffer
->syntax_table
= table
;
662 /* Indicate that this buffer now has a specified syntax table. */
663 current_buffer
->local_var_flags
664 |= XFASTINT (buffer_local_flags
.syntax_table
);
668 /* Convert a letter which signifies a syntax code
669 into the code it signifies.
670 This is used by modify-syntax-entry, and other things. */
672 unsigned char syntax_spec_code
[0400] =
673 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
674 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
675 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
676 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
677 (char) Swhitespace
, (char) Scomment_fence
, (char) Sstring
, 0377,
678 (char) Smath
, 0377, 0377, (char) Squote
,
679 (char) Sopen
, (char) Sclose
, 0377, 0377,
680 0377, (char) Swhitespace
, (char) Spunct
, (char) Scharquote
,
681 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
682 0377, 0377, 0377, 0377,
683 (char) Scomment
, 0377, (char) Sendcomment
, 0377,
684 (char) Sinherit
, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */
685 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
686 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
687 0377, 0377, 0377, 0377, (char) Sescape
, 0377, 0377, (char) Ssymbol
,
688 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
689 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
690 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
691 0377, 0377, 0377, 0377, (char) Sstring_fence
, 0377, 0377, 0377
694 /* Indexed by syntax code, give the letter that describes it. */
696 char syntax_code_spec
[16] =
698 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@',
702 /* Indexed by syntax code, give the object (cons of syntax code and
703 nil) to be stored in syntax table. Since these objects can be
704 shared among syntax tables, we generate them in advance. By
705 sharing objects, the function `describe-syntax' can give a more
707 static Lisp_Object Vsyntax_code_object
;
710 /* Look up the value for CHARACTER in syntax table TABLE's parent
711 and its parents. SYNTAX_ENTRY calls this, when TABLE itself has nil
712 for CHARACTER. It's actually used only when not compiled with GCC. */
715 syntax_parent_lookup (table
, character
)
723 table
= XCHAR_TABLE (table
)->parent
;
727 value
= XCHAR_TABLE (table
)->contents
[character
];
733 DEFUN ("char-syntax", Fchar_syntax
, Schar_syntax
, 1, 1, 0,
734 "Return the syntax code of CHARACTER, described by a character.\n\
735 For example, if CHARACTER is a word constituent,\n\
736 the character `w' is returned.\n\
737 The characters that correspond to various syntax codes\n\
738 are listed in the documentation of `modify-syntax-entry'.")
740 Lisp_Object character
;
743 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
745 gl_state
.use_global
= 0;
746 CHECK_NUMBER (character
, 0);
747 char_int
= XINT (character
);
748 return make_number (syntax_code_spec
[(int) SYNTAX (char_int
)]);
751 DEFUN ("matching-paren", Fmatching_paren
, Smatching_paren
, 1, 1, 0,
752 "Return the matching parenthesis of CHARACTER, or nil if none.")
754 Lisp_Object character
;
757 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
758 gl_state
.use_global
= 0;
759 CHECK_NUMBER (character
, 0);
760 char_int
= XINT (character
);
761 code
= SYNTAX (char_int
);
762 if (code
== Sopen
|| code
== Sclose
)
763 return SYNTAX_MATCH (char_int
);
767 /* This comment supplies the doc string for modify-syntax-entry,
768 for make-docfile to see. We cannot put this in the real DEFUN
769 due to limits in the Unix cpp.
771 DEFUN ("modify-syntax-entry", foo, bar, 2, 3, 0,
772 "Set syntax for character CHAR according to string S.\n\
773 The syntax is changed only for table TABLE, which defaults to\n\
774 the current buffer's syntax table.\n\
775 The first character of S should be one of the following:\n\
776 Space or - whitespace syntax. w word constituent.\n\
777 _ symbol constituent. . punctuation.\n\
778 ( open-parenthesis. ) close-parenthesis.\n\
779 \" string quote. \\ escape.\n\
780 $ paired delimiter. ' expression quote or prefix operator.\n\
781 < comment starter. > comment ender.\n\
782 / character-quote. @ inherit from `standard-syntax-table'.\n\
784 Only single-character comment start and end sequences are represented thus.\n\
785 Two-character sequences are represented as described below.\n\
786 The second character of S is the matching parenthesis,\n\
787 used only if the first character is `(' or `)'.\n\
788 Any additional characters are flags.\n\
789 Defined flags are the characters 1, 2, 3, 4, b, and p.\n\
790 1 means CHAR is the start of a two-char comment start sequence.\n\
791 2 means CHAR is the second character of such a sequence.\n\
792 3 means CHAR is the start of a two-char comment end sequence.\n\
793 4 means CHAR is the second character of such a sequence.\n\
795 There can be up to two orthogonal comment sequences. This is to support\n\
796 language modes such as C++. By default, all comment sequences are of style\n\
797 a, but you can set the comment sequence style to b (on the second character\n\
798 of a comment-start, or the first character of a comment-end sequence) using\n\
800 b means CHAR is part of comment sequence b.\n\
802 p means CHAR is a prefix character for `backward-prefix-chars';\n\
803 such characters are treated as whitespace when they occur\n\
804 between expressions.")
808 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry
, Smodify_syntax_entry
, 2, 3,
809 /* I really don't know why this is interactive
810 help-form should at least be made useful whilst reading the second arg
812 "cSet syntax for character: \nsSet syntax for %s to: ",
813 0 /* See immediately above */)
814 (c
, newentry
, syntax_table
)
815 Lisp_Object c
, newentry
, syntax_table
;
817 register unsigned char *p
;
818 register enum syntaxcode code
;
823 CHECK_STRING (newentry
, 1);
825 if (NILP (syntax_table
))
826 syntax_table
= current_buffer
->syntax_table
;
828 check_syntax_table (syntax_table
);
830 p
= XSTRING (newentry
)->data
;
831 code
= (enum syntaxcode
) syntax_spec_code
[*p
++];
832 if (((int) code
& 0377) == 0377)
833 error ("invalid syntax description letter: %c", p
[-1]);
835 if (code
== Sinherit
)
837 SET_RAW_SYNTAX_ENTRY (syntax_table
, XINT (c
), Qnil
);
844 int character
= STRING_CHAR_AND_LENGTH (p
, XSTRING (newentry
)->size
- 1,
846 XSETINT (match
, character
);
847 if (XFASTINT (match
) == ' ')
883 if (val
< XVECTOR (Vsyntax_code_object
)->size
&& NILP (match
))
884 newentry
= XVECTOR (Vsyntax_code_object
)->contents
[val
];
886 /* Since we can't use a shared object, let's make a new one. */
887 newentry
= Fcons (make_number (val
), match
);
889 SET_RAW_SYNTAX_ENTRY (syntax_table
, XINT (c
), newentry
);
894 /* Dump syntax table to buffer in human-readable format */
897 describe_syntax (value
)
900 register enum syntaxcode code
;
901 char desc
, match
, start1
, start2
, end1
, end2
, prefix
, comstyle
;
903 Lisp_Object first
, match_lisp
;
905 Findent_to (make_number (16), make_number (1));
909 insert_string ("default\n");
913 if (CHAR_TABLE_P (value
))
915 insert_string ("deeper char-table ...\n");
921 insert_string ("invalid\n");
925 first
= XCONS (value
)->car
;
926 match_lisp
= XCONS (value
)->cdr
;
928 if (!INTEGERP (first
) || !(NILP (match_lisp
) || INTEGERP (match_lisp
)))
930 insert_string ("invalid\n");
934 code
= (enum syntaxcode
) (XINT (first
) & 0377);
935 start1
= (XINT (first
) >> 16) & 1;
936 start2
= (XINT (first
) >> 17) & 1;
937 end1
= (XINT (first
) >> 18) & 1;
938 end2
= (XINT (first
) >> 19) & 1;
939 prefix
= (XINT (first
) >> 20) & 1;
940 comstyle
= (XINT (first
) >> 21) & 1;
942 if ((int) code
< 0 || (int) code
>= (int) Smax
)
944 insert_string ("invalid");
947 desc
= syntax_code_spec
[(int) code
];
949 str
[0] = desc
, str
[1] = 0;
952 if (NILP (match_lisp
))
955 insert_char (XINT (match_lisp
));
972 insert_string ("\twhich means: ");
974 switch (SWITCH_ENUM_CAST (code
))
977 insert_string ("whitespace"); break;
979 insert_string ("punctuation"); break;
981 insert_string ("word"); break;
983 insert_string ("symbol"); break;
985 insert_string ("open"); break;
987 insert_string ("close"); break;
989 insert_string ("quote"); break;
991 insert_string ("string"); break;
993 insert_string ("math"); break;
995 insert_string ("escape"); break;
997 insert_string ("charquote"); break;
999 insert_string ("comment"); break;
1001 insert_string ("endcomment"); break;
1003 insert_string ("invalid");
1007 if (!NILP (match_lisp
))
1009 insert_string (", matches ");
1010 insert_char (XINT (match_lisp
));
1014 insert_string (",\n\t is the first character of a comment-start sequence");
1016 insert_string (",\n\t is the second character of a comment-start sequence");
1019 insert_string (",\n\t is the first character of a comment-end sequence");
1021 insert_string (",\n\t is the second character of a comment-end sequence");
1023 insert_string (" (comment style b)");
1026 insert_string (",\n\t is a prefix character for `backward-prefix-chars'");
1028 insert_string ("\n");
1032 describe_syntax_1 (vector
)
1035 struct buffer
*old
= current_buffer
;
1036 set_buffer_internal (XBUFFER (Vstandard_output
));
1037 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
, (int *) 0, 0);
1038 while (! NILP (XCHAR_TABLE (vector
)->parent
))
1040 vector
= XCHAR_TABLE (vector
)->parent
;
1041 insert_string ("\nThe parent syntax table is:");
1042 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
,
1046 call0 (intern ("help-mode"));
1047 set_buffer_internal (old
);
1051 DEFUN ("describe-syntax", Fdescribe_syntax
, Sdescribe_syntax
, 0, 0, "",
1052 "Describe the syntax specifications in the syntax table.\n\
1053 The descriptions are inserted in a buffer, which is then displayed.")
1056 internal_with_output_to_temp_buffer
1057 ("*Help*", describe_syntax_1
, current_buffer
->syntax_table
);
1062 int parse_sexp_ignore_comments
;
1064 /* Return the position across COUNT words from FROM.
1065 If that many words cannot be found before the end of the buffer, return 0.
1066 COUNT negative means scan backward and stop at word beginning. */
1069 scan_words (from
, count
)
1070 register int from
, count
;
1072 register int beg
= BEGV
;
1073 register int end
= ZV
;
1074 register int from_byte
= CHAR_TO_BYTE (from
);
1075 register enum syntaxcode code
;
1081 SETUP_SYNTAX_TABLE (from
, count
);
1092 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1093 ch0
= FETCH_CHAR (from_byte
);
1094 code
= SYNTAX (ch0
);
1095 INC_BOTH (from
, from_byte
);
1096 if (words_include_escapes
1097 && (code
== Sescape
|| code
== Scharquote
))
1102 /* Now CH0 is a character which begins a word and FROM is the
1103 position of the next character. */
1106 if (from
== end
) break;
1107 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1108 ch1
= FETCH_CHAR (from_byte
);
1109 code
= SYNTAX (ch1
);
1110 if (!(words_include_escapes
1111 && (code
== Sescape
|| code
== Scharquote
)))
1112 if (code
!= Sword
|| WORD_BOUNDARY_P (ch0
, ch1
))
1114 INC_BOTH (from
, from_byte
);
1128 DEC_BOTH (from
, from_byte
);
1129 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1130 ch1
= FETCH_CHAR (from_byte
);
1131 code
= SYNTAX (ch1
);
1132 if (words_include_escapes
1133 && (code
== Sescape
|| code
== Scharquote
))
1138 /* Now CH1 is a character which ends a word and FROM is the
1146 temp_byte
= dec_bytepos (from_byte
);
1147 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1148 ch0
= FETCH_CHAR (temp_byte
);
1149 code
= SYNTAX (ch0
);
1150 if (!(words_include_escapes
1151 && (code
== Sescape
|| code
== Scharquote
)))
1152 if (code
!= Sword
|| WORD_BOUNDARY_P (ch0
, ch1
))
1154 DEC_BOTH (from
, from_byte
);
1165 DEFUN ("forward-word", Fforward_word
, Sforward_word
, 1, 1, "p",
1166 "Move point forward ARG words (backward if ARG is negative).\n\
1167 Normally returns t.\n\
1168 If an edge of the buffer is reached, point is left there\n\
1169 and nil is returned.")
1174 CHECK_NUMBER (count
, 0);
1176 if (!(val
= scan_words (PT
, XINT (count
))))
1178 SET_PT (XINT (count
) > 0 ? ZV
: BEGV
);
1185 Lisp_Object
skip_chars ();
1187 DEFUN ("skip-chars-forward", Fskip_chars_forward
, Sskip_chars_forward
, 1, 2, 0,
1188 "Move point forward, stopping before a char not in STRING, or at pos LIM.\n\
1189 STRING is like the inside of a `[...]' in a regular expression\n\
1190 except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\
1191 Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
1192 With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\
1193 Returns the distance traveled, either zero or positive.")
1195 Lisp_Object string
, lim
;
1197 return skip_chars (1, 0, string
, lim
);
1200 DEFUN ("skip-chars-backward", Fskip_chars_backward
, Sskip_chars_backward
, 1, 2, 0,
1201 "Move point backward, stopping after a char not in STRING, or at pos LIM.\n\
1202 See `skip-chars-forward' for details.\n\
1203 Returns the distance traveled, either zero or negative.")
1205 Lisp_Object string
, lim
;
1207 return skip_chars (0, 0, string
, lim
);
1210 DEFUN ("skip-syntax-forward", Fskip_syntax_forward
, Sskip_syntax_forward
, 1, 2, 0,
1211 "Move point forward across chars in specified syntax classes.\n\
1212 SYNTAX is a string of syntax code characters.\n\
1213 Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\
1214 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1215 This function returns the distance traveled, either zero or positive.")
1217 Lisp_Object syntax
, lim
;
1219 return skip_chars (1, 1, syntax
, lim
);
1222 DEFUN ("skip-syntax-backward", Fskip_syntax_backward
, Sskip_syntax_backward
, 1, 2, 0,
1223 "Move point backward across chars in specified syntax classes.\n\
1224 SYNTAX is a string of syntax code characters.\n\
1225 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\
1226 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1227 This function returns the distance traveled, either zero or negative.")
1229 Lisp_Object syntax
, lim
;
1231 return skip_chars (0, 1, syntax
, lim
);
1235 skip_chars (forwardp
, syntaxp
, string
, lim
)
1236 int forwardp
, syntaxp
;
1237 Lisp_Object string
, lim
;
1239 register unsigned char *p
, *pend
;
1240 register unsigned int c
;
1242 unsigned char fastmap
[0400];
1243 /* If SYNTAXP is 0, STRING may contain multi-byte form of characters
1244 of which codes don't fit in FASTMAP. In that case, we set the
1245 first byte of multibyte form (i.e. base leading-code) in FASTMAP
1246 and set the actual ranges of characters in CHAR_RANGES. In the
1247 form "X-Y" of STRING, both X and Y must belong to the same
1248 character set because a range striding across character sets is
1251 int n_char_ranges
= 0;
1253 register int i
, i_byte
;
1254 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
1255 int string_multibyte
= STRING_MULTIBYTE (string
);
1257 CHECK_STRING (string
, 0);
1258 char_ranges
= (int *) alloca (XSTRING (string
)->size
* (sizeof (int)) * 2);
1261 XSETINT (lim
, forwardp
? ZV
: BEGV
);
1263 CHECK_NUMBER_COERCE_MARKER (lim
, 0);
1265 /* In any case, don't allow scan outside bounds of buffer. */
1266 if (XINT (lim
) > ZV
)
1267 XSETFASTINT (lim
, ZV
);
1268 if (XINT (lim
) < BEGV
)
1269 XSETFASTINT (lim
, BEGV
);
1271 bzero (fastmap
, sizeof fastmap
);
1275 if (i
< XSTRING (string
)->size
1276 && XSTRING (string
)->data
[0] == '^')
1278 negate
= 1; i
++, i_byte
++;
1281 /* Find the characters specified and set their elements of fastmap.
1282 If syntaxp, each character counts as itself.
1283 Otherwise, handle backslashes and ranges specially. */
1285 while (i
< XSTRING (string
)->size
)
1289 if (string_multibyte
)
1291 c_leading_code
= XSTRING (string
)->data
[i_byte
];
1292 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1295 c
= c_leading_code
= XSTRING (string
)->data
[i
++];
1297 /* Convert multibyteness between what the string has
1298 and what the buffer has. */
1300 c
= unibyte_char_to_multibyte (c
);
1305 fastmap
[syntax_spec_code
[c
& 0377]] = 1;
1310 if (i
== XSTRING (string
)->size
)
1313 if (string_multibyte
)
1314 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1316 c
= XSTRING (string
)->data
[i
++];
1318 if (i
< XSTRING (string
)->size
&& XSTRING (string
)->data
[i
] == '-')
1322 /* Skip over the dash. */
1325 if (i
== XSTRING (string
)->size
)
1328 /* Get the end of the range. */
1329 if (string_multibyte
)
1330 FETCH_STRING_CHAR_ADVANCE (c2
, string
, i
, i_byte
);
1332 c2
= XSTRING (string
)->data
[i
++];
1334 if (SINGLE_BYTE_CHAR_P (c
))
1342 fastmap
[c_leading_code
] = 1;
1345 char_ranges
[n_char_ranges
++] = c
;
1346 char_ranges
[n_char_ranges
++] = c2
;
1352 fastmap
[c_leading_code
] = 1;
1353 if (!SINGLE_BYTE_CHAR_P (c
))
1355 char_ranges
[n_char_ranges
++] = c
;
1356 char_ranges
[n_char_ranges
++] = c
;
1362 /* If ^ was the first character, complement the fastmap. In
1363 addition, as all multibyte characters have possibility of
1364 matching, set all entries for base leading codes, which is
1365 harmless even if SYNTAXP is 1. */
1368 for (i
= 0; i
< sizeof fastmap
; i
++)
1370 if (!multibyte
|| !BASE_LEADING_CODE_P (i
))
1377 int start_point
= PT
;
1379 int pos_byte
= PT_BYTE
;
1384 SETUP_SYNTAX_TABLE (pos
, forwardp
? 1 : -1);
1389 if (pos
< XINT (lim
))
1390 while (fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1392 /* Since we already checked for multibyteness,
1393 avoid using INC_BOTH which checks again. */
1396 if (pos
>= XINT (lim
))
1398 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1403 while (pos
< XINT (lim
)
1404 && fastmap
[(int) SYNTAX (FETCH_BYTE (pos
))])
1407 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1415 while (pos
> XINT (lim
))
1417 int savepos
= pos_byte
;
1418 /* Since we already checked for multibyteness,
1419 avoid using DEC_BOTH which checks again. */
1422 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
1423 if (!fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1433 if (pos
> XINT (lim
))
1434 while (fastmap
[(int) SYNTAX (FETCH_BYTE (pos
- 1))])
1437 if (pos
<= XINT (lim
))
1439 UPDATE_SYNTAX_TABLE_BACKWARD (pos
- 1);
1449 while (pos
< XINT (lim
) && fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1451 if (!BASE_LEADING_CODE_P (c
))
1452 INC_BOTH (pos
, pos_byte
);
1453 else if (n_char_ranges
)
1455 /* We much check CHAR_RANGES for a multibyte
1457 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1458 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1459 if ((ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1]))
1461 if (!(negate
^ (i
< n_char_ranges
)))
1464 INC_BOTH (pos
, pos_byte
);
1469 INC_BOTH (pos
, pos_byte
);
1473 while (pos
< XINT (lim
) && fastmap
[FETCH_BYTE (pos
)])
1479 while (pos
> XINT (lim
))
1481 int savepos
= pos_byte
;
1482 DEC_BOTH (pos
, pos_byte
);
1483 if (fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1485 if (!BASE_LEADING_CODE_P (c
))
1487 else if (n_char_ranges
)
1489 /* We much check CHAR_RANGES for a multibyte
1491 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1492 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1493 if (ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1])
1495 if (!(negate
^ (i
< n_char_ranges
)))
1518 while (pos
> XINT (lim
) && fastmap
[FETCH_BYTE (pos
- 1)])
1523 #if 0 /* Not needed now that a position in mid-character
1524 cannot be specified in Lisp. */
1526 /* INC_POS or DEC_POS might have moved POS over LIM. */
1527 && (forwardp
? (pos
> XINT (lim
)) : (pos
< XINT (lim
))))
1534 SET_PT_BOTH (pos
, pos_byte
);
1537 return make_number (PT
- start_point
);
1541 DEFUN ("forward-comment", Fforward_comment
, Sforward_comment
, 1, 1, 0,
1542 "Move forward across up to N comments. If N is negative, move backward.\n\
1543 Stop scanning if we find something other than a comment or whitespace.\n\
1544 Set point to where scanning stops.\n\
1545 If N comments are found as expected, with nothing except whitespace\n\
1546 between them, return t; otherwise return nil.")
1554 register enum syntaxcode code
;
1555 int comstyle
= 0; /* style of comment encountered */
1559 int out_charpos
, out_bytepos
;
1561 CHECK_NUMBER (count
, 0);
1562 count1
= XINT (count
);
1563 stop
= count1
> 0 ? ZV
: BEGV
;
1569 from_byte
= PT_BYTE
;
1571 SETUP_SYNTAX_TABLE (from
, count1
);
1578 SET_PT_BOTH (from
, from_byte
);
1582 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1583 c
= FETCH_CHAR (from_byte
);
1585 INC_BOTH (from
, from_byte
);
1587 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
1588 && (c1
= FETCH_CHAR (from_byte
),
1589 SYNTAX_COMSTART_SECOND (c1
)))
1591 /* We have encountered a comment start sequence and we
1592 are ignoring all text inside comments. We must record
1593 the comment style this sequence begins so that later,
1594 only a comment end of the same style actually ends
1595 the comment section. */
1597 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1598 INC_BOTH (from
, from_byte
);
1601 while (code
== Swhitespace
|| code
== Sendcomment
);
1603 if (code
!= Scomment
&& code
!= Scomment_fence
)
1606 DEC_BOTH (from
, from_byte
);
1607 SET_PT_BOTH (from
, from_byte
);
1610 /* We're at the start of a comment. */
1616 SET_PT_BOTH (from
, from_byte
);
1619 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1620 c
= FETCH_CHAR (from_byte
);
1621 INC_BOTH (from
, from_byte
);
1622 if (SYNTAX (c
) == Sendcomment
1623 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1624 /* we have encountered a comment end of the same style
1625 as the comment sequence which began this comment
1628 if (SYNTAX (c
) == Scomment_fence
1629 && comstyle
== ST_COMMENT_STYLE
)
1630 /* we have encountered a comment end of the same style
1631 as the comment sequence which began this comment
1634 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
1635 && (c1
= FETCH_CHAR (from_byte
),
1636 SYNTAX_COMEND_SECOND (c1
))
1637 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1638 /* we have encountered a comment end of the same style
1639 as the comment sequence which began this comment
1642 INC_BOTH (from
, from_byte
);
1646 /* We have skipped one comment. */
1657 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
1662 DEC_BOTH (from
, from_byte
);
1663 quoted
= char_quoted (from
, from_byte
);
1666 DEC_BOTH (from
, from_byte
);
1669 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1670 c
= FETCH_CHAR (from_byte
);
1673 if (code
== Sendcomment
)
1674 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1675 temp_pos
= dec_bytepos (from_byte
);
1676 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1677 && (c1
= FETCH_CHAR (temp_pos
),
1678 SYNTAX_COMEND_FIRST (c1
))
1679 && !char_quoted (from
- 1, temp_pos
))
1681 /* We must record the comment style encountered so that
1682 later, we can match only the proper comment begin
1683 sequence of the same style. */
1685 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1686 DEC_BOTH (from
, from_byte
);
1688 if (from
> stop
&& SYNTAX_COMSTART_SECOND (c
)
1689 && (c1
= FETCH_CHAR (temp_pos
),
1690 SYNTAX_COMSTART_FIRST (c1
))
1691 && !char_quoted (from
- 1, temp_pos
))
1693 /* We must record the comment style encountered so that
1694 later, we can match only the proper comment begin
1695 sequence of the same style. */
1697 DEC_BOTH (from
, from_byte
);
1700 if (code
== Scomment_fence
)
1702 /* Skip until first preceding unquoted comment_fence. */
1703 int found
= 0, ini
= from
, ini_byte
= from_byte
;
1707 DEC_BOTH (from
, from_byte
);
1710 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1711 c
= FETCH_CHAR (from_byte
);
1712 if (SYNTAX (c
) == Scomment_fence
1713 && !char_quoted (from
, from_byte
))
1721 from
= ini
; /* Set point to ini + 1. */
1722 from_byte
= ini_byte
;
1726 else if (code
== Sendcomment
)
1728 found
= back_comment (from
, from_byte
, stop
, comstyle
,
1729 &out_charpos
, &out_bytepos
);
1731 from
= out_charpos
, from_byte
= out_bytepos
;
1732 /* We have skipped one comment. */
1735 else if (code
!= Swhitespace
&& code
!= Scomment
)
1739 INC_BOTH (from
, from_byte
);
1740 SET_PT_BOTH (from
, from_byte
);
1748 SET_PT_BOTH (from
, from_byte
);
1754 scan_lists (from
, count
, depth
, sexpflag
)
1756 int count
, depth
, sexpflag
;
1759 register int stop
= count
> 0 ? ZV
: BEGV
;
1764 register enum syntaxcode code
, temp_code
;
1765 int min_depth
= depth
; /* Err out if depth gets less than this. */
1766 int comstyle
= 0; /* style of comment encountered */
1768 int last_good
= from
;
1770 int from_byte
= CHAR_TO_BYTE (from
);
1771 int out_bytepos
, out_charpos
;
1773 if (depth
> 0) min_depth
= 0;
1778 SETUP_SYNTAX_TABLE (from
, count
);
1783 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1784 c
= FETCH_CHAR (from_byte
);
1786 if (depth
== min_depth
)
1788 INC_BOTH (from
, from_byte
);
1789 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1790 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
1791 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
))
1792 && parse_sexp_ignore_comments
)
1794 /* we have encountered a comment start sequence and we
1795 are ignoring all text inside comments. We must record
1796 the comment style this sequence begins so that later,
1797 only a comment end of the same style actually ends
1798 the comment section */
1800 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
));
1801 INC_BOTH (from
, from_byte
);
1804 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1805 if (SYNTAX_PREFIX (c
))
1808 switch (SWITCH_ENUM_CAST (code
))
1812 if (from
== stop
) goto lose
;
1813 INC_BOTH (from
, from_byte
);
1814 /* treat following character as a word constituent */
1817 if (depth
|| !sexpflag
) break;
1818 /* This word counts as a sexp; return at end of it. */
1821 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1822 switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from_byte
))))
1826 INC_BOTH (from
, from_byte
);
1827 if (from
== stop
) goto lose
;
1836 INC_BOTH (from
, from_byte
);
1841 case Scomment_fence
:
1842 if (!parse_sexp_ignore_comments
) break;
1851 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1852 c
= FETCH_CHAR (from_byte
);
1853 if (code
== Scomment
1854 ? (SYNTAX (c
) == Sendcomment
1855 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1856 : (SYNTAX (c
) == Scomment_fence
))
1857 /* we have encountered a comment end of the same style
1858 as the comment sequence which began this comment
1861 INC_BOTH (from
, from_byte
);
1862 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
1863 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from_byte
))
1864 && SYNTAX_COMMENT_STYLE (c
) == comstyle
1865 && code
== Scomment
)
1866 /* we have encountered a comment end of the same style
1867 as the comment sequence which began this comment
1870 INC_BOTH (from
, from_byte
);
1879 if (from
!= stop
&& c
== FETCH_CHAR (from_byte
))
1881 INC_BOTH (from
, from_byte
);
1891 if (!++depth
) goto done
;
1896 if (!--depth
) goto done
;
1897 if (depth
< min_depth
)
1898 Fsignal (Qscan_error
,
1899 Fcons (build_string ("Containing expression ends prematurely"),
1900 Fcons (make_number (last_good
),
1901 Fcons (make_number (from
), Qnil
))));
1906 temp_pos
= dec_bytepos (from_byte
);
1907 stringterm
= FETCH_CHAR (temp_pos
);
1910 if (from
>= stop
) goto lose
;
1911 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1913 ? (FETCH_CHAR (from_byte
) == stringterm
)
1914 : SYNTAX (FETCH_CHAR (from_byte
)) == Sstring_fence
)
1916 switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from_byte
))))
1920 INC_BOTH (from
, from_byte
);
1922 INC_BOTH (from
, from_byte
);
1924 INC_BOTH (from
, from_byte
);
1925 if (!depth
&& sexpflag
) goto done
;
1930 /* Reached end of buffer. Error if within object, return nil if between */
1931 if (depth
) goto lose
;
1936 /* End of object reached */
1945 DEC_BOTH (from
, from_byte
);
1946 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1947 c
= FETCH_CHAR (from_byte
);
1949 if (depth
== min_depth
)
1952 if (code
== Sendcomment
)
1953 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1954 temp_pos
= from_byte
;
1955 if (! NILP (current_buffer
->enable_multibyte_characters
))
1959 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1960 && (c1
= FETCH_CHAR (temp_pos
), SYNTAX_COMEND_FIRST (c1
))
1961 && parse_sexp_ignore_comments
)
1963 /* we must record the comment style encountered so that
1964 later, we can match only the proper comment begin
1965 sequence of the same style */
1967 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1968 DEC_BOTH (from
, from_byte
);
1971 /* Quoting turns anything except a comment-ender
1972 into a word character. */
1973 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
1975 else if (SYNTAX_PREFIX (c
))
1978 switch (SWITCH_ENUM_CAST (code
))
1984 if (depth
|| !sexpflag
) break;
1985 /* This word counts as a sexp; count object finished
1986 after passing it. */
1989 temp_pos
= from_byte
;
1990 if (! NILP (current_buffer
->enable_multibyte_characters
))
1994 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
1995 c1
= FETCH_CHAR (temp_pos
);
1996 temp_code
= SYNTAX (c1
);
1997 /* Don't allow comment-end to be quoted. */
1998 if (temp_code
== Sendcomment
)
2000 quoted
= char_quoted (from
- 1, temp_pos
);
2003 DEC_BOTH (from
, from_byte
);
2004 temp_pos
= dec_bytepos (temp_pos
);
2005 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2007 c1
= FETCH_CHAR (temp_pos
);
2008 temp_code
= SYNTAX (c1
);
2009 if (! (quoted
|| temp_code
== Sword
2010 || temp_code
== Ssymbol
2011 || temp_code
== Squote
))
2013 DEC_BOTH (from
, from_byte
);
2020 temp_pos
= dec_bytepos (from_byte
);
2021 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2022 if (from
!= stop
&& c
== FETCH_CHAR (temp_pos
))
2023 DEC_BOTH (from
, from_byte
);
2032 if (!++depth
) goto done2
;
2037 if (!--depth
) goto done2
;
2038 if (depth
< min_depth
)
2039 Fsignal (Qscan_error
,
2040 Fcons (build_string ("Containing expression ends prematurely"),
2041 Fcons (make_number (last_good
),
2042 Fcons (make_number (from
), Qnil
))));
2046 if (!parse_sexp_ignore_comments
)
2048 found
= back_comment (from
, from_byte
, stop
, comstyle
,
2049 &out_charpos
, &out_bytepos
);
2051 from
= out_charpos
, from_byte
= out_bytepos
;
2054 case Scomment_fence
:
2058 DEC_BOTH (from
, from_byte
);
2059 if (from
== stop
) goto lose
;
2060 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2061 if (!char_quoted (from
, from_byte
)
2062 && SYNTAX (FETCH_CHAR (from_byte
)) == code
)
2065 if (code
== Sstring_fence
&& !depth
&& sexpflag
) goto done2
;
2069 stringterm
= FETCH_CHAR (from_byte
);
2072 if (from
== stop
) goto lose
;
2073 temp_pos
= from_byte
;
2074 if (! NILP (current_buffer
->enable_multibyte_characters
))
2078 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2079 if (!char_quoted (from
- 1, temp_pos
)
2080 && stringterm
== FETCH_CHAR (temp_pos
))
2082 DEC_BOTH (from
, from_byte
);
2084 DEC_BOTH (from
, from_byte
);
2085 if (!depth
&& sexpflag
) goto done2
;
2090 /* Reached start of buffer. Error if within object, return nil if between */
2091 if (depth
) goto lose
;
2102 XSETFASTINT (val
, from
);
2106 Fsignal (Qscan_error
,
2107 Fcons (build_string ("Unbalanced parentheses"),
2108 Fcons (make_number (last_good
),
2109 Fcons (make_number (from
), Qnil
))));
2114 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
2115 "Scan from character number FROM by COUNT lists.\n\
2116 Returns the character number of the position thus found.\n\
2118 If DEPTH is nonzero, paren depth begins counting from that value,\n\
2119 only places where the depth in parentheses becomes zero\n\
2120 are candidates for stopping; COUNT such places are counted.\n\
2121 Thus, a positive value for DEPTH means go out levels.\n\
2123 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2125 If the beginning or end of (the accessible part of) the buffer is reached\n\
2126 and the depth is wrong, an error is signaled.\n\
2127 If the depth is right but the count is not used up, nil is returned.")
2128 (from
, count
, depth
)
2129 Lisp_Object from
, count
, depth
;
2131 CHECK_NUMBER (from
, 0);
2132 CHECK_NUMBER (count
, 1);
2133 CHECK_NUMBER (depth
, 2);
2135 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
2138 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
2139 "Scan from character number FROM by COUNT balanced expressions.\n\
2140 If COUNT is negative, scan backwards.\n\
2141 Returns the character number of the position thus found.\n\
2143 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2145 If the beginning or end of (the accessible part of) the buffer is reached\n\
2146 in the middle of a parenthetical grouping, an error is signaled.\n\
2147 If the beginning or end is reached between groupings\n\
2148 but before count is used up, nil is returned.")
2150 Lisp_Object from
, count
;
2152 CHECK_NUMBER (from
, 0);
2153 CHECK_NUMBER (count
, 1);
2155 return scan_lists (XINT (from
), XINT (count
), 0, 1);
2158 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
2160 "Move point backward over any number of chars with prefix syntax.\n\
2161 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
2166 int opoint_byte
= PT_BYTE
;
2168 int pos_byte
= PT_BYTE
;
2173 SETUP_SYNTAX_TABLE (pos
, -1);
2176 DEC_BOTH (pos
, pos_byte
);
2178 while (!char_quoted (pos
, pos_byte
)
2179 /* Previous statement updates syntax table. */
2180 && ((c
= FETCH_CHAR (pos_byte
), SYNTAX (c
) == Squote
)
2181 || SYNTAX_PREFIX (c
)))
2184 opoint_byte
= pos_byte
;
2187 DEC_BOTH (pos
, pos_byte
);
2190 SET_PT_BOTH (opoint
, opoint_byte
);
2195 /* Parse forward from FROM / FROM_BYTE to END,
2196 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
2197 and return a description of the state of the parse at END.
2198 If STOPBEFORE is nonzero, stop at the start of an atom.
2199 If COMMENTSTOP is 1, stop at the start of a comment.
2200 If COMMENTSTOP is -1, stop at the start or end of a comment,
2201 after the beginning of a string, or after the end of a string. */
2204 scan_sexps_forward (stateptr
, from
, from_byte
, end
, targetdepth
,
2205 stopbefore
, oldstate
, commentstop
)
2206 struct lisp_parse_state
*stateptr
;
2208 int end
, targetdepth
, stopbefore
;
2209 Lisp_Object oldstate
;
2212 struct lisp_parse_state state
;
2214 register enum syntaxcode code
;
2215 struct level
{ int last
, prev
; };
2216 struct level levelstart
[100];
2217 register struct level
*curlevel
= levelstart
;
2218 struct level
*endlevel
= levelstart
+ 100;
2220 register int depth
; /* Paren depth of current scanning location.
2221 level - levelstart equals this except
2222 when the depth becomes negative. */
2223 int mindepth
; /* Lowest DEPTH value seen. */
2224 int start_quoted
= 0; /* Nonzero means starting after a char quote */
2226 int prev_from
; /* Keep one character before FROM. */
2228 int prev_from_syntax
;
2229 int boundary_stop
= commentstop
== -1;
2233 prev_from_byte
= from_byte
;
2235 DEC_BOTH (prev_from
, prev_from_byte
);
2237 /* Use this macro instead of `from++'. */
2239 do { prev_from = from; \
2240 prev_from_byte = from_byte; \
2242 = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); \
2243 INC_BOTH (from, from_byte); \
2244 UPDATE_SYNTAX_TABLE_FORWARD (from); \
2250 if (NILP (oldstate
))
2253 state
.instring
= -1;
2254 state
.incomment
= 0;
2255 state
.comstyle
= 0; /* comment style a by default. */
2256 state
.comstr_start
= -1; /* no comment/string seen. */
2260 tem
= Fcar (oldstate
);
2266 oldstate
= Fcdr (oldstate
);
2267 oldstate
= Fcdr (oldstate
);
2268 oldstate
= Fcdr (oldstate
);
2269 tem
= Fcar (oldstate
);
2270 /* Check whether we are inside string_fence-style string: */
2271 state
.instring
= ( !NILP (tem
)
2272 ? ( INTEGERP (tem
) ? XINT (tem
) : ST_STRING_STYLE
)
2275 oldstate
= Fcdr (oldstate
);
2276 tem
= Fcar (oldstate
);
2277 state
.incomment
= !NILP (tem
);
2279 oldstate
= Fcdr (oldstate
);
2280 tem
= Fcar (oldstate
);
2281 start_quoted
= !NILP (tem
);
2283 /* if the eight element of the list is nil, we are in comment
2284 style a. If it is non-nil, we are in comment style b */
2285 oldstate
= Fcdr (oldstate
);
2286 oldstate
= Fcdr (oldstate
);
2287 tem
= Fcar (oldstate
);
2288 state
.comstyle
= NILP (tem
) ? 0 : ( EQ (tem
, Qsyntax_table
)
2289 ? ST_COMMENT_STYLE
: 1 );
2291 oldstate
= Fcdr (oldstate
);
2292 tem
= Fcar (oldstate
);
2293 state
.comstr_start
= NILP (tem
) ? -1 : XINT (tem
) ;
2298 curlevel
->prev
= -1;
2299 curlevel
->last
= -1;
2301 /* Enter the loop at a place appropriate for initial state. */
2303 if (state
.incomment
) goto startincomment
;
2304 if (state
.instring
>= 0)
2306 nofence
= state
.instring
!= ST_STRING_STYLE
;
2307 if (start_quoted
) goto startquotedinstring
;
2310 if (start_quoted
) goto startquoted
;
2313 SETUP_SYNTAX_TABLE (prev_from
, 1);
2314 prev_from_syntax
= SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte
));
2315 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2320 code
= prev_from_syntax
& 0xff;
2322 if (code
== Scomment
)
2323 state
.comstr_start
= prev_from
;
2324 else if (code
== Scomment_fence
)
2326 /* Record the comment style we have entered so that only
2327 the comment-end sequence of the same style actually
2328 terminates the comment section. */
2329 state
.comstyle
= ( code
== Scomment_fence
2331 : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)));
2332 state
.comstr_start
= prev_from
;
2333 if (code
!= Scomment_fence
)
2337 else if (from
< end
)
2338 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax
))
2339 if (SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
)))
2340 /* Duplicate code to avoid a complex if-expression
2341 which causes trouble for the SGI compiler. */
2343 /* Record the comment style we have entered so that only
2344 the comment-end sequence of the same style actually
2345 terminates the comment section. */
2346 state
.comstyle
= ( code
== Scomment_fence
2348 : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)));
2349 state
.comstr_start
= prev_from
;
2350 if (code
!= Scomment_fence
)
2355 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax
))
2357 switch (SWITCH_ENUM_CAST (code
))
2361 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2362 curlevel
->last
= prev_from
;
2364 if (from
== end
) goto endquoted
;
2367 /* treat following character as a word constituent */
2370 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2371 curlevel
->last
= prev_from
;
2375 switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from_byte
))))
2380 if (from
== end
) goto endquoted
;
2392 curlevel
->prev
= curlevel
->last
;
2396 if (commentstop
== 1)
2400 /* Enter the loop in the middle so that we find
2401 a 2-char comment ender if we start in the middle of it. */
2402 goto startincomment_1
;
2404 /* At beginning of buffer, enter the loop the ordinary way. */
2405 state
.incomment
= 1;
2409 state
.incomment
= 1;
2410 if (commentstop
|| boundary_stop
) goto done
;
2414 if (from
== end
) goto done
;
2415 prev
= FETCH_CHAR (from_byte
);
2416 if (SYNTAX (prev
) == Sendcomment
2417 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
2418 /* Only terminate the comment section if the endcomment
2419 of the same style as the start sequence has been
2422 if (state
.comstyle
== ST_COMMENT_STYLE
2423 && SYNTAX (prev
) == Scomment_fence
)
2427 if (from
< end
&& SYNTAX_FLAGS_COMEND_FIRST (prev_from_syntax
)
2428 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from_byte
))
2429 && (SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax
)
2431 /* Only terminate the comment section if the end-comment
2432 sequence of the same style as the start sequence has
2433 been encountered. */
2437 state
.incomment
= 0;
2438 state
.comstyle
= 0; /* reset the comment style */
2439 if (boundary_stop
) goto done
;
2443 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2445 /* curlevel++->last ran into compiler bug on Apollo */
2446 curlevel
->last
= prev_from
;
2447 if (++curlevel
== endlevel
)
2448 error ("Nesting too deep for parser");
2449 curlevel
->prev
= -1;
2450 curlevel
->last
= -1;
2451 if (targetdepth
== depth
) goto done
;
2456 if (depth
< mindepth
)
2458 if (curlevel
!= levelstart
)
2460 curlevel
->prev
= curlevel
->last
;
2461 if (targetdepth
== depth
) goto done
;
2466 state
.comstr_start
= from
- 1;
2467 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2468 curlevel
->last
= prev_from
;
2469 state
.instring
= (code
== Sstring
2470 ? (FETCH_CHAR (prev_from_byte
))
2472 if (boundary_stop
) goto done
;
2475 nofence
= state
.instring
!= ST_STRING_STYLE
;
2481 if (from
>= end
) goto done
;
2482 c
= FETCH_CHAR (from_byte
);
2483 if (nofence
&& c
== state
.instring
) break;
2484 switch (SWITCH_ENUM_CAST (SYNTAX (c
)))
2487 if (!nofence
) goto string_end
;
2492 startquotedinstring
:
2493 if (from
>= end
) goto endquoted
;
2499 state
.instring
= -1;
2500 curlevel
->prev
= curlevel
->last
;
2502 if (boundary_stop
) goto done
;
2511 stop
: /* Here if stopping before start of sexp. */
2512 from
= prev_from
; /* We have just fetched the char that starts it; */
2513 goto done
; /* but return the position before it. */
2518 state
.depth
= depth
;
2519 state
.mindepth
= mindepth
;
2520 state
.thislevelstart
= curlevel
->prev
;
2521 state
.prevlevelstart
2522 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
2523 state
.location
= from
;
2529 /* This comment supplies the doc string for parse-partial-sexp,
2530 for make-docfile to see. We cannot put this in the real DEFUN
2531 due to limits in the Unix cpp.
2533 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
2534 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
2535 Parsing stops at TO or when certain criteria are met;\n\
2536 point is set to where parsing stops.\n\
2537 If fifth arg STATE is omitted or nil,\n\
2538 parsing assumes that FROM is the beginning of a function.\n\
2539 Value is a list of nine elements describing final state of parsing:\n\
2540 0. depth in parens.\n\
2541 1. character address of start of innermost containing list; nil if none.\n\
2542 2. character address of start of last complete sexp terminated.\n\
2543 3. non-nil if inside a string.\n\
2544 (it is the character that will terminate the string,\n\
2545 or t if the string should be terminated by a generic string delimiter.)\n\
2546 4. t if inside a comment.\n\
2547 5. t if following a quote character.\n\
2548 6. the minimum paren-depth encountered during this scan.\n\
2549 7. t if in a comment of style b; `syntax-table' if the comment\n\
2550 should be terminated by a generic comment delimiter.\n\
2551 8. character address of start of comment or string; nil if not in one.\n\
2552 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
2553 in parentheses becomes equal to TARGETDEPTH.\n\
2554 Fourth arg STOPBEFORE non-nil means stop when come to\n\
2555 any character that starts a sexp.\n\
2556 Fifth arg STATE is a nine-element list like what this function returns.\n\
2557 It is used to initialize the state of the parse. Elements number 1, 2, 6\n\
2558 and 8 are ignored; you can leave off element 8 (the last) entirely.\n\
2559 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.\n\
2560 If it is `syntax-table', stop after the start of a comment or a string,\n\
2561 or after end of a comment or a string.")
2562 (from, to, targetdepth, stopbefore, state, commentstop)
2565 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 6, 0,
2566 0 /* See immediately above */)
2567 (from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
)
2568 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
;
2570 struct lisp_parse_state state
;
2573 if (!NILP (targetdepth
))
2575 CHECK_NUMBER (targetdepth
, 3);
2576 target
= XINT (targetdepth
);
2579 target
= -100000; /* We won't reach this depth */
2581 validate_region (&from
, &to
);
2582 scan_sexps_forward (&state
, XINT (from
), CHAR_TO_BYTE (XINT (from
)),
2584 target
, !NILP (stopbefore
), oldstate
,
2586 ? 0 : (EQ (commentstop
, Qsyntax_table
) ? -1 : 1)));
2588 SET_PT (state
.location
);
2590 return Fcons (make_number (state
.depth
),
2591 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
2592 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
2593 Fcons (state
.instring
>= 0
2594 ? (state
.instring
== ST_STRING_STYLE
2595 ? Qt
: make_number (state
.instring
)) : Qnil
,
2596 Fcons (state
.incomment
? Qt
: Qnil
,
2597 Fcons (state
.quoted
? Qt
: Qnil
,
2598 Fcons (make_number (state
.mindepth
),
2599 Fcons ((state
.comstyle
2600 ? (state
.comstyle
== ST_COMMENT_STYLE
2601 ? Qsyntax_table
: Qt
) :
2603 Fcons ((state
.incomment
|| state
.instring
2604 ? make_number (state
.comstr_start
)
2615 /* This has to be done here, before we call Fmake_char_table. */
2616 Qsyntax_table
= intern ("syntax-table");
2617 staticpro (&Qsyntax_table
);
2619 /* Intern this now in case it isn't already done.
2620 Setting this variable twice is harmless.
2621 But don't staticpro it here--that is done in alloc.c. */
2622 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
2624 /* Create objects which can be shared among syntax tables. */
2625 Vsyntax_code_object
= Fmake_vector (make_number (13), Qnil
);
2626 for (i
= 0; i
< XVECTOR (Vsyntax_code_object
)->size
; i
++)
2627 XVECTOR (Vsyntax_code_object
)->contents
[i
]
2628 = Fcons (make_number (i
), Qnil
);
2630 /* Now we are ready to set up this property, so we can
2631 create syntax tables. */
2632 Fput (Qsyntax_table
, Qchar_table_extra_slots
, make_number (0));
2634 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Swhitespace
];
2636 Vstandard_syntax_table
= Fmake_char_table (Qsyntax_table
, temp
);
2638 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Sword
];
2639 for (i
= 'a'; i
<= 'z'; i
++)
2640 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2641 for (i
= 'A'; i
<= 'Z'; i
++)
2642 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2643 for (i
= '0'; i
<= '9'; i
++)
2644 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2646 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '$', temp
);
2647 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '%', temp
);
2649 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '(',
2650 Fcons (make_number (Sopen
), make_number (')')));
2651 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ')',
2652 Fcons (make_number (Sclose
), make_number ('(')));
2653 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '[',
2654 Fcons (make_number (Sopen
), make_number (']')));
2655 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ']',
2656 Fcons (make_number (Sclose
), make_number ('[')));
2657 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '{',
2658 Fcons (make_number (Sopen
), make_number ('}')));
2659 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '}',
2660 Fcons (make_number (Sclose
), make_number ('{')));
2661 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '"',
2662 Fcons (make_number ((int) Sstring
), Qnil
));
2663 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '\\',
2664 Fcons (make_number ((int) Sescape
), Qnil
));
2666 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Ssymbol
];
2667 for (i
= 0; i
< 10; i
++)
2669 c
= "_-+*/&|<>="[i
];
2670 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2673 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Spunct
];
2674 for (i
= 0; i
< 12; i
++)
2676 c
= ".,;:?!#@~^'`"[i
];
2677 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2684 Qsyntax_table_p
= intern ("syntax-table-p");
2685 staticpro (&Qsyntax_table_p
);
2687 staticpro (&Vsyntax_code_object
);
2689 Qscan_error
= intern ("scan-error");
2690 staticpro (&Qscan_error
);
2691 Fput (Qscan_error
, Qerror_conditions
,
2692 Fcons (Qerror
, Qnil
));
2693 Fput (Qscan_error
, Qerror_message
,
2694 build_string ("Scan error"));
2696 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
2697 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
2699 DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties
,
2700 "Non-nil means `forward-sexp', etc., grant `syntax-table' property.\n\
2701 The value of this property should be either a syntax table, or a cons\n\
2702 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric\n\
2703 syntax code, MATCHCHAR being nil or the character to match (which is\n\
2704 relevant only for open/close type.");
2706 words_include_escapes
= 0;
2707 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
2708 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
2710 defsubr (&Ssyntax_table_p
);
2711 defsubr (&Ssyntax_table
);
2712 defsubr (&Sstandard_syntax_table
);
2713 defsubr (&Scopy_syntax_table
);
2714 defsubr (&Sset_syntax_table
);
2715 defsubr (&Schar_syntax
);
2716 defsubr (&Smatching_paren
);
2717 defsubr (&Smodify_syntax_entry
);
2718 defsubr (&Sdescribe_syntax
);
2720 defsubr (&Sforward_word
);
2722 defsubr (&Sskip_chars_forward
);
2723 defsubr (&Sskip_chars_backward
);
2724 defsubr (&Sskip_syntax_forward
);
2725 defsubr (&Sskip_syntax_backward
);
2727 defsubr (&Sforward_comment
);
2728 defsubr (&Sscan_lists
);
2729 defsubr (&Sscan_sexps
);
2730 defsubr (&Sbackward_prefix_chars
);
2731 defsubr (&Sparse_partial_sexp
);