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
)
1366 if (string_multibyte
)
1368 c_leading_code
= XSTRING (string
)->data
[i_byte
];
1369 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1372 c
= c_leading_code
= XSTRING (string
)->data
[i_byte
++];
1374 /* Convert multibyteness between what the string has
1375 and what the buffer has. */
1377 c
= unibyte_char_to_multibyte (c
);
1382 fastmap
[syntax_spec_code
[c
& 0377]] = 1;
1387 if (i_byte
== size_byte
)
1390 if (string_multibyte
)
1392 c_leading_code
= XSTRING (string
)->data
[i_byte
];
1393 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1396 c
= c_leading_code
= XSTRING (string
)->data
[i_byte
++];
1398 if (i_byte
< size_byte
1399 && XSTRING (string
)->data
[i_byte
] == '-')
1401 unsigned int c2
, c2_leading_code
;
1403 /* Skip over the dash. */
1406 if (i_byte
== size_byte
)
1409 /* Get the end of the range. */
1410 if (string_multibyte
)
1412 c2_leading_code
= XSTRING (string
)->data
[i_byte
];
1413 FETCH_STRING_CHAR_ADVANCE (c2
, string
, i
, i_byte
);
1416 c2
= XSTRING (string
)->data
[i_byte
++];
1418 if (SINGLE_BYTE_CHAR_P (c
))
1420 if (! SINGLE_BYTE_CHAR_P (c2
))
1421 error ("Invalid charcter range: %s",
1422 XSTRING (string
)->data
);
1431 if (c_leading_code
!= c2_leading_code
)
1432 error ("Invalid charcter range: %s",
1433 XSTRING (string
)->data
);
1434 fastmap
[c_leading_code
] = 1;
1437 char_ranges
[n_char_ranges
++] = c
;
1438 char_ranges
[n_char_ranges
++] = c2
;
1444 fastmap
[c_leading_code
] = 1;
1445 if (!SINGLE_BYTE_CHAR_P (c
))
1447 char_ranges
[n_char_ranges
++] = c
;
1448 char_ranges
[n_char_ranges
++] = c
;
1454 /* If ^ was the first character, complement the fastmap. In
1455 addition, as all multibyte characters have possibility of
1456 matching, set all entries for base leading codes, which is
1457 harmless even if SYNTAXP is 1. */
1460 for (i
= 0; i
< sizeof fastmap
; i
++)
1462 if (!multibyte
|| !BASE_LEADING_CODE_P (i
))
1469 int start_point
= PT
;
1471 int pos_byte
= PT_BYTE
;
1476 SETUP_SYNTAX_TABLE (pos
, forwardp
? 1 : -1);
1481 if (pos
< XINT (lim
))
1482 while (fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1484 /* Since we already checked for multibyteness,
1485 avoid using INC_BOTH which checks again. */
1488 if (pos
>= XINT (lim
))
1490 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1495 while (pos
< XINT (lim
)
1496 && fastmap
[(int) SYNTAX (FETCH_BYTE (pos
))])
1499 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1507 while (pos
> XINT (lim
))
1509 int savepos
= pos_byte
;
1510 /* Since we already checked for multibyteness,
1511 avoid using DEC_BOTH which checks again. */
1514 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
1515 if (!fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1525 if (pos
> XINT (lim
))
1526 while (fastmap
[(int) SYNTAX (FETCH_BYTE (pos
- 1))])
1529 if (pos
<= XINT (lim
))
1531 UPDATE_SYNTAX_TABLE_BACKWARD (pos
- 1);
1541 while (pos
< XINT (lim
) && fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1543 if (!BASE_LEADING_CODE_P (c
))
1544 INC_BOTH (pos
, pos_byte
);
1545 else if (n_char_ranges
)
1547 /* We much check CHAR_RANGES for a multibyte
1549 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1550 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1551 if ((ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1]))
1553 if (!(negate
^ (i
< n_char_ranges
)))
1556 INC_BOTH (pos
, pos_byte
);
1561 INC_BOTH (pos
, pos_byte
);
1565 while (pos
< XINT (lim
) && fastmap
[FETCH_BYTE (pos
)])
1571 while (pos
> XINT (lim
))
1573 int savepos
= pos_byte
;
1574 DEC_BOTH (pos
, pos_byte
);
1575 if (fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1577 if (!BASE_LEADING_CODE_P (c
))
1579 else if (n_char_ranges
)
1581 /* We much check CHAR_RANGES for a multibyte
1583 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1584 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1585 if (ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1])
1587 if (!(negate
^ (i
< n_char_ranges
)))
1610 while (pos
> XINT (lim
) && fastmap
[FETCH_BYTE (pos
- 1)])
1615 #if 0 /* Not needed now that a position in mid-character
1616 cannot be specified in Lisp. */
1618 /* INC_POS or DEC_POS might have moved POS over LIM. */
1619 && (forwardp
? (pos
> XINT (lim
)) : (pos
< XINT (lim
))))
1626 SET_PT_BOTH (pos
, pos_byte
);
1629 return make_number (PT
- start_point
);
1633 /* Jump over a comment, assuming we are at the beginning of one.
1634 FROM is the current position.
1635 FROM_BYTE is the bytepos corresponding to FROM.
1636 Do not move past STOP (a charpos).
1637 The comment over which we have to jump is of style STYLE
1638 (either SYNTAX_COMMENT_STYLE(foo) or ST_COMMENT_STYLE).
1639 NESTING should be positive to indicate the nesting at the beginning
1640 for nested comments and should be zero or negative else.
1641 ST_COMMENT_STYLE cannot be nested.
1642 PREV_SYNTAX is the SYNTAX_WITH_FLAGS of the previous character
1643 (or 0 If the search cannot start in the middle of a two-character).
1645 If successful, return 1 and store the charpos of the comment's end
1646 into *CHARPOS_PTR and the corresponding bytepos into *BYTEPOS_PTR.
1647 Else, return 0 and store the charpos STOP into *CHARPOS_PTR, the
1648 corresponding bytepos into *BYTEPOS_PTR and the current nesting
1649 (as defined for state.incomment) in *INCOMMENT_PTR.
1651 The comment end is the last character of the comment rather than the
1652 character just after the comment.
1654 Global syntax data is assumed to initially be valid for FROM and
1655 remains valid for forward search starting at the returned position. */
1658 forw_comment (from
, from_byte
, stop
, nesting
, style
, prev_syntax
,
1659 charpos_ptr
, bytepos_ptr
, incomment_ptr
)
1660 int from
, from_byte
, stop
;
1661 int nesting
, style
, prev_syntax
;
1662 int *charpos_ptr
, *bytepos_ptr
, *incomment_ptr
;
1665 register enum syntaxcode code
;
1666 register int syntax
;
1668 if (nesting
<= 0) nesting
= -1;
1670 /* Enter the loop in the middle so that we find
1671 a 2-char comment ender if we start in the middle of it. */
1672 syntax
= prev_syntax
;
1673 if (syntax
!= 0) goto forw_incomment
;
1679 *incomment_ptr
= nesting
;
1680 *charpos_ptr
= from
;
1681 *bytepos_ptr
= from_byte
;
1684 c
= FETCH_CHAR (from_byte
);
1685 syntax
= SYNTAX_WITH_FLAGS (c
);
1686 code
= syntax
& 0xff;
1687 if (code
== Sendcomment
1688 && SYNTAX_FLAGS_COMMENT_STYLE (syntax
) == style
1690 /* we have encountered a comment end of the same style
1691 as the comment sequence which began this comment
1694 if (code
== Scomment_fence
1695 && style
== ST_COMMENT_STYLE
)
1696 /* we have encountered a comment end of the same style
1697 as the comment sequence which began this comment
1702 && SYNTAX_FLAGS_COMMENT_STYLE (syntax
) == style
)
1703 /* we have encountered a nested comment of the same style
1704 as the comment sequence which began this comment section */
1706 INC_BOTH (from
, from_byte
);
1707 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1710 if (from
< stop
&& SYNTAX_FLAGS_COMEND_FIRST (syntax
)
1711 && SYNTAX_FLAGS_COMMENT_STYLE (syntax
) == style
1712 && (c1
= FETCH_CHAR (from_byte
),
1713 SYNTAX_COMEND_SECOND (c1
)))
1716 /* we have encountered a comment end of the same style
1717 as the comment sequence which began this comment
1722 INC_BOTH (from
, from_byte
);
1723 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1728 && SYNTAX_FLAGS_COMSTART_FIRST (syntax
)
1729 && (c1
= FETCH_CHAR (from_byte
),
1730 SYNTAX_COMMENT_STYLE (c1
) == style
1731 && SYNTAX_COMSTART_SECOND (c1
)))
1732 /* we have encountered a nested comment of the same style
1733 as the comment sequence which began this comment
1736 INC_BOTH (from
, from_byte
);
1737 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1741 *charpos_ptr
= from
;
1742 *bytepos_ptr
= from_byte
;
1746 DEFUN ("forward-comment", Fforward_comment
, Sforward_comment
, 1, 1, 0,
1747 "Move forward across up to N comments. If N is negative, move backward.\n\
1748 Stop scanning if we find something other than a comment or whitespace.\n\
1749 Set point to where scanning stops.\n\
1750 If N comments are found as expected, with nothing except whitespace\n\
1751 between them, return t; otherwise return nil.")
1759 register enum syntaxcode code
;
1760 int comstyle
= 0; /* style of comment encountered */
1761 int comnested
= 0; /* whether the comment is nestable or not */
1764 int out_charpos
, out_bytepos
;
1767 CHECK_NUMBER (count
, 0);
1768 count1
= XINT (count
);
1769 stop
= count1
> 0 ? ZV
: BEGV
;
1775 from_byte
= PT_BYTE
;
1777 SETUP_SYNTAX_TABLE (from
, count1
);
1786 SET_PT_BOTH (from
, from_byte
);
1790 c
= FETCH_CHAR (from_byte
);
1792 comstart_first
= SYNTAX_COMSTART_FIRST (c
);
1793 comnested
= SYNTAX_COMMENT_NESTED (c
);
1794 INC_BOTH (from
, from_byte
);
1795 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1797 if (from
< stop
&& comstart_first
1798 && (c1
= FETCH_CHAR (from_byte
),
1799 SYNTAX_COMSTART_SECOND (c1
)))
1801 /* We have encountered a comment start sequence and we
1802 are ignoring all text inside comments. We must record
1803 the comment style this sequence begins so that later,
1804 only a comment end of the same style actually ends
1805 the comment section. */
1807 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1808 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
1809 INC_BOTH (from
, from_byte
);
1810 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1812 /* FIXME: here we ignore 2-char endcomments while we don't
1813 when going backwards. */
1815 while (code
== Swhitespace
|| code
== Sendcomment
);
1817 if (code
== Scomment_fence
)
1818 comstyle
= ST_COMMENT_STYLE
;
1819 else if (code
!= Scomment
)
1822 DEC_BOTH (from
, from_byte
);
1823 SET_PT_BOTH (from
, from_byte
);
1826 /* We're at the start of a comment. */
1827 found
= forw_comment (from
, from_byte
, stop
, comnested
, comstyle
, 0,
1828 &out_charpos
, &out_bytepos
, &dummy
);
1829 from
= out_charpos
; from_byte
= out_bytepos
;
1833 SET_PT_BOTH (from
, from_byte
);
1836 INC_BOTH (from
, from_byte
);
1837 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1838 /* We have skipped one comment. */
1846 int quoted
, comstart_second
;
1850 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
1855 DEC_BOTH (from
, from_byte
);
1856 /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
1857 quoted
= char_quoted (from
, from_byte
);
1860 DEC_BOTH (from
, from_byte
);
1863 c
= FETCH_CHAR (from_byte
);
1866 comnested
= SYNTAX_COMMENT_NESTED (c
);
1867 if (code
== Sendcomment
)
1868 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1869 comstart_second
= SYNTAX_COMSTART_SECOND (c
);
1870 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1871 && prev_char_comend_first (from
, from_byte
)
1872 && !char_quoted (from
- 1, dec_bytepos (from_byte
)))
1874 /* We must record the comment style encountered so that
1875 later, we can match only the proper comment begin
1876 sequence of the same style. */
1877 DEC_BOTH (from
, from_byte
);
1879 /* Calling char_quoted, above, set up global syntax position
1880 at the new value of FROM. */
1881 c1
= FETCH_CHAR (from_byte
);
1882 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1883 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
1885 if (from
> stop
&& comstart_second
1886 && prev_char_comstart_first (from
, from_byte
)
1887 && !char_quoted (from
- 1, dec_bytepos (from_byte
)))
1890 DEC_BOTH (from
, from_byte
);
1893 if (code
== Scomment_fence
)
1895 /* Skip until first preceding unquoted comment_fence. */
1896 int found
= 0, ini
= from
, ini_byte
= from_byte
;
1900 DEC_BOTH (from
, from_byte
);
1903 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1904 c
= FETCH_CHAR (from_byte
);
1905 if (SYNTAX (c
) == Scomment_fence
1906 && !char_quoted (from
, from_byte
))
1914 from
= ini
; /* Set point to ini + 1. */
1915 from_byte
= ini_byte
;
1919 else if (code
== Sendcomment
)
1921 found
= back_comment (from
, from_byte
, stop
, comnested
, comstyle
,
1922 &out_charpos
, &out_bytepos
);
1925 #if 0 /* cc-mode (and maybe others) relies on the bogus behavior. */
1926 /* Failure: we should go back to the end of this
1927 not-quite-endcomment. */
1928 if (SYNTAX(c
) != code
)
1929 /* It was a two-char Sendcomment. */
1930 INC_BOTH (from
, from_byte
);
1935 /* We have skipped one comment. */
1936 from
= out_charpos
, from_byte
= out_bytepos
;
1939 else if (code
!= Swhitespace
&& code
!= Scomment
)
1943 INC_BOTH (from
, from_byte
);
1944 SET_PT_BOTH (from
, from_byte
);
1952 SET_PT_BOTH (from
, from_byte
);
1957 /* Return syntax code of character C if C is a single byte character
1958 or `multibyte_symbol_p' is zero. Otherwise, retrun Ssymbol. */
1960 #define SYNTAX_WITH_MULTIBYTE_CHECK(c) \
1961 ((SINGLE_BYTE_CHAR_P (c) || !multibyte_symbol_p) \
1962 ? SYNTAX (c) : Ssymbol)
1965 scan_lists (from
, count
, depth
, sexpflag
)
1967 int count
, depth
, sexpflag
;
1970 register int stop
= count
> 0 ? ZV
: BEGV
;
1975 register enum syntaxcode code
, temp_code
;
1976 int min_depth
= depth
; /* Err out if depth gets less than this. */
1977 int comstyle
= 0; /* style of comment encountered */
1978 int comnested
= 0; /* whether the comment is nestable or not */
1980 int last_good
= from
;
1983 int out_bytepos
, out_charpos
;
1985 int multibyte_symbol_p
= sexpflag
&& multibyte_syntax_as_symbol
;
1987 if (depth
> 0) min_depth
= 0;
1989 if (from
> ZV
) from
= ZV
;
1990 if (from
< BEGV
) from
= BEGV
;
1992 from_byte
= CHAR_TO_BYTE (from
);
1997 SETUP_SYNTAX_TABLE (from
, count
);
2002 int comstart_first
, prefix
;
2003 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2004 c
= FETCH_CHAR (from_byte
);
2005 code
= SYNTAX_WITH_MULTIBYTE_CHECK (c
);
2006 comstart_first
= SYNTAX_COMSTART_FIRST (c
);
2007 comnested
= SYNTAX_COMMENT_NESTED (c
);
2008 prefix
= SYNTAX_PREFIX (c
);
2009 if (depth
== min_depth
)
2011 INC_BOTH (from
, from_byte
);
2012 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2013 if (from
< stop
&& comstart_first
2014 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
))
2015 && parse_sexp_ignore_comments
)
2017 /* we have encountered a comment start sequence and we
2018 are ignoring all text inside comments. We must record
2019 the comment style this sequence begins so that later,
2020 only a comment end of the same style actually ends
2021 the comment section */
2023 c1
= FETCH_CHAR (from_byte
);
2024 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
2025 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
2026 INC_BOTH (from
, from_byte
);
2027 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2033 switch (SWITCH_ENUM_CAST (code
))
2037 if (from
== stop
) goto lose
;
2038 INC_BOTH (from
, from_byte
);
2039 /* treat following character as a word constituent */
2042 if (depth
|| !sexpflag
) break;
2043 /* This word counts as a sexp; return at end of it. */
2046 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2048 /* Some compilers can't handle this inside the switch. */
2049 c
= FETCH_CHAR (from_byte
);
2050 temp
= SYNTAX_WITH_MULTIBYTE_CHECK (c
);
2055 INC_BOTH (from
, from_byte
);
2056 if (from
== stop
) goto lose
;
2065 INC_BOTH (from
, from_byte
);
2069 case Scomment_fence
:
2070 comstyle
= ST_COMMENT_STYLE
;
2073 if (!parse_sexp_ignore_comments
) break;
2074 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2075 found
= forw_comment (from
, from_byte
, stop
,
2076 comnested
, comstyle
, 0,
2077 &out_charpos
, &out_bytepos
, &dummy
);
2078 from
= out_charpos
, from_byte
= out_bytepos
;
2085 INC_BOTH (from
, from_byte
);
2086 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2092 if (from
!= stop
&& c
== FETCH_CHAR (from_byte
))
2094 INC_BOTH (from
, from_byte
);
2104 if (!++depth
) goto done
;
2109 if (!--depth
) goto done
;
2110 if (depth
< min_depth
)
2111 Fsignal (Qscan_error
,
2112 Fcons (build_string ("Containing expression ends prematurely"),
2113 Fcons (make_number (last_good
),
2114 Fcons (make_number (from
), Qnil
))));
2119 temp_pos
= dec_bytepos (from_byte
);
2120 stringterm
= FETCH_CHAR (temp_pos
);
2123 if (from
>= stop
) goto lose
;
2124 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2125 c
= FETCH_CHAR (from_byte
);
2128 : SYNTAX_WITH_MULTIBYTE_CHECK (c
) == Sstring_fence
)
2131 /* Some compilers can't handle this inside the switch. */
2132 temp
= SYNTAX_WITH_MULTIBYTE_CHECK (c
);
2137 INC_BOTH (from
, from_byte
);
2139 INC_BOTH (from
, from_byte
);
2141 INC_BOTH (from
, from_byte
);
2142 if (!depth
&& sexpflag
) goto done
;
2147 /* Reached end of buffer. Error if within object, return nil if between */
2148 if (depth
) goto lose
;
2153 /* End of object reached */
2162 DEC_BOTH (from
, from_byte
);
2163 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2164 c
= FETCH_CHAR (from_byte
);
2165 code
= SYNTAX_WITH_MULTIBYTE_CHECK (c
);
2166 if (depth
== min_depth
)
2169 comnested
= SYNTAX_COMMENT_NESTED (c
);
2170 if (code
== Sendcomment
)
2171 comstyle
= SYNTAX_COMMENT_STYLE (c
);
2172 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
2173 && prev_char_comend_first (from
, from_byte
)
2174 && parse_sexp_ignore_comments
)
2176 /* We must record the comment style encountered so that
2177 later, we can match only the proper comment begin
2178 sequence of the same style. */
2179 DEC_BOTH (from
, from_byte
);
2180 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2182 c1
= FETCH_CHAR (from_byte
);
2183 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
2184 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
2187 /* Quoting turns anything except a comment-ender
2188 into a word character. Note that this if cannot be true
2189 if we decremented FROM in the if-statement above. */
2190 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
2192 else if (SYNTAX_PREFIX (c
))
2195 switch (SWITCH_ENUM_CAST (code
))
2201 if (depth
|| !sexpflag
) break;
2202 /* This word counts as a sexp; count object finished
2203 after passing it. */
2206 temp_pos
= from_byte
;
2207 if (! NILP (current_buffer
->enable_multibyte_characters
))
2211 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2212 c1
= FETCH_CHAR (temp_pos
);
2213 temp_code
= SYNTAX_WITH_MULTIBYTE_CHECK (c1
);
2214 /* Don't allow comment-end to be quoted. */
2215 if (temp_code
== Sendcomment
)
2217 quoted
= char_quoted (from
- 1, temp_pos
);
2220 DEC_BOTH (from
, from_byte
);
2221 temp_pos
= dec_bytepos (temp_pos
);
2222 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2224 c1
= FETCH_CHAR (temp_pos
);
2225 temp_code
= SYNTAX_WITH_MULTIBYTE_CHECK (c1
);
2226 if (! (quoted
|| temp_code
== Sword
2227 || temp_code
== Ssymbol
2228 || temp_code
== Squote
))
2230 DEC_BOTH (from
, from_byte
);
2237 temp_pos
= dec_bytepos (from_byte
);
2238 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2239 if (from
!= stop
&& c
== FETCH_CHAR (temp_pos
))
2240 DEC_BOTH (from
, from_byte
);
2249 if (!++depth
) goto done2
;
2254 if (!--depth
) goto done2
;
2255 if (depth
< min_depth
)
2256 Fsignal (Qscan_error
,
2257 Fcons (build_string ("Containing expression ends prematurely"),
2258 Fcons (make_number (last_good
),
2259 Fcons (make_number (from
), Qnil
))));
2263 if (!parse_sexp_ignore_comments
)
2265 found
= back_comment (from
, from_byte
, stop
, comnested
, comstyle
,
2266 &out_charpos
, &out_bytepos
);
2267 /* FIXME: if found == -1, then it really wasn't a comment-end.
2268 For single-char Sendcomment, we can't do much about it apart
2269 from skipping the char.
2270 For 2-char endcomments, we could try again, taking both
2271 chars as separate entities, but it's a lot of trouble
2272 for very little gain, so we don't bother either. -sm */
2274 from
= out_charpos
, from_byte
= out_bytepos
;
2277 case Scomment_fence
:
2281 DEC_BOTH (from
, from_byte
);
2282 if (from
== stop
) goto lose
;
2283 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2284 if (!char_quoted (from
, from_byte
)
2285 && (c
= FETCH_CHAR (from_byte
),
2286 SYNTAX_WITH_MULTIBYTE_CHECK (c
) == code
))
2289 if (code
== Sstring_fence
&& !depth
&& sexpflag
) goto done2
;
2293 stringterm
= FETCH_CHAR (from_byte
);
2296 if (from
== stop
) goto lose
;
2297 temp_pos
= from_byte
;
2298 if (! NILP (current_buffer
->enable_multibyte_characters
))
2302 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2303 if (!char_quoted (from
- 1, temp_pos
)
2304 && stringterm
== FETCH_CHAR (temp_pos
))
2306 DEC_BOTH (from
, from_byte
);
2308 DEC_BOTH (from
, from_byte
);
2309 if (!depth
&& sexpflag
) goto done2
;
2314 /* Reached start of buffer. Error if within object, return nil if between */
2315 if (depth
) goto lose
;
2326 XSETFASTINT (val
, from
);
2330 Fsignal (Qscan_error
,
2331 Fcons (build_string ("Unbalanced parentheses"),
2332 Fcons (make_number (last_good
),
2333 Fcons (make_number (from
), Qnil
))));
2338 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
2339 "Scan from character number FROM by COUNT lists.\n\
2340 Returns the character number of the position thus found.\n\
2342 If DEPTH is nonzero, paren depth begins counting from that value,\n\
2343 only places where the depth in parentheses becomes zero\n\
2344 are candidates for stopping; COUNT such places are counted.\n\
2345 Thus, a positive value for DEPTH means go out levels.\n\
2347 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2349 If the beginning or end of (the accessible part of) the buffer is reached\n\
2350 and the depth is wrong, an error is signaled.\n\
2351 If the depth is right but the count is not used up, nil is returned.")
2352 (from
, count
, depth
)
2353 Lisp_Object from
, count
, depth
;
2355 CHECK_NUMBER (from
, 0);
2356 CHECK_NUMBER (count
, 1);
2357 CHECK_NUMBER (depth
, 2);
2359 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
2362 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
2363 "Scan from character number FROM by COUNT balanced expressions.\n\
2364 If COUNT is negative, scan backwards.\n\
2365 Returns the character number of the position thus found.\n\
2367 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2369 If the beginning or end of (the accessible part of) the buffer is reached\n\
2370 in the middle of a parenthetical grouping, an error is signaled.\n\
2371 If the beginning or end is reached between groupings\n\
2372 but before count is used up, nil is returned.")
2374 Lisp_Object from
, count
;
2376 CHECK_NUMBER (from
, 0);
2377 CHECK_NUMBER (count
, 1);
2379 return scan_lists (XINT (from
), XINT (count
), 0, 1);
2382 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
2384 "Move point backward over any number of chars with prefix syntax.\n\
2385 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
2390 int opoint_byte
= PT_BYTE
;
2392 int pos_byte
= PT_BYTE
;
2397 SET_PT_BOTH (opoint
, opoint_byte
);
2402 SETUP_SYNTAX_TABLE (pos
, -1);
2404 DEC_BOTH (pos
, pos_byte
);
2406 while (!char_quoted (pos
, pos_byte
)
2407 /* Previous statement updates syntax table. */
2408 && ((c
= FETCH_CHAR (pos_byte
), SYNTAX (c
) == Squote
)
2409 || SYNTAX_PREFIX (c
)))
2412 opoint_byte
= pos_byte
;
2415 DEC_BOTH (pos
, pos_byte
);
2418 SET_PT_BOTH (opoint
, opoint_byte
);
2423 /* Parse forward from FROM / FROM_BYTE to END,
2424 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
2425 and return a description of the state of the parse at END.
2426 If STOPBEFORE is nonzero, stop at the start of an atom.
2427 If COMMENTSTOP is 1, stop at the start of a comment.
2428 If COMMENTSTOP is -1, stop at the start or end of a comment,
2429 after the beginning of a string, or after the end of a string. */
2432 scan_sexps_forward (stateptr
, from
, from_byte
, end
, targetdepth
,
2433 stopbefore
, oldstate
, commentstop
)
2434 struct lisp_parse_state
*stateptr
;
2436 int end
, targetdepth
, stopbefore
;
2437 Lisp_Object oldstate
;
2440 struct lisp_parse_state state
;
2442 register enum syntaxcode code
;
2445 struct level
{ int last
, prev
; };
2446 struct level levelstart
[100];
2447 register struct level
*curlevel
= levelstart
;
2448 struct level
*endlevel
= levelstart
+ 100;
2449 register int depth
; /* Paren depth of current scanning location.
2450 level - levelstart equals this except
2451 when the depth becomes negative. */
2452 int mindepth
; /* Lowest DEPTH value seen. */
2453 int start_quoted
= 0; /* Nonzero means starting after a char quote */
2455 int prev_from
; /* Keep one character before FROM. */
2457 int prev_from_syntax
;
2458 int boundary_stop
= commentstop
== -1;
2461 int out_bytepos
, out_charpos
;
2465 prev_from_byte
= from_byte
;
2467 DEC_BOTH (prev_from
, prev_from_byte
);
2469 /* Use this macro instead of `from++'. */
2471 do { prev_from = from; \
2472 prev_from_byte = from_byte; \
2474 = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); \
2475 INC_BOTH (from, from_byte); \
2476 UPDATE_SYNTAX_TABLE_FORWARD (from); \
2482 if (NILP (oldstate
))
2485 state
.instring
= -1;
2486 state
.incomment
= 0;
2487 state
.comstyle
= 0; /* comment style a by default. */
2488 state
.comstr_start
= -1; /* no comment/string seen. */
2492 tem
= Fcar (oldstate
);
2498 oldstate
= Fcdr (oldstate
);
2499 oldstate
= Fcdr (oldstate
);
2500 oldstate
= Fcdr (oldstate
);
2501 tem
= Fcar (oldstate
);
2502 /* Check whether we are inside string_fence-style string: */
2503 state
.instring
= (!NILP (tem
)
2504 ? (INTEGERP (tem
) ? XINT (tem
) : ST_STRING_STYLE
)
2507 oldstate
= Fcdr (oldstate
);
2508 tem
= Fcar (oldstate
);
2509 state
.incomment
= (!NILP (tem
)
2510 ? (INTEGERP (tem
) ? XINT (tem
) : -1)
2513 oldstate
= Fcdr (oldstate
);
2514 tem
= Fcar (oldstate
);
2515 start_quoted
= !NILP (tem
);
2517 /* if the eighth element of the list is nil, we are in comment
2518 style a. If it is non-nil, we are in comment style b */
2519 oldstate
= Fcdr (oldstate
);
2520 oldstate
= Fcdr (oldstate
);
2521 tem
= Fcar (oldstate
);
2522 state
.comstyle
= NILP (tem
) ? 0 : (EQ (tem
, Qsyntax_table
)
2523 ? ST_COMMENT_STYLE
: 1);
2525 oldstate
= Fcdr (oldstate
);
2526 tem
= Fcar (oldstate
);
2527 state
.comstr_start
= NILP (tem
) ? -1 : XINT (tem
) ;
2528 oldstate
= Fcdr (oldstate
);
2529 tem
= Fcar (oldstate
);
2530 while (!NILP (tem
)) /* >= second enclosing sexps. */
2532 /* curlevel++->last ran into compiler bug on Apollo */
2533 curlevel
->last
= XINT (Fcar (tem
));
2534 if (++curlevel
== endlevel
)
2535 error ("Nesting too deep for parser");
2536 curlevel
->prev
= -1;
2537 curlevel
->last
= -1;
2544 curlevel
->prev
= -1;
2545 curlevel
->last
= -1;
2547 SETUP_SYNTAX_TABLE (prev_from
, 1);
2548 prev_from_syntax
= SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte
));
2549 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2551 /* Enter the loop at a place appropriate for initial state. */
2553 if (state
.incomment
)
2554 goto startincomment
;
2555 if (state
.instring
>= 0)
2557 nofence
= state
.instring
!= ST_STRING_STYLE
;
2559 goto startquotedinstring
;
2562 else if (start_quoted
)
2565 #if 0 /* This seems to be redundant with the identical code above. */
2566 SETUP_SYNTAX_TABLE (prev_from
, 1);
2567 prev_from_syntax
= SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte
));
2568 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2574 code
= prev_from_syntax
& 0xff;
2576 if (code
== Scomment
)
2578 state
.incomment
= (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax
) ?
2580 state
.comstr_start
= prev_from
;
2582 else if (code
== Scomment_fence
)
2584 /* Record the comment style we have entered so that only
2585 the comment-end sequence of the same style actually
2586 terminates the comment section. */
2587 state
.comstyle
= ST_COMMENT_STYLE
;
2588 state
.incomment
= -1;
2589 state
.comstr_start
= prev_from
;
2592 else if (from
< end
)
2593 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax
))
2594 if (c1
= FETCH_CHAR (from_byte
),
2595 SYNTAX_COMSTART_SECOND (c1
))
2596 /* Duplicate code to avoid a complex if-expression
2597 which causes trouble for the SGI compiler. */
2599 /* Record the comment style we have entered so that only
2600 the comment-end sequence of the same style actually
2601 terminates the comment section. */
2602 state
.comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
));
2603 comnested
= SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax
);
2604 comnested
= comnested
|| SYNTAX_COMMENT_NESTED (c1
);
2605 state
.incomment
= comnested
? 1 : -1;
2606 state
.comstr_start
= prev_from
;
2611 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax
))
2613 switch (SWITCH_ENUM_CAST (code
))
2617 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2618 curlevel
->last
= prev_from
;
2620 if (from
== end
) goto endquoted
;
2623 /* treat following character as a word constituent */
2626 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2627 curlevel
->last
= prev_from
;
2631 /* Some compilers can't handle this inside the switch. */
2632 temp
= SYNTAX (FETCH_CHAR (from_byte
));
2638 if (from
== end
) goto endquoted
;
2650 curlevel
->prev
= curlevel
->last
;
2654 if (commentstop
== 1)
2659 if (! state
.incomment
)
2661 if (commentstop
|| boundary_stop
) goto done
;
2663 /* The (from == BEGV) test is to enter the loop in the middle so
2664 that we find a 2-char comment ender even if we start in the
2666 found
= forw_comment (from
, from_byte
, end
,
2667 state
.incomment
, state
.comstyle
,
2668 (from
== BEGV
) ? 0 : prev_from_syntax
,
2669 &out_charpos
, &out_bytepos
, &state
.incomment
);
2670 from
= out_charpos
; from_byte
= out_bytepos
;
2671 /* Beware! prev_from and friends are invalid now.
2672 Luckily, the `done' doesn't use them and the INC_FROM
2673 sets them to a sane value without looking at them. */
2674 if (!found
) goto done
;
2676 state
.incomment
= 0;
2677 state
.comstyle
= 0; /* reset the comment style */
2678 if (boundary_stop
) goto done
;
2682 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2684 /* curlevel++->last ran into compiler bug on Apollo */
2685 curlevel
->last
= prev_from
;
2686 if (++curlevel
== endlevel
)
2687 error ("Nesting too deep for parser");
2688 curlevel
->prev
= -1;
2689 curlevel
->last
= -1;
2690 if (targetdepth
== depth
) goto done
;
2695 if (depth
< mindepth
)
2697 if (curlevel
!= levelstart
)
2699 curlevel
->prev
= curlevel
->last
;
2700 if (targetdepth
== depth
) goto done
;
2705 state
.comstr_start
= from
- 1;
2706 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2707 curlevel
->last
= prev_from
;
2708 state
.instring
= (code
== Sstring
2709 ? (FETCH_CHAR (prev_from_byte
))
2711 if (boundary_stop
) goto done
;
2714 nofence
= state
.instring
!= ST_STRING_STYLE
;
2720 if (from
>= end
) goto done
;
2721 c
= FETCH_CHAR (from_byte
);
2722 /* Some compilers can't handle this inside the switch. */
2725 /* Check TEMP here so that if the char has
2726 a syntax-table property which says it is NOT
2727 a string character, it does not end the string. */
2728 if (nofence
&& c
== state
.instring
&& temp
== Sstring
)
2734 if (!nofence
) goto string_end
;
2739 startquotedinstring
:
2740 if (from
>= end
) goto endquoted
;
2746 state
.instring
= -1;
2747 curlevel
->prev
= curlevel
->last
;
2749 if (boundary_stop
) goto done
;
2758 stop
: /* Here if stopping before start of sexp. */
2759 from
= prev_from
; /* We have just fetched the char that starts it; */
2760 goto done
; /* but return the position before it. */
2765 state
.depth
= depth
;
2766 state
.mindepth
= mindepth
;
2767 state
.thislevelstart
= curlevel
->prev
;
2768 state
.prevlevelstart
2769 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
2770 state
.location
= from
;
2771 state
.levelstarts
= Qnil
;
2772 while (--curlevel
>= levelstart
)
2773 state
.levelstarts
= Fcons (make_number (curlevel
->last
),
2780 /* This comment supplies the doc string for parse-partial-sexp,
2781 for make-docfile to see. We cannot put this in the real DEFUN
2782 due to limits in the Unix cpp.
2784 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
2785 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
2786 Parsing stops at TO or when certain criteria are met;\n\
2787 point is set to where parsing stops.\n\
2788 If fifth arg STATE is omitted or nil,\n\
2789 parsing assumes that FROM is the beginning of a function.\n\
2790 Value is a list of ten elements describing final state of parsing:\n\
2791 0. depth in parens.\n\
2792 1. character address of start of innermost containing list; nil if none.\n\
2793 2. character address of start of last complete sexp terminated.\n\
2794 3. non-nil if inside a string.\n\
2795 (it is the character that will terminate the string,\n\
2796 or t if the string should be terminated by a generic string delimiter.)\n\
2797 4. nil if outside a comment, t if inside a non-nestable comment, \n\
2798 else an integer (the current comment nesting).\n\
2799 5. t if following a quote character.\n\
2800 6. the minimum paren-depth encountered during this scan.\n\
2801 7. t if in a comment of style b; `syntax-table' if the comment\n\
2802 should be terminated by a generic comment delimiter.\n\
2803 8. character address of start of comment or string; nil if not in one.\n\
2804 9. Intermediate data for continuation of parsing (subject to change).\n\
2805 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
2806 in parentheses becomes equal to TARGETDEPTH.\n\
2807 Fourth arg STOPBEFORE non-nil means stop when come to\n\
2808 any character that starts a sexp.\n\
2809 Fifth arg STATE is a nine-element list like what this function returns.\n\
2810 It is used to initialize the state of the parse. Elements number 1, 2, 6\n\
2811 and 8 are ignored; you can leave off element 8 (the last) entirely.\n\
2812 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.\n\
2813 If it is `syntax-table', stop after the start of a comment or a string,\n\
2814 or after end of a comment or a string.")
2815 (from, to, targetdepth, stopbefore, state, commentstop)
2818 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 6, 0,
2819 0 /* See immediately above */)
2820 (from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
)
2821 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
;
2823 struct lisp_parse_state state
;
2826 if (!NILP (targetdepth
))
2828 CHECK_NUMBER (targetdepth
, 3);
2829 target
= XINT (targetdepth
);
2832 target
= -100000; /* We won't reach this depth */
2834 validate_region (&from
, &to
);
2835 scan_sexps_forward (&state
, XINT (from
), CHAR_TO_BYTE (XINT (from
)),
2837 target
, !NILP (stopbefore
), oldstate
,
2839 ? 0 : (EQ (commentstop
, Qsyntax_table
) ? -1 : 1)));
2841 SET_PT (state
.location
);
2843 return Fcons (make_number (state
.depth
),
2844 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
2845 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
2846 Fcons (state
.instring
>= 0
2847 ? (state
.instring
== ST_STRING_STYLE
2848 ? Qt
: make_number (state
.instring
)) : Qnil
,
2849 Fcons (state
.incomment
< 0 ? Qt
:
2850 (state
.incomment
== 0 ? Qnil
:
2851 make_number (state
.incomment
)),
2852 Fcons (state
.quoted
? Qt
: Qnil
,
2853 Fcons (make_number (state
.mindepth
),
2854 Fcons ((state
.comstyle
2855 ? (state
.comstyle
== ST_COMMENT_STYLE
2856 ? Qsyntax_table
: Qt
) :
2858 Fcons (((state
.incomment
2859 || (state
.instring
>= 0))
2860 ? make_number (state
.comstr_start
)
2862 Fcons (state
.levelstarts
, Qnil
))))))))));
2871 /* This has to be done here, before we call Fmake_char_table. */
2872 Qsyntax_table
= intern ("syntax-table");
2873 staticpro (&Qsyntax_table
);
2875 /* Intern this now in case it isn't already done.
2876 Setting this variable twice is harmless.
2877 But don't staticpro it here--that is done in alloc.c. */
2878 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
2880 /* Create objects which can be shared among syntax tables. */
2881 Vsyntax_code_object
= Fmake_vector (make_number (13), Qnil
);
2882 for (i
= 0; i
< XVECTOR (Vsyntax_code_object
)->size
; i
++)
2883 XVECTOR (Vsyntax_code_object
)->contents
[i
]
2884 = Fcons (make_number (i
), Qnil
);
2886 /* Now we are ready to set up this property, so we can
2887 create syntax tables. */
2888 Fput (Qsyntax_table
, Qchar_table_extra_slots
, make_number (0));
2890 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Swhitespace
];
2892 Vstandard_syntax_table
= Fmake_char_table (Qsyntax_table
, temp
);
2894 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Sword
];
2895 for (i
= 'a'; i
<= 'z'; i
++)
2896 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2897 for (i
= 'A'; i
<= 'Z'; i
++)
2898 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2899 for (i
= '0'; i
<= '9'; i
++)
2900 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2902 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '$', temp
);
2903 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '%', temp
);
2905 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '(',
2906 Fcons (make_number (Sopen
), make_number (')')));
2907 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ')',
2908 Fcons (make_number (Sclose
), make_number ('(')));
2909 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '[',
2910 Fcons (make_number (Sopen
), make_number (']')));
2911 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ']',
2912 Fcons (make_number (Sclose
), make_number ('[')));
2913 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '{',
2914 Fcons (make_number (Sopen
), make_number ('}')));
2915 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '}',
2916 Fcons (make_number (Sclose
), make_number ('{')));
2917 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '"',
2918 Fcons (make_number ((int) Sstring
), Qnil
));
2919 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '\\',
2920 Fcons (make_number ((int) Sescape
), Qnil
));
2922 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Ssymbol
];
2923 for (i
= 0; i
< 10; i
++)
2925 c
= "_-+*/&|<>="[i
];
2926 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2929 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Spunct
];
2930 for (i
= 0; i
< 12; i
++)
2932 c
= ".,;:?!#@~^'`"[i
];
2933 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2936 /* All multibyte characters have syntax `word' by default. */
2937 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Sword
];
2938 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
2939 XCHAR_TABLE (Vstandard_syntax_table
)->contents
[i
] = temp
;
2945 Qsyntax_table_p
= intern ("syntax-table-p");
2946 staticpro (&Qsyntax_table_p
);
2948 staticpro (&Vsyntax_code_object
);
2950 Qscan_error
= intern ("scan-error");
2951 staticpro (&Qscan_error
);
2952 Fput (Qscan_error
, Qerror_conditions
,
2953 Fcons (Qscan_error
, Fcons (Qerror
, Qnil
)));
2954 Fput (Qscan_error
, Qerror_message
,
2955 build_string ("Scan error"));
2957 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
2958 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
2960 DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties
,
2961 "Non-nil means `forward-sexp', etc., grant `syntax-table' property.\n\
2962 The value of this property should be either a syntax table, or a cons\n\
2963 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric\n\
2964 syntax code, MATCHCHAR being nil or the character to match (which is\n\
2965 relevant only for open/close type.");
2967 words_include_escapes
= 0;
2968 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
2969 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
2971 DEFVAR_BOOL ("multibyte-syntax-as-symbol", &multibyte_syntax_as_symbol
,
2972 "Non-nil means `scan-sexps' treats all multibyte characters as symbol.");
2973 multibyte_syntax_as_symbol
= 0;
2975 DEFVAR_BOOL ("open-paren-in-column-0-is-defun-start",
2976 &open_paren_in_column_0_is_defun_start
,
2977 "Non-nil means an open paren in column 0 denotes the start of a defun.");
2978 open_paren_in_column_0_is_defun_start
= 1;
2980 defsubr (&Ssyntax_table_p
);
2981 defsubr (&Ssyntax_table
);
2982 defsubr (&Sstandard_syntax_table
);
2983 defsubr (&Scopy_syntax_table
);
2984 defsubr (&Sset_syntax_table
);
2985 defsubr (&Schar_syntax
);
2986 defsubr (&Smatching_paren
);
2987 defsubr (&Smodify_syntax_entry
);
2988 defsubr (&Sdescribe_syntax
);
2990 defsubr (&Sforward_word
);
2992 defsubr (&Sskip_chars_forward
);
2993 defsubr (&Sskip_chars_backward
);
2994 defsubr (&Sskip_syntax_forward
);
2995 defsubr (&Sskip_syntax_backward
);
2997 defsubr (&Sforward_comment
);
2998 defsubr (&Sscan_lists
);
2999 defsubr (&Sscan_sexps
);
3000 defsubr (&Sbackward_prefix_chars
);
3001 defsubr (&Sparse_partial_sexp
);