1 /* GNU Emacs routines to deal with syntax tables; also word and list parsing.
2 Copyright (C) 1985, 87, 93, 94, 95, 97, 1998, 1999 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
; /* -1 if in unnestable comment else comment nesting */
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. */
67 Lisp_Object levelstarts
; /* Char numbers of starts-of-expression
68 of levels (starting from outermost). */
71 /* These variables are a cache for finding the start of a defun.
72 find_start_pos is the place for which the defun start was found.
73 find_start_value is the defun start position found for it.
74 find_start_value_byte is the corresponding byte position.
75 find_start_buffer is the buffer it was found in.
76 find_start_begv is the BEGV value when it was found.
77 find_start_modiff is the value of MODIFF when it was found. */
79 static int find_start_pos
;
80 static int find_start_value
;
81 static int find_start_value_byte
;
82 static struct buffer
*find_start_buffer
;
83 static int find_start_begv
;
84 static int find_start_modiff
;
87 static int find_defun_start
P_ ((int, int));
88 static int back_comment
P_ ((int, int, int, int, int, int *, int *));
89 static int char_quoted
P_ ((int, int));
90 static Lisp_Object skip_chars
P_ ((int, int, Lisp_Object
, Lisp_Object
));
91 static Lisp_Object scan_lists
P_ ((int, int, int, int));
92 static void scan_sexps_forward
P_ ((struct lisp_parse_state
*,
94 int, Lisp_Object
, int));
97 struct gl_state_s gl_state
; /* Global state of syntax parser. */
99 INTERVAL
interval_of ();
100 #define INTERVALS_AT_ONCE 10 /* 1 + max-number of intervals
101 to scan to property-change. */
103 /* Update gl_state to an appropriate interval which contains CHARPOS. The
104 sign of COUNT give the relative position of CHARPOS wrt the previously
105 valid interval. If INIT, only [be]_property fields of gl_state are
106 valid at start, the rest is filled basing on OBJECT.
108 `gl_state.*_i' are the intervals, and CHARPOS is further in the search
109 direction than the intervals - or in an interval. We update the
110 current syntax-table basing on the property of this interval, and
111 update the interval to start further than CHARPOS - or be
112 NULL_INTERVAL. We also update lim_property to be the next value of
113 charpos to call this subroutine again - or be before/after the
114 start/end of OBJECT. */
117 update_syntax_table (charpos
, count
, init
, object
)
118 int charpos
, count
, init
;
121 Lisp_Object tmp_table
;
122 int cnt
= 0, invalidate
= 1;
127 gl_state
.start
= gl_state
.b_property
;
128 gl_state
.stop
= gl_state
.e_property
;
129 gl_state
.forward_i
= interval_of (charpos
, object
);
130 i
= gl_state
.backward_i
= gl_state
.forward_i
;
131 gl_state
.left_ok
= gl_state
.right_ok
= 1;
133 if (NULL_INTERVAL_P (i
))
135 /* interval_of updates only ->position of the return value, so
136 update the parents manually to speed up update_interval. */
137 while (!NULL_PARENT (i
))
139 if (AM_RIGHT_CHILD (i
))
140 i
->parent
->position
= i
->position
141 - LEFT_TOTAL_LENGTH (i
) + TOTAL_LENGTH (i
) /* right end */
142 - TOTAL_LENGTH (i
->parent
)
143 + LEFT_TOTAL_LENGTH (i
->parent
);
145 i
->parent
->position
= i
->position
- LEFT_TOTAL_LENGTH (i
)
149 i
= gl_state
.forward_i
;
150 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
151 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
154 oldi
= i
= count
> 0 ? gl_state
.forward_i
: gl_state
.backward_i
;
156 /* We are guarantied to be called with CHARPOS either in i,
158 if (NULL_INTERVAL_P (i
))
159 error ("Error in syntax_table logic for to-the-end intervals");
160 else if (charpos
< i
->position
) /* Move left. */
163 error ("Error in syntax_table logic for intervals <-");
164 /* Update the interval. */
165 i
= update_interval (i
, charpos
);
166 if (oldi
->position
!= INTERVAL_LAST_POS (i
))
169 gl_state
.right_ok
= 1; /* Invalidate the other end. */
170 gl_state
.forward_i
= i
;
171 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
174 else if (charpos
>= INTERVAL_LAST_POS (i
)) /* Move right. */
177 error ("Error in syntax_table logic for intervals ->");
178 /* Update the interval. */
179 i
= update_interval (i
, charpos
);
180 if (i
->position
!= INTERVAL_LAST_POS (oldi
))
183 gl_state
.left_ok
= 1; /* Invalidate the other end. */
184 gl_state
.backward_i
= i
;
185 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
188 else if (count
> 0 ? gl_state
.right_ok
: gl_state
.left_ok
)
190 /* We do not need to recalculate tmp_table. */
191 tmp_table
= gl_state
.old_prop
;
195 tmp_table
= textget (i
->plist
, Qsyntax_table
);
198 invalidate
= !EQ (tmp_table
, gl_state
.old_prop
); /* Need to invalidate? */
200 if (invalidate
) /* Did not get to adjacent interval. */
201 { /* with the same table => */
202 /* invalidate the old range. */
205 gl_state
.backward_i
= i
;
206 gl_state
.left_ok
= 1; /* Invalidate the other end. */
207 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
211 gl_state
.forward_i
= i
;
212 gl_state
.right_ok
= 1; /* Invalidate the other end. */
213 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
217 gl_state
.current_syntax_table
= tmp_table
;
218 gl_state
.old_prop
= tmp_table
;
219 if (EQ (Fsyntax_table_p (tmp_table
), Qt
))
221 gl_state
.use_global
= 0;
223 else if (CONSP (tmp_table
))
225 gl_state
.use_global
= 1;
226 gl_state
.global_code
= tmp_table
;
230 gl_state
.use_global
= 0;
231 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
234 while (!NULL_INTERVAL_P (i
))
236 if (cnt
&& !EQ (tmp_table
, textget (i
->plist
, Qsyntax_table
)))
239 gl_state
.right_ok
= 0;
241 gl_state
.left_ok
= 0;
244 else if (cnt
== INTERVALS_AT_ONCE
)
247 gl_state
.right_ok
= 1;
249 gl_state
.left_ok
= 1;
253 i
= count
> 0 ? next_interval (i
) : previous_interval (i
);
255 if (NULL_INTERVAL_P (i
))
256 { /* This property goes to the end. */
258 gl_state
.e_property
= gl_state
.stop
;
260 gl_state
.b_property
= gl_state
.start
;
266 gl_state
.e_property
= i
->position
- gl_state
.offset
;
267 gl_state
.forward_i
= i
;
271 gl_state
.b_property
= i
->position
+ LENGTH (i
) - 1 - gl_state
.offset
;
272 gl_state
.backward_i
= i
;
277 /* Returns TRUE if char at CHARPOS is quoted.
278 Global syntax-table data should be set up already to be good at CHARPOS
279 or after. On return global syntax data is good for lookup at CHARPOS. */
282 char_quoted (charpos
, bytepos
)
283 register int charpos
, bytepos
;
285 register enum syntaxcode code
;
286 register int beg
= BEGV
;
287 register int quoted
= 0;
290 DEC_BOTH (charpos
, bytepos
);
292 while (bytepos
>= beg
)
294 UPDATE_SYNTAX_TABLE_BACKWARD (charpos
);
295 code
= SYNTAX (FETCH_CHAR (bytepos
));
296 if (! (code
== Scharquote
|| code
== Sescape
))
299 DEC_BOTH (charpos
, bytepos
);
303 UPDATE_SYNTAX_TABLE (orig
);
307 /* Return the bytepos one character after BYTEPOS.
308 We assume that BYTEPOS is not at the end of the buffer. */
311 inc_bytepos (bytepos
)
314 if (NILP (current_buffer
->enable_multibyte_characters
))
321 /* Return the bytepos one character before BYTEPOS.
322 We assume that BYTEPOS is not at the start of the buffer. */
325 dec_bytepos (bytepos
)
328 if (NILP (current_buffer
->enable_multibyte_characters
))
335 /* Find a defun-start that is the last one before POS (or nearly the last).
336 We record what we find, so that another call in the same area
337 can return the same value right away.
339 There is no promise at which position the global syntax data is
340 valid on return from the subroutine, so the caller should explicitly
341 update the global data. */
344 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 /* Return the SYNTAX_COMEND_FIRST of the character before POS, POS_BYTE. */
400 prev_char_comend_first (pos
, pos_byte
)
405 DEC_BOTH (pos
, pos_byte
);
406 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
407 c
= FETCH_CHAR (pos_byte
);
408 val
= SYNTAX_COMEND_FIRST (c
);
409 UPDATE_SYNTAX_TABLE_FORWARD (pos
+ 1);
413 /* Return the SYNTAX_COMSTART_FIRST of the character before POS, POS_BYTE. */
416 prev_char_comstart_first (pos
, pos_byte
)
421 DEC_BOTH (pos
, pos_byte
);
422 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
423 c
= FETCH_CHAR (pos_byte
);
424 val
= SYNTAX_COMSTART_FIRST (c
);
425 UPDATE_SYNTAX_TABLE_FORWARD (pos
+ 1);
429 /* Checks whether charpos FROM is at the end of a comment.
430 FROM_BYTE is the bytepos corresponding to FROM.
431 Do not move back before STOP.
433 Return a positive value if we find a comment ending at FROM/FROM_BYTE;
436 If successful, store the charpos of the comment's beginning
437 into *CHARPOS_PTR, and the bytepos into *BYTEPOS_PTR.
439 Global syntax data remains valid for backward search starting at
440 the returned value (or at FROM, if the search was not successful). */
443 back_comment (from
, from_byte
, stop
, comnested
, comstyle
, charpos_ptr
, bytepos_ptr
)
444 int from
, from_byte
, stop
;
445 int comnested
, comstyle
;
446 int *charpos_ptr
, *bytepos_ptr
;
448 /* Look back, counting the parity of string-quotes,
449 and recording the comment-starters seen.
450 When we reach a safe place, assume that's not in a string;
451 then step the main scan to the earliest comment-starter seen
452 an even number of string quotes away from the safe place.
454 OFROM[I] is position of the earliest comment-starter seen
455 which is I+2X quotes from the comment-end.
456 PARITY is current parity of quotes from the comment end. */
458 int my_stringend
= 0;
459 int string_lossage
= 0;
460 int comment_end
= from
;
461 int comment_end_byte
= from_byte
;
462 int comstart_pos
= 0;
464 /* Value that PARITY had, when we reached the position
466 int comstart_parity
= 0;
467 int scanstart
= from
- 1;
468 /* Place where the containing defun starts,
469 or 0 if we didn't come across it yet. */
471 int defun_start_byte
= 0;
472 register enum syntaxcode code
;
473 int nesting
= 1; /* current comment nesting */
476 /* At beginning of range to scan, we're outside of strings;
477 that determines quote parity to the comment-end. */
482 /* Move back and examine a character. */
483 DEC_BOTH (from
, from_byte
);
484 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
486 c
= FETCH_CHAR (from_byte
);
489 /* If this char is the second of a 2-char comment end sequence,
490 back up and give the pair the appropriate syntax. */
491 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
492 && prev_char_comend_first (from
, from_byte
))
495 DEC_BOTH (from
, from_byte
);
496 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
497 c
= FETCH_CHAR (from_byte
);
500 /* If this char starts a 2-char comment start sequence,
501 treat it like a 1-char comment starter. */
502 if (from
< scanstart
&& SYNTAX_COMSTART_FIRST (c
))
504 temp_byte
= inc_bytepos (from_byte
);
505 UPDATE_SYNTAX_TABLE_FORWARD (from
+ 1);
506 if (SYNTAX_COMSTART_SECOND (FETCH_CHAR (temp_byte
))
507 && comstyle
== SYNTAX_COMMENT_STYLE (FETCH_CHAR (temp_byte
)))
509 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
512 /* Ignore escaped characters, except comment-enders. */
513 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
516 /* Track parity of quotes. */
520 if (my_stringend
== 0)
522 /* If we have two kinds of string delimiters.
523 There's no way to grok this scanning backwards. */
524 else if (my_stringend
!= c
)
528 if (code
== Sstring_fence
|| code
== Scomment_fence
)
531 if (my_stringend
== 0)
533 = code
== Sstring_fence
? ST_STRING_STYLE
: ST_COMMENT_STYLE
;
534 /* If we have two kinds of string delimiters.
535 There's no way to grok this scanning backwards. */
536 else if (my_stringend
!= (code
== Sstring_fence
537 ? ST_STRING_STYLE
: ST_COMMENT_STYLE
))
541 if (code
== Scomment
)
542 /* FIXME: we should also check that the comstyle is correct
543 if the Scomment is a single-char. */
545 if (comnested
&& --nesting
<= 0 && parity
== 0 && !string_lossage
)
546 /* nested comments have to be balanced, so we don't need to
547 keep looking for earlier ones. We use here the same (slightly
548 incorrect) reasoning as below: since it is followed by uniform
549 paired string quotes, this comment-start has to be outside of
550 strings, else the comment-end itself would be inside a string. */
553 /* Record comment-starters according to that
554 quote-parity to the comment-end. */
555 comstart_parity
= parity
;
557 comstart_byte
= from_byte
;
560 /* If we find another earlier comment-ender,
561 any comment-starts earlier than that don't count
562 (because they go with the earlier comment-ender). */
563 if (code
== Sendcomment
564 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)) == comstyle
)
572 /* Assume a defun-start point is outside of strings. */
575 || (temp_byte
= dec_bytepos (from_byte
),
576 FETCH_CHAR (temp_byte
) == '\n')))
579 defun_start_byte
= from_byte
;
584 if (comstart_pos
== 0)
587 from_byte
= comment_end_byte
;
588 UPDATE_SYNTAX_TABLE_FORWARD (comment_end
- 1);
590 /* If the earliest comment starter
591 is followed by uniform paired string quotes or none,
592 we know it can't be inside a string
593 since if it were then the comment ender would be inside one.
594 So it does start a comment. Skip back to it. */
595 else if (!comnested
&& comstart_parity
== 0 && !string_lossage
)
598 from_byte
= comstart_byte
;
599 /* Globals are correct now. */
603 /* We had two kinds of string delimiters mixed up
604 together. Decode this going forwards.
605 Scan fwd from the previous comment ender
606 to the one in question; this records where we
607 last passed a comment starter. */
608 struct lisp_parse_state state
;
609 /* If we did not already find the defun start, find it now. */
610 if (defun_start
== 0)
612 defun_start
= find_defun_start (comment_end
, comment_end_byte
);
613 defun_start_byte
= find_start_value_byte
;
615 scan_sexps_forward (&state
,
616 defun_start
, defun_start_byte
,
617 comment_end
- 1, -10000, 0, Qnil
, 0);
620 /* scan_sexps_forward changed the direction of search in
621 global variables, so we need to update it completely. */
623 from
= state
.comstr_start
;
629 from_byte
= CHAR_TO_BYTE (from
);
630 UPDATE_SYNTAX_TABLE_FORWARD (from
- 1);
635 *bytepos_ptr
= from_byte
;
640 DEFUN ("syntax-table-p", Fsyntax_table_p
, Ssyntax_table_p
, 1, 1, 0,
641 "Return t if OBJECT is a syntax table.\n\
642 Currently, any char-table counts as a syntax table.")
646 if (CHAR_TABLE_P (object
)
647 && EQ (XCHAR_TABLE (object
)->purpose
, Qsyntax_table
))
653 check_syntax_table (obj
)
656 if (!(CHAR_TABLE_P (obj
)
657 && EQ (XCHAR_TABLE (obj
)->purpose
, Qsyntax_table
)))
658 wrong_type_argument (Qsyntax_table_p
, obj
);
661 DEFUN ("syntax-table", Fsyntax_table
, Ssyntax_table
, 0, 0, 0,
662 "Return the current syntax table.\n\
663 This is the one specified by the current buffer.")
666 return current_buffer
->syntax_table
;
669 DEFUN ("standard-syntax-table", Fstandard_syntax_table
,
670 Sstandard_syntax_table
, 0, 0, 0,
671 "Return the standard syntax table.\n\
672 This is the one used for new buffers.")
675 return Vstandard_syntax_table
;
678 DEFUN ("copy-syntax-table", Fcopy_syntax_table
, Scopy_syntax_table
, 0, 1, 0,
679 "Construct a new syntax table and return it.\n\
680 It is a copy of the TABLE, which defaults to the standard syntax table.")
687 check_syntax_table (table
);
689 table
= Vstandard_syntax_table
;
691 copy
= Fcopy_sequence (table
);
693 /* Only the standard syntax table should have a default element.
694 Other syntax tables should inherit from parents instead. */
695 XCHAR_TABLE (copy
)->defalt
= Qnil
;
697 /* Copied syntax tables should all have parents.
698 If we copied one with no parent, such as the standard syntax table,
699 use the standard syntax table as the copy's parent. */
700 if (NILP (XCHAR_TABLE (copy
)->parent
))
701 Fset_char_table_parent (copy
, Vstandard_syntax_table
);
705 DEFUN ("set-syntax-table", Fset_syntax_table
, Sset_syntax_table
, 1, 1, 0,
706 "Select a new syntax table for the current buffer.\n\
707 One argument, a syntax table.")
711 check_syntax_table (table
);
712 current_buffer
->syntax_table
= table
;
713 /* Indicate that this buffer now has a specified syntax table. */
714 current_buffer
->local_var_flags
715 |= XFASTINT (buffer_local_flags
.syntax_table
);
719 /* Convert a letter which signifies a syntax code
720 into the code it signifies.
721 This is used by modify-syntax-entry, and other things. */
723 unsigned char syntax_spec_code
[0400] =
724 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
725 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
726 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
727 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
728 (char) Swhitespace
, (char) Scomment_fence
, (char) Sstring
, 0377,
729 (char) Smath
, 0377, 0377, (char) Squote
,
730 (char) Sopen
, (char) Sclose
, 0377, 0377,
731 0377, (char) Swhitespace
, (char) Spunct
, (char) Scharquote
,
732 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
733 0377, 0377, 0377, 0377,
734 (char) Scomment
, 0377, (char) Sendcomment
, 0377,
735 (char) Sinherit
, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */
736 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
737 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
738 0377, 0377, 0377, 0377, (char) Sescape
, 0377, 0377, (char) Ssymbol
,
739 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
740 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
741 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
742 0377, 0377, 0377, 0377, (char) Sstring_fence
, 0377, 0377, 0377
745 /* Indexed by syntax code, give the letter that describes it. */
747 char syntax_code_spec
[16] =
749 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@',
753 /* Indexed by syntax code, give the object (cons of syntax code and
754 nil) to be stored in syntax table. Since these objects can be
755 shared among syntax tables, we generate them in advance. By
756 sharing objects, the function `describe-syntax' can give a more
758 static Lisp_Object Vsyntax_code_object
;
761 /* Look up the value for CHARACTER in syntax table TABLE's parent
762 and its parents. SYNTAX_ENTRY calls this, when TABLE itself has nil
763 for CHARACTER. It's actually used only when not compiled with GCC. */
766 syntax_parent_lookup (table
, character
)
774 table
= XCHAR_TABLE (table
)->parent
;
778 value
= XCHAR_TABLE (table
)->contents
[character
];
784 DEFUN ("char-syntax", Fchar_syntax
, Schar_syntax
, 1, 1, 0,
785 "Return the syntax code of CHARACTER, described by a character.\n\
786 For example, if CHARACTER is a word constituent,\n\
787 the character `w' is returned.\n\
788 The characters that correspond to various syntax codes\n\
789 are listed in the documentation of `modify-syntax-entry'.")
791 Lisp_Object character
;
794 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
796 gl_state
.use_global
= 0;
797 CHECK_NUMBER (character
, 0);
798 char_int
= XINT (character
);
799 return make_number (syntax_code_spec
[(int) SYNTAX (char_int
)]);
802 DEFUN ("matching-paren", Fmatching_paren
, Smatching_paren
, 1, 1, 0,
803 "Return the matching parenthesis of CHARACTER, or nil if none.")
805 Lisp_Object character
;
808 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
809 gl_state
.use_global
= 0;
810 CHECK_NUMBER (character
, 0);
811 char_int
= XINT (character
);
812 code
= SYNTAX (char_int
);
813 if (code
== Sopen
|| code
== Sclose
)
814 return SYNTAX_MATCH (char_int
);
818 /* This comment supplies the doc string for modify-syntax-entry,
819 for make-docfile to see. We cannot put this in the real DEFUN
820 due to limits in the Unix cpp.
822 DEFUN ("modify-syntax-entry", foo, bar, 2, 3, 0,
823 "Set syntax for character CHAR according to string S.\n\
824 The syntax is changed only for table TABLE, which defaults to\n\
825 the current buffer's syntax table.\n\
826 The first character of S should be one of the following:\n\
827 Space or - whitespace syntax. w word constituent.\n\
828 _ symbol constituent. . punctuation.\n\
829 ( open-parenthesis. ) close-parenthesis.\n\
830 \" string quote. \\ escape.\n\
831 $ paired delimiter. ' expression quote or prefix operator.\n\
832 < comment starter. > comment ender.\n\
833 / character-quote. @ inherit from `standard-syntax-table'.\n\
835 Only single-character comment start and end sequences are represented thus.\n\
836 Two-character sequences are represented as described below.\n\
837 The second character of S is the matching parenthesis,\n\
838 used only if the first character is `(' or `)'.\n\
839 Any additional characters are flags.\n\
840 Defined flags are the characters 1, 2, 3, 4, b, p, and n.\n\
841 1 means CHAR is the start of a two-char comment start sequence.\n\
842 2 means CHAR is the second character of such a sequence.\n\
843 3 means CHAR is the start of a two-char comment end sequence.\n\
844 4 means CHAR is the second character of such a sequence.\n\
846 There can be up to two orthogonal comment sequences. This is to support\n\
847 language modes such as C++. By default, all comment sequences are of style\n\
848 a, but you can set the comment sequence style to b (on the second character\n\
849 of a comment-start, or the first character of a comment-end sequence) using\n\
851 b means CHAR is part of comment sequence b.\n\
852 n means CHAR is part of a nestable comment sequence.\n\
854 p means CHAR is a prefix character for `backward-prefix-chars';\n\
855 such characters are treated as whitespace when they occur\n\
856 between expressions.")
860 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry
, Smodify_syntax_entry
, 2, 3,
861 /* I really don't know why this is interactive
862 help-form should at least be made useful whilst reading the second arg
864 "cSet syntax for character: \nsSet syntax for %s to: ",
865 0 /* See immediately above */)
866 (c
, newentry
, syntax_table
)
867 Lisp_Object c
, newentry
, syntax_table
;
869 register unsigned char *p
;
870 register enum syntaxcode code
;
875 CHECK_STRING (newentry
, 1);
877 if (NILP (syntax_table
))
878 syntax_table
= current_buffer
->syntax_table
;
880 check_syntax_table (syntax_table
);
882 p
= XSTRING (newentry
)->data
;
883 code
= (enum syntaxcode
) syntax_spec_code
[*p
++];
884 if (((int) code
& 0377) == 0377)
885 error ("invalid syntax description letter: %c", p
[-1]);
887 if (code
== Sinherit
)
889 SET_RAW_SYNTAX_ENTRY (syntax_table
, XINT (c
), Qnil
);
896 int character
= (STRING_CHAR_AND_LENGTH
897 (p
, STRING_BYTES (XSTRING (newentry
)) - 1, len
));
898 XSETINT (match
, character
);
899 if (XFASTINT (match
) == ' ')
939 if (val
< XVECTOR (Vsyntax_code_object
)->size
&& NILP (match
))
940 newentry
= XVECTOR (Vsyntax_code_object
)->contents
[val
];
942 /* Since we can't use a shared object, let's make a new one. */
943 newentry
= Fcons (make_number (val
), match
);
945 SET_RAW_SYNTAX_ENTRY (syntax_table
, XINT (c
), newentry
);
950 /* Dump syntax table to buffer in human-readable format */
953 describe_syntax (value
)
956 register enum syntaxcode code
;
957 char desc
, start1
, start2
, end1
, end2
, prefix
, comstyle
;
959 Lisp_Object first
, match_lisp
;
961 Findent_to (make_number (16), make_number (1));
965 insert_string ("default\n");
969 if (CHAR_TABLE_P (value
))
971 insert_string ("deeper char-table ...\n");
977 insert_string ("invalid\n");
981 first
= XCAR (value
);
982 match_lisp
= XCDR (value
);
984 if (!INTEGERP (first
) || !(NILP (match_lisp
) || INTEGERP (match_lisp
)))
986 insert_string ("invalid\n");
990 code
= (enum syntaxcode
) (XINT (first
) & 0377);
991 start1
= (XINT (first
) >> 16) & 1;
992 start2
= (XINT (first
) >> 17) & 1;
993 end1
= (XINT (first
) >> 18) & 1;
994 end2
= (XINT (first
) >> 19) & 1;
995 prefix
= (XINT (first
) >> 20) & 1;
996 comstyle
= (XINT (first
) >> 21) & 1;
998 if ((int) code
< 0 || (int) code
>= (int) Smax
)
1000 insert_string ("invalid");
1003 desc
= syntax_code_spec
[(int) code
];
1005 str
[0] = desc
, str
[1] = 0;
1008 if (NILP (match_lisp
))
1011 insert_char (XINT (match_lisp
));
1028 insert_string ("\twhich means: ");
1030 switch (SWITCH_ENUM_CAST (code
))
1033 insert_string ("whitespace"); break;
1035 insert_string ("punctuation"); break;
1037 insert_string ("word"); break;
1039 insert_string ("symbol"); break;
1041 insert_string ("open"); break;
1043 insert_string ("close"); break;
1045 insert_string ("quote"); break;
1047 insert_string ("string"); break;
1049 insert_string ("math"); break;
1051 insert_string ("escape"); break;
1053 insert_string ("charquote"); break;
1055 insert_string ("comment"); break;
1057 insert_string ("endcomment"); break;
1059 insert_string ("invalid");
1063 if (!NILP (match_lisp
))
1065 insert_string (", matches ");
1066 insert_char (XINT (match_lisp
));
1070 insert_string (",\n\t is the first character of a comment-start sequence");
1072 insert_string (",\n\t is the second character of a comment-start sequence");
1075 insert_string (",\n\t is the first character of a comment-end sequence");
1077 insert_string (",\n\t is the second character of a comment-end sequence");
1079 insert_string (" (comment style b)");
1082 insert_string (",\n\t is a prefix character for `backward-prefix-chars'");
1084 insert_string ("\n");
1088 describe_syntax_1 (vector
)
1091 struct buffer
*old
= current_buffer
;
1092 set_buffer_internal (XBUFFER (Vstandard_output
));
1093 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
, (int *) 0, 0);
1094 while (! NILP (XCHAR_TABLE (vector
)->parent
))
1096 vector
= XCHAR_TABLE (vector
)->parent
;
1097 insert_string ("\nThe parent syntax table is:");
1098 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
,
1102 call0 (intern ("help-mode"));
1103 set_buffer_internal (old
);
1107 DEFUN ("describe-syntax", Fdescribe_syntax
, Sdescribe_syntax
, 0, 0, "",
1108 "Describe the syntax specifications in the syntax table.\n\
1109 The descriptions are inserted in a buffer, which is then displayed.")
1112 internal_with_output_to_temp_buffer
1113 ("*Help*", describe_syntax_1
, current_buffer
->syntax_table
);
1118 int parse_sexp_ignore_comments
;
1120 /* Return the position across COUNT words from FROM.
1121 If that many words cannot be found before the end of the buffer, return 0.
1122 COUNT negative means scan backward and stop at word beginning. */
1125 scan_words (from
, count
)
1126 register int from
, count
;
1128 register int beg
= BEGV
;
1129 register int end
= ZV
;
1130 register int from_byte
= CHAR_TO_BYTE (from
);
1131 register enum syntaxcode code
;
1137 SETUP_SYNTAX_TABLE (from
, count
);
1148 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1149 ch0
= FETCH_CHAR (from_byte
);
1150 code
= SYNTAX (ch0
);
1151 INC_BOTH (from
, from_byte
);
1152 if (words_include_escapes
1153 && (code
== Sescape
|| code
== Scharquote
))
1158 /* Now CH0 is a character which begins a word and FROM is the
1159 position of the next character. */
1162 if (from
== end
) break;
1163 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1164 ch1
= FETCH_CHAR (from_byte
);
1165 code
= SYNTAX (ch1
);
1166 if (!(words_include_escapes
1167 && (code
== Sescape
|| code
== Scharquote
)))
1168 if (code
!= Sword
|| WORD_BOUNDARY_P (ch0
, ch1
))
1170 INC_BOTH (from
, from_byte
);
1184 DEC_BOTH (from
, from_byte
);
1185 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1186 ch1
= FETCH_CHAR (from_byte
);
1187 code
= SYNTAX (ch1
);
1188 if (words_include_escapes
1189 && (code
== Sescape
|| code
== Scharquote
))
1194 /* Now CH1 is a character which ends a word and FROM is the
1202 temp_byte
= dec_bytepos (from_byte
);
1203 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1204 ch0
= FETCH_CHAR (temp_byte
);
1205 code
= SYNTAX (ch0
);
1206 if (!(words_include_escapes
1207 && (code
== Sescape
|| code
== Scharquote
)))
1208 if (code
!= Sword
|| WORD_BOUNDARY_P (ch0
, ch1
))
1210 DEC_BOTH (from
, from_byte
);
1221 DEFUN ("forward-word", Fforward_word
, Sforward_word
, 1, 1, "p",
1222 "Move point forward ARG words (backward if ARG is negative).\n\
1223 Normally returns t.\n\
1224 If an edge of the buffer or a field boundary is reached, point is left there\n\
1225 and the function returns nil.")
1230 CHECK_NUMBER (count
, 0);
1232 val
= orig_val
= scan_words (PT
, XINT (count
));
1234 val
= XINT (count
) > 0 ? ZV
: BEGV
;
1236 /* Avoid jumping out of an input field. */
1237 val
= XFASTINT (Fconstrain_to_field (make_number (val
), make_number (PT
),
1241 return (val
== orig_val
? Qt
: Qnil
);
1244 Lisp_Object
skip_chars ();
1246 DEFUN ("skip-chars-forward", Fskip_chars_forward
, Sskip_chars_forward
, 1, 2, 0,
1247 "Move point forward, stopping before a char not in STRING, or at pos LIM.\n\
1248 STRING is like the inside of a `[...]' in a regular expression\n\
1249 except that `]' is never special and `\\' quotes `^', `-' or `\\'\n\
1250 (but not as the end of a range; quoting is never needed there).\n\
1251 Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
1252 With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\
1253 Returns the distance traveled, either zero or positive.")
1255 Lisp_Object string
, lim
;
1257 return skip_chars (1, 0, string
, lim
);
1260 DEFUN ("skip-chars-backward", Fskip_chars_backward
, Sskip_chars_backward
, 1, 2, 0,
1261 "Move point backward, stopping after a char not in STRING, or at pos LIM.\n\
1262 See `skip-chars-forward' for details.\n\
1263 Returns the distance traveled, either zero or negative.")
1265 Lisp_Object string
, lim
;
1267 return skip_chars (0, 0, string
, lim
);
1270 DEFUN ("skip-syntax-forward", Fskip_syntax_forward
, Sskip_syntax_forward
, 1, 2, 0,
1271 "Move point forward across chars in specified syntax classes.\n\
1272 SYNTAX is a string of syntax code characters.\n\
1273 Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\
1274 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1275 This function returns the distance traveled, either zero or positive.")
1277 Lisp_Object syntax
, lim
;
1279 return skip_chars (1, 1, syntax
, lim
);
1282 DEFUN ("skip-syntax-backward", Fskip_syntax_backward
, Sskip_syntax_backward
, 1, 2, 0,
1283 "Move point backward across chars in specified syntax classes.\n\
1284 SYNTAX is a string of syntax code characters.\n\
1285 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\
1286 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1287 This function returns the distance traveled, either zero or negative.")
1289 Lisp_Object syntax
, lim
;
1291 return skip_chars (0, 1, syntax
, lim
);
1295 skip_chars (forwardp
, syntaxp
, string
, lim
)
1296 int forwardp
, syntaxp
;
1297 Lisp_Object string
, lim
;
1299 register unsigned int c
;
1301 unsigned char fastmap
[0400];
1302 /* If SYNTAXP is 0, STRING may contain multi-byte form of characters
1303 of which codes don't fit in FASTMAP. In that case, we set the
1304 first byte of multibyte form (i.e. base leading-code) in FASTMAP
1305 and set the actual ranges of characters in CHAR_RANGES. In the
1306 form "X-Y" of STRING, both X and Y must belong to the same
1307 character set because a range striding across character sets is
1310 int n_char_ranges
= 0;
1312 register int i
, i_byte
;
1313 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
1314 int string_multibyte
;
1317 CHECK_STRING (string
, 0);
1318 char_ranges
= (int *) alloca (XSTRING (string
)->size
* (sizeof (int)) * 2);
1319 string_multibyte
= STRING_MULTIBYTE (string
);
1320 size_byte
= STRING_BYTES (XSTRING (string
));
1323 XSETINT (lim
, forwardp
? ZV
: BEGV
);
1325 CHECK_NUMBER_COERCE_MARKER (lim
, 0);
1327 /* In any case, don't allow scan outside bounds of buffer. */
1328 if (XINT (lim
) > ZV
)
1329 XSETFASTINT (lim
, ZV
);
1330 if (XINT (lim
) < BEGV
)
1331 XSETFASTINT (lim
, BEGV
);
1333 bzero (fastmap
, sizeof fastmap
);
1337 if (i_byte
< size_byte
1338 && XSTRING (string
)->data
[0] == '^')
1340 negate
= 1; i
++, i_byte
++;
1343 /* Find the characters specified and set their elements of fastmap.
1344 If syntaxp, each character counts as itself.
1345 Otherwise, handle backslashes and ranges specially. */
1347 while (i_byte
< size_byte
)
1351 if (string_multibyte
)
1353 c_leading_code
= XSTRING (string
)->data
[i_byte
];
1354 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1357 c
= c_leading_code
= XSTRING (string
)->data
[i_byte
++];
1359 /* Convert multibyteness between what the string has
1360 and what the buffer has. */
1362 c
= unibyte_char_to_multibyte (c
);
1367 fastmap
[syntax_spec_code
[c
& 0377]] = 1;
1372 if (i_byte
== size_byte
)
1375 if (string_multibyte
)
1377 c_leading_code
= XSTRING (string
)->data
[i_byte
];
1378 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1381 c
= c_leading_code
= XSTRING (string
)->data
[i_byte
++];
1383 if (i_byte
< size_byte
1384 && XSTRING (string
)->data
[i_byte
] == '-')
1386 unsigned int c2
, c2_leading_code
;
1388 /* Skip over the dash. */
1391 if (i_byte
== size_byte
)
1394 /* Get the end of the range. */
1395 if (string_multibyte
)
1397 c2_leading_code
= XSTRING (string
)->data
[i_byte
];
1398 FETCH_STRING_CHAR_ADVANCE (c2
, string
, i
, i_byte
);
1401 c2
= XSTRING (string
)->data
[i_byte
++];
1403 if (SINGLE_BYTE_CHAR_P (c
))
1405 if (! SINGLE_BYTE_CHAR_P (c2
))
1406 error ("Invalid charcter range: %s",
1407 XSTRING (string
)->data
);
1416 if (c_leading_code
!= c2_leading_code
)
1417 error ("Invalid charcter range: %s",
1418 XSTRING (string
)->data
);
1419 fastmap
[c_leading_code
] = 1;
1422 char_ranges
[n_char_ranges
++] = c
;
1423 char_ranges
[n_char_ranges
++] = c2
;
1429 fastmap
[c_leading_code
] = 1;
1430 if (!SINGLE_BYTE_CHAR_P (c
))
1432 char_ranges
[n_char_ranges
++] = c
;
1433 char_ranges
[n_char_ranges
++] = c
;
1439 /* If ^ was the first character, complement the fastmap. In
1440 addition, as all multibyte characters have possibility of
1441 matching, set all entries for base leading codes, which is
1442 harmless even if SYNTAXP is 1. */
1445 for (i
= 0; i
< sizeof fastmap
; i
++)
1447 if (!multibyte
|| !BASE_LEADING_CODE_P (i
))
1454 int start_point
= PT
;
1456 int pos_byte
= PT_BYTE
;
1461 SETUP_SYNTAX_TABLE (pos
, forwardp
? 1 : -1);
1466 if (pos
< XINT (lim
))
1467 while (fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1469 /* Since we already checked for multibyteness,
1470 avoid using INC_BOTH which checks again. */
1473 if (pos
>= XINT (lim
))
1475 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1480 while (pos
< XINT (lim
)
1481 && fastmap
[(int) SYNTAX (FETCH_BYTE (pos
))])
1484 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1492 while (pos
> XINT (lim
))
1494 int savepos
= pos_byte
;
1495 /* Since we already checked for multibyteness,
1496 avoid using DEC_BOTH which checks again. */
1499 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
1500 if (!fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1510 if (pos
> XINT (lim
))
1511 while (fastmap
[(int) SYNTAX (FETCH_BYTE (pos
- 1))])
1514 if (pos
<= XINT (lim
))
1516 UPDATE_SYNTAX_TABLE_BACKWARD (pos
- 1);
1526 while (pos
< XINT (lim
) && fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1528 if (!BASE_LEADING_CODE_P (c
))
1529 INC_BOTH (pos
, pos_byte
);
1530 else if (n_char_ranges
)
1532 /* We much check CHAR_RANGES for a multibyte
1534 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1535 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1536 if ((ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1]))
1538 if (!(negate
^ (i
< n_char_ranges
)))
1541 INC_BOTH (pos
, pos_byte
);
1546 INC_BOTH (pos
, pos_byte
);
1550 while (pos
< XINT (lim
) && fastmap
[FETCH_BYTE (pos
)])
1556 while (pos
> XINT (lim
))
1558 int savepos
= pos_byte
;
1559 DEC_BOTH (pos
, pos_byte
);
1560 if (fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1562 if (!BASE_LEADING_CODE_P (c
))
1564 else if (n_char_ranges
)
1566 /* We much check CHAR_RANGES for a multibyte
1568 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1569 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1570 if (ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1])
1572 if (!(negate
^ (i
< n_char_ranges
)))
1595 while (pos
> XINT (lim
) && fastmap
[FETCH_BYTE (pos
- 1)])
1600 #if 0 /* Not needed now that a position in mid-character
1601 cannot be specified in Lisp. */
1603 /* INC_POS or DEC_POS might have moved POS over LIM. */
1604 && (forwardp
? (pos
> XINT (lim
)) : (pos
< XINT (lim
))))
1611 SET_PT_BOTH (pos
, pos_byte
);
1614 return make_number (PT
- start_point
);
1618 /* Jump over a comment, assuming we are at the beginning of one.
1619 FROM is the current position.
1620 FROM_BYTE is the bytepos corresponding to FROM.
1621 Do not move past STOP (a charpos).
1622 The comment over which we have to jump is of style STYLE
1623 (either SYNTAX_COMMENT_STYLE(foo) or ST_COMMENT_STYLE).
1624 NESTING should be positive to indicate the nesting at the beginning
1625 for nested comments and should be zero or negative else.
1626 ST_COMMENT_STYLE cannot be nested.
1627 PREV_SYNTAX is the SYNTAX_WITH_FLAGS of the previous character
1628 (or 0 If the search cannot start in the middle of a two-character).
1630 If successful, return 1 and store the charpos of the comment's end
1631 into *CHARPOS_PTR and the corresponding bytepos into *BYTEPOS_PTR.
1632 Else, return 0 and store the charpos STOP into *CHARPOS_PTR, the
1633 corresponding bytepos into *BYTEPOS_PTR and the current nesting
1634 (as defined for state.incomment) in *INCOMMENT_PTR.
1636 The comment end is the last character of the comment rather than the
1637 character just after the comment.
1639 Global syntax data is assumed to initially be valid for FROM and
1640 remains valid for forward search starting at the returned position. */
1643 forw_comment (from
, from_byte
, stop
, nesting
, style
, prev_syntax
,
1644 charpos_ptr
, bytepos_ptr
, incomment_ptr
)
1645 int from
, from_byte
, stop
;
1646 int nesting
, style
, prev_syntax
;
1647 int *charpos_ptr
, *bytepos_ptr
, *incomment_ptr
;
1650 register enum syntaxcode code
;
1651 register int syntax
;
1653 if (nesting
<= 0) nesting
= -1;
1655 /* Enter the loop in the middle so that we find
1656 a 2-char comment ender if we start in the middle of it. */
1657 syntax
= prev_syntax
;
1658 if (syntax
!= 0) goto forw_incomment
;
1664 *incomment_ptr
= nesting
;
1665 *charpos_ptr
= from
;
1666 *bytepos_ptr
= from_byte
;
1669 c
= FETCH_CHAR (from_byte
);
1670 syntax
= SYNTAX_WITH_FLAGS (c
);
1671 code
= syntax
& 0xff;
1672 if (code
== Sendcomment
1673 && SYNTAX_FLAGS_COMMENT_STYLE (syntax
) == style
1675 /* we have encountered a comment end of the same style
1676 as the comment sequence which began this comment
1679 if (code
== Scomment_fence
1680 && style
== ST_COMMENT_STYLE
)
1681 /* we have encountered a comment end of the same style
1682 as the comment sequence which began this comment
1687 && SYNTAX_FLAGS_COMMENT_STYLE (syntax
) == style
)
1688 /* we have encountered a nested comment of the same style
1689 as the comment sequence which began this comment section */
1691 INC_BOTH (from
, from_byte
);
1692 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1695 if (from
< stop
&& SYNTAX_FLAGS_COMEND_FIRST (syntax
)
1696 && SYNTAX_FLAGS_COMMENT_STYLE (syntax
) == style
1697 && (c1
= FETCH_CHAR (from_byte
),
1698 SYNTAX_COMEND_SECOND (c1
)))
1701 /* we have encountered a comment end of the same style
1702 as the comment sequence which began this comment
1707 INC_BOTH (from
, from_byte
);
1708 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1713 && SYNTAX_FLAGS_COMSTART_FIRST (syntax
)
1714 && (c1
= FETCH_CHAR (from_byte
),
1715 SYNTAX_COMMENT_STYLE (c1
) == style
1716 && SYNTAX_COMSTART_SECOND (c1
)))
1717 /* we have encountered a nested comment of the same style
1718 as the comment sequence which began this comment
1721 INC_BOTH (from
, from_byte
);
1722 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1726 *charpos_ptr
= from
;
1727 *bytepos_ptr
= from_byte
;
1731 DEFUN ("forward-comment", Fforward_comment
, Sforward_comment
, 1, 1, 0,
1732 "Move forward across up to N comments. If N is negative, move backward.\n\
1733 Stop scanning if we find something other than a comment or whitespace.\n\
1734 Set point to where scanning stops.\n\
1735 If N comments are found as expected, with nothing except whitespace\n\
1736 between them, return t; otherwise return nil.")
1744 register enum syntaxcode code
;
1745 int comstyle
= 0; /* style of comment encountered */
1746 int comnested
= 0; /* whether the comment is nestable or not */
1749 int out_charpos
, out_bytepos
;
1752 CHECK_NUMBER (count
, 0);
1753 count1
= XINT (count
);
1754 stop
= count1
> 0 ? ZV
: BEGV
;
1760 from_byte
= PT_BYTE
;
1762 SETUP_SYNTAX_TABLE (from
, count1
);
1771 SET_PT_BOTH (from
, from_byte
);
1775 c
= FETCH_CHAR (from_byte
);
1777 comstart_first
= SYNTAX_COMSTART_FIRST (c
);
1778 comnested
= SYNTAX_COMMENT_NESTED (c
);
1779 INC_BOTH (from
, from_byte
);
1780 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1782 if (from
< stop
&& comstart_first
1783 && (c1
= FETCH_CHAR (from_byte
),
1784 SYNTAX_COMSTART_SECOND (c1
)))
1786 /* We have encountered a comment start sequence and we
1787 are ignoring all text inside comments. We must record
1788 the comment style this sequence begins so that later,
1789 only a comment end of the same style actually ends
1790 the comment section. */
1792 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1793 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
1794 INC_BOTH (from
, from_byte
);
1795 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1798 while (code
== Swhitespace
|| code
== Sendcomment
);
1800 if (code
== Scomment_fence
)
1801 comstyle
= ST_COMMENT_STYLE
;
1802 else if (code
!= Scomment
)
1805 DEC_BOTH (from
, from_byte
);
1806 SET_PT_BOTH (from
, from_byte
);
1809 /* We're at the start of a comment. */
1810 found
= forw_comment (from
, from_byte
, stop
, comnested
, comstyle
, 0,
1811 &out_charpos
, &out_bytepos
, &dummy
);
1812 from
= out_charpos
; from_byte
= out_bytepos
;
1816 SET_PT_BOTH (from
, from_byte
);
1819 INC_BOTH (from
, from_byte
);
1820 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1821 /* We have skipped one comment. */
1829 int quoted
, comstart_second
;
1833 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
1838 DEC_BOTH (from
, from_byte
);
1839 /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
1840 quoted
= char_quoted (from
, from_byte
);
1843 DEC_BOTH (from
, from_byte
);
1846 c
= FETCH_CHAR (from_byte
);
1849 comnested
= SYNTAX_COMMENT_NESTED (c
);
1850 if (code
== Sendcomment
)
1851 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1852 comstart_second
= SYNTAX_COMSTART_SECOND (c
);
1853 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1854 && prev_char_comend_first (from
, from_byte
)
1855 && !char_quoted (from
- 1, dec_bytepos (from_byte
)))
1857 /* We must record the comment style encountered so that
1858 later, we can match only the proper comment begin
1859 sequence of the same style. */
1860 DEC_BOTH (from
, from_byte
);
1862 /* Calling char_quoted, above, set up global syntax position
1863 at the new value of FROM. */
1864 c1
= FETCH_CHAR (from_byte
);
1865 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1866 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
1868 if (from
> stop
&& comstart_second
1869 && prev_char_comstart_first (from
, from_byte
)
1870 && !char_quoted (from
- 1, dec_bytepos (from_byte
)))
1873 DEC_BOTH (from
, from_byte
);
1876 if (code
== Scomment_fence
)
1878 /* Skip until first preceding unquoted comment_fence. */
1879 int found
= 0, ini
= from
, ini_byte
= from_byte
;
1883 DEC_BOTH (from
, from_byte
);
1886 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1887 c
= FETCH_CHAR (from_byte
);
1888 if (SYNTAX (c
) == Scomment_fence
1889 && !char_quoted (from
, from_byte
))
1897 from
= ini
; /* Set point to ini + 1. */
1898 from_byte
= ini_byte
;
1902 else if (code
== Sendcomment
)
1904 found
= back_comment (from
, from_byte
, stop
, comnested
, comstyle
,
1905 &out_charpos
, &out_bytepos
);
1907 from
= out_charpos
, from_byte
= out_bytepos
;
1908 /* We have skipped one comment. */
1911 else if (code
!= Swhitespace
&& code
!= Scomment
)
1915 INC_BOTH (from
, from_byte
);
1916 SET_PT_BOTH (from
, from_byte
);
1924 SET_PT_BOTH (from
, from_byte
);
1930 scan_lists (from
, count
, depth
, sexpflag
)
1932 int count
, depth
, sexpflag
;
1935 register int stop
= count
> 0 ? ZV
: BEGV
;
1940 register enum syntaxcode code
, temp_code
;
1941 int min_depth
= depth
; /* Err out if depth gets less than this. */
1942 int comstyle
= 0; /* style of comment encountered */
1943 int comnested
= 0; /* whether the comment is nestable or not */
1945 int last_good
= from
;
1948 int out_bytepos
, out_charpos
;
1951 if (depth
> 0) min_depth
= 0;
1953 if (from
> ZV
) from
= ZV
;
1954 if (from
< BEGV
) from
= BEGV
;
1956 from_byte
= CHAR_TO_BYTE (from
);
1961 SETUP_SYNTAX_TABLE (from
, count
);
1966 int comstart_first
, prefix
;
1967 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1968 c
= FETCH_CHAR (from_byte
);
1970 comstart_first
= SYNTAX_COMSTART_FIRST (c
);
1971 comnested
= SYNTAX_COMMENT_NESTED (c
);
1972 prefix
= SYNTAX_PREFIX (c
);
1973 if (depth
== min_depth
)
1975 INC_BOTH (from
, from_byte
);
1976 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1977 if (from
< stop
&& comstart_first
1978 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
))
1979 && parse_sexp_ignore_comments
)
1981 /* we have encountered a comment start sequence and we
1982 are ignoring all text inside comments. We must record
1983 the comment style this sequence begins so that later,
1984 only a comment end of the same style actually ends
1985 the comment section */
1987 c1
= FETCH_CHAR (from_byte
);
1988 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1989 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
1990 INC_BOTH (from
, from_byte
);
1991 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1997 switch (SWITCH_ENUM_CAST (code
))
2001 if (from
== stop
) goto lose
;
2002 INC_BOTH (from
, from_byte
);
2003 /* treat following character as a word constituent */
2006 if (depth
|| !sexpflag
) break;
2007 /* This word counts as a sexp; return at end of it. */
2010 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2012 /* Some compilers can't handle this inside the switch. */
2013 temp
= SYNTAX (FETCH_CHAR (from_byte
));
2018 INC_BOTH (from
, from_byte
);
2019 if (from
== stop
) goto lose
;
2028 INC_BOTH (from
, from_byte
);
2032 case Scomment_fence
:
2033 comstyle
= ST_COMMENT_STYLE
;
2036 if (!parse_sexp_ignore_comments
) break;
2037 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2038 found
= forw_comment (from
, from_byte
, stop
,
2039 comnested
, comstyle
, 0,
2040 &out_charpos
, &out_bytepos
, &dummy
);
2041 from
= out_charpos
, from_byte
= out_bytepos
;
2048 INC_BOTH (from
, from_byte
);
2049 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2055 if (from
!= stop
&& c
== FETCH_CHAR (from_byte
))
2057 INC_BOTH (from
, from_byte
);
2067 if (!++depth
) goto done
;
2072 if (!--depth
) goto done
;
2073 if (depth
< min_depth
)
2074 Fsignal (Qscan_error
,
2075 Fcons (build_string ("Containing expression ends prematurely"),
2076 Fcons (make_number (last_good
),
2077 Fcons (make_number (from
), Qnil
))));
2082 temp_pos
= dec_bytepos (from_byte
);
2083 stringterm
= FETCH_CHAR (temp_pos
);
2086 if (from
>= stop
) goto lose
;
2087 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2089 ? (FETCH_CHAR (from_byte
) == stringterm
)
2090 : SYNTAX (FETCH_CHAR (from_byte
)) == Sstring_fence
)
2093 /* Some compilers can't handle this inside the switch. */
2094 temp
= SYNTAX (FETCH_CHAR (from_byte
));
2099 INC_BOTH (from
, from_byte
);
2101 INC_BOTH (from
, from_byte
);
2103 INC_BOTH (from
, from_byte
);
2104 if (!depth
&& sexpflag
) goto done
;
2109 /* Reached end of buffer. Error if within object, return nil if between */
2110 if (depth
) goto lose
;
2115 /* End of object reached */
2124 DEC_BOTH (from
, from_byte
);
2125 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2126 c
= FETCH_CHAR (from_byte
);
2128 if (depth
== min_depth
)
2131 comnested
= SYNTAX_COMMENT_NESTED (c
);
2132 if (code
== Sendcomment
)
2133 comstyle
= SYNTAX_COMMENT_STYLE (c
);
2134 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
2135 && prev_char_comend_first (from
, from_byte
)
2136 && parse_sexp_ignore_comments
)
2138 /* We must record the comment style encountered so that
2139 later, we can match only the proper comment begin
2140 sequence of the same style. */
2141 DEC_BOTH (from
, from_byte
);
2142 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2144 c1
= FETCH_CHAR (from_byte
);
2145 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
2146 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
2149 /* Quoting turns anything except a comment-ender
2150 into a word character. Note that this if cannot be true
2151 if we decremented FROM in the if-statement above. */
2152 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
2154 else if (SYNTAX_PREFIX (c
))
2157 switch (SWITCH_ENUM_CAST (code
))
2163 if (depth
|| !sexpflag
) break;
2164 /* This word counts as a sexp; count object finished
2165 after passing it. */
2168 temp_pos
= from_byte
;
2169 if (! NILP (current_buffer
->enable_multibyte_characters
))
2173 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2174 c1
= FETCH_CHAR (temp_pos
);
2175 temp_code
= SYNTAX (c1
);
2176 /* Don't allow comment-end to be quoted. */
2177 if (temp_code
== Sendcomment
)
2179 quoted
= char_quoted (from
- 1, temp_pos
);
2182 DEC_BOTH (from
, from_byte
);
2183 temp_pos
= dec_bytepos (temp_pos
);
2184 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2186 c1
= FETCH_CHAR (temp_pos
);
2187 temp_code
= SYNTAX (c1
);
2188 if (! (quoted
|| temp_code
== Sword
2189 || temp_code
== Ssymbol
2190 || temp_code
== Squote
))
2192 DEC_BOTH (from
, from_byte
);
2199 temp_pos
= dec_bytepos (from_byte
);
2200 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2201 if (from
!= stop
&& c
== FETCH_CHAR (temp_pos
))
2202 DEC_BOTH (from
, from_byte
);
2211 if (!++depth
) goto done2
;
2216 if (!--depth
) goto done2
;
2217 if (depth
< min_depth
)
2218 Fsignal (Qscan_error
,
2219 Fcons (build_string ("Containing expression ends prematurely"),
2220 Fcons (make_number (last_good
),
2221 Fcons (make_number (from
), Qnil
))));
2225 if (!parse_sexp_ignore_comments
)
2227 found
= back_comment (from
, from_byte
, stop
, comnested
, comstyle
,
2228 &out_charpos
, &out_bytepos
);
2230 from
= out_charpos
, from_byte
= out_bytepos
;
2233 case Scomment_fence
:
2237 DEC_BOTH (from
, from_byte
);
2238 if (from
== stop
) goto lose
;
2239 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2240 if (!char_quoted (from
, from_byte
)
2241 && SYNTAX (FETCH_CHAR (from_byte
)) == code
)
2244 if (code
== Sstring_fence
&& !depth
&& sexpflag
) goto done2
;
2248 stringterm
= FETCH_CHAR (from_byte
);
2251 if (from
== stop
) goto lose
;
2252 temp_pos
= from_byte
;
2253 if (! NILP (current_buffer
->enable_multibyte_characters
))
2257 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2258 if (!char_quoted (from
- 1, temp_pos
)
2259 && stringterm
== FETCH_CHAR (temp_pos
))
2261 DEC_BOTH (from
, from_byte
);
2263 DEC_BOTH (from
, from_byte
);
2264 if (!depth
&& sexpflag
) goto done2
;
2269 /* Reached start of buffer. Error if within object, return nil if between */
2270 if (depth
) goto lose
;
2281 XSETFASTINT (val
, from
);
2285 Fsignal (Qscan_error
,
2286 Fcons (build_string ("Unbalanced parentheses"),
2287 Fcons (make_number (last_good
),
2288 Fcons (make_number (from
), Qnil
))));
2293 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
2294 "Scan from character number FROM by COUNT lists.\n\
2295 Returns the character number of the position thus found.\n\
2297 If DEPTH is nonzero, paren depth begins counting from that value,\n\
2298 only places where the depth in parentheses becomes zero\n\
2299 are candidates for stopping; COUNT such places are counted.\n\
2300 Thus, a positive value for DEPTH means go out levels.\n\
2302 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2304 If the beginning or end of (the accessible part of) the buffer is reached\n\
2305 and the depth is wrong, an error is signaled.\n\
2306 If the depth is right but the count is not used up, nil is returned.")
2307 (from
, count
, depth
)
2308 Lisp_Object from
, count
, depth
;
2310 CHECK_NUMBER (from
, 0);
2311 CHECK_NUMBER (count
, 1);
2312 CHECK_NUMBER (depth
, 2);
2314 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
2317 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
2318 "Scan from character number FROM by COUNT balanced expressions.\n\
2319 If COUNT is negative, scan backwards.\n\
2320 Returns the character number of the position thus found.\n\
2322 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2324 If the beginning or end of (the accessible part of) the buffer is reached\n\
2325 in the middle of a parenthetical grouping, an error is signaled.\n\
2326 If the beginning or end is reached between groupings\n\
2327 but before count is used up, nil is returned.")
2329 Lisp_Object from
, count
;
2331 CHECK_NUMBER (from
, 0);
2332 CHECK_NUMBER (count
, 1);
2334 return scan_lists (XINT (from
), XINT (count
), 0, 1);
2337 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
2339 "Move point backward over any number of chars with prefix syntax.\n\
2340 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
2345 int opoint_byte
= PT_BYTE
;
2347 int pos_byte
= PT_BYTE
;
2352 SET_PT_BOTH (opoint
, opoint_byte
);
2357 SETUP_SYNTAX_TABLE (pos
, -1);
2359 DEC_BOTH (pos
, pos_byte
);
2361 while (!char_quoted (pos
, pos_byte
)
2362 /* Previous statement updates syntax table. */
2363 && ((c
= FETCH_CHAR (pos_byte
), SYNTAX (c
) == Squote
)
2364 || SYNTAX_PREFIX (c
)))
2367 opoint_byte
= pos_byte
;
2370 DEC_BOTH (pos
, pos_byte
);
2373 SET_PT_BOTH (opoint
, opoint_byte
);
2378 /* Parse forward from FROM / FROM_BYTE to END,
2379 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
2380 and return a description of the state of the parse at END.
2381 If STOPBEFORE is nonzero, stop at the start of an atom.
2382 If COMMENTSTOP is 1, stop at the start of a comment.
2383 If COMMENTSTOP is -1, stop at the start or end of a comment,
2384 after the beginning of a string, or after the end of a string. */
2387 scan_sexps_forward (stateptr
, from
, from_byte
, end
, targetdepth
,
2388 stopbefore
, oldstate
, commentstop
)
2389 struct lisp_parse_state
*stateptr
;
2391 int end
, targetdepth
, stopbefore
;
2392 Lisp_Object oldstate
;
2395 struct lisp_parse_state state
;
2397 register enum syntaxcode code
;
2400 struct level
{ int last
, prev
; };
2401 struct level levelstart
[100];
2402 register struct level
*curlevel
= levelstart
;
2403 struct level
*endlevel
= levelstart
+ 100;
2404 register int depth
; /* Paren depth of current scanning location.
2405 level - levelstart equals this except
2406 when the depth becomes negative. */
2407 int mindepth
; /* Lowest DEPTH value seen. */
2408 int start_quoted
= 0; /* Nonzero means starting after a char quote */
2410 int prev_from
; /* Keep one character before FROM. */
2412 int prev_from_syntax
;
2413 int boundary_stop
= commentstop
== -1;
2416 int out_bytepos
, out_charpos
;
2420 prev_from_byte
= from_byte
;
2422 DEC_BOTH (prev_from
, prev_from_byte
);
2424 /* Use this macro instead of `from++'. */
2426 do { prev_from = from; \
2427 prev_from_byte = from_byte; \
2429 = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); \
2430 INC_BOTH (from, from_byte); \
2431 UPDATE_SYNTAX_TABLE_FORWARD (from); \
2437 if (NILP (oldstate
))
2440 state
.instring
= -1;
2441 state
.incomment
= 0;
2442 state
.comstyle
= 0; /* comment style a by default. */
2443 state
.comstr_start
= -1; /* no comment/string seen. */
2447 tem
= Fcar (oldstate
);
2453 oldstate
= Fcdr (oldstate
);
2454 oldstate
= Fcdr (oldstate
);
2455 oldstate
= Fcdr (oldstate
);
2456 tem
= Fcar (oldstate
);
2457 /* Check whether we are inside string_fence-style string: */
2458 state
.instring
= (!NILP (tem
)
2459 ? (INTEGERP (tem
) ? XINT (tem
) : ST_STRING_STYLE
)
2462 oldstate
= Fcdr (oldstate
);
2463 tem
= Fcar (oldstate
);
2464 state
.incomment
= (!NILP (tem
)
2465 ? (INTEGERP (tem
) ? XINT (tem
) : -1)
2468 oldstate
= Fcdr (oldstate
);
2469 tem
= Fcar (oldstate
);
2470 start_quoted
= !NILP (tem
);
2472 /* if the eighth element of the list is nil, we are in comment
2473 style a. If it is non-nil, we are in comment style b */
2474 oldstate
= Fcdr (oldstate
);
2475 oldstate
= Fcdr (oldstate
);
2476 tem
= Fcar (oldstate
);
2477 state
.comstyle
= NILP (tem
) ? 0 : (EQ (tem
, Qsyntax_table
)
2478 ? ST_COMMENT_STYLE
: 1);
2480 oldstate
= Fcdr (oldstate
);
2481 tem
= Fcar (oldstate
);
2482 state
.comstr_start
= NILP (tem
) ? -1 : XINT (tem
) ;
2483 oldstate
= Fcdr (oldstate
);
2484 tem
= Fcar (oldstate
);
2485 while (!NILP (tem
)) /* >= second enclosing sexps. */
2487 /* curlevel++->last ran into compiler bug on Apollo */
2488 curlevel
->last
= XINT (Fcar (tem
));
2489 if (++curlevel
== endlevel
)
2490 error ("Nesting too deep for parser");
2491 curlevel
->prev
= -1;
2492 curlevel
->last
= -1;
2499 curlevel
->prev
= -1;
2500 curlevel
->last
= -1;
2502 SETUP_SYNTAX_TABLE (prev_from
, 1);
2503 prev_from_syntax
= SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte
));
2504 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2506 /* Enter the loop at a place appropriate for initial state. */
2508 if (state
.incomment
)
2509 goto startincomment
;
2510 if (state
.instring
>= 0)
2512 nofence
= state
.instring
!= ST_STRING_STYLE
;
2514 goto startquotedinstring
;
2517 else if (start_quoted
)
2520 #if 0 /* This seems to be redundant with the identical code above. */
2521 SETUP_SYNTAX_TABLE (prev_from
, 1);
2522 prev_from_syntax
= SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte
));
2523 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2529 code
= prev_from_syntax
& 0xff;
2531 if (code
== Scomment
)
2533 state
.incomment
= (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax
) ?
2535 state
.comstr_start
= prev_from
;
2537 else if (code
== Scomment_fence
)
2539 /* Record the comment style we have entered so that only
2540 the comment-end sequence of the same style actually
2541 terminates the comment section. */
2542 state
.comstyle
= ST_COMMENT_STYLE
;
2543 state
.incomment
= -1;
2544 state
.comstr_start
= prev_from
;
2547 else if (from
< end
)
2548 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax
))
2549 if (c1
= FETCH_CHAR (from_byte
),
2550 SYNTAX_COMSTART_SECOND (c1
))
2551 /* Duplicate code to avoid a complex if-expression
2552 which causes trouble for the SGI compiler. */
2554 /* Record the comment style we have entered so that only
2555 the comment-end sequence of the same style actually
2556 terminates the comment section. */
2557 state
.comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
));
2558 comnested
= SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax
);
2559 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
2560 state
.incomment
= comnested
? 1 : -1;
2561 state
.comstr_start
= prev_from
;
2566 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax
))
2568 switch (SWITCH_ENUM_CAST (code
))
2572 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2573 curlevel
->last
= prev_from
;
2575 if (from
== end
) goto endquoted
;
2578 /* treat following character as a word constituent */
2581 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2582 curlevel
->last
= prev_from
;
2586 /* Some compilers can't handle this inside the switch. */
2587 temp
= SYNTAX (FETCH_CHAR (from_byte
));
2593 if (from
== end
) goto endquoted
;
2605 curlevel
->prev
= curlevel
->last
;
2609 if (commentstop
== 1)
2614 if (! state
.incomment
)
2616 if (commentstop
|| boundary_stop
) goto done
;
2618 /* The (from == BEGV) test is to enter the loop in the middle so
2619 that we find a 2-char comment ender even if we start in the
2621 found
= forw_comment (from
, from_byte
, end
,
2622 state
.incomment
, state
.comstyle
,
2623 (from
== BEGV
) ? 0 : prev_from_syntax
,
2624 &out_charpos
, &out_bytepos
, &state
.incomment
);
2625 from
= out_charpos
; from_byte
= out_bytepos
;
2626 /* Beware! prev_from and friends are invalid now.
2627 Luckily, the `done' doesn't use them and the INC_FROM
2628 sets them to a sane value without looking at them. */
2629 if (!found
) goto done
;
2631 state
.incomment
= 0;
2632 state
.comstyle
= 0; /* reset the comment style */
2633 if (boundary_stop
) goto done
;
2637 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2639 /* curlevel++->last ran into compiler bug on Apollo */
2640 curlevel
->last
= prev_from
;
2641 if (++curlevel
== endlevel
)
2642 error ("Nesting too deep for parser");
2643 curlevel
->prev
= -1;
2644 curlevel
->last
= -1;
2645 if (targetdepth
== depth
) goto done
;
2650 if (depth
< mindepth
)
2652 if (curlevel
!= levelstart
)
2654 curlevel
->prev
= curlevel
->last
;
2655 if (targetdepth
== depth
) goto done
;
2660 state
.comstr_start
= from
- 1;
2661 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2662 curlevel
->last
= prev_from
;
2663 state
.instring
= (code
== Sstring
2664 ? (FETCH_CHAR (prev_from_byte
))
2666 if (boundary_stop
) goto done
;
2669 nofence
= state
.instring
!= ST_STRING_STYLE
;
2675 if (from
>= end
) goto done
;
2676 c
= FETCH_CHAR (from_byte
);
2677 /* Some compilers can't handle this inside the switch. */
2680 /* Check TEMP here so that if the char has
2681 a syntax-table property which says it is NOT
2682 a string character, it does not end the string. */
2683 if (nofence
&& c
== state
.instring
&& temp
== Sstring
)
2689 if (!nofence
) goto string_end
;
2694 startquotedinstring
:
2695 if (from
>= end
) goto endquoted
;
2701 state
.instring
= -1;
2702 curlevel
->prev
= curlevel
->last
;
2704 if (boundary_stop
) goto done
;
2713 stop
: /* Here if stopping before start of sexp. */
2714 from
= prev_from
; /* We have just fetched the char that starts it; */
2715 goto done
; /* but return the position before it. */
2720 state
.depth
= depth
;
2721 state
.mindepth
= mindepth
;
2722 state
.thislevelstart
= curlevel
->prev
;
2723 state
.prevlevelstart
2724 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
2725 state
.location
= from
;
2726 state
.levelstarts
= Qnil
;
2727 while (--curlevel
>= levelstart
)
2728 state
.levelstarts
= Fcons (make_number (curlevel
->last
),
2735 /* This comment supplies the doc string for parse-partial-sexp,
2736 for make-docfile to see. We cannot put this in the real DEFUN
2737 due to limits in the Unix cpp.
2739 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
2740 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
2741 Parsing stops at TO or when certain criteria are met;\n\
2742 point is set to where parsing stops.\n\
2743 If fifth arg STATE is omitted or nil,\n\
2744 parsing assumes that FROM is the beginning of a function.\n\
2745 Value is a list of ten elements describing final state of parsing:\n\
2746 0. depth in parens.\n\
2747 1. character address of start of innermost containing list; nil if none.\n\
2748 2. character address of start of last complete sexp terminated.\n\
2749 3. non-nil if inside a string.\n\
2750 (it is the character that will terminate the string,\n\
2751 or t if the string should be terminated by a generic string delimiter.)\n\
2752 4. nil if outside a comment, t if inside a non-nestable comment, \n\
2753 else an integer (the current comment nesting).\n\
2754 5. t if following a quote character.\n\
2755 6. the minimum paren-depth encountered during this scan.\n\
2756 7. t if in a comment of style b; `syntax-table' if the comment\n\
2757 should be terminated by a generic comment delimiter.\n\
2758 8. character address of start of comment or string; nil if not in one.\n\
2759 9. Intermediate data for continuation of parsing (subject to change).\n\
2760 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
2761 in parentheses becomes equal to TARGETDEPTH.\n\
2762 Fourth arg STOPBEFORE non-nil means stop when come to\n\
2763 any character that starts a sexp.\n\
2764 Fifth arg STATE is a nine-element list like what this function returns.\n\
2765 It is used to initialize the state of the parse. Elements number 1, 2, 6\n\
2766 and 8 are ignored; you can leave off element 8 (the last) entirely.\n\
2767 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.\n\
2768 If it is `syntax-table', stop after the start of a comment or a string,\n\
2769 or after end of a comment or a string.")
2770 (from, to, targetdepth, stopbefore, state, commentstop)
2773 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 6, 0,
2774 0 /* See immediately above */)
2775 (from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
)
2776 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
;
2778 struct lisp_parse_state state
;
2781 if (!NILP (targetdepth
))
2783 CHECK_NUMBER (targetdepth
, 3);
2784 target
= XINT (targetdepth
);
2787 target
= -100000; /* We won't reach this depth */
2789 validate_region (&from
, &to
);
2790 scan_sexps_forward (&state
, XINT (from
), CHAR_TO_BYTE (XINT (from
)),
2792 target
, !NILP (stopbefore
), oldstate
,
2794 ? 0 : (EQ (commentstop
, Qsyntax_table
) ? -1 : 1)));
2796 SET_PT (state
.location
);
2798 return Fcons (make_number (state
.depth
),
2799 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
2800 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
2801 Fcons (state
.instring
>= 0
2802 ? (state
.instring
== ST_STRING_STYLE
2803 ? Qt
: make_number (state
.instring
)) : Qnil
,
2804 Fcons (state
.incomment
< 0 ? Qt
:
2805 (state
.incomment
== 0 ? Qnil
:
2806 make_number (state
.incomment
)),
2807 Fcons (state
.quoted
? Qt
: Qnil
,
2808 Fcons (make_number (state
.mindepth
),
2809 Fcons ((state
.comstyle
2810 ? (state
.comstyle
== ST_COMMENT_STYLE
2811 ? Qsyntax_table
: Qt
) :
2813 Fcons (((state
.incomment
2814 || (state
.instring
>= 0))
2815 ? make_number (state
.comstr_start
)
2817 Fcons (state
.levelstarts
, Qnil
))))))))));
2826 /* This has to be done here, before we call Fmake_char_table. */
2827 Qsyntax_table
= intern ("syntax-table");
2828 staticpro (&Qsyntax_table
);
2830 /* Intern this now in case it isn't already done.
2831 Setting this variable twice is harmless.
2832 But don't staticpro it here--that is done in alloc.c. */
2833 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
2835 /* Create objects which can be shared among syntax tables. */
2836 Vsyntax_code_object
= Fmake_vector (make_number (13), Qnil
);
2837 for (i
= 0; i
< XVECTOR (Vsyntax_code_object
)->size
; i
++)
2838 XVECTOR (Vsyntax_code_object
)->contents
[i
]
2839 = Fcons (make_number (i
), Qnil
);
2841 /* Now we are ready to set up this property, so we can
2842 create syntax tables. */
2843 Fput (Qsyntax_table
, Qchar_table_extra_slots
, make_number (0));
2845 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Swhitespace
];
2847 Vstandard_syntax_table
= Fmake_char_table (Qsyntax_table
, temp
);
2849 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Sword
];
2850 for (i
= 'a'; i
<= 'z'; i
++)
2851 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2852 for (i
= 'A'; i
<= 'Z'; i
++)
2853 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2854 for (i
= '0'; i
<= '9'; i
++)
2855 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2857 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '$', temp
);
2858 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '%', temp
);
2860 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '(',
2861 Fcons (make_number (Sopen
), make_number (')')));
2862 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ')',
2863 Fcons (make_number (Sclose
), make_number ('(')));
2864 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '[',
2865 Fcons (make_number (Sopen
), make_number (']')));
2866 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ']',
2867 Fcons (make_number (Sclose
), make_number ('[')));
2868 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '{',
2869 Fcons (make_number (Sopen
), make_number ('}')));
2870 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '}',
2871 Fcons (make_number (Sclose
), make_number ('{')));
2872 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '"',
2873 Fcons (make_number ((int) Sstring
), Qnil
));
2874 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '\\',
2875 Fcons (make_number ((int) Sescape
), Qnil
));
2877 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Ssymbol
];
2878 for (i
= 0; i
< 10; i
++)
2880 c
= "_-+*/&|<>="[i
];
2881 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2884 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Spunct
];
2885 for (i
= 0; i
< 12; i
++)
2887 c
= ".,;:?!#@~^'`"[i
];
2888 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2895 Qsyntax_table_p
= intern ("syntax-table-p");
2896 staticpro (&Qsyntax_table_p
);
2898 staticpro (&Vsyntax_code_object
);
2900 Qscan_error
= intern ("scan-error");
2901 staticpro (&Qscan_error
);
2902 Fput (Qscan_error
, Qerror_conditions
,
2903 Fcons (Qscan_error
, Fcons (Qerror
, Qnil
)));
2904 Fput (Qscan_error
, Qerror_message
,
2905 build_string ("Scan error"));
2907 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
2908 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
2910 DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties
,
2911 "Non-nil means `forward-sexp', etc., grant `syntax-table' property.\n\
2912 The value of this property should be either a syntax table, or a cons\n\
2913 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric\n\
2914 syntax code, MATCHCHAR being nil or the character to match (which is\n\
2915 relevant only for open/close type.");
2917 words_include_escapes
= 0;
2918 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
2919 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
2921 defsubr (&Ssyntax_table_p
);
2922 defsubr (&Ssyntax_table
);
2923 defsubr (&Sstandard_syntax_table
);
2924 defsubr (&Scopy_syntax_table
);
2925 defsubr (&Sset_syntax_table
);
2926 defsubr (&Schar_syntax
);
2927 defsubr (&Smatching_paren
);
2928 defsubr (&Smodify_syntax_entry
);
2929 defsubr (&Sdescribe_syntax
);
2931 defsubr (&Sforward_word
);
2933 defsubr (&Sskip_chars_forward
);
2934 defsubr (&Sskip_chars_backward
);
2935 defsubr (&Sskip_syntax_forward
);
2936 defsubr (&Sskip_syntax_backward
);
2938 defsubr (&Sforward_comment
);
2939 defsubr (&Sscan_lists
);
2940 defsubr (&Sscan_sexps
);
2941 defsubr (&Sbackward_prefix_chars
);
2942 defsubr (&Sparse_partial_sexp
);