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 /* Nonzero means `scan-sexps' treat all multibyte characters as symbol. */
49 int multibyte_syntax_as_symbol
;
51 /* Used as a temporary in SYNTAX_ENTRY and other macros in syntax.h,
52 if not compiled with GCC. No need to mark it, since it is used
53 only very temporarily. */
54 Lisp_Object syntax_temp
;
56 /* Non-zero means an open parenthesis in column 0 is always considered
57 to be the start of a defun. Zero means an open parenthesis in
58 column 0 has no special meaning. */
60 int open_paren_in_column_0_is_defun_start
;
62 /* This is the internal form of the parse state used in parse-partial-sexp. */
64 struct lisp_parse_state
66 int depth
; /* Depth at end of parsing. */
67 int instring
; /* -1 if not within string, else desired terminator. */
68 int incomment
; /* -1 if in unnestable comment else comment nesting */
69 int comstyle
; /* comment style a=0, or b=1, or ST_COMMENT_STYLE. */
70 int quoted
; /* Nonzero if just after an escape char at end of parsing */
71 int thislevelstart
; /* Char number of most recent start-of-expression at current level */
72 int prevlevelstart
; /* Char number of start of containing expression */
73 int location
; /* Char number at which parsing stopped. */
74 int mindepth
; /* Minimum depth seen while scanning. */
75 int comstr_start
; /* Position just after last comment/string starter. */
76 Lisp_Object levelstarts
; /* Char numbers of starts-of-expression
77 of levels (starting from outermost). */
80 /* These variables are a cache for finding the start of a defun.
81 find_start_pos is the place for which the defun start was found.
82 find_start_value is the defun start position found for it.
83 find_start_value_byte is the corresponding byte position.
84 find_start_buffer is the buffer it was found in.
85 find_start_begv is the BEGV value when it was found.
86 find_start_modiff is the value of MODIFF when it was found. */
88 static int find_start_pos
;
89 static int find_start_value
;
90 static int find_start_value_byte
;
91 static struct buffer
*find_start_buffer
;
92 static int find_start_begv
;
93 static int find_start_modiff
;
96 static int find_defun_start
P_ ((int, int));
97 static int back_comment
P_ ((int, int, int, int, int, int *, int *));
98 static int char_quoted
P_ ((int, int));
99 static Lisp_Object skip_chars
P_ ((int, int, Lisp_Object
, Lisp_Object
));
100 static Lisp_Object scan_lists
P_ ((int, int, int, int));
101 static void scan_sexps_forward
P_ ((struct lisp_parse_state
*,
103 int, Lisp_Object
, int));
106 struct gl_state_s gl_state
; /* Global state of syntax parser. */
108 INTERVAL
interval_of ();
109 #define INTERVALS_AT_ONCE 10 /* 1 + max-number of intervals
110 to scan to property-change. */
112 /* Update gl_state to an appropriate interval which contains CHARPOS. The
113 sign of COUNT give the relative position of CHARPOS wrt the previously
114 valid interval. If INIT, only [be]_property fields of gl_state are
115 valid at start, the rest is filled basing on OBJECT.
117 `gl_state.*_i' are the intervals, and CHARPOS is further in the search
118 direction than the intervals - or in an interval. We update the
119 current syntax-table basing on the property of this interval, and
120 update the interval to start further than CHARPOS - or be
121 NULL_INTERVAL. We also update lim_property to be the next value of
122 charpos to call this subroutine again - or be before/after the
123 start/end of OBJECT. */
126 update_syntax_table (charpos
, count
, init
, object
)
127 int charpos
, count
, init
;
130 Lisp_Object tmp_table
;
131 int cnt
= 0, invalidate
= 1;
136 gl_state
.start
= gl_state
.b_property
;
137 gl_state
.stop
= gl_state
.e_property
;
138 gl_state
.forward_i
= interval_of (charpos
, object
);
139 i
= gl_state
.backward_i
= gl_state
.forward_i
;
140 gl_state
.left_ok
= gl_state
.right_ok
= 1;
142 if (NULL_INTERVAL_P (i
))
144 /* interval_of updates only ->position of the return value, so
145 update the parents manually to speed up update_interval. */
146 while (!NULL_PARENT (i
))
148 if (AM_RIGHT_CHILD (i
))
149 INTERVAL_PARENT (i
)->position
= i
->position
150 - LEFT_TOTAL_LENGTH (i
) + TOTAL_LENGTH (i
) /* right end */
151 - TOTAL_LENGTH (INTERVAL_PARENT (i
))
152 + LEFT_TOTAL_LENGTH (INTERVAL_PARENT (i
));
154 INTERVAL_PARENT (i
)->position
= i
->position
- LEFT_TOTAL_LENGTH (i
)
156 i
= INTERVAL_PARENT (i
);
158 i
= gl_state
.forward_i
;
159 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
160 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
163 oldi
= i
= count
> 0 ? gl_state
.forward_i
: gl_state
.backward_i
;
165 /* We are guarantied to be called with CHARPOS either in i,
167 if (NULL_INTERVAL_P (i
))
168 error ("Error in syntax_table logic for to-the-end intervals");
169 else if (charpos
< i
->position
) /* Move left. */
172 error ("Error in syntax_table logic for intervals <-");
173 /* Update the interval. */
174 i
= update_interval (i
, charpos
);
175 if (oldi
->position
!= INTERVAL_LAST_POS (i
))
178 gl_state
.right_ok
= 1; /* Invalidate the other end. */
179 gl_state
.forward_i
= i
;
180 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
183 else if (charpos
>= INTERVAL_LAST_POS (i
)) /* Move right. */
186 error ("Error in syntax_table logic for intervals ->");
187 /* Update the interval. */
188 i
= update_interval (i
, charpos
);
189 if (i
->position
!= INTERVAL_LAST_POS (oldi
))
192 gl_state
.left_ok
= 1; /* Invalidate the other end. */
193 gl_state
.backward_i
= i
;
194 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
197 else if (count
> 0 ? gl_state
.right_ok
: gl_state
.left_ok
)
199 /* We do not need to recalculate tmp_table. */
200 tmp_table
= gl_state
.old_prop
;
204 tmp_table
= textget (i
->plist
, Qsyntax_table
);
207 invalidate
= !EQ (tmp_table
, gl_state
.old_prop
); /* Need to invalidate? */
209 if (invalidate
) /* Did not get to adjacent interval. */
210 { /* with the same table => */
211 /* invalidate the old range. */
214 gl_state
.backward_i
= i
;
215 gl_state
.left_ok
= 1; /* Invalidate the other end. */
216 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
220 gl_state
.forward_i
= i
;
221 gl_state
.right_ok
= 1; /* Invalidate the other end. */
222 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
226 gl_state
.current_syntax_table
= tmp_table
;
227 gl_state
.old_prop
= tmp_table
;
228 if (EQ (Fsyntax_table_p (tmp_table
), Qt
))
230 gl_state
.use_global
= 0;
232 else if (CONSP (tmp_table
))
234 gl_state
.use_global
= 1;
235 gl_state
.global_code
= tmp_table
;
239 gl_state
.use_global
= 0;
240 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
243 while (!NULL_INTERVAL_P (i
))
245 if (cnt
&& !EQ (tmp_table
, textget (i
->plist
, Qsyntax_table
)))
248 gl_state
.right_ok
= 0;
250 gl_state
.left_ok
= 0;
253 else if (cnt
== INTERVALS_AT_ONCE
)
256 gl_state
.right_ok
= 1;
258 gl_state
.left_ok
= 1;
262 i
= count
> 0 ? next_interval (i
) : previous_interval (i
);
264 if (NULL_INTERVAL_P (i
))
265 { /* This property goes to the end. */
267 gl_state
.e_property
= gl_state
.stop
;
269 gl_state
.b_property
= gl_state
.start
;
275 gl_state
.e_property
= i
->position
- gl_state
.offset
;
276 gl_state
.forward_i
= i
;
280 gl_state
.b_property
= i
->position
+ LENGTH (i
) - 1 - gl_state
.offset
;
281 gl_state
.backward_i
= i
;
286 /* Returns TRUE if char at CHARPOS is quoted.
287 Global syntax-table data should be set up already to be good at CHARPOS
288 or after. On return global syntax data is good for lookup at CHARPOS. */
291 char_quoted (charpos
, bytepos
)
292 register int charpos
, bytepos
;
294 register enum syntaxcode code
;
295 register int beg
= BEGV
;
296 register int quoted
= 0;
299 DEC_BOTH (charpos
, bytepos
);
301 while (bytepos
>= beg
)
303 UPDATE_SYNTAX_TABLE_BACKWARD (charpos
);
304 code
= SYNTAX (FETCH_CHAR (bytepos
));
305 if (! (code
== Scharquote
|| code
== Sescape
))
308 DEC_BOTH (charpos
, bytepos
);
312 UPDATE_SYNTAX_TABLE (orig
);
316 /* Return the bytepos one character after BYTEPOS.
317 We assume that BYTEPOS is not at the end of the buffer. */
320 inc_bytepos (bytepos
)
323 if (NILP (current_buffer
->enable_multibyte_characters
))
330 /* Return the bytepos one character before BYTEPOS.
331 We assume that BYTEPOS is not at the start of the buffer. */
334 dec_bytepos (bytepos
)
337 if (NILP (current_buffer
->enable_multibyte_characters
))
344 /* Find a defun-start that is the last one before POS (or nearly the last).
345 We record what we find, so that another call in the same area
346 can return the same value right away.
348 There is no promise at which position the global syntax data is
349 valid on return from the subroutine, so the caller should explicitly
350 update the global data. */
353 find_defun_start (pos
, pos_byte
)
356 int opoint
= PT
, opoint_byte
= PT_BYTE
;
358 /* Use previous finding, if it's valid and applies to this inquiry. */
359 if (current_buffer
== find_start_buffer
360 /* Reuse the defun-start even if POS is a little farther on.
361 POS might be in the next defun, but that's ok.
362 Our value may not be the best possible, but will still be usable. */
363 && pos
<= find_start_pos
+ 1000
364 && pos
>= find_start_value
365 && BEGV
== find_start_begv
366 && MODIFF
== find_start_modiff
)
367 return find_start_value
;
369 /* Back up to start of line. */
370 scan_newline (pos
, pos_byte
, BEGV
, BEGV_BYTE
, -1, 1);
372 /* We optimize syntax-table lookup for rare updates. Thus we accept
373 only those `^\s(' which are good in global _and_ text-property
375 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
376 gl_state
.use_global
= 0;
379 /* Open-paren at start of line means we may have found our
381 if (SYNTAX (FETCH_CHAR (PT_BYTE
)) == Sopen
)
383 SETUP_SYNTAX_TABLE (PT
+ 1, -1); /* Try again... */
384 if (SYNTAX (FETCH_CHAR (PT_BYTE
)) == Sopen
385 && open_paren_in_column_0_is_defun_start
)
387 /* Now fallback to the default value. */
388 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
389 gl_state
.use_global
= 0;
391 /* Move to beg of previous line. */
392 scan_newline (PT
, PT_BYTE
, BEGV
, BEGV_BYTE
, -2, 1);
395 /* Record what we found, for the next try. */
396 find_start_value
= PT
;
397 find_start_value_byte
= PT_BYTE
;
398 find_start_buffer
= current_buffer
;
399 find_start_modiff
= MODIFF
;
400 find_start_begv
= BEGV
;
401 find_start_pos
= pos
;
403 TEMP_SET_PT_BOTH (opoint
, opoint_byte
);
405 return find_start_value
;
408 /* Return the SYNTAX_COMEND_FIRST of the character before POS, POS_BYTE. */
411 prev_char_comend_first (pos
, pos_byte
)
416 DEC_BOTH (pos
, pos_byte
);
417 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
418 c
= FETCH_CHAR (pos_byte
);
419 val
= SYNTAX_COMEND_FIRST (c
);
420 UPDATE_SYNTAX_TABLE_FORWARD (pos
+ 1);
424 /* Return the SYNTAX_COMSTART_FIRST of the character before POS, POS_BYTE. */
427 prev_char_comstart_first (pos
, pos_byte
)
432 DEC_BOTH (pos
, pos_byte
);
433 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
434 c
= FETCH_CHAR (pos_byte
);
435 val
= SYNTAX_COMSTART_FIRST (c
);
436 UPDATE_SYNTAX_TABLE_FORWARD (pos
+ 1);
440 /* Checks whether charpos FROM is at the end of a comment.
441 FROM_BYTE is the bytepos corresponding to FROM.
442 Do not move back before STOP.
444 Return a positive value if we find a comment ending at FROM/FROM_BYTE;
447 If successful, store the charpos of the comment's beginning
448 into *CHARPOS_PTR, and the bytepos into *BYTEPOS_PTR.
450 Global syntax data remains valid for backward search starting at
451 the returned value (or at FROM, if the search was not successful). */
454 back_comment (from
, from_byte
, stop
, comnested
, comstyle
, charpos_ptr
, bytepos_ptr
)
455 int from
, from_byte
, stop
;
456 int comnested
, comstyle
;
457 int *charpos_ptr
, *bytepos_ptr
;
459 /* Look back, counting the parity of string-quotes,
460 and recording the comment-starters seen.
461 When we reach a safe place, assume that's not in a string;
462 then step the main scan to the earliest comment-starter seen
463 an even number of string quotes away from the safe place.
465 OFROM[I] is position of the earliest comment-starter seen
466 which is I+2X quotes from the comment-end.
467 PARITY is current parity of quotes from the comment end. */
469 int my_stringend
= 0;
470 int string_lossage
= 0;
471 int comment_end
= from
;
472 int comment_end_byte
= from_byte
;
473 int comstart_pos
= 0;
475 /* Value that PARITY had, when we reached the position
477 int comstart_parity
= 0;
478 int scanstart
= from
- 1;
479 /* Place where the containing defun starts,
480 or 0 if we didn't come across it yet. */
482 int defun_start_byte
= 0;
483 register enum syntaxcode code
;
484 int nesting
= 1; /* current comment nesting */
487 /* At beginning of range to scan, we're outside of strings;
488 that determines quote parity to the comment-end. */
493 /* Move back and examine a character. */
494 DEC_BOTH (from
, from_byte
);
495 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
497 c
= FETCH_CHAR (from_byte
);
500 /* If this char is the second of a 2-char comment end sequence,
501 back up and give the pair the appropriate syntax. */
502 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
503 && prev_char_comend_first (from
, from_byte
))
506 DEC_BOTH (from
, from_byte
);
507 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
508 c
= FETCH_CHAR (from_byte
);
511 /* If this char starts a 2-char comment start sequence,
512 treat it like a 1-char comment starter. */
513 if (from
< scanstart
&& SYNTAX_COMSTART_FIRST (c
))
515 temp_byte
= inc_bytepos (from_byte
);
516 UPDATE_SYNTAX_TABLE_FORWARD (from
+ 1);
517 if (SYNTAX_COMSTART_SECOND (FETCH_CHAR (temp_byte
))
518 && comstyle
== SYNTAX_COMMENT_STYLE (FETCH_CHAR (temp_byte
)))
520 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
522 else if (code
== Scomment
&& comstyle
!= SYNTAX_COMMENT_STYLE (c
))
523 /* Ignore comment starters of a different style. */
526 /* Ignore escaped characters, except comment-enders. */
527 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
530 /* Track parity of quotes. */
534 if (my_stringend
== 0)
536 /* If we have two kinds of string delimiters.
537 There's no way to grok this scanning backwards. */
538 else if (my_stringend
!= c
)
542 if (code
== Sstring_fence
|| code
== Scomment_fence
)
545 if (my_stringend
== 0)
547 = code
== Sstring_fence
? ST_STRING_STYLE
: ST_COMMENT_STYLE
;
548 /* If we have two kinds of string delimiters.
549 There's no way to grok this scanning backwards. */
550 else if (my_stringend
!= (code
== Sstring_fence
551 ? ST_STRING_STYLE
: ST_COMMENT_STYLE
))
555 if (code
== Scomment
)
556 /* We've already checked that it is the relevant comstyle. */
558 if (comnested
&& --nesting
<= 0 && parity
== 0 && !string_lossage
)
559 /* nested comments have to be balanced, so we don't need to
560 keep looking for earlier ones. We use here the same (slightly
561 incorrect) reasoning as below: since it is followed by uniform
562 paired string quotes, this comment-start has to be outside of
563 strings, else the comment-end itself would be inside a string. */
566 /* Record comment-starters according to that
567 quote-parity to the comment-end. */
568 comstart_parity
= parity
;
570 comstart_byte
= from_byte
;
573 /* If we find another earlier comment-ender,
574 any comment-starts earlier than that don't count
575 (because they go with the earlier comment-ender). */
576 if (code
== Sendcomment
577 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)) == comstyle
)
585 /* Assume a defun-start point is outside of strings. */
588 || (temp_byte
= dec_bytepos (from_byte
),
589 FETCH_CHAR (temp_byte
) == '\n')))
592 defun_start_byte
= from_byte
;
597 if (comstart_pos
== 0)
600 from_byte
= comment_end_byte
;
601 UPDATE_SYNTAX_TABLE_FORWARD (comment_end
- 1);
603 /* If the earliest comment starter
604 is followed by uniform paired string quotes or none,
605 we know it can't be inside a string
606 since if it were then the comment ender would be inside one.
607 So it does start a comment. Skip back to it. */
608 else if (!comnested
&& comstart_parity
== 0 && !string_lossage
)
611 from_byte
= comstart_byte
;
612 /* Globals are correct now. */
616 /* We had two kinds of string delimiters mixed up
617 together. Decode this going forwards.
618 Scan fwd from the previous comment ender
619 to the one in question; this records where we
620 last passed a comment starter. */
621 struct lisp_parse_state state
;
622 /* If we did not already find the defun start, find it now. */
623 if (defun_start
== 0)
625 defun_start
= find_defun_start (comment_end
, comment_end_byte
);
626 defun_start_byte
= find_start_value_byte
;
628 scan_sexps_forward (&state
,
629 defun_start
, defun_start_byte
,
630 comment_end
- 1, -10000, 0, Qnil
, 0);
633 /* scan_sexps_forward changed the direction of search in
634 global variables, so we need to update it completely. */
636 from
= state
.comstr_start
;
642 from_byte
= CHAR_TO_BYTE (from
);
643 UPDATE_SYNTAX_TABLE_FORWARD (from
- 1);
648 *bytepos_ptr
= from_byte
;
650 return (from
== comment_end
) ? -1 : from
;
653 DEFUN ("syntax-table-p", Fsyntax_table_p
, Ssyntax_table_p
, 1, 1, 0,
654 "Return t if OBJECT is a syntax table.\n\
655 Currently, any char-table counts as a syntax table.")
659 if (CHAR_TABLE_P (object
)
660 && EQ (XCHAR_TABLE (object
)->purpose
, Qsyntax_table
))
666 check_syntax_table (obj
)
669 if (!(CHAR_TABLE_P (obj
)
670 && EQ (XCHAR_TABLE (obj
)->purpose
, Qsyntax_table
)))
671 wrong_type_argument (Qsyntax_table_p
, obj
);
674 DEFUN ("syntax-table", Fsyntax_table
, Ssyntax_table
, 0, 0, 0,
675 "Return the current syntax table.\n\
676 This is the one specified by the current buffer.")
679 return current_buffer
->syntax_table
;
682 DEFUN ("standard-syntax-table", Fstandard_syntax_table
,
683 Sstandard_syntax_table
, 0, 0, 0,
684 "Return the standard syntax table.\n\
685 This is the one used for new buffers.")
688 return Vstandard_syntax_table
;
691 DEFUN ("copy-syntax-table", Fcopy_syntax_table
, Scopy_syntax_table
, 0, 1, 0,
692 "Construct a new syntax table and return it.\n\
693 It is a copy of the TABLE, which defaults to the standard syntax table.")
700 check_syntax_table (table
);
702 table
= Vstandard_syntax_table
;
704 copy
= Fcopy_sequence (table
);
706 /* Only the standard syntax table should have a default element.
707 Other syntax tables should inherit from parents instead. */
708 XCHAR_TABLE (copy
)->defalt
= Qnil
;
710 /* Copied syntax tables should all have parents.
711 If we copied one with no parent, such as the standard syntax table,
712 use the standard syntax table as the copy's parent. */
713 if (NILP (XCHAR_TABLE (copy
)->parent
))
714 Fset_char_table_parent (copy
, Vstandard_syntax_table
);
718 DEFUN ("set-syntax-table", Fset_syntax_table
, Sset_syntax_table
, 1, 1, 0,
719 "Select a new syntax table for the current buffer.\n\
720 One argument, a syntax table.")
725 check_syntax_table (table
);
726 current_buffer
->syntax_table
= table
;
727 /* Indicate that this buffer now has a specified syntax table. */
728 idx
= PER_BUFFER_VAR_IDX (syntax_table
);
729 SET_PER_BUFFER_VALUE_P (current_buffer
, idx
, 1);
733 /* Convert a letter which signifies a syntax code
734 into the code it signifies.
735 This is used by modify-syntax-entry, and other things. */
737 unsigned char syntax_spec_code
[0400] =
738 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
739 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
740 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
741 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
742 (char) Swhitespace
, (char) Scomment_fence
, (char) Sstring
, 0377,
743 (char) Smath
, 0377, 0377, (char) Squote
,
744 (char) Sopen
, (char) Sclose
, 0377, 0377,
745 0377, (char) Swhitespace
, (char) Spunct
, (char) Scharquote
,
746 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
747 0377, 0377, 0377, 0377,
748 (char) Scomment
, 0377, (char) Sendcomment
, 0377,
749 (char) Sinherit
, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */
750 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
751 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
752 0377, 0377, 0377, 0377, (char) Sescape
, 0377, 0377, (char) Ssymbol
,
753 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
754 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
755 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
756 0377, 0377, 0377, 0377, (char) Sstring_fence
, 0377, 0377, 0377
759 /* Indexed by syntax code, give the letter that describes it. */
761 char syntax_code_spec
[16] =
763 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@',
767 /* Indexed by syntax code, give the object (cons of syntax code and
768 nil) to be stored in syntax table. Since these objects can be
769 shared among syntax tables, we generate them in advance. By
770 sharing objects, the function `describe-syntax' can give a more
772 static Lisp_Object Vsyntax_code_object
;
775 /* Look up the value for CHARACTER in syntax table TABLE's parent
776 and its parents. SYNTAX_ENTRY calls this, when TABLE itself has nil
777 for CHARACTER. It's actually used only when not compiled with GCC. */
780 syntax_parent_lookup (table
, character
)
788 table
= XCHAR_TABLE (table
)->parent
;
792 value
= XCHAR_TABLE (table
)->contents
[character
];
798 DEFUN ("char-syntax", Fchar_syntax
, Schar_syntax
, 1, 1, 0,
799 "Return the syntax code of CHARACTER, described by a character.\n\
800 For example, if CHARACTER is a word constituent,\n\
801 the character `w' is returned.\n\
802 The characters that correspond to various syntax codes\n\
803 are listed in the documentation of `modify-syntax-entry'.")
805 Lisp_Object character
;
808 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
810 gl_state
.use_global
= 0;
811 CHECK_NUMBER (character
, 0);
812 char_int
= XINT (character
);
813 return make_number (syntax_code_spec
[(int) SYNTAX (char_int
)]);
816 DEFUN ("matching-paren", Fmatching_paren
, Smatching_paren
, 1, 1, 0,
817 "Return the matching parenthesis of CHARACTER, or nil if none.")
819 Lisp_Object character
;
822 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
823 gl_state
.use_global
= 0;
824 CHECK_NUMBER (character
, 0);
825 char_int
= XINT (character
);
826 code
= SYNTAX (char_int
);
827 if (code
== Sopen
|| code
== Sclose
)
828 return SYNTAX_MATCH (char_int
);
832 /* This comment supplies the doc string for modify-syntax-entry,
833 for make-docfile to see. We cannot put this in the real DEFUN
834 due to limits in the Unix cpp.
836 DEFUN ("modify-syntax-entry", foo, bar, 2, 3, 0,
837 "Set syntax for character CHAR according to string S.\n\
838 The syntax is changed only for table TABLE, which defaults to\n\
839 the current buffer's syntax table.\n\
840 The first character of S should be one of the following:\n\
841 Space or - whitespace syntax. w word constituent.\n\
842 _ symbol constituent. . punctuation.\n\
843 ( open-parenthesis. ) close-parenthesis.\n\
844 \" string quote. \\ escape.\n\
845 $ paired delimiter. ' expression quote or prefix operator.\n\
846 < comment starter. > comment ender.\n\
847 / character-quote. @ inherit from `standard-syntax-table'.\n\
849 Only single-character comment start and end sequences are represented thus.\n\
850 Two-character sequences are represented as described below.\n\
851 The second character of S is the matching parenthesis,\n\
852 used only if the first character is `(' or `)'.\n\
853 Any additional characters are flags.\n\
854 Defined flags are the characters 1, 2, 3, 4, b, p, and n.\n\
855 1 means CHAR is the start of a two-char comment start sequence.\n\
856 2 means CHAR is the second character of such a sequence.\n\
857 3 means CHAR is the start of a two-char comment end sequence.\n\
858 4 means CHAR is the second character of such a sequence.\n\
860 There can be up to two orthogonal comment sequences. This is to support\n\
861 language modes such as C++. By default, all comment sequences are of style\n\
862 a, but you can set the comment sequence style to b (on the second character\n\
863 of a comment-start, or the first character of a comment-end sequence) using\n\
865 b means CHAR is part of comment sequence b.\n\
866 n means CHAR is part of a nestable comment sequence.\n\
868 p means CHAR is a prefix character for `backward-prefix-chars';\n\
869 such characters are treated as whitespace when they occur\n\
870 between expressions.")
874 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry
, Smodify_syntax_entry
, 2, 3,
875 /* I really don't know why this is interactive
876 help-form should at least be made useful whilst reading the second arg
878 "cSet syntax for character: \nsSet syntax for %s to: ",
879 0 /* See immediately above */)
880 (c
, newentry
, syntax_table
)
881 Lisp_Object c
, newentry
, syntax_table
;
883 register unsigned char *p
;
884 register enum syntaxcode code
;
889 CHECK_STRING (newentry
, 1);
891 if (NILP (syntax_table
))
892 syntax_table
= current_buffer
->syntax_table
;
894 check_syntax_table (syntax_table
);
896 p
= XSTRING (newentry
)->data
;
897 code
= (enum syntaxcode
) syntax_spec_code
[*p
++];
898 if (((int) code
& 0377) == 0377)
899 error ("invalid syntax description letter: %c", p
[-1]);
901 if (code
== Sinherit
)
903 SET_RAW_SYNTAX_ENTRY (syntax_table
, XINT (c
), Qnil
);
910 int character
= (STRING_CHAR_AND_LENGTH
911 (p
, STRING_BYTES (XSTRING (newentry
)) - 1, len
));
912 XSETINT (match
, character
);
913 if (XFASTINT (match
) == ' ')
953 if (val
< XVECTOR (Vsyntax_code_object
)->size
&& NILP (match
))
954 newentry
= XVECTOR (Vsyntax_code_object
)->contents
[val
];
956 /* Since we can't use a shared object, let's make a new one. */
957 newentry
= Fcons (make_number (val
), match
);
959 SET_RAW_SYNTAX_ENTRY (syntax_table
, XINT (c
), newentry
);
964 /* Dump syntax table to buffer in human-readable format */
967 describe_syntax (value
)
970 register enum syntaxcode code
;
971 char desc
, start1
, start2
, end1
, end2
, prefix
, comstyle
;
973 Lisp_Object first
, match_lisp
;
975 Findent_to (make_number (16), make_number (1));
979 insert_string ("default\n");
983 if (CHAR_TABLE_P (value
))
985 insert_string ("deeper char-table ...\n");
991 insert_string ("invalid\n");
995 first
= XCAR (value
);
996 match_lisp
= XCDR (value
);
998 if (!INTEGERP (first
) || !(NILP (match_lisp
) || INTEGERP (match_lisp
)))
1000 insert_string ("invalid\n");
1004 code
= (enum syntaxcode
) (XINT (first
) & 0377);
1005 start1
= (XINT (first
) >> 16) & 1;
1006 start2
= (XINT (first
) >> 17) & 1;
1007 end1
= (XINT (first
) >> 18) & 1;
1008 end2
= (XINT (first
) >> 19) & 1;
1009 prefix
= (XINT (first
) >> 20) & 1;
1010 comstyle
= (XINT (first
) >> 21) & 1;
1012 if ((int) code
< 0 || (int) code
>= (int) Smax
)
1014 insert_string ("invalid");
1017 desc
= syntax_code_spec
[(int) code
];
1019 str
[0] = desc
, str
[1] = 0;
1022 if (NILP (match_lisp
))
1025 insert_char (XINT (match_lisp
));
1042 insert_string ("\twhich means: ");
1044 switch (SWITCH_ENUM_CAST (code
))
1047 insert_string ("whitespace"); break;
1049 insert_string ("punctuation"); break;
1051 insert_string ("word"); break;
1053 insert_string ("symbol"); break;
1055 insert_string ("open"); break;
1057 insert_string ("close"); break;
1059 insert_string ("quote"); break;
1061 insert_string ("string"); break;
1063 insert_string ("math"); break;
1065 insert_string ("escape"); break;
1067 insert_string ("charquote"); break;
1069 insert_string ("comment"); break;
1071 insert_string ("endcomment"); break;
1073 insert_string ("invalid");
1077 if (!NILP (match_lisp
))
1079 insert_string (", matches ");
1080 insert_char (XINT (match_lisp
));
1084 insert_string (",\n\t is the first character of a comment-start sequence");
1086 insert_string (",\n\t is the second character of a comment-start sequence");
1089 insert_string (",\n\t is the first character of a comment-end sequence");
1091 insert_string (",\n\t is the second character of a comment-end sequence");
1093 insert_string (" (comment style b)");
1096 insert_string (",\n\t is a prefix character for `backward-prefix-chars'");
1098 insert_string ("\n");
1102 describe_syntax_1 (vector
)
1105 struct buffer
*old
= current_buffer
;
1106 set_buffer_internal (XBUFFER (Vstandard_output
));
1107 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
, (int *) 0, 0);
1108 while (! NILP (XCHAR_TABLE (vector
)->parent
))
1110 vector
= XCHAR_TABLE (vector
)->parent
;
1111 insert_string ("\nThe parent syntax table is:");
1112 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
,
1116 call0 (intern ("help-mode"));
1117 set_buffer_internal (old
);
1121 DEFUN ("describe-syntax", Fdescribe_syntax
, Sdescribe_syntax
, 0, 0, "",
1122 "Describe the syntax specifications in the syntax table.\n\
1123 The descriptions are inserted in a buffer, which is then displayed.")
1126 internal_with_output_to_temp_buffer
1127 ("*Help*", describe_syntax_1
, current_buffer
->syntax_table
);
1132 int parse_sexp_ignore_comments
;
1134 /* Return the position across COUNT words from FROM.
1135 If that many words cannot be found before the end of the buffer, return 0.
1136 COUNT negative means scan backward and stop at word beginning. */
1139 scan_words (from
, count
)
1140 register int from
, count
;
1142 register int beg
= BEGV
;
1143 register int end
= ZV
;
1144 register int from_byte
= CHAR_TO_BYTE (from
);
1145 register enum syntaxcode code
;
1151 SETUP_SYNTAX_TABLE (from
, count
);
1162 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1163 ch0
= FETCH_CHAR (from_byte
);
1164 code
= SYNTAX (ch0
);
1165 INC_BOTH (from
, from_byte
);
1166 if (words_include_escapes
1167 && (code
== Sescape
|| code
== Scharquote
))
1172 /* Now CH0 is a character which begins a word and FROM is the
1173 position of the next character. */
1176 if (from
== end
) break;
1177 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1178 ch1
= FETCH_CHAR (from_byte
);
1179 code
= SYNTAX (ch1
);
1180 if (!(words_include_escapes
1181 && (code
== Sescape
|| code
== Scharquote
)))
1182 if (code
!= Sword
|| WORD_BOUNDARY_P (ch0
, ch1
))
1184 INC_BOTH (from
, from_byte
);
1198 DEC_BOTH (from
, from_byte
);
1199 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1200 ch1
= FETCH_CHAR (from_byte
);
1201 code
= SYNTAX (ch1
);
1202 if (words_include_escapes
1203 && (code
== Sescape
|| code
== Scharquote
))
1208 /* Now CH1 is a character which ends a word and FROM is the
1216 temp_byte
= dec_bytepos (from_byte
);
1217 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1218 ch0
= FETCH_CHAR (temp_byte
);
1219 code
= SYNTAX (ch0
);
1220 if (!(words_include_escapes
1221 && (code
== Sescape
|| code
== Scharquote
)))
1222 if (code
!= Sword
|| WORD_BOUNDARY_P (ch0
, ch1
))
1224 DEC_BOTH (from
, from_byte
);
1235 DEFUN ("forward-word", Fforward_word
, Sforward_word
, 1, 1, "p",
1236 "Move point forward ARG words (backward if ARG is negative).\n\
1237 Normally returns t.\n\
1238 If an edge of the buffer or a field boundary is reached, point is left there\n\
1239 and the function returns nil. Field boundaries are not noticed if\n\
1240 `inhibit-field-text-motion' is non-nil.")
1245 CHECK_NUMBER (count
, 0);
1247 val
= orig_val
= scan_words (PT
, XINT (count
));
1249 val
= XINT (count
) > 0 ? ZV
: BEGV
;
1251 /* Avoid jumping out of an input field. */
1252 val
= XFASTINT (Fconstrain_to_field (make_number (val
), make_number (PT
),
1256 return val
== orig_val
? Qt
: Qnil
;
1259 Lisp_Object
skip_chars ();
1261 DEFUN ("skip-chars-forward", Fskip_chars_forward
, Sskip_chars_forward
, 1, 2, 0,
1262 "Move point forward, stopping before a char not in STRING, or at pos LIM.\n\
1263 STRING is like the inside of a `[...]' in a regular expression\n\
1264 except that `]' is never special and `\\' quotes `^', `-' or `\\'\n\
1265 (but not as the end of a range; quoting is never needed there).\n\
1266 Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
1267 With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\
1268 Returns the distance traveled, either zero or positive.")
1270 Lisp_Object string
, lim
;
1272 return skip_chars (1, 0, string
, lim
);
1275 DEFUN ("skip-chars-backward", Fskip_chars_backward
, Sskip_chars_backward
, 1, 2, 0,
1276 "Move point backward, stopping after a char not in STRING, or at pos LIM.\n\
1277 See `skip-chars-forward' for details.\n\
1278 Returns the distance traveled, either zero or negative.")
1280 Lisp_Object string
, lim
;
1282 return skip_chars (0, 0, string
, lim
);
1285 DEFUN ("skip-syntax-forward", Fskip_syntax_forward
, Sskip_syntax_forward
, 1, 2, 0,
1286 "Move point forward across chars in specified syntax classes.\n\
1287 SYNTAX is a string of syntax code characters.\n\
1288 Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\
1289 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1290 This function returns the distance traveled, either zero or positive.")
1292 Lisp_Object syntax
, lim
;
1294 return skip_chars (1, 1, syntax
, lim
);
1297 DEFUN ("skip-syntax-backward", Fskip_syntax_backward
, Sskip_syntax_backward
, 1, 2, 0,
1298 "Move point backward across chars in specified syntax classes.\n\
1299 SYNTAX is a string of syntax code characters.\n\
1300 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\
1301 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1302 This function returns the distance traveled, either zero or negative.")
1304 Lisp_Object syntax
, lim
;
1306 return skip_chars (0, 1, syntax
, lim
);
1310 skip_chars (forwardp
, syntaxp
, string
, lim
)
1311 int forwardp
, syntaxp
;
1312 Lisp_Object string
, lim
;
1314 register unsigned int c
;
1316 unsigned char fastmap
[0400];
1317 /* If SYNTAXP is 0, STRING may contain multi-byte form of characters
1318 of which codes don't fit in FASTMAP. In that case, we set the
1319 first byte of multibyte form (i.e. base leading-code) in FASTMAP
1320 and set the actual ranges of characters in CHAR_RANGES. In the
1321 form "X-Y" of STRING, both X and Y must belong to the same
1322 character set because a range striding across character sets is
1325 int n_char_ranges
= 0;
1327 register int i
, i_byte
;
1328 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
1329 int string_multibyte
;
1332 CHECK_STRING (string
, 0);
1333 char_ranges
= (int *) alloca (XSTRING (string
)->size
* (sizeof (int)) * 2);
1334 string_multibyte
= STRING_MULTIBYTE (string
);
1335 size_byte
= STRING_BYTES (XSTRING (string
));
1338 XSETINT (lim
, forwardp
? ZV
: BEGV
);
1340 CHECK_NUMBER_COERCE_MARKER (lim
, 0);
1342 /* In any case, don't allow scan outside bounds of buffer. */
1343 if (XINT (lim
) > ZV
)
1344 XSETFASTINT (lim
, ZV
);
1345 if (XINT (lim
) < BEGV
)
1346 XSETFASTINT (lim
, BEGV
);
1348 bzero (fastmap
, sizeof fastmap
);
1352 if (i_byte
< size_byte
1353 && XSTRING (string
)->data
[0] == '^')
1355 negate
= 1; i
++, i_byte
++;
1358 /* Find the characters specified and set their elements of fastmap.
1359 If syntaxp, each character counts as itself.
1360 Otherwise, handle backslashes and ranges specially. */
1362 while (i_byte
< size_byte
)
1364 int c_leading_code
= XSTRING (string
)->data
[i_byte
];
1366 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1368 /* Convert multibyteness between what the string has
1369 and what the buffer has. */
1371 c
= unibyte_char_to_multibyte (c
);
1376 fastmap
[syntax_spec_code
[c
& 0377]] = 1;
1381 if (i_byte
== size_byte
)
1384 c_leading_code
= XSTRING (string
)->data
[i_byte
];
1385 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1387 if (i_byte
< size_byte
1388 && XSTRING (string
)->data
[i_byte
] == '-')
1390 unsigned int c2
, c2_leading_code
;
1392 /* Skip over the dash. */
1395 if (i_byte
== size_byte
)
1398 /* Get the end of the range. */
1399 c2_leading_code
= XSTRING (string
)->data
[i_byte
];
1400 FETCH_STRING_CHAR_ADVANCE (c2
, string
, i
, i_byte
);
1402 if (SINGLE_BYTE_CHAR_P (c
))
1404 if (! SINGLE_BYTE_CHAR_P (c2
))
1405 error ("Invalid charcter range: %s",
1406 XSTRING (string
)->data
);
1415 if (c_leading_code
!= c2_leading_code
)
1416 error ("Invalid charcter range: %s",
1417 XSTRING (string
)->data
);
1418 fastmap
[c_leading_code
] = 1;
1421 char_ranges
[n_char_ranges
++] = c
;
1422 char_ranges
[n_char_ranges
++] = c2
;
1428 fastmap
[c_leading_code
] = 1;
1429 if (!SINGLE_BYTE_CHAR_P (c
))
1431 char_ranges
[n_char_ranges
++] = c
;
1432 char_ranges
[n_char_ranges
++] = c
;
1438 /* If ^ was the first character, complement the fastmap. In
1439 addition, as all multibyte characters have possibility of
1440 matching, set all entries for base leading codes, which is
1441 harmless even if SYNTAXP is 1. */
1444 for (i
= 0; i
< sizeof fastmap
; i
++)
1446 if (!multibyte
|| !BASE_LEADING_CODE_P (i
))
1453 int start_point
= PT
;
1455 int pos_byte
= PT_BYTE
;
1460 SETUP_SYNTAX_TABLE (pos
, forwardp
? 1 : -1);
1465 if (pos
< XINT (lim
))
1466 while (fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1468 /* Since we already checked for multibyteness,
1469 avoid using INC_BOTH which checks again. */
1472 if (pos
>= XINT (lim
))
1474 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1479 while (pos
< XINT (lim
)
1480 && fastmap
[(int) SYNTAX (FETCH_BYTE (pos
))])
1483 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1491 while (pos
> XINT (lim
))
1493 int savepos
= pos_byte
;
1494 /* Since we already checked for multibyteness,
1495 avoid using DEC_BOTH which checks again. */
1498 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
1499 if (!fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1509 if (pos
> XINT (lim
))
1510 while (fastmap
[(int) SYNTAX (FETCH_BYTE (pos
- 1))])
1513 if (pos
<= XINT (lim
))
1515 UPDATE_SYNTAX_TABLE_BACKWARD (pos
- 1);
1525 while (pos
< XINT (lim
) && fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1527 if (!BASE_LEADING_CODE_P (c
))
1528 INC_BOTH (pos
, pos_byte
);
1529 else if (n_char_ranges
)
1531 /* We much check CHAR_RANGES for a multibyte
1533 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1534 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1535 if ((ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1]))
1537 if (!(negate
^ (i
< n_char_ranges
)))
1540 INC_BOTH (pos
, pos_byte
);
1545 INC_BOTH (pos
, pos_byte
);
1549 while (pos
< XINT (lim
) && fastmap
[FETCH_BYTE (pos
)])
1555 while (pos
> XINT (lim
))
1557 int savepos
= pos_byte
;
1558 DEC_BOTH (pos
, pos_byte
);
1559 if (fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1561 if (!BASE_LEADING_CODE_P (c
))
1563 else if (n_char_ranges
)
1565 /* We much check CHAR_RANGES for a multibyte
1567 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1568 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1569 if (ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1])
1571 if (!(negate
^ (i
< n_char_ranges
)))
1594 while (pos
> XINT (lim
) && fastmap
[FETCH_BYTE (pos
- 1)])
1599 #if 0 /* Not needed now that a position in mid-character
1600 cannot be specified in Lisp. */
1602 /* INC_POS or DEC_POS might have moved POS over LIM. */
1603 && (forwardp
? (pos
> XINT (lim
)) : (pos
< XINT (lim
))))
1610 SET_PT_BOTH (pos
, pos_byte
);
1613 return make_number (PT
- start_point
);
1617 /* Jump over a comment, assuming we are at the beginning of one.
1618 FROM is the current position.
1619 FROM_BYTE is the bytepos corresponding to FROM.
1620 Do not move past STOP (a charpos).
1621 The comment over which we have to jump is of style STYLE
1622 (either SYNTAX_COMMENT_STYLE(foo) or ST_COMMENT_STYLE).
1623 NESTING should be positive to indicate the nesting at the beginning
1624 for nested comments and should be zero or negative else.
1625 ST_COMMENT_STYLE cannot be nested.
1626 PREV_SYNTAX is the SYNTAX_WITH_FLAGS of the previous character
1627 (or 0 If the search cannot start in the middle of a two-character).
1629 If successful, return 1 and store the charpos of the comment's end
1630 into *CHARPOS_PTR and the corresponding bytepos into *BYTEPOS_PTR.
1631 Else, return 0 and store the charpos STOP into *CHARPOS_PTR, the
1632 corresponding bytepos into *BYTEPOS_PTR and the current nesting
1633 (as defined for state.incomment) in *INCOMMENT_PTR.
1635 The comment end is the last character of the comment rather than the
1636 character just after the comment.
1638 Global syntax data is assumed to initially be valid for FROM and
1639 remains valid for forward search starting at the returned position. */
1642 forw_comment (from
, from_byte
, stop
, nesting
, style
, prev_syntax
,
1643 charpos_ptr
, bytepos_ptr
, incomment_ptr
)
1644 int from
, from_byte
, stop
;
1645 int nesting
, style
, prev_syntax
;
1646 int *charpos_ptr
, *bytepos_ptr
, *incomment_ptr
;
1649 register enum syntaxcode code
;
1650 register int syntax
;
1652 if (nesting
<= 0) nesting
= -1;
1654 /* Enter the loop in the middle so that we find
1655 a 2-char comment ender if we start in the middle of it. */
1656 syntax
= prev_syntax
;
1657 if (syntax
!= 0) goto forw_incomment
;
1663 *incomment_ptr
= nesting
;
1664 *charpos_ptr
= from
;
1665 *bytepos_ptr
= from_byte
;
1668 c
= FETCH_CHAR (from_byte
);
1669 syntax
= SYNTAX_WITH_FLAGS (c
);
1670 code
= syntax
& 0xff;
1671 if (code
== Sendcomment
1672 && SYNTAX_FLAGS_COMMENT_STYLE (syntax
) == style
1674 /* we have encountered a comment end of the same style
1675 as the comment sequence which began this comment
1678 if (code
== Scomment_fence
1679 && style
== ST_COMMENT_STYLE
)
1680 /* we have encountered a comment end of the same style
1681 as the comment sequence which began this comment
1686 && SYNTAX_FLAGS_COMMENT_STYLE (syntax
) == style
)
1687 /* we have encountered a nested comment of the same style
1688 as the comment sequence which began this comment section */
1690 INC_BOTH (from
, from_byte
);
1691 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1694 if (from
< stop
&& SYNTAX_FLAGS_COMEND_FIRST (syntax
)
1695 && SYNTAX_FLAGS_COMMENT_STYLE (syntax
) == style
1696 && (c1
= FETCH_CHAR (from_byte
),
1697 SYNTAX_COMEND_SECOND (c1
)))
1700 /* we have encountered a comment end of the same style
1701 as the comment sequence which began this comment
1706 INC_BOTH (from
, from_byte
);
1707 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1712 && SYNTAX_FLAGS_COMSTART_FIRST (syntax
)
1713 && (c1
= FETCH_CHAR (from_byte
),
1714 SYNTAX_COMMENT_STYLE (c1
) == style
1715 && SYNTAX_COMSTART_SECOND (c1
)))
1716 /* we have encountered a nested comment of the same style
1717 as the comment sequence which began this comment
1720 INC_BOTH (from
, from_byte
);
1721 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1725 *charpos_ptr
= from
;
1726 *bytepos_ptr
= from_byte
;
1730 DEFUN ("forward-comment", Fforward_comment
, Sforward_comment
, 1, 1, 0,
1731 "Move forward across up to N comments. If N is negative, move backward.\n\
1732 Stop scanning if we find something other than a comment or whitespace.\n\
1733 Set point to where scanning stops.\n\
1734 If N comments are found as expected, with nothing except whitespace\n\
1735 between them, return t; otherwise return nil.")
1743 register enum syntaxcode code
;
1744 int comstyle
= 0; /* style of comment encountered */
1745 int comnested
= 0; /* whether the comment is nestable or not */
1748 int out_charpos
, out_bytepos
;
1751 CHECK_NUMBER (count
, 0);
1752 count1
= XINT (count
);
1753 stop
= count1
> 0 ? ZV
: BEGV
;
1759 from_byte
= PT_BYTE
;
1761 SETUP_SYNTAX_TABLE (from
, count1
);
1770 SET_PT_BOTH (from
, from_byte
);
1774 c
= FETCH_CHAR (from_byte
);
1776 comstart_first
= SYNTAX_COMSTART_FIRST (c
);
1777 comnested
= SYNTAX_COMMENT_NESTED (c
);
1778 INC_BOTH (from
, from_byte
);
1779 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1781 if (from
< stop
&& comstart_first
1782 && (c1
= FETCH_CHAR (from_byte
),
1783 SYNTAX_COMSTART_SECOND (c1
)))
1785 /* We have encountered a comment start sequence and we
1786 are ignoring all text inside comments. We must record
1787 the comment style this sequence begins so that later,
1788 only a comment end of the same style actually ends
1789 the comment section. */
1791 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1792 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
1793 INC_BOTH (from
, from_byte
);
1794 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1796 /* FIXME: here we ignore 2-char endcomments while we don't
1797 when going backwards. */
1799 while (code
== Swhitespace
|| code
== Sendcomment
);
1801 if (code
== Scomment_fence
)
1802 comstyle
= ST_COMMENT_STYLE
;
1803 else if (code
!= Scomment
)
1806 DEC_BOTH (from
, from_byte
);
1807 SET_PT_BOTH (from
, from_byte
);
1810 /* We're at the start of a comment. */
1811 found
= forw_comment (from
, from_byte
, stop
, comnested
, comstyle
, 0,
1812 &out_charpos
, &out_bytepos
, &dummy
);
1813 from
= out_charpos
; from_byte
= out_bytepos
;
1817 SET_PT_BOTH (from
, from_byte
);
1820 INC_BOTH (from
, from_byte
);
1821 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1822 /* We have skipped one comment. */
1830 int quoted
, comstart_second
;
1834 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
1839 DEC_BOTH (from
, from_byte
);
1840 /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
1841 quoted
= char_quoted (from
, from_byte
);
1844 DEC_BOTH (from
, from_byte
);
1847 c
= FETCH_CHAR (from_byte
);
1850 comnested
= SYNTAX_COMMENT_NESTED (c
);
1851 if (code
== Sendcomment
)
1852 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1853 comstart_second
= SYNTAX_COMSTART_SECOND (c
);
1854 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1855 && prev_char_comend_first (from
, from_byte
)
1856 && !char_quoted (from
- 1, dec_bytepos (from_byte
)))
1858 /* We must record the comment style encountered so that
1859 later, we can match only the proper comment begin
1860 sequence of the same style. */
1861 DEC_BOTH (from
, from_byte
);
1863 /* Calling char_quoted, above, set up global syntax position
1864 at the new value of FROM. */
1865 c1
= FETCH_CHAR (from_byte
);
1866 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1867 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
1869 if (from
> stop
&& comstart_second
1870 && prev_char_comstart_first (from
, from_byte
)
1871 && !char_quoted (from
- 1, dec_bytepos (from_byte
)))
1874 DEC_BOTH (from
, from_byte
);
1877 if (code
== Scomment_fence
)
1879 /* Skip until first preceding unquoted comment_fence. */
1880 int found
= 0, ini
= from
, ini_byte
= from_byte
;
1884 DEC_BOTH (from
, from_byte
);
1887 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1888 c
= FETCH_CHAR (from_byte
);
1889 if (SYNTAX (c
) == Scomment_fence
1890 && !char_quoted (from
, from_byte
))
1898 from
= ini
; /* Set point to ini + 1. */
1899 from_byte
= ini_byte
;
1903 else if (code
== Sendcomment
)
1905 found
= back_comment (from
, from_byte
, stop
, comnested
, comstyle
,
1906 &out_charpos
, &out_bytepos
);
1909 #if 0 /* cc-mode (and maybe others) relies on the bogus behavior. */
1910 /* Failure: we should go back to the end of this
1911 not-quite-endcomment. */
1912 if (SYNTAX(c
) != code
)
1913 /* It was a two-char Sendcomment. */
1914 INC_BOTH (from
, from_byte
);
1919 /* We have skipped one comment. */
1920 from
= out_charpos
, from_byte
= out_bytepos
;
1923 else if (code
!= Swhitespace
&& code
!= Scomment
)
1927 INC_BOTH (from
, from_byte
);
1928 SET_PT_BOTH (from
, from_byte
);
1936 SET_PT_BOTH (from
, from_byte
);
1941 /* Return syntax code of character C if C is a single byte character
1942 or `multibyte_symbol_p' is zero. Otherwise, retrun Ssymbol. */
1944 #define SYNTAX_WITH_MULTIBYTE_CHECK(c) \
1945 ((SINGLE_BYTE_CHAR_P (c) || !multibyte_symbol_p) \
1946 ? SYNTAX (c) : Ssymbol)
1949 scan_lists (from
, count
, depth
, sexpflag
)
1951 int count
, depth
, sexpflag
;
1954 register int stop
= count
> 0 ? ZV
: BEGV
;
1959 register enum syntaxcode code
, temp_code
;
1960 int min_depth
= depth
; /* Err out if depth gets less than this. */
1961 int comstyle
= 0; /* style of comment encountered */
1962 int comnested
= 0; /* whether the comment is nestable or not */
1964 int last_good
= from
;
1967 int out_bytepos
, out_charpos
;
1969 int multibyte_symbol_p
= sexpflag
&& multibyte_syntax_as_symbol
;
1971 if (depth
> 0) min_depth
= 0;
1973 if (from
> ZV
) from
= ZV
;
1974 if (from
< BEGV
) from
= BEGV
;
1976 from_byte
= CHAR_TO_BYTE (from
);
1981 SETUP_SYNTAX_TABLE (from
, count
);
1986 int comstart_first
, prefix
;
1987 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1988 c
= FETCH_CHAR (from_byte
);
1989 code
= SYNTAX_WITH_MULTIBYTE_CHECK (c
);
1990 comstart_first
= SYNTAX_COMSTART_FIRST (c
);
1991 comnested
= SYNTAX_COMMENT_NESTED (c
);
1992 prefix
= SYNTAX_PREFIX (c
);
1993 if (depth
== min_depth
)
1995 INC_BOTH (from
, from_byte
);
1996 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1997 if (from
< stop
&& comstart_first
1998 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
))
1999 && parse_sexp_ignore_comments
)
2001 /* we have encountered a comment start sequence and we
2002 are ignoring all text inside comments. We must record
2003 the comment style this sequence begins so that later,
2004 only a comment end of the same style actually ends
2005 the comment section */
2007 c1
= FETCH_CHAR (from_byte
);
2008 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
2009 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
2010 INC_BOTH (from
, from_byte
);
2011 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2017 switch (SWITCH_ENUM_CAST (code
))
2021 if (from
== stop
) goto lose
;
2022 INC_BOTH (from
, from_byte
);
2023 /* treat following character as a word constituent */
2026 if (depth
|| !sexpflag
) break;
2027 /* This word counts as a sexp; return at end of it. */
2030 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2032 /* Some compilers can't handle this inside the switch. */
2033 c
= FETCH_CHAR (from_byte
);
2034 temp
= SYNTAX_WITH_MULTIBYTE_CHECK (c
);
2039 INC_BOTH (from
, from_byte
);
2040 if (from
== stop
) goto lose
;
2049 INC_BOTH (from
, from_byte
);
2053 case Scomment_fence
:
2054 comstyle
= ST_COMMENT_STYLE
;
2057 if (!parse_sexp_ignore_comments
) break;
2058 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2059 found
= forw_comment (from
, from_byte
, stop
,
2060 comnested
, comstyle
, 0,
2061 &out_charpos
, &out_bytepos
, &dummy
);
2062 from
= out_charpos
, from_byte
= out_bytepos
;
2069 INC_BOTH (from
, from_byte
);
2070 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2076 if (from
!= stop
&& c
== FETCH_CHAR (from_byte
))
2078 INC_BOTH (from
, from_byte
);
2088 if (!++depth
) goto done
;
2093 if (!--depth
) goto done
;
2094 if (depth
< min_depth
)
2095 Fsignal (Qscan_error
,
2096 Fcons (build_string ("Containing expression ends prematurely"),
2097 Fcons (make_number (last_good
),
2098 Fcons (make_number (from
), Qnil
))));
2103 temp_pos
= dec_bytepos (from_byte
);
2104 stringterm
= FETCH_CHAR (temp_pos
);
2107 if (from
>= stop
) goto lose
;
2108 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2109 c
= FETCH_CHAR (from_byte
);
2112 : SYNTAX_WITH_MULTIBYTE_CHECK (c
) == Sstring_fence
)
2115 /* Some compilers can't handle this inside the switch. */
2116 temp
= SYNTAX_WITH_MULTIBYTE_CHECK (c
);
2121 INC_BOTH (from
, from_byte
);
2123 INC_BOTH (from
, from_byte
);
2125 INC_BOTH (from
, from_byte
);
2126 if (!depth
&& sexpflag
) goto done
;
2131 /* Reached end of buffer. Error if within object, return nil if between */
2132 if (depth
) goto lose
;
2137 /* End of object reached */
2146 DEC_BOTH (from
, from_byte
);
2147 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2148 c
= FETCH_CHAR (from_byte
);
2149 code
= SYNTAX_WITH_MULTIBYTE_CHECK (c
);
2150 if (depth
== min_depth
)
2153 comnested
= SYNTAX_COMMENT_NESTED (c
);
2154 if (code
== Sendcomment
)
2155 comstyle
= SYNTAX_COMMENT_STYLE (c
);
2156 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
2157 && prev_char_comend_first (from
, from_byte
)
2158 && parse_sexp_ignore_comments
)
2160 /* We must record the comment style encountered so that
2161 later, we can match only the proper comment begin
2162 sequence of the same style. */
2163 DEC_BOTH (from
, from_byte
);
2164 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2166 c1
= FETCH_CHAR (from_byte
);
2167 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
2168 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
2171 /* Quoting turns anything except a comment-ender
2172 into a word character. Note that this if cannot be true
2173 if we decremented FROM in the if-statement above. */
2174 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
2176 else if (SYNTAX_PREFIX (c
))
2179 switch (SWITCH_ENUM_CAST (code
))
2185 if (depth
|| !sexpflag
) break;
2186 /* This word counts as a sexp; count object finished
2187 after passing it. */
2190 temp_pos
= from_byte
;
2191 if (! NILP (current_buffer
->enable_multibyte_characters
))
2195 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2196 c1
= FETCH_CHAR (temp_pos
);
2197 temp_code
= SYNTAX_WITH_MULTIBYTE_CHECK (c1
);
2198 /* Don't allow comment-end to be quoted. */
2199 if (temp_code
== Sendcomment
)
2201 quoted
= char_quoted (from
- 1, temp_pos
);
2204 DEC_BOTH (from
, from_byte
);
2205 temp_pos
= dec_bytepos (temp_pos
);
2206 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2208 c1
= FETCH_CHAR (temp_pos
);
2209 temp_code
= SYNTAX_WITH_MULTIBYTE_CHECK (c1
);
2210 if (! (quoted
|| temp_code
== Sword
2211 || temp_code
== Ssymbol
2212 || temp_code
== Squote
))
2214 DEC_BOTH (from
, from_byte
);
2221 temp_pos
= dec_bytepos (from_byte
);
2222 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2223 if (from
!= stop
&& c
== FETCH_CHAR (temp_pos
))
2224 DEC_BOTH (from
, from_byte
);
2233 if (!++depth
) goto done2
;
2238 if (!--depth
) goto done2
;
2239 if (depth
< min_depth
)
2240 Fsignal (Qscan_error
,
2241 Fcons (build_string ("Containing expression ends prematurely"),
2242 Fcons (make_number (last_good
),
2243 Fcons (make_number (from
), Qnil
))));
2247 if (!parse_sexp_ignore_comments
)
2249 found
= back_comment (from
, from_byte
, stop
, comnested
, comstyle
,
2250 &out_charpos
, &out_bytepos
);
2251 /* FIXME: if found == -1, then it really wasn't a comment-end.
2252 For single-char Sendcomment, we can't do much about it apart
2253 from skipping the char.
2254 For 2-char endcomments, we could try again, taking both
2255 chars as separate entities, but it's a lot of trouble
2256 for very little gain, so we don't bother either. -sm */
2258 from
= out_charpos
, from_byte
= out_bytepos
;
2261 case Scomment_fence
:
2265 DEC_BOTH (from
, from_byte
);
2266 if (from
== stop
) goto lose
;
2267 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2268 if (!char_quoted (from
, from_byte
)
2269 && (c
= FETCH_CHAR (from_byte
),
2270 SYNTAX_WITH_MULTIBYTE_CHECK (c
) == code
))
2273 if (code
== Sstring_fence
&& !depth
&& sexpflag
) goto done2
;
2277 stringterm
= FETCH_CHAR (from_byte
);
2280 if (from
== stop
) goto lose
;
2281 temp_pos
= from_byte
;
2282 if (! NILP (current_buffer
->enable_multibyte_characters
))
2286 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2287 if (!char_quoted (from
- 1, temp_pos
)
2288 && stringterm
== FETCH_CHAR (temp_pos
))
2290 DEC_BOTH (from
, from_byte
);
2292 DEC_BOTH (from
, from_byte
);
2293 if (!depth
&& sexpflag
) goto done2
;
2298 /* Reached start of buffer. Error if within object, return nil if between */
2299 if (depth
) goto lose
;
2310 XSETFASTINT (val
, from
);
2314 Fsignal (Qscan_error
,
2315 Fcons (build_string ("Unbalanced parentheses"),
2316 Fcons (make_number (last_good
),
2317 Fcons (make_number (from
), Qnil
))));
2322 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
2323 "Scan from character number FROM by COUNT lists.\n\
2324 Returns the character number of the position thus found.\n\
2326 If DEPTH is nonzero, paren depth begins counting from that value,\n\
2327 only places where the depth in parentheses becomes zero\n\
2328 are candidates for stopping; COUNT such places are counted.\n\
2329 Thus, a positive value for DEPTH means go out levels.\n\
2331 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2333 If the beginning or end of (the accessible part of) the buffer is reached\n\
2334 and the depth is wrong, an error is signaled.\n\
2335 If the depth is right but the count is not used up, nil is returned.")
2336 (from
, count
, depth
)
2337 Lisp_Object from
, count
, depth
;
2339 CHECK_NUMBER (from
, 0);
2340 CHECK_NUMBER (count
, 1);
2341 CHECK_NUMBER (depth
, 2);
2343 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
2346 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
2347 "Scan from character number FROM by COUNT balanced expressions.\n\
2348 If COUNT is negative, scan backwards.\n\
2349 Returns the character number of the position thus found.\n\
2351 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2353 If the beginning or end of (the accessible part of) the buffer is reached\n\
2354 in the middle of a parenthetical grouping, an error is signaled.\n\
2355 If the beginning or end is reached between groupings\n\
2356 but before count is used up, nil is returned.")
2358 Lisp_Object from
, count
;
2360 CHECK_NUMBER (from
, 0);
2361 CHECK_NUMBER (count
, 1);
2363 return scan_lists (XINT (from
), XINT (count
), 0, 1);
2366 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
2368 "Move point backward over any number of chars with prefix syntax.\n\
2369 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
2374 int opoint_byte
= PT_BYTE
;
2376 int pos_byte
= PT_BYTE
;
2381 SET_PT_BOTH (opoint
, opoint_byte
);
2386 SETUP_SYNTAX_TABLE (pos
, -1);
2388 DEC_BOTH (pos
, pos_byte
);
2390 while (!char_quoted (pos
, pos_byte
)
2391 /* Previous statement updates syntax table. */
2392 && ((c
= FETCH_CHAR (pos_byte
), SYNTAX (c
) == Squote
)
2393 || SYNTAX_PREFIX (c
)))
2396 opoint_byte
= pos_byte
;
2399 DEC_BOTH (pos
, pos_byte
);
2402 SET_PT_BOTH (opoint
, opoint_byte
);
2407 /* Parse forward from FROM / FROM_BYTE to END,
2408 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
2409 and return a description of the state of the parse at END.
2410 If STOPBEFORE is nonzero, stop at the start of an atom.
2411 If COMMENTSTOP is 1, stop at the start of a comment.
2412 If COMMENTSTOP is -1, stop at the start or end of a comment,
2413 after the beginning of a string, or after the end of a string. */
2416 scan_sexps_forward (stateptr
, from
, from_byte
, end
, targetdepth
,
2417 stopbefore
, oldstate
, commentstop
)
2418 struct lisp_parse_state
*stateptr
;
2420 int end
, targetdepth
, stopbefore
;
2421 Lisp_Object oldstate
;
2424 struct lisp_parse_state state
;
2426 register enum syntaxcode code
;
2429 struct level
{ int last
, prev
; };
2430 struct level levelstart
[100];
2431 register struct level
*curlevel
= levelstart
;
2432 struct level
*endlevel
= levelstart
+ 100;
2433 register int depth
; /* Paren depth of current scanning location.
2434 level - levelstart equals this except
2435 when the depth becomes negative. */
2436 int mindepth
; /* Lowest DEPTH value seen. */
2437 int start_quoted
= 0; /* Nonzero means starting after a char quote */
2439 int prev_from
; /* Keep one character before FROM. */
2441 int prev_from_syntax
;
2442 int boundary_stop
= commentstop
== -1;
2445 int out_bytepos
, out_charpos
;
2449 prev_from_byte
= from_byte
;
2451 DEC_BOTH (prev_from
, prev_from_byte
);
2453 /* Use this macro instead of `from++'. */
2455 do { prev_from = from; \
2456 prev_from_byte = from_byte; \
2458 = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); \
2459 INC_BOTH (from, from_byte); \
2460 UPDATE_SYNTAX_TABLE_FORWARD (from); \
2466 if (NILP (oldstate
))
2469 state
.instring
= -1;
2470 state
.incomment
= 0;
2471 state
.comstyle
= 0; /* comment style a by default. */
2472 state
.comstr_start
= -1; /* no comment/string seen. */
2476 tem
= Fcar (oldstate
);
2482 oldstate
= Fcdr (oldstate
);
2483 oldstate
= Fcdr (oldstate
);
2484 oldstate
= Fcdr (oldstate
);
2485 tem
= Fcar (oldstate
);
2486 /* Check whether we are inside string_fence-style string: */
2487 state
.instring
= (!NILP (tem
)
2488 ? (INTEGERP (tem
) ? XINT (tem
) : ST_STRING_STYLE
)
2491 oldstate
= Fcdr (oldstate
);
2492 tem
= Fcar (oldstate
);
2493 state
.incomment
= (!NILP (tem
)
2494 ? (INTEGERP (tem
) ? XINT (tem
) : -1)
2497 oldstate
= Fcdr (oldstate
);
2498 tem
= Fcar (oldstate
);
2499 start_quoted
= !NILP (tem
);
2501 /* if the eighth element of the list is nil, we are in comment
2502 style a. If it is non-nil, we are in comment style b */
2503 oldstate
= Fcdr (oldstate
);
2504 oldstate
= Fcdr (oldstate
);
2505 tem
= Fcar (oldstate
);
2506 state
.comstyle
= NILP (tem
) ? 0 : (EQ (tem
, Qsyntax_table
)
2507 ? ST_COMMENT_STYLE
: 1);
2509 oldstate
= Fcdr (oldstate
);
2510 tem
= Fcar (oldstate
);
2511 state
.comstr_start
= NILP (tem
) ? -1 : XINT (tem
) ;
2512 oldstate
= Fcdr (oldstate
);
2513 tem
= Fcar (oldstate
);
2514 while (!NILP (tem
)) /* >= second enclosing sexps. */
2516 /* curlevel++->last ran into compiler bug on Apollo */
2517 curlevel
->last
= XINT (Fcar (tem
));
2518 if (++curlevel
== endlevel
)
2519 error ("Nesting too deep for parser");
2520 curlevel
->prev
= -1;
2521 curlevel
->last
= -1;
2528 curlevel
->prev
= -1;
2529 curlevel
->last
= -1;
2531 SETUP_SYNTAX_TABLE (prev_from
, 1);
2532 prev_from_syntax
= SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte
));
2533 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2535 /* Enter the loop at a place appropriate for initial state. */
2537 if (state
.incomment
)
2538 goto startincomment
;
2539 if (state
.instring
>= 0)
2541 nofence
= state
.instring
!= ST_STRING_STYLE
;
2543 goto startquotedinstring
;
2546 else if (start_quoted
)
2549 #if 0 /* This seems to be redundant with the identical code above. */
2550 SETUP_SYNTAX_TABLE (prev_from
, 1);
2551 prev_from_syntax
= SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte
));
2552 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2558 code
= prev_from_syntax
& 0xff;
2560 if (code
== Scomment
)
2562 state
.incomment
= (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax
) ?
2564 state
.comstr_start
= prev_from
;
2566 else if (code
== Scomment_fence
)
2568 /* Record the comment style we have entered so that only
2569 the comment-end sequence of the same style actually
2570 terminates the comment section. */
2571 state
.comstyle
= ST_COMMENT_STYLE
;
2572 state
.incomment
= -1;
2573 state
.comstr_start
= prev_from
;
2576 else if (from
< end
)
2577 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax
))
2578 if (c1
= FETCH_CHAR (from_byte
),
2579 SYNTAX_COMSTART_SECOND (c1
))
2580 /* Duplicate code to avoid a complex if-expression
2581 which causes trouble for the SGI compiler. */
2583 /* Record the comment style we have entered so that only
2584 the comment-end sequence of the same style actually
2585 terminates the comment section. */
2586 state
.comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
));
2587 comnested
= SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax
);
2588 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
2589 state
.incomment
= comnested
? 1 : -1;
2590 state
.comstr_start
= prev_from
;
2595 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax
))
2597 switch (SWITCH_ENUM_CAST (code
))
2601 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2602 curlevel
->last
= prev_from
;
2604 if (from
== end
) goto endquoted
;
2607 /* treat following character as a word constituent */
2610 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2611 curlevel
->last
= prev_from
;
2615 /* Some compilers can't handle this inside the switch. */
2616 temp
= SYNTAX (FETCH_CHAR (from_byte
));
2622 if (from
== end
) goto endquoted
;
2634 curlevel
->prev
= curlevel
->last
;
2638 if (commentstop
== 1)
2643 if (! state
.incomment
)
2645 if (commentstop
|| boundary_stop
) goto done
;
2647 /* The (from == BEGV) test is to enter the loop in the middle so
2648 that we find a 2-char comment ender even if we start in the
2650 found
= forw_comment (from
, from_byte
, end
,
2651 state
.incomment
, state
.comstyle
,
2652 (from
== BEGV
) ? 0 : prev_from_syntax
,
2653 &out_charpos
, &out_bytepos
, &state
.incomment
);
2654 from
= out_charpos
; from_byte
= out_bytepos
;
2655 /* Beware! prev_from and friends are invalid now.
2656 Luckily, the `done' doesn't use them and the INC_FROM
2657 sets them to a sane value without looking at them. */
2658 if (!found
) goto done
;
2660 state
.incomment
= 0;
2661 state
.comstyle
= 0; /* reset the comment style */
2662 if (boundary_stop
) goto done
;
2666 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2668 /* curlevel++->last ran into compiler bug on Apollo */
2669 curlevel
->last
= prev_from
;
2670 if (++curlevel
== endlevel
)
2671 error ("Nesting too deep for parser");
2672 curlevel
->prev
= -1;
2673 curlevel
->last
= -1;
2674 if (targetdepth
== depth
) goto done
;
2679 if (depth
< mindepth
)
2681 if (curlevel
!= levelstart
)
2683 curlevel
->prev
= curlevel
->last
;
2684 if (targetdepth
== depth
) goto done
;
2689 state
.comstr_start
= from
- 1;
2690 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2691 curlevel
->last
= prev_from
;
2692 state
.instring
= (code
== Sstring
2693 ? (FETCH_CHAR (prev_from_byte
))
2695 if (boundary_stop
) goto done
;
2698 nofence
= state
.instring
!= ST_STRING_STYLE
;
2704 if (from
>= end
) goto done
;
2705 c
= FETCH_CHAR (from_byte
);
2706 /* Some compilers can't handle this inside the switch. */
2709 /* Check TEMP here so that if the char has
2710 a syntax-table property which says it is NOT
2711 a string character, it does not end the string. */
2712 if (nofence
&& c
== state
.instring
&& temp
== Sstring
)
2718 if (!nofence
) goto string_end
;
2723 startquotedinstring
:
2724 if (from
>= end
) goto endquoted
;
2730 state
.instring
= -1;
2731 curlevel
->prev
= curlevel
->last
;
2733 if (boundary_stop
) goto done
;
2742 stop
: /* Here if stopping before start of sexp. */
2743 from
= prev_from
; /* We have just fetched the char that starts it; */
2744 goto done
; /* but return the position before it. */
2749 state
.depth
= depth
;
2750 state
.mindepth
= mindepth
;
2751 state
.thislevelstart
= curlevel
->prev
;
2752 state
.prevlevelstart
2753 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
2754 state
.location
= from
;
2755 state
.levelstarts
= Qnil
;
2756 while (--curlevel
>= levelstart
)
2757 state
.levelstarts
= Fcons (make_number (curlevel
->last
),
2764 /* This comment supplies the doc string for parse-partial-sexp,
2765 for make-docfile to see. We cannot put this in the real DEFUN
2766 due to limits in the Unix cpp.
2768 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
2769 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
2770 Parsing stops at TO or when certain criteria are met;\n\
2771 point is set to where parsing stops.\n\
2772 If fifth arg STATE is omitted or nil,\n\
2773 parsing assumes that FROM is the beginning of a function.\n\
2774 Value is a list of ten elements describing final state of parsing:\n\
2775 0. depth in parens.\n\
2776 1. character address of start of innermost containing list; nil if none.\n\
2777 2. character address of start of last complete sexp terminated.\n\
2778 3. non-nil if inside a string.\n\
2779 (it is the character that will terminate the string,\n\
2780 or t if the string should be terminated by a generic string delimiter.)\n\
2781 4. nil if outside a comment, t if inside a non-nestable comment, \n\
2782 else an integer (the current comment nesting).\n\
2783 5. t if following a quote character.\n\
2784 6. the minimum paren-depth encountered during this scan.\n\
2785 7. t if in a comment of style b; `syntax-table' if the comment\n\
2786 should be terminated by a generic comment delimiter.\n\
2787 8. character address of start of comment or string; nil if not in one.\n\
2788 9. Intermediate data for continuation of parsing (subject to change).\n\
2789 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
2790 in parentheses becomes equal to TARGETDEPTH.\n\
2791 Fourth arg STOPBEFORE non-nil means stop when come to\n\
2792 any character that starts a sexp.\n\
2793 Fifth arg STATE is a nine-element list like what this function returns.\n\
2794 It is used to initialize the state of the parse. Elements number 1, 2, 6\n\
2795 and 8 are ignored; you can leave off element 8 (the last) entirely.\n\
2796 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.\n\
2797 If it is `syntax-table', stop after the start of a comment or a string,\n\
2798 or after end of a comment or a string.")
2799 (from, to, targetdepth, stopbefore, state, commentstop)
2802 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 6, 0,
2803 0 /* See immediately above */)
2804 (from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
)
2805 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
;
2807 struct lisp_parse_state state
;
2810 if (!NILP (targetdepth
))
2812 CHECK_NUMBER (targetdepth
, 3);
2813 target
= XINT (targetdepth
);
2816 target
= -100000; /* We won't reach this depth */
2818 validate_region (&from
, &to
);
2819 scan_sexps_forward (&state
, XINT (from
), CHAR_TO_BYTE (XINT (from
)),
2821 target
, !NILP (stopbefore
), oldstate
,
2823 ? 0 : (EQ (commentstop
, Qsyntax_table
) ? -1 : 1)));
2825 SET_PT (state
.location
);
2827 return Fcons (make_number (state
.depth
),
2828 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
2829 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
2830 Fcons (state
.instring
>= 0
2831 ? (state
.instring
== ST_STRING_STYLE
2832 ? Qt
: make_number (state
.instring
)) : Qnil
,
2833 Fcons (state
.incomment
< 0 ? Qt
:
2834 (state
.incomment
== 0 ? Qnil
:
2835 make_number (state
.incomment
)),
2836 Fcons (state
.quoted
? Qt
: Qnil
,
2837 Fcons (make_number (state
.mindepth
),
2838 Fcons ((state
.comstyle
2839 ? (state
.comstyle
== ST_COMMENT_STYLE
2840 ? Qsyntax_table
: Qt
) :
2842 Fcons (((state
.incomment
2843 || (state
.instring
>= 0))
2844 ? make_number (state
.comstr_start
)
2846 Fcons (state
.levelstarts
, Qnil
))))))))));
2855 /* This has to be done here, before we call Fmake_char_table. */
2856 Qsyntax_table
= intern ("syntax-table");
2857 staticpro (&Qsyntax_table
);
2859 /* Intern this now in case it isn't already done.
2860 Setting this variable twice is harmless.
2861 But don't staticpro it here--that is done in alloc.c. */
2862 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
2864 /* Create objects which can be shared among syntax tables. */
2865 Vsyntax_code_object
= Fmake_vector (make_number (13), Qnil
);
2866 for (i
= 0; i
< XVECTOR (Vsyntax_code_object
)->size
; i
++)
2867 XVECTOR (Vsyntax_code_object
)->contents
[i
]
2868 = Fcons (make_number (i
), Qnil
);
2870 /* Now we are ready to set up this property, so we can
2871 create syntax tables. */
2872 Fput (Qsyntax_table
, Qchar_table_extra_slots
, make_number (0));
2874 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Swhitespace
];
2876 Vstandard_syntax_table
= Fmake_char_table (Qsyntax_table
, temp
);
2878 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Sword
];
2879 for (i
= 'a'; i
<= 'z'; i
++)
2880 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2881 for (i
= 'A'; i
<= 'Z'; i
++)
2882 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2883 for (i
= '0'; i
<= '9'; i
++)
2884 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2886 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '$', temp
);
2887 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '%', temp
);
2889 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '(',
2890 Fcons (make_number (Sopen
), make_number (')')));
2891 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ')',
2892 Fcons (make_number (Sclose
), make_number ('(')));
2893 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '[',
2894 Fcons (make_number (Sopen
), make_number (']')));
2895 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ']',
2896 Fcons (make_number (Sclose
), make_number ('[')));
2897 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '{',
2898 Fcons (make_number (Sopen
), make_number ('}')));
2899 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '}',
2900 Fcons (make_number (Sclose
), make_number ('{')));
2901 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '"',
2902 Fcons (make_number ((int) Sstring
), Qnil
));
2903 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '\\',
2904 Fcons (make_number ((int) Sescape
), Qnil
));
2906 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Ssymbol
];
2907 for (i
= 0; i
< 10; i
++)
2909 c
= "_-+*/&|<>="[i
];
2910 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2913 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Spunct
];
2914 for (i
= 0; i
< 12; i
++)
2916 c
= ".,;:?!#@~^'`"[i
];
2917 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2920 /* All multibyte characters have syntax `word' by default. */
2921 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Sword
];
2922 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
2923 XCHAR_TABLE (Vstandard_syntax_table
)->contents
[i
] = temp
;
2929 Qsyntax_table_p
= intern ("syntax-table-p");
2930 staticpro (&Qsyntax_table_p
);
2932 staticpro (&Vsyntax_code_object
);
2934 Qscan_error
= intern ("scan-error");
2935 staticpro (&Qscan_error
);
2936 Fput (Qscan_error
, Qerror_conditions
,
2937 Fcons (Qscan_error
, Fcons (Qerror
, Qnil
)));
2938 Fput (Qscan_error
, Qerror_message
,
2939 build_string ("Scan error"));
2941 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
2942 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
2944 DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties
,
2945 "Non-nil means `forward-sexp', etc., grant `syntax-table' property.\n\
2946 The value of this property should be either a syntax table, or a cons\n\
2947 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric\n\
2948 syntax code, MATCHCHAR being nil or the character to match (which is\n\
2949 relevant only for open/close type.");
2951 words_include_escapes
= 0;
2952 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
2953 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
2955 DEFVAR_BOOL ("multibyte-syntax-as-symbol", &multibyte_syntax_as_symbol
,
2956 "Non-nil means `scan-sexps' treats all multibyte characters as symbol.");
2957 multibyte_syntax_as_symbol
= 0;
2959 DEFVAR_BOOL ("open-paren-in-column-0-is-defun-start",
2960 &open_paren_in_column_0_is_defun_start
,
2961 "Non-nil means an open paren in column 0 denotes the start of a defun.");
2962 open_paren_in_column_0_is_defun_start
= 1;
2964 defsubr (&Ssyntax_table_p
);
2965 defsubr (&Ssyntax_table
);
2966 defsubr (&Sstandard_syntax_table
);
2967 defsubr (&Scopy_syntax_table
);
2968 defsubr (&Sset_syntax_table
);
2969 defsubr (&Schar_syntax
);
2970 defsubr (&Smatching_paren
);
2971 defsubr (&Smodify_syntax_entry
);
2972 defsubr (&Sdescribe_syntax
);
2974 defsubr (&Sforward_word
);
2976 defsubr (&Sskip_chars_forward
);
2977 defsubr (&Sskip_chars_backward
);
2978 defsubr (&Sskip_syntax_forward
);
2979 defsubr (&Sskip_syntax_backward
);
2981 defsubr (&Sforward_comment
);
2982 defsubr (&Sscan_lists
);
2983 defsubr (&Sscan_sexps
);
2984 defsubr (&Sbackward_prefix_chars
);
2985 defsubr (&Sparse_partial_sexp
);