1 /* GNU Emacs routines to deal with syntax tables; also word and list parsing.
2 Copyright (C) 1985, 87, 93, 94, 95, 97, 1998 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
29 /* Make syntax table lookup grant data in gl_state. */
30 #define SYNTAX_ENTRY_VIA_PROPERTY
33 #include "intervals.h"
35 /* We use these constants in place for comment-style and
36 string-ender-char to distinguish comments/strings started by
37 comment_fence and string_fence codes. */
39 #define ST_COMMENT_STYLE (256 + 1)
40 #define ST_STRING_STYLE (256 + 2)
43 Lisp_Object Qsyntax_table_p
, Qsyntax_table
, Qscan_error
;
45 int words_include_escapes
;
46 int parse_sexp_lookup_properties
;
48 /* Used as a temporary in SYNTAX_ENTRY and other macros in syntax.h,
49 if not compiled with GCC. No need to mark it, since it is used
50 only very temporarily. */
51 Lisp_Object syntax_temp
;
53 /* This is the internal form of the parse state used in parse-partial-sexp. */
55 struct lisp_parse_state
57 int depth
; /* Depth at end of parsing. */
58 int instring
; /* -1 if not within string, else desired terminator. */
59 int incomment
; /* Nonzero if within a comment at end of parsing. */
60 int comstyle
; /* comment style a=0, or b=1, or ST_COMMENT_STYLE. */
61 int quoted
; /* Nonzero if just after an escape char at end of parsing */
62 int thislevelstart
; /* Char number of most recent start-of-expression at current level */
63 int prevlevelstart
; /* Char number of start of containing expression */
64 int location
; /* Char number at which parsing stopped. */
65 int mindepth
; /* Minimum depth seen while scanning. */
66 int comstr_start
; /* Position just after last comment/string starter. */
67 Lisp_Object levelstarts
; /* Char numbers of starts-of-expression
68 of levels (starting from outermost). */
71 /* These variables are a cache for finding the start of a defun.
72 find_start_pos is the place for which the defun start was found.
73 find_start_value is the defun start position found for it.
74 find_start_value_byte is the corresponding byte position.
75 find_start_buffer is the buffer it was found in.
76 find_start_begv is the BEGV value when it was found.
77 find_start_modiff is the value of MODIFF when it was found. */
79 static int find_start_pos
;
80 static int find_start_value
;
81 static int find_start_value_byte
;
82 static struct buffer
*find_start_buffer
;
83 static int find_start_begv
;
84 static int find_start_modiff
;
87 static int find_defun_start
P_ ((int, int));
88 static int back_comment
P_ ((int, int, int, int, int *, int *));
89 static int char_quoted
P_ ((int, int));
90 static Lisp_Object skip_chars
P_ ((int, int, Lisp_Object
, Lisp_Object
));
91 static Lisp_Object scan_lists
P_ ((int, int, int, int));
92 static void scan_sexps_forward
P_ ((struct lisp_parse_state
*,
94 int, Lisp_Object
, int));
97 struct gl_state_s gl_state
; /* Global state of syntax parser. */
99 INTERVAL
interval_of ();
100 #define INTERVALS_AT_ONCE 10 /* 1 + max-number of intervals
101 to scan to property-change. */
103 /* Update gl_state to an appropriate interval which contains CHARPOS. The
104 sign of COUNT give the relative position of CHARPOS wrt the previously
105 valid interval. If INIT, only [be]_property fields of gl_state are
106 valid at start, the rest is filled basing on OBJECT.
108 `gl_state.*_i' are the intervals, and CHARPOS is further in the search
109 direction than the intervals - or in an interval. We update the
110 current syntax-table basing on the property of this interval, and
111 update the interval to start further than CHARPOS - or be
112 NULL_INTERVAL. We also update lim_property to be the next value of
113 charpos to call this subroutine again - or be before/after the
114 start/end of OBJECT. */
117 update_syntax_table (charpos
, count
, init
, object
)
118 int charpos
, count
, init
;
121 Lisp_Object tmp_table
;
122 int cnt
= 0, doing_extra
= 0, invalidate
= 1;
127 gl_state
.start
= gl_state
.b_property
;
128 gl_state
.stop
= gl_state
.e_property
;
129 gl_state
.forward_i
= interval_of (charpos
, object
);
130 i
= gl_state
.backward_i
= gl_state
.forward_i
;
131 gl_state
.left_ok
= gl_state
.right_ok
= 1;
133 if (NULL_INTERVAL_P (i
))
135 /* interval_of updates only ->position of the return value, so
136 update the parents manually to speed up update_interval. */
137 while (!NULL_PARENT (i
))
139 if (AM_RIGHT_CHILD (i
))
140 i
->parent
->position
= i
->position
141 - LEFT_TOTAL_LENGTH (i
) + TOTAL_LENGTH (i
) /* right end */
142 - TOTAL_LENGTH (i
->parent
)
143 + LEFT_TOTAL_LENGTH (i
->parent
);
145 i
->parent
->position
= i
->position
- LEFT_TOTAL_LENGTH (i
)
149 i
= gl_state
.forward_i
;
150 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
151 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
154 oldi
= i
= count
> 0 ? gl_state
.forward_i
: gl_state
.backward_i
;
156 /* We are guarantied to be called with CHARPOS either in i,
158 if (NULL_INTERVAL_P (i
))
159 error ("Error in syntax_table logic for to-the-end intervals");
160 else if (charpos
< i
->position
) /* Move left. */
163 error ("Error in syntax_table logic for intervals <-");
164 /* Update the interval. */
165 i
= update_interval (i
, charpos
);
166 if (oldi
->position
!= INTERVAL_LAST_POS (i
))
169 gl_state
.right_ok
= 1; /* Invalidate the other end. */
170 gl_state
.forward_i
= i
;
171 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
174 else if (charpos
>= INTERVAL_LAST_POS (i
)) /* Move right. */
177 error ("Error in syntax_table logic for intervals ->");
178 /* Update the interval. */
179 i
= update_interval (i
, charpos
);
180 if (i
->position
!= INTERVAL_LAST_POS (oldi
))
183 gl_state
.left_ok
= 1; /* Invalidate the other end. */
184 gl_state
.backward_i
= i
;
185 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
188 else if (count
> 0 ? gl_state
.right_ok
: gl_state
.left_ok
)
190 /* We do not need to recalculate tmp_table. */
191 tmp_table
= gl_state
.old_prop
;
195 tmp_table
= textget (i
->plist
, Qsyntax_table
);
198 invalidate
= !EQ (tmp_table
, gl_state
.old_prop
); /* Need to invalidate? */
200 if (invalidate
) /* Did not get to adjacent interval. */
201 { /* with the same table => */
202 /* invalidate the old range. */
205 gl_state
.backward_i
= i
;
206 gl_state
.left_ok
= 1; /* Invalidate the other end. */
207 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
211 gl_state
.forward_i
= i
;
212 gl_state
.right_ok
= 1; /* Invalidate the other end. */
213 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
217 gl_state
.current_syntax_table
= tmp_table
;
218 gl_state
.old_prop
= tmp_table
;
219 if (EQ (Fsyntax_table_p (tmp_table
), Qt
))
221 gl_state
.use_global
= 0;
223 else if (CONSP (tmp_table
))
225 gl_state
.use_global
= 1;
226 gl_state
.global_code
= tmp_table
;
230 gl_state
.use_global
= 0;
231 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
234 while (!NULL_INTERVAL_P (i
))
236 if (cnt
&& !EQ (tmp_table
, textget (i
->plist
, Qsyntax_table
)))
239 gl_state
.right_ok
= 0;
241 gl_state
.left_ok
= 0;
244 else if (cnt
== INTERVALS_AT_ONCE
)
247 gl_state
.right_ok
= 1;
249 gl_state
.left_ok
= 1;
253 i
= count
> 0 ? next_interval (i
) : previous_interval (i
);
255 if (NULL_INTERVAL_P (i
))
256 { /* This property goes to the end. */
258 gl_state
.e_property
= gl_state
.stop
;
260 gl_state
.b_property
= gl_state
.start
;
266 gl_state
.e_property
= i
->position
- gl_state
.offset
;
267 gl_state
.forward_i
= i
;
271 gl_state
.b_property
= i
->position
+ LENGTH (i
) - 1 - gl_state
.offset
;
272 gl_state
.backward_i
= i
;
277 /* Returns TRUE if char at CHARPOS is quoted.
278 Global syntax-table data should be set up already to be good at CHARPOS
279 or after. On return global syntax data is good for lookup at CHARPOS. */
282 char_quoted (charpos
, bytepos
)
283 register int charpos
, bytepos
;
285 register enum syntaxcode code
;
286 register int beg
= BEGV
;
287 register int quoted
= 0;
290 DEC_BOTH (charpos
, bytepos
);
292 while (bytepos
>= beg
)
294 UPDATE_SYNTAX_TABLE_BACKWARD (charpos
);
295 code
= SYNTAX (FETCH_CHAR (bytepos
));
296 if (! (code
== Scharquote
|| code
== Sescape
))
299 DEC_BOTH (charpos
, bytepos
);
303 UPDATE_SYNTAX_TABLE (orig
);
307 /* Return the bytepos one character after BYTEPOS.
308 We assume that BYTEPOS is not at the end of the buffer. */
311 inc_bytepos (bytepos
)
314 if (NILP (current_buffer
->enable_multibyte_characters
))
321 /* Return the bytepos one character before BYTEPOS.
322 We assume that BYTEPOS is not at the start of the buffer. */
325 dec_bytepos (bytepos
)
328 if (NILP (current_buffer
->enable_multibyte_characters
))
335 /* Find a defun-start that is the last one before POS (or nearly the last).
336 We record what we find, so that another call in the same area
337 can return the same value right away.
339 There is no promise at which position the global syntax data is
340 valid on return from the subroutine, so the caller should explicitly
341 update the global data. */
344 find_defun_start (pos
, pos_byte
)
349 int opoint
= PT
, opoint_byte
= PT_BYTE
;
351 /* Use previous finding, if it's valid and applies to this inquiry. */
352 if (current_buffer
== find_start_buffer
353 /* Reuse the defun-start even if POS is a little farther on.
354 POS might be in the next defun, but that's ok.
355 Our value may not be the best possible, but will still be usable. */
356 && pos
<= find_start_pos
+ 1000
357 && pos
>= find_start_value
358 && BEGV
== find_start_begv
359 && MODIFF
== find_start_modiff
)
360 return find_start_value
;
362 /* Back up to start of line. */
363 scan_newline (pos
, pos_byte
, BEGV
, BEGV_BYTE
, -1, 1);
365 /* We optimize syntax-table lookup for rare updates. Thus we accept
366 only those `^\s(' which are good in global _and_ text-property
368 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
369 gl_state
.use_global
= 0;
372 /* Open-paren at start of line means we found our defun-start. */
373 if (SYNTAX (FETCH_CHAR (PT_BYTE
)) == Sopen
)
375 SETUP_SYNTAX_TABLE (PT
+ 1, -1); /* Try again... */
376 if (SYNTAX (FETCH_CHAR (PT_BYTE
)) == Sopen
)
378 /* Now fallback to the default value. */
379 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
380 gl_state
.use_global
= 0;
382 /* Move to beg of previous line. */
383 scan_newline (PT
, PT_BYTE
, BEGV
, BEGV_BYTE
, -2, 1);
386 /* Record what we found, for the next try. */
387 find_start_value
= PT
;
388 find_start_value_byte
= PT_BYTE
;
389 find_start_buffer
= current_buffer
;
390 find_start_modiff
= MODIFF
;
391 find_start_begv
= BEGV
;
392 find_start_pos
= pos
;
394 TEMP_SET_PT_BOTH (opoint
, opoint_byte
);
396 return find_start_value
;
399 /* Return the SYNTAX_COMEND_FIRST of the character before POS, POS_BYTE. */
402 prev_char_comend_first (pos
, pos_byte
)
407 DEC_BOTH (pos
, pos_byte
);
408 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
409 c
= FETCH_CHAR (pos_byte
);
410 val
= SYNTAX_COMEND_FIRST (c
);
411 UPDATE_SYNTAX_TABLE_FORWARD (pos
+ 1);
415 /* Return the SYNTAX_COMSTART_FIRST of the character before POS, POS_BYTE. */
418 prev_char_comstart_first (pos
, pos_byte
)
423 DEC_BOTH (pos
, pos_byte
);
424 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
425 c
= FETCH_CHAR (pos_byte
);
426 val
= SYNTAX_COMSTART_FIRST (c
);
427 UPDATE_SYNTAX_TABLE_FORWARD (pos
+ 1);
431 /* Checks whether charpos FROM is at the end of a comment.
432 FROM_BYTE is the bytepos corresponding to FROM.
433 Do not move back before STOP.
435 Return a positive value if we find a comment ending at FROM/FROM_BYTE;
438 If successful, store the charpos of the comment's beginning
439 into *CHARPOS_PTR, and the bytepos into *BYTEPOS_PTR.
441 Global syntax data remains valid for backward search starting at
442 the returned value (or at FROM, if the search was not successful). */
445 back_comment (from
, from_byte
, stop
, comstyle
, charpos_ptr
, bytepos_ptr
)
446 int from
, from_byte
, stop
;
448 int *charpos_ptr
, *bytepos_ptr
;
450 /* Look back, counting the parity of string-quotes,
451 and recording the comment-starters seen.
452 When we reach a safe place, assume that's not in a string;
453 then step the main scan to the earliest comment-starter seen
454 an even number of string quotes away from the safe place.
456 OFROM[I] is position of the earliest comment-starter seen
457 which is I+2X quotes from the comment-end.
458 PARITY is current parity of quotes from the comment end. */
460 int my_stringend
= 0;
461 int string_lossage
= 0;
462 int comment_end
= from
;
463 int comment_end_byte
= from_byte
;
464 int comstart_pos
= 0;
466 /* Value that PARITY had, when we reached the position
468 int comstart_parity
= 0;
469 int scanstart
= from
- 1;
470 /* Place where the containing defun starts,
471 or 0 if we didn't come across it yet. */
473 int defun_start_byte
= 0;
474 register enum syntaxcode code
;
477 /* At beginning of range to scan, we're outside of strings;
478 that determines quote parity to the comment-end. */
481 int temp_byte
, prev_comend_second
;
483 /* Move back and examine a character. */
484 DEC_BOTH (from
, from_byte
);
485 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
487 c
= FETCH_CHAR (from_byte
);
490 /* If this char is the second of a 2-char comment end sequence,
491 back up and give the pair the appropriate syntax. */
492 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
493 && prev_char_comend_first (from
, from_byte
))
496 DEC_BOTH (from
, from_byte
);
497 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
498 c
= FETCH_CHAR (from_byte
);
501 /* If this char starts a 2-char comment start sequence,
502 treat it like a 1-char comment starter. */
503 if (from
< scanstart
&& SYNTAX_COMSTART_FIRST (c
))
505 temp_byte
= inc_bytepos (from_byte
);
506 UPDATE_SYNTAX_TABLE_FORWARD (from
+ 1);
507 if (SYNTAX_COMSTART_SECOND (FETCH_CHAR (temp_byte
))
508 && comstyle
== SYNTAX_COMMENT_STYLE (FETCH_CHAR (temp_byte
)))
510 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
513 /* Ignore escaped characters, except comment-enders. */
514 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
517 /* Track parity of quotes. */
521 if (my_stringend
== 0)
523 /* If we have two kinds of string delimiters.
524 There's no way to grok this scanning backwards. */
525 else if (my_stringend
!= c
)
529 if (code
== Sstring_fence
|| code
== Scomment_fence
)
532 if (my_stringend
== 0)
534 = code
== Sstring_fence
? ST_STRING_STYLE
: ST_COMMENT_STYLE
;
535 /* If we have two kinds of string delimiters.
536 There's no way to grok this scanning backwards. */
537 else if (my_stringend
!= (code
== Sstring_fence
538 ? ST_STRING_STYLE
: ST_COMMENT_STYLE
))
542 /* Record comment-starters according to that
543 quote-parity to the comment-end. */
544 if (code
== Scomment
)
546 comstart_parity
= parity
;
548 comstart_byte
= from_byte
;
551 /* If we find another earlier comment-ender,
552 any comment-starts earlier than that don't count
553 (because they go with the earlier comment-ender). */
554 if (code
== Sendcomment
555 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)) == comstyle
)
558 /* Assume a defun-start point is outside of strings. */
561 || (temp_byte
= dec_bytepos (from_byte
),
562 FETCH_CHAR (temp_byte
) == '\n')))
565 defun_start_byte
= from_byte
;
570 if (comstart_pos
== 0)
573 from_byte
= comment_end_byte
;
574 UPDATE_SYNTAX_TABLE_FORWARD (comment_end
- 1);
576 /* If the earliest comment starter
577 is followed by uniform paired string quotes or none,
578 we know it can't be inside a string
579 since if it were then the comment ender would be inside one.
580 So it does start a comment. Skip back to it. */
581 else if (comstart_parity
== 0 && !string_lossage
)
584 from_byte
= comstart_byte
;
585 /* Globals are correct now. */
589 /* We had two kinds of string delimiters mixed up
590 together. Decode this going forwards.
591 Scan fwd from the previous comment ender
592 to the one in question; this records where we
593 last passed a comment starter. */
594 struct lisp_parse_state state
;
595 /* If we did not already find the defun start, find it now. */
596 if (defun_start
== 0)
598 defun_start
= find_defun_start (comment_end
, comment_end_byte
);
599 defun_start_byte
= find_start_value_byte
;
601 scan_sexps_forward (&state
,
602 defun_start
, defun_start_byte
,
603 comment_end
- 1, -10000, 0, Qnil
, 0);
606 /* scan_sexps_forward changed the direction of search in
607 global variables, so we need to update it completely. */
609 from
= state
.comstr_start
;
615 from_byte
= CHAR_TO_BYTE (from
);
616 UPDATE_SYNTAX_TABLE_FORWARD (from
- 1);
620 *bytepos_ptr
= from_byte
;
625 DEFUN ("syntax-table-p", Fsyntax_table_p
, Ssyntax_table_p
, 1, 1, 0,
626 "Return t if OBJECT is a syntax table.\n\
627 Currently, any char-table counts as a syntax table.")
631 if (CHAR_TABLE_P (object
)
632 && EQ (XCHAR_TABLE (object
)->purpose
, Qsyntax_table
))
638 check_syntax_table (obj
)
641 if (!(CHAR_TABLE_P (obj
)
642 && EQ (XCHAR_TABLE (obj
)->purpose
, Qsyntax_table
)))
643 wrong_type_argument (Qsyntax_table_p
, obj
);
646 DEFUN ("syntax-table", Fsyntax_table
, Ssyntax_table
, 0, 0, 0,
647 "Return the current syntax table.\n\
648 This is the one specified by the current buffer.")
651 return current_buffer
->syntax_table
;
654 DEFUN ("standard-syntax-table", Fstandard_syntax_table
,
655 Sstandard_syntax_table
, 0, 0, 0,
656 "Return the standard syntax table.\n\
657 This is the one used for new buffers.")
660 return Vstandard_syntax_table
;
663 DEFUN ("copy-syntax-table", Fcopy_syntax_table
, Scopy_syntax_table
, 0, 1, 0,
664 "Construct a new syntax table and return it.\n\
665 It is a copy of the TABLE, which defaults to the standard syntax table.")
672 check_syntax_table (table
);
674 table
= Vstandard_syntax_table
;
676 copy
= Fcopy_sequence (table
);
678 /* Only the standard syntax table should have a default element.
679 Other syntax tables should inherit from parents instead. */
680 XCHAR_TABLE (copy
)->defalt
= Qnil
;
682 /* Copied syntax tables should all have parents.
683 If we copied one with no parent, such as the standard syntax table,
684 use the standard syntax table as the copy's parent. */
685 if (NILP (XCHAR_TABLE (copy
)->parent
))
686 Fset_char_table_parent (copy
, Vstandard_syntax_table
);
690 DEFUN ("set-syntax-table", Fset_syntax_table
, Sset_syntax_table
, 1, 1, 0,
691 "Select a new syntax table for the current buffer.\n\
692 One argument, a syntax table.")
696 check_syntax_table (table
);
697 current_buffer
->syntax_table
= table
;
698 /* Indicate that this buffer now has a specified syntax table. */
699 current_buffer
->local_var_flags
700 |= XFASTINT (buffer_local_flags
.syntax_table
);
704 /* Convert a letter which signifies a syntax code
705 into the code it signifies.
706 This is used by modify-syntax-entry, and other things. */
708 unsigned char syntax_spec_code
[0400] =
709 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
710 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
711 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
712 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
713 (char) Swhitespace
, (char) Scomment_fence
, (char) Sstring
, 0377,
714 (char) Smath
, 0377, 0377, (char) Squote
,
715 (char) Sopen
, (char) Sclose
, 0377, 0377,
716 0377, (char) Swhitespace
, (char) Spunct
, (char) Scharquote
,
717 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
718 0377, 0377, 0377, 0377,
719 (char) Scomment
, 0377, (char) Sendcomment
, 0377,
720 (char) Sinherit
, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */
721 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
722 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
723 0377, 0377, 0377, 0377, (char) Sescape
, 0377, 0377, (char) Ssymbol
,
724 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
725 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
726 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
727 0377, 0377, 0377, 0377, (char) Sstring_fence
, 0377, 0377, 0377
730 /* Indexed by syntax code, give the letter that describes it. */
732 char syntax_code_spec
[16] =
734 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@',
738 /* Indexed by syntax code, give the object (cons of syntax code and
739 nil) to be stored in syntax table. Since these objects can be
740 shared among syntax tables, we generate them in advance. By
741 sharing objects, the function `describe-syntax' can give a more
743 static Lisp_Object Vsyntax_code_object
;
746 /* Look up the value for CHARACTER in syntax table TABLE's parent
747 and its parents. SYNTAX_ENTRY calls this, when TABLE itself has nil
748 for CHARACTER. It's actually used only when not compiled with GCC. */
751 syntax_parent_lookup (table
, character
)
759 table
= XCHAR_TABLE (table
)->parent
;
763 value
= XCHAR_TABLE (table
)->contents
[character
];
769 DEFUN ("char-syntax", Fchar_syntax
, Schar_syntax
, 1, 1, 0,
770 "Return the syntax code of CHARACTER, described by a character.\n\
771 For example, if CHARACTER is a word constituent,\n\
772 the character `w' is returned.\n\
773 The characters that correspond to various syntax codes\n\
774 are listed in the documentation of `modify-syntax-entry'.")
776 Lisp_Object character
;
779 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
781 gl_state
.use_global
= 0;
782 CHECK_NUMBER (character
, 0);
783 char_int
= XINT (character
);
784 return make_number (syntax_code_spec
[(int) SYNTAX (char_int
)]);
787 DEFUN ("matching-paren", Fmatching_paren
, Smatching_paren
, 1, 1, 0,
788 "Return the matching parenthesis of CHARACTER, or nil if none.")
790 Lisp_Object character
;
793 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
794 gl_state
.use_global
= 0;
795 CHECK_NUMBER (character
, 0);
796 char_int
= XINT (character
);
797 code
= SYNTAX (char_int
);
798 if (code
== Sopen
|| code
== Sclose
)
799 return SYNTAX_MATCH (char_int
);
803 /* This comment supplies the doc string for modify-syntax-entry,
804 for make-docfile to see. We cannot put this in the real DEFUN
805 due to limits in the Unix cpp.
807 DEFUN ("modify-syntax-entry", foo, bar, 2, 3, 0,
808 "Set syntax for character CHAR according to string S.\n\
809 The syntax is changed only for table TABLE, which defaults to\n\
810 the current buffer's syntax table.\n\
811 The first character of S should be one of the following:\n\
812 Space or - whitespace syntax. w word constituent.\n\
813 _ symbol constituent. . punctuation.\n\
814 ( open-parenthesis. ) close-parenthesis.\n\
815 \" string quote. \\ escape.\n\
816 $ paired delimiter. ' expression quote or prefix operator.\n\
817 < comment starter. > comment ender.\n\
818 / character-quote. @ inherit from `standard-syntax-table'.\n\
820 Only single-character comment start and end sequences are represented thus.\n\
821 Two-character sequences are represented as described below.\n\
822 The second character of S is the matching parenthesis,\n\
823 used only if the first character is `(' or `)'.\n\
824 Any additional characters are flags.\n\
825 Defined flags are the characters 1, 2, 3, 4, b, and p.\n\
826 1 means CHAR is the start of a two-char comment start sequence.\n\
827 2 means CHAR is the second character of such a sequence.\n\
828 3 means CHAR is the start of a two-char comment end sequence.\n\
829 4 means CHAR is the second character of such a sequence.\n\
831 There can be up to two orthogonal comment sequences. This is to support\n\
832 language modes such as C++. By default, all comment sequences are of style\n\
833 a, but you can set the comment sequence style to b (on the second character\n\
834 of a comment-start, or the first character of a comment-end sequence) using\n\
836 b means CHAR is part of comment sequence b.\n\
838 p means CHAR is a prefix character for `backward-prefix-chars';\n\
839 such characters are treated as whitespace when they occur\n\
840 between expressions.")
844 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry
, Smodify_syntax_entry
, 2, 3,
845 /* I really don't know why this is interactive
846 help-form should at least be made useful whilst reading the second arg
848 "cSet syntax for character: \nsSet syntax for %s to: ",
849 0 /* See immediately above */)
850 (c
, newentry
, syntax_table
)
851 Lisp_Object c
, newentry
, syntax_table
;
853 register unsigned char *p
;
854 register enum syntaxcode code
;
859 CHECK_STRING (newentry
, 1);
861 if (NILP (syntax_table
))
862 syntax_table
= current_buffer
->syntax_table
;
864 check_syntax_table (syntax_table
);
866 p
= XSTRING (newentry
)->data
;
867 code
= (enum syntaxcode
) syntax_spec_code
[*p
++];
868 if (((int) code
& 0377) == 0377)
869 error ("invalid syntax description letter: %c", p
[-1]);
871 if (code
== Sinherit
)
873 SET_RAW_SYNTAX_ENTRY (syntax_table
, XINT (c
), Qnil
);
880 int character
= (STRING_CHAR_AND_LENGTH
881 (p
, STRING_BYTES (XSTRING (newentry
)) - 1, len
));
882 XSETINT (match
, character
);
883 if (XFASTINT (match
) == ' ')
919 if (val
< XVECTOR (Vsyntax_code_object
)->size
&& NILP (match
))
920 newentry
= XVECTOR (Vsyntax_code_object
)->contents
[val
];
922 /* Since we can't use a shared object, let's make a new one. */
923 newentry
= Fcons (make_number (val
), match
);
925 SET_RAW_SYNTAX_ENTRY (syntax_table
, XINT (c
), newentry
);
930 /* Dump syntax table to buffer in human-readable format */
933 describe_syntax (value
)
936 register enum syntaxcode code
;
937 char desc
, match
, start1
, start2
, end1
, end2
, prefix
, comstyle
;
939 Lisp_Object first
, match_lisp
;
941 Findent_to (make_number (16), make_number (1));
945 insert_string ("default\n");
949 if (CHAR_TABLE_P (value
))
951 insert_string ("deeper char-table ...\n");
957 insert_string ("invalid\n");
961 first
= XCONS (value
)->car
;
962 match_lisp
= XCONS (value
)->cdr
;
964 if (!INTEGERP (first
) || !(NILP (match_lisp
) || INTEGERP (match_lisp
)))
966 insert_string ("invalid\n");
970 code
= (enum syntaxcode
) (XINT (first
) & 0377);
971 start1
= (XINT (first
) >> 16) & 1;
972 start2
= (XINT (first
) >> 17) & 1;
973 end1
= (XINT (first
) >> 18) & 1;
974 end2
= (XINT (first
) >> 19) & 1;
975 prefix
= (XINT (first
) >> 20) & 1;
976 comstyle
= (XINT (first
) >> 21) & 1;
978 if ((int) code
< 0 || (int) code
>= (int) Smax
)
980 insert_string ("invalid");
983 desc
= syntax_code_spec
[(int) code
];
985 str
[0] = desc
, str
[1] = 0;
988 if (NILP (match_lisp
))
991 insert_char (XINT (match_lisp
));
1008 insert_string ("\twhich means: ");
1010 switch (SWITCH_ENUM_CAST (code
))
1013 insert_string ("whitespace"); break;
1015 insert_string ("punctuation"); break;
1017 insert_string ("word"); break;
1019 insert_string ("symbol"); break;
1021 insert_string ("open"); break;
1023 insert_string ("close"); break;
1025 insert_string ("quote"); break;
1027 insert_string ("string"); break;
1029 insert_string ("math"); break;
1031 insert_string ("escape"); break;
1033 insert_string ("charquote"); break;
1035 insert_string ("comment"); break;
1037 insert_string ("endcomment"); break;
1039 insert_string ("invalid");
1043 if (!NILP (match_lisp
))
1045 insert_string (", matches ");
1046 insert_char (XINT (match_lisp
));
1050 insert_string (",\n\t is the first character of a comment-start sequence");
1052 insert_string (",\n\t is the second character of a comment-start sequence");
1055 insert_string (",\n\t is the first character of a comment-end sequence");
1057 insert_string (",\n\t is the second character of a comment-end sequence");
1059 insert_string (" (comment style b)");
1062 insert_string (",\n\t is a prefix character for `backward-prefix-chars'");
1064 insert_string ("\n");
1068 describe_syntax_1 (vector
)
1071 struct buffer
*old
= current_buffer
;
1072 set_buffer_internal (XBUFFER (Vstandard_output
));
1073 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
, (int *) 0, 0);
1074 while (! NILP (XCHAR_TABLE (vector
)->parent
))
1076 vector
= XCHAR_TABLE (vector
)->parent
;
1077 insert_string ("\nThe parent syntax table is:");
1078 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
,
1082 call0 (intern ("help-mode"));
1083 set_buffer_internal (old
);
1087 DEFUN ("describe-syntax", Fdescribe_syntax
, Sdescribe_syntax
, 0, 0, "",
1088 "Describe the syntax specifications in the syntax table.\n\
1089 The descriptions are inserted in a buffer, which is then displayed.")
1092 internal_with_output_to_temp_buffer
1093 ("*Help*", describe_syntax_1
, current_buffer
->syntax_table
);
1098 int parse_sexp_ignore_comments
;
1100 /* Return the position across COUNT words from FROM.
1101 If that many words cannot be found before the end of the buffer, return 0.
1102 COUNT negative means scan backward and stop at word beginning. */
1105 scan_words (from
, count
)
1106 register int from
, count
;
1108 register int beg
= BEGV
;
1109 register int end
= ZV
;
1110 register int from_byte
= CHAR_TO_BYTE (from
);
1111 register enum syntaxcode code
;
1117 SETUP_SYNTAX_TABLE (from
, count
);
1128 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1129 ch0
= FETCH_CHAR (from_byte
);
1130 code
= SYNTAX (ch0
);
1131 INC_BOTH (from
, from_byte
);
1132 if (words_include_escapes
1133 && (code
== Sescape
|| code
== Scharquote
))
1138 /* Now CH0 is a character which begins a word and FROM is the
1139 position of the next character. */
1142 if (from
== end
) break;
1143 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1144 ch1
= FETCH_CHAR (from_byte
);
1145 code
= SYNTAX (ch1
);
1146 if (!(words_include_escapes
1147 && (code
== Sescape
|| code
== Scharquote
)))
1148 if (code
!= Sword
|| WORD_BOUNDARY_P (ch0
, ch1
))
1150 INC_BOTH (from
, from_byte
);
1164 DEC_BOTH (from
, from_byte
);
1165 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1166 ch1
= FETCH_CHAR (from_byte
);
1167 code
= SYNTAX (ch1
);
1168 if (words_include_escapes
1169 && (code
== Sescape
|| code
== Scharquote
))
1174 /* Now CH1 is a character which ends a word and FROM is the
1182 temp_byte
= dec_bytepos (from_byte
);
1183 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1184 ch0
= FETCH_CHAR (temp_byte
);
1185 code
= SYNTAX (ch0
);
1186 if (!(words_include_escapes
1187 && (code
== Sescape
|| code
== Scharquote
)))
1188 if (code
!= Sword
|| WORD_BOUNDARY_P (ch0
, ch1
))
1190 DEC_BOTH (from
, from_byte
);
1201 DEFUN ("forward-word", Fforward_word
, Sforward_word
, 1, 1, "p",
1202 "Move point forward ARG words (backward if ARG is negative).\n\
1203 Normally returns t.\n\
1204 If an edge of the buffer is reached, point is left there\n\
1205 and nil is returned.")
1210 CHECK_NUMBER (count
, 0);
1212 if (!(val
= scan_words (PT
, XINT (count
))))
1214 SET_PT (XINT (count
) > 0 ? ZV
: BEGV
);
1221 Lisp_Object
skip_chars ();
1223 DEFUN ("skip-chars-forward", Fskip_chars_forward
, Sskip_chars_forward
, 1, 2, 0,
1224 "Move point forward, stopping before a char not in STRING, or at pos LIM.\n\
1225 STRING is like the inside of a `[...]' in a regular expression\n\
1226 except that `]' is never special and `\\' quotes `^', `-' or `\\'\n\
1227 (but not as the end of a range; quoting is never needed there).\n\
1228 Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
1229 With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\
1230 Returns the distance traveled, either zero or positive.")
1232 Lisp_Object string
, lim
;
1234 return skip_chars (1, 0, string
, lim
);
1237 DEFUN ("skip-chars-backward", Fskip_chars_backward
, Sskip_chars_backward
, 1, 2, 0,
1238 "Move point backward, stopping after a char not in STRING, or at pos LIM.\n\
1239 See `skip-chars-forward' for details.\n\
1240 Returns the distance traveled, either zero or negative.")
1242 Lisp_Object string
, lim
;
1244 return skip_chars (0, 0, string
, lim
);
1247 DEFUN ("skip-syntax-forward", Fskip_syntax_forward
, Sskip_syntax_forward
, 1, 2, 0,
1248 "Move point forward across chars in specified syntax classes.\n\
1249 SYNTAX is a string of syntax code characters.\n\
1250 Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\
1251 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1252 This function returns the distance traveled, either zero or positive.")
1254 Lisp_Object syntax
, lim
;
1256 return skip_chars (1, 1, syntax
, lim
);
1259 DEFUN ("skip-syntax-backward", Fskip_syntax_backward
, Sskip_syntax_backward
, 1, 2, 0,
1260 "Move point backward across chars in specified syntax classes.\n\
1261 SYNTAX is a string of syntax code characters.\n\
1262 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\
1263 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1264 This function returns the distance traveled, either zero or negative.")
1266 Lisp_Object syntax
, lim
;
1268 return skip_chars (0, 1, syntax
, lim
);
1272 skip_chars (forwardp
, syntaxp
, string
, lim
)
1273 int forwardp
, syntaxp
;
1274 Lisp_Object string
, lim
;
1276 register unsigned char *p
, *pend
;
1277 register unsigned int c
;
1279 unsigned char fastmap
[0400];
1280 /* If SYNTAXP is 0, STRING may contain multi-byte form of characters
1281 of which codes don't fit in FASTMAP. In that case, we set the
1282 first byte of multibyte form (i.e. base leading-code) in FASTMAP
1283 and set the actual ranges of characters in CHAR_RANGES. In the
1284 form "X-Y" of STRING, both X and Y must belong to the same
1285 character set because a range striding across character sets is
1288 int n_char_ranges
= 0;
1290 register int i
, i_byte
;
1291 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
1292 int string_multibyte
;
1295 CHECK_STRING (string
, 0);
1296 char_ranges
= (int *) alloca (XSTRING (string
)->size
* (sizeof (int)) * 2);
1297 string_multibyte
= STRING_MULTIBYTE (string
);
1298 size_byte
= STRING_BYTES (XSTRING (string
));
1301 XSETINT (lim
, forwardp
? ZV
: BEGV
);
1303 CHECK_NUMBER_COERCE_MARKER (lim
, 0);
1305 /* In any case, don't allow scan outside bounds of buffer. */
1306 if (XINT (lim
) > ZV
)
1307 XSETFASTINT (lim
, ZV
);
1308 if (XINT (lim
) < BEGV
)
1309 XSETFASTINT (lim
, BEGV
);
1311 bzero (fastmap
, sizeof fastmap
);
1315 if (i_byte
< size_byte
1316 && XSTRING (string
)->data
[0] == '^')
1318 negate
= 1; i
++, i_byte
++;
1321 /* Find the characters specified and set their elements of fastmap.
1322 If syntaxp, each character counts as itself.
1323 Otherwise, handle backslashes and ranges specially. */
1325 while (i_byte
< size_byte
)
1329 if (string_multibyte
)
1331 c_leading_code
= XSTRING (string
)->data
[i_byte
];
1332 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1335 c
= c_leading_code
= XSTRING (string
)->data
[i_byte
++];
1337 /* Convert multibyteness between what the string has
1338 and what the buffer has. */
1340 c
= unibyte_char_to_multibyte (c
);
1345 fastmap
[syntax_spec_code
[c
& 0377]] = 1;
1350 if (i_byte
== size_byte
)
1353 if (string_multibyte
)
1355 c_leading_code
= XSTRING (string
)->data
[i_byte
];
1356 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1359 c
= c_leading_code
= XSTRING (string
)->data
[i_byte
++];
1361 if (i_byte
< size_byte
1362 && XSTRING (string
)->data
[i_byte
] == '-')
1364 unsigned int c2
, c2_leading_code
;
1366 /* Skip over the dash. */
1369 if (i_byte
== size_byte
)
1372 /* Get the end of the range. */
1373 if (string_multibyte
)
1375 c2_leading_code
= XSTRING (string
)->data
[i_byte
];
1376 FETCH_STRING_CHAR_ADVANCE (c2
, string
, i
, i_byte
);
1379 c2
= XSTRING (string
)->data
[i_byte
++];
1381 if (SINGLE_BYTE_CHAR_P (c
))
1383 if (! SINGLE_BYTE_CHAR_P (c2
))
1384 error ("Invalid charcter range: %s",
1385 XSTRING (string
)->data
);
1394 if (c_leading_code
!= c2_leading_code
)
1395 error ("Invalid charcter range: %s",
1396 XSTRING (string
)->data
);
1397 fastmap
[c_leading_code
] = 1;
1400 char_ranges
[n_char_ranges
++] = c
;
1401 char_ranges
[n_char_ranges
++] = c2
;
1407 fastmap
[c_leading_code
] = 1;
1408 if (!SINGLE_BYTE_CHAR_P (c
))
1410 char_ranges
[n_char_ranges
++] = c
;
1411 char_ranges
[n_char_ranges
++] = c
;
1417 /* If ^ was the first character, complement the fastmap. In
1418 addition, as all multibyte characters have possibility of
1419 matching, set all entries for base leading codes, which is
1420 harmless even if SYNTAXP is 1. */
1423 for (i
= 0; i
< sizeof fastmap
; i
++)
1425 if (!multibyte
|| !BASE_LEADING_CODE_P (i
))
1432 int start_point
= PT
;
1434 int pos_byte
= PT_BYTE
;
1439 SETUP_SYNTAX_TABLE (pos
, forwardp
? 1 : -1);
1444 if (pos
< XINT (lim
))
1445 while (fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1447 /* Since we already checked for multibyteness,
1448 avoid using INC_BOTH which checks again. */
1451 if (pos
>= XINT (lim
))
1453 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1458 while (pos
< XINT (lim
)
1459 && fastmap
[(int) SYNTAX (FETCH_BYTE (pos
))])
1462 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1470 while (pos
> XINT (lim
))
1472 int savepos
= pos_byte
;
1473 /* Since we already checked for multibyteness,
1474 avoid using DEC_BOTH which checks again. */
1477 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
1478 if (!fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1488 if (pos
> XINT (lim
))
1489 while (fastmap
[(int) SYNTAX (FETCH_BYTE (pos
- 1))])
1492 if (pos
<= XINT (lim
))
1494 UPDATE_SYNTAX_TABLE_BACKWARD (pos
- 1);
1504 while (pos
< XINT (lim
) && fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1506 if (!BASE_LEADING_CODE_P (c
))
1507 INC_BOTH (pos
, pos_byte
);
1508 else if (n_char_ranges
)
1510 /* We much check CHAR_RANGES for a multibyte
1512 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1513 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1514 if ((ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1]))
1516 if (!(negate
^ (i
< n_char_ranges
)))
1519 INC_BOTH (pos
, pos_byte
);
1524 INC_BOTH (pos
, pos_byte
);
1528 while (pos
< XINT (lim
) && fastmap
[FETCH_BYTE (pos
)])
1534 while (pos
> XINT (lim
))
1536 int savepos
= pos_byte
;
1537 DEC_BOTH (pos
, pos_byte
);
1538 if (fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1540 if (!BASE_LEADING_CODE_P (c
))
1542 else if (n_char_ranges
)
1544 /* We much check CHAR_RANGES for a multibyte
1546 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1547 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1548 if (ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1])
1550 if (!(negate
^ (i
< n_char_ranges
)))
1573 while (pos
> XINT (lim
) && fastmap
[FETCH_BYTE (pos
- 1)])
1578 #if 0 /* Not needed now that a position in mid-character
1579 cannot be specified in Lisp. */
1581 /* INC_POS or DEC_POS might have moved POS over LIM. */
1582 && (forwardp
? (pos
> XINT (lim
)) : (pos
< XINT (lim
))))
1589 SET_PT_BOTH (pos
, pos_byte
);
1592 return make_number (PT
- start_point
);
1596 DEFUN ("forward-comment", Fforward_comment
, Sforward_comment
, 1, 1, 0,
1597 "Move forward across up to N comments. If N is negative, move backward.\n\
1598 Stop scanning if we find something other than a comment or whitespace.\n\
1599 Set point to where scanning stops.\n\
1600 If N comments are found as expected, with nothing except whitespace\n\
1601 between them, return t; otherwise return nil.")
1609 register enum syntaxcode code
;
1610 int comstyle
= 0; /* style of comment encountered */
1613 int out_charpos
, out_bytepos
;
1615 CHECK_NUMBER (count
, 0);
1616 count1
= XINT (count
);
1617 stop
= count1
> 0 ? ZV
: BEGV
;
1623 from_byte
= PT_BYTE
;
1625 SETUP_SYNTAX_TABLE (from
, count1
);
1634 SET_PT_BOTH (from
, from_byte
);
1638 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1639 c
= FETCH_CHAR (from_byte
);
1641 comstart_first
= SYNTAX_COMSTART_FIRST (c
);
1642 INC_BOTH (from
, from_byte
);
1643 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1645 if (from
< stop
&& comstart_first
1646 && (c1
= FETCH_CHAR (from_byte
),
1647 SYNTAX_COMSTART_SECOND (c1
)))
1649 /* We have encountered a comment start sequence and we
1650 are ignoring all text inside comments. We must record
1651 the comment style this sequence begins so that later,
1652 only a comment end of the same style actually ends
1653 the comment section. */
1655 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1656 INC_BOTH (from
, from_byte
);
1659 while (code
== Swhitespace
|| code
== Sendcomment
);
1661 if (code
!= Scomment
&& code
!= Scomment_fence
)
1664 DEC_BOTH (from
, from_byte
);
1665 SET_PT_BOTH (from
, from_byte
);
1668 /* We're at the start of a comment. */
1674 SET_PT_BOTH (from
, from_byte
);
1677 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1678 c
= FETCH_CHAR (from_byte
);
1679 INC_BOTH (from
, from_byte
);
1680 if (SYNTAX (c
) == Sendcomment
1681 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1682 /* we have encountered a comment end of the same style
1683 as the comment sequence which began this comment
1686 if (SYNTAX (c
) == Scomment_fence
1687 && comstyle
== ST_COMMENT_STYLE
)
1688 /* we have encountered a comment end of the same style
1689 as the comment sequence which began this comment
1692 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
1693 && SYNTAX_COMMENT_STYLE (c
) == comstyle
1694 && (c1
= FETCH_CHAR (from_byte
),
1695 UPDATE_SYNTAX_TABLE_FORWARD (from
),
1696 SYNTAX_COMEND_SECOND (c1
)))
1697 /* we have encountered a comment end of the same style
1698 as the comment sequence which began this comment
1701 INC_BOTH (from
, from_byte
);
1705 /* We have skipped one comment. */
1713 int quoted
, comstart_second
;
1717 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
1722 DEC_BOTH (from
, from_byte
);
1723 /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
1724 quoted
= char_quoted (from
, from_byte
);
1727 DEC_BOTH (from
, from_byte
);
1730 c
= FETCH_CHAR (from_byte
);
1733 if (code
== Sendcomment
)
1734 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1735 comstart_second
= SYNTAX_COMSTART_SECOND (c
);
1736 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1737 && prev_char_comend_first (from
, from_byte
)
1738 && !char_quoted (from
- 1, dec_bytepos (from_byte
)))
1740 /* We must record the comment style encountered so that
1741 later, we can match only the proper comment begin
1742 sequence of the same style. */
1743 DEC_BOTH (from
, from_byte
);
1745 /* Calling char_quoted, above, set up global syntax position
1746 at the new value of FROM. */
1747 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
));
1749 if (from
> stop
&& comstart_second
1750 && prev_char_comstart_first (from
, from_byte
)
1751 && !char_quoted (from
- 1, dec_bytepos (from_byte
)))
1753 /* We must record the comment style encountered so that
1754 later, we can match only the proper comment begin
1755 sequence of the same style. */
1757 DEC_BOTH (from
, from_byte
);
1760 if (code
== Scomment_fence
)
1762 /* Skip until first preceding unquoted comment_fence. */
1763 int found
= 0, ini
= from
, ini_byte
= from_byte
;
1767 DEC_BOTH (from
, from_byte
);
1770 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1771 c
= FETCH_CHAR (from_byte
);
1772 if (SYNTAX (c
) == Scomment_fence
1773 && !char_quoted (from
, from_byte
))
1781 from
= ini
; /* Set point to ini + 1. */
1782 from_byte
= ini_byte
;
1786 else if (code
== Sendcomment
)
1788 found
= back_comment (from
, from_byte
, stop
, comstyle
,
1789 &out_charpos
, &out_bytepos
);
1791 from
= out_charpos
, from_byte
= out_bytepos
;
1792 /* We have skipped one comment. */
1795 else if (code
!= Swhitespace
&& code
!= Scomment
)
1799 INC_BOTH (from
, from_byte
);
1800 SET_PT_BOTH (from
, from_byte
);
1808 SET_PT_BOTH (from
, from_byte
);
1814 scan_lists (from
, count
, depth
, sexpflag
)
1816 int count
, depth
, sexpflag
;
1819 register int stop
= count
> 0 ? ZV
: BEGV
;
1824 register enum syntaxcode code
, temp_code
;
1825 int min_depth
= depth
; /* Err out if depth gets less than this. */
1826 int comstyle
= 0; /* style of comment encountered */
1828 int last_good
= from
;
1831 int out_bytepos
, out_charpos
;
1834 if (depth
> 0) min_depth
= 0;
1836 if (from
> ZV
) from
= ZV
;
1837 if (from
< BEGV
) from
= BEGV
;
1839 from_byte
= CHAR_TO_BYTE (from
);
1844 SETUP_SYNTAX_TABLE (from
, count
);
1849 int comstart_first
, prefix
;
1850 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1851 c
= FETCH_CHAR (from_byte
);
1853 comstart_first
= SYNTAX_COMSTART_FIRST (c
);
1854 prefix
= SYNTAX_PREFIX (c
);
1855 if (depth
== min_depth
)
1857 INC_BOTH (from
, from_byte
);
1858 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1859 if (from
< stop
&& comstart_first
1860 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
))
1861 && parse_sexp_ignore_comments
)
1863 /* we have encountered a comment start sequence and we
1864 are ignoring all text inside comments. We must record
1865 the comment style this sequence begins so that later,
1866 only a comment end of the same style actually ends
1867 the comment section */
1869 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
));
1870 INC_BOTH (from
, from_byte
);
1871 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1877 switch (SWITCH_ENUM_CAST (code
))
1881 if (from
== stop
) goto lose
;
1882 INC_BOTH (from
, from_byte
);
1883 /* treat following character as a word constituent */
1886 if (depth
|| !sexpflag
) break;
1887 /* This word counts as a sexp; return at end of it. */
1890 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1892 /* Some compilers can't handle this inside the switch. */
1893 temp
= SYNTAX (FETCH_CHAR (from_byte
));
1898 INC_BOTH (from
, from_byte
);
1899 if (from
== stop
) goto lose
;
1908 INC_BOTH (from
, from_byte
);
1913 case Scomment_fence
:
1914 if (!parse_sexp_ignore_comments
) break;
1923 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1924 c
= FETCH_CHAR (from_byte
);
1925 INC_BOTH (from
, from_byte
);
1926 if (code
== Scomment
1927 ? (SYNTAX (c
) == Sendcomment
1928 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1929 : (SYNTAX (c
) == Scomment_fence
))
1930 /* we have encountered a comment end of the same style
1931 as the comment sequence which began this comment
1934 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
1935 && SYNTAX_COMMENT_STYLE (c
) == comstyle
1936 && (UPDATE_SYNTAX_TABLE_FORWARD (from
),
1937 SYNTAX_COMEND_SECOND (FETCH_CHAR (from_byte
)))
1938 && code
== Scomment
)
1939 /* we have encountered a comment end of the same style
1940 as the comment sequence which began this comment
1943 INC_BOTH (from
, from_byte
);
1952 if (from
!= stop
&& c
== FETCH_CHAR (from_byte
))
1954 INC_BOTH (from
, from_byte
);
1964 if (!++depth
) goto done
;
1969 if (!--depth
) goto done
;
1970 if (depth
< min_depth
)
1971 Fsignal (Qscan_error
,
1972 Fcons (build_string ("Containing expression ends prematurely"),
1973 Fcons (make_number (last_good
),
1974 Fcons (make_number (from
), Qnil
))));
1979 temp_pos
= dec_bytepos (from_byte
);
1980 stringterm
= FETCH_CHAR (temp_pos
);
1983 if (from
>= stop
) goto lose
;
1984 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1986 ? (FETCH_CHAR (from_byte
) == stringterm
)
1987 : SYNTAX (FETCH_CHAR (from_byte
)) == Sstring_fence
)
1990 /* Some compilers can't handle this inside the switch. */
1991 temp
= SYNTAX (FETCH_CHAR (from_byte
));
1996 INC_BOTH (from
, from_byte
);
1998 INC_BOTH (from
, from_byte
);
2000 INC_BOTH (from
, from_byte
);
2001 if (!depth
&& sexpflag
) goto done
;
2006 /* Reached end of buffer. Error if within object, return nil if between */
2007 if (depth
) goto lose
;
2012 /* End of object reached */
2021 DEC_BOTH (from
, from_byte
);
2022 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2023 c
= FETCH_CHAR (from_byte
);
2025 if (depth
== min_depth
)
2028 if (code
== Sendcomment
)
2029 comstyle
= SYNTAX_COMMENT_STYLE (c
);
2030 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
2031 && prev_char_comend_first (from
, from_byte
)
2032 && parse_sexp_ignore_comments
)
2034 /* We must record the comment style encountered so that
2035 later, we can match only the proper comment begin
2036 sequence of the same style. */
2037 DEC_BOTH (from
, from_byte
);
2038 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2040 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
));
2043 /* Quoting turns anything except a comment-ender
2044 into a word character. Note that this if cannot be true
2045 if we decremented FROM in the if-statement above. */
2046 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
2048 else if (SYNTAX_PREFIX (c
))
2051 switch (SWITCH_ENUM_CAST (code
))
2057 if (depth
|| !sexpflag
) break;
2058 /* This word counts as a sexp; count object finished
2059 after passing it. */
2062 temp_pos
= from_byte
;
2063 if (! NILP (current_buffer
->enable_multibyte_characters
))
2067 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2068 c1
= FETCH_CHAR (temp_pos
);
2069 temp_code
= SYNTAX (c1
);
2070 /* Don't allow comment-end to be quoted. */
2071 if (temp_code
== Sendcomment
)
2073 quoted
= char_quoted (from
- 1, temp_pos
);
2076 DEC_BOTH (from
, from_byte
);
2077 temp_pos
= dec_bytepos (temp_pos
);
2078 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2080 c1
= FETCH_CHAR (temp_pos
);
2081 temp_code
= SYNTAX (c1
);
2082 if (! (quoted
|| temp_code
== Sword
2083 || temp_code
== Ssymbol
2084 || temp_code
== Squote
))
2086 DEC_BOTH (from
, from_byte
);
2093 temp_pos
= dec_bytepos (from_byte
);
2094 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2095 if (from
!= stop
&& c
== FETCH_CHAR (temp_pos
))
2096 DEC_BOTH (from
, from_byte
);
2105 if (!++depth
) goto done2
;
2110 if (!--depth
) goto done2
;
2111 if (depth
< min_depth
)
2112 Fsignal (Qscan_error
,
2113 Fcons (build_string ("Containing expression ends prematurely"),
2114 Fcons (make_number (last_good
),
2115 Fcons (make_number (from
), Qnil
))));
2119 if (!parse_sexp_ignore_comments
)
2121 found
= back_comment (from
, from_byte
, stop
, comstyle
,
2122 &out_charpos
, &out_bytepos
);
2124 from
= out_charpos
, from_byte
= out_bytepos
;
2127 case Scomment_fence
:
2131 DEC_BOTH (from
, from_byte
);
2132 if (from
== stop
) goto lose
;
2133 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2134 if (!char_quoted (from
, from_byte
)
2135 && SYNTAX (FETCH_CHAR (from_byte
)) == code
)
2138 if (code
== Sstring_fence
&& !depth
&& sexpflag
) goto done2
;
2142 stringterm
= FETCH_CHAR (from_byte
);
2145 if (from
== stop
) goto lose
;
2146 temp_pos
= from_byte
;
2147 if (! NILP (current_buffer
->enable_multibyte_characters
))
2151 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2152 if (!char_quoted (from
- 1, temp_pos
)
2153 && stringterm
== FETCH_CHAR (temp_pos
))
2155 DEC_BOTH (from
, from_byte
);
2157 DEC_BOTH (from
, from_byte
);
2158 if (!depth
&& sexpflag
) goto done2
;
2163 /* Reached start of buffer. Error if within object, return nil if between */
2164 if (depth
) goto lose
;
2175 XSETFASTINT (val
, from
);
2179 Fsignal (Qscan_error
,
2180 Fcons (build_string ("Unbalanced parentheses"),
2181 Fcons (make_number (last_good
),
2182 Fcons (make_number (from
), Qnil
))));
2187 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
2188 "Scan from character number FROM by COUNT lists.\n\
2189 Returns the character number of the position thus found.\n\
2191 If DEPTH is nonzero, paren depth begins counting from that value,\n\
2192 only places where the depth in parentheses becomes zero\n\
2193 are candidates for stopping; COUNT such places are counted.\n\
2194 Thus, a positive value for DEPTH means go out levels.\n\
2196 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2198 If the beginning or end of (the accessible part of) the buffer is reached\n\
2199 and the depth is wrong, an error is signaled.\n\
2200 If the depth is right but the count is not used up, nil is returned.")
2201 (from
, count
, depth
)
2202 Lisp_Object from
, count
, depth
;
2204 CHECK_NUMBER (from
, 0);
2205 CHECK_NUMBER (count
, 1);
2206 CHECK_NUMBER (depth
, 2);
2208 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
2211 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
2212 "Scan from character number FROM by COUNT balanced expressions.\n\
2213 If COUNT is negative, scan backwards.\n\
2214 Returns the character number of the position thus found.\n\
2216 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2218 If the beginning or end of (the accessible part of) the buffer is reached\n\
2219 in the middle of a parenthetical grouping, an error is signaled.\n\
2220 If the beginning or end is reached between groupings\n\
2221 but before count is used up, nil is returned.")
2223 Lisp_Object from
, count
;
2225 CHECK_NUMBER (from
, 0);
2226 CHECK_NUMBER (count
, 1);
2228 return scan_lists (XINT (from
), XINT (count
), 0, 1);
2231 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
2233 "Move point backward over any number of chars with prefix syntax.\n\
2234 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
2239 int opoint_byte
= PT_BYTE
;
2241 int pos_byte
= PT_BYTE
;
2246 SET_PT_BOTH (opoint
, opoint_byte
);
2251 SETUP_SYNTAX_TABLE (pos
, -1);
2253 DEC_BOTH (pos
, pos_byte
);
2255 while (!char_quoted (pos
, pos_byte
)
2256 /* Previous statement updates syntax table. */
2257 && ((c
= FETCH_CHAR (pos_byte
), SYNTAX (c
) == Squote
)
2258 || SYNTAX_PREFIX (c
)))
2261 opoint_byte
= pos_byte
;
2264 DEC_BOTH (pos
, pos_byte
);
2267 SET_PT_BOTH (opoint
, opoint_byte
);
2272 /* Parse forward from FROM / FROM_BYTE to END,
2273 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
2274 and return a description of the state of the parse at END.
2275 If STOPBEFORE is nonzero, stop at the start of an atom.
2276 If COMMENTSTOP is 1, stop at the start of a comment.
2277 If COMMENTSTOP is -1, stop at the start or end of a comment,
2278 after the beginning of a string, or after the end of a string. */
2281 scan_sexps_forward (stateptr
, from
, from_byte
, end
, targetdepth
,
2282 stopbefore
, oldstate
, commentstop
)
2283 struct lisp_parse_state
*stateptr
;
2285 int end
, targetdepth
, stopbefore
;
2286 Lisp_Object oldstate
;
2289 struct lisp_parse_state state
;
2291 register enum syntaxcode code
;
2292 struct level
{ int last
, prev
; };
2293 struct level levelstart
[100];
2294 register struct level
*curlevel
= levelstart
;
2295 struct level
*endlevel
= levelstart
+ 100;
2297 register int depth
; /* Paren depth of current scanning location.
2298 level - levelstart equals this except
2299 when the depth becomes negative. */
2300 int mindepth
; /* Lowest DEPTH value seen. */
2301 int start_quoted
= 0; /* Nonzero means starting after a char quote */
2303 int prev_from
; /* Keep one character before FROM. */
2305 int prev_from_syntax
;
2306 int boundary_stop
= commentstop
== -1;
2311 prev_from_byte
= from_byte
;
2313 DEC_BOTH (prev_from
, prev_from_byte
);
2315 /* Use this macro instead of `from++'. */
2317 do { prev_from = from; \
2318 prev_from_byte = from_byte; \
2320 = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); \
2321 INC_BOTH (from, from_byte); \
2322 UPDATE_SYNTAX_TABLE_FORWARD (from); \
2328 if (NILP (oldstate
))
2331 state
.instring
= -1;
2332 state
.incomment
= 0;
2333 state
.comstyle
= 0; /* comment style a by default. */
2334 state
.comstr_start
= -1; /* no comment/string seen. */
2338 tem
= Fcar (oldstate
);
2344 oldstate
= Fcdr (oldstate
);
2345 oldstate
= Fcdr (oldstate
);
2346 oldstate
= Fcdr (oldstate
);
2347 tem
= Fcar (oldstate
);
2348 /* Check whether we are inside string_fence-style string: */
2349 state
.instring
= ( !NILP (tem
)
2350 ? ( INTEGERP (tem
) ? XINT (tem
) : ST_STRING_STYLE
)
2353 oldstate
= Fcdr (oldstate
);
2354 tem
= Fcar (oldstate
);
2355 state
.incomment
= !NILP (tem
);
2357 oldstate
= Fcdr (oldstate
);
2358 tem
= Fcar (oldstate
);
2359 start_quoted
= !NILP (tem
);
2361 /* if the eight element of the list is nil, we are in comment
2362 style a. If it is non-nil, we are in comment style b */
2363 oldstate
= Fcdr (oldstate
);
2364 oldstate
= Fcdr (oldstate
);
2365 tem
= Fcar (oldstate
);
2366 state
.comstyle
= NILP (tem
) ? 0 : ( EQ (tem
, Qsyntax_table
)
2367 ? ST_COMMENT_STYLE
: 1 );
2369 oldstate
= Fcdr (oldstate
);
2370 tem
= Fcar (oldstate
);
2371 state
.comstr_start
= NILP (tem
) ? -1 : XINT (tem
) ;
2372 oldstate
= Fcdr (oldstate
);
2373 tem
= Fcar (oldstate
);
2374 while (!NILP (tem
)) /* >= second enclosing sexps. */
2376 /* curlevel++->last ran into compiler bug on Apollo */
2377 curlevel
->last
= XINT (Fcar (tem
));
2378 if (++curlevel
== endlevel
)
2379 error ("Nesting too deep for parser");
2380 curlevel
->prev
= -1;
2381 curlevel
->last
= -1;
2388 curlevel
->prev
= -1;
2389 curlevel
->last
= -1;
2391 SETUP_SYNTAX_TABLE (prev_from
, 1);
2392 prev_from_syntax
= SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte
));
2393 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2395 /* Enter the loop at a place appropriate for initial state. */
2397 if (state
.incomment
)
2398 goto startincomment
;
2399 if (state
.instring
>= 0)
2401 nofence
= state
.instring
!= ST_STRING_STYLE
;
2403 goto startquotedinstring
;
2406 else if (start_quoted
)
2409 #if 0 /* This seems to be redundant with the identical code above. */
2410 SETUP_SYNTAX_TABLE (prev_from
, 1);
2411 prev_from_syntax
= SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte
));
2412 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2418 code
= prev_from_syntax
& 0xff;
2420 if (code
== Scomment
)
2421 state
.comstr_start
= prev_from
;
2422 else if (code
== Scomment_fence
)
2424 /* Record the comment style we have entered so that only
2425 the comment-end sequence of the same style actually
2426 terminates the comment section. */
2427 state
.comstyle
= ( code
== Scomment_fence
2429 : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)));
2430 state
.comstr_start
= prev_from
;
2431 if (code
!= Scomment_fence
)
2435 else if (from
< end
)
2436 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax
))
2437 if (SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
)))
2438 /* Duplicate code to avoid a complex if-expression
2439 which causes trouble for the SGI compiler. */
2441 /* Record the comment style we have entered so that only
2442 the comment-end sequence of the same style actually
2443 terminates the comment section. */
2444 state
.comstyle
= ( code
== Scomment_fence
2446 : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)));
2447 state
.comstr_start
= prev_from
;
2448 if (code
!= Scomment_fence
)
2453 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax
))
2455 switch (SWITCH_ENUM_CAST (code
))
2459 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2460 curlevel
->last
= prev_from
;
2462 if (from
== end
) goto endquoted
;
2465 /* treat following character as a word constituent */
2468 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2469 curlevel
->last
= prev_from
;
2473 /* Some compilers can't handle this inside the switch. */
2474 temp
= SYNTAX (FETCH_CHAR (from_byte
));
2480 if (from
== end
) goto endquoted
;
2492 curlevel
->prev
= curlevel
->last
;
2496 if (commentstop
== 1)
2500 /* Enter the loop in the middle so that we find
2501 a 2-char comment ender if we start in the middle of it. */
2502 goto startincomment_1
;
2504 /* At beginning of buffer, enter the loop the ordinary way. */
2505 state
.incomment
= 1;
2509 state
.incomment
= 1;
2510 if (commentstop
|| boundary_stop
) goto done
;
2514 if (from
== end
) goto done
;
2515 prev
= FETCH_CHAR (from_byte
);
2516 if (SYNTAX (prev
) == Sendcomment
2517 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
2518 /* Only terminate the comment section if the endcomment
2519 of the same style as the start sequence has been
2522 if (state
.comstyle
== ST_COMMENT_STYLE
2523 && SYNTAX (prev
) == Scomment_fence
)
2527 if (from
< end
&& SYNTAX_FLAGS_COMEND_FIRST (prev_from_syntax
)
2528 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from_byte
))
2529 && (SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax
)
2531 /* Only terminate the comment section if the end-comment
2532 sequence of the same style as the start sequence has
2533 been encountered. */
2537 state
.incomment
= 0;
2538 state
.comstyle
= 0; /* reset the comment style */
2539 if (boundary_stop
) goto done
;
2543 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2545 /* curlevel++->last ran into compiler bug on Apollo */
2546 curlevel
->last
= prev_from
;
2547 if (++curlevel
== endlevel
)
2548 error ("Nesting too deep for parser");
2549 curlevel
->prev
= -1;
2550 curlevel
->last
= -1;
2551 if (targetdepth
== depth
) goto done
;
2556 if (depth
< mindepth
)
2558 if (curlevel
!= levelstart
)
2560 curlevel
->prev
= curlevel
->last
;
2561 if (targetdepth
== depth
) goto done
;
2566 state
.comstr_start
= from
- 1;
2567 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2568 curlevel
->last
= prev_from
;
2569 state
.instring
= (code
== Sstring
2570 ? (FETCH_CHAR (prev_from_byte
))
2572 if (boundary_stop
) goto done
;
2575 nofence
= state
.instring
!= ST_STRING_STYLE
;
2581 if (from
>= end
) goto done
;
2582 c
= FETCH_CHAR (from_byte
);
2583 /* Some compilers can't handle this inside the switch. */
2586 /* Check TEMP here so that if the char has
2587 a syntax-table property which says it is NOT
2588 a string character, it does not end the string. */
2589 if (nofence
&& c
== state
.instring
&& temp
== Sstring
)
2595 if (!nofence
) goto string_end
;
2600 startquotedinstring
:
2601 if (from
>= end
) goto endquoted
;
2607 state
.instring
= -1;
2608 curlevel
->prev
= curlevel
->last
;
2610 if (boundary_stop
) goto done
;
2619 stop
: /* Here if stopping before start of sexp. */
2620 from
= prev_from
; /* We have just fetched the char that starts it; */
2621 goto done
; /* but return the position before it. */
2626 state
.depth
= depth
;
2627 state
.mindepth
= mindepth
;
2628 state
.thislevelstart
= curlevel
->prev
;
2629 state
.prevlevelstart
2630 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
2631 state
.location
= from
;
2632 state
.levelstarts
= Qnil
;
2633 while (--curlevel
>= levelstart
)
2634 state
.levelstarts
= Fcons (make_number (curlevel
->last
),
2641 /* This comment supplies the doc string for parse-partial-sexp,
2642 for make-docfile to see. We cannot put this in the real DEFUN
2643 due to limits in the Unix cpp.
2645 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
2646 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
2647 Parsing stops at TO or when certain criteria are met;\n\
2648 point is set to where parsing stops.\n\
2649 If fifth arg STATE is omitted or nil,\n\
2650 parsing assumes that FROM is the beginning of a function.\n\
2651 Value is a list of ten elements describing final state of parsing:\n\
2652 0. depth in parens.\n\
2653 1. character address of start of innermost containing list; nil if none.\n\
2654 2. character address of start of last complete sexp terminated.\n\
2655 3. non-nil if inside a string.\n\
2656 (it is the character that will terminate the string,\n\
2657 or t if the string should be terminated by a generic string delimiter.)\n\
2658 4. t if inside a comment.\n\
2659 5. t if following a quote character.\n\
2660 6. the minimum paren-depth encountered during this scan.\n\
2661 7. t if in a comment of style b; `syntax-table' if the comment\n\
2662 should be terminated by a generic comment delimiter.\n\
2663 8. character address of start of comment or string; nil if not in one.\n\
2664 9. Intermediate data for continuation of parsing (subject to change).\n\
2665 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
2666 in parentheses becomes equal to TARGETDEPTH.\n\
2667 Fourth arg STOPBEFORE non-nil means stop when come to\n\
2668 any character that starts a sexp.\n\
2669 Fifth arg STATE is a nine-element list like what this function returns.\n\
2670 It is used to initialize the state of the parse. Elements number 1, 2, 6\n\
2671 and 8 are ignored; you can leave off element 8 (the last) entirely.\n\
2672 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.\n\
2673 If it is `syntax-table', stop after the start of a comment or a string,\n\
2674 or after end of a comment or a string.")
2675 (from, to, targetdepth, stopbefore, state, commentstop)
2678 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 6, 0,
2679 0 /* See immediately above */)
2680 (from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
)
2681 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
;
2683 struct lisp_parse_state state
;
2686 if (!NILP (targetdepth
))
2688 CHECK_NUMBER (targetdepth
, 3);
2689 target
= XINT (targetdepth
);
2692 target
= -100000; /* We won't reach this depth */
2694 validate_region (&from
, &to
);
2695 scan_sexps_forward (&state
, XINT (from
), CHAR_TO_BYTE (XINT (from
)),
2697 target
, !NILP (stopbefore
), oldstate
,
2699 ? 0 : (EQ (commentstop
, Qsyntax_table
) ? -1 : 1)));
2701 SET_PT (state
.location
);
2703 return Fcons (make_number (state
.depth
),
2704 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
2705 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
2706 Fcons (state
.instring
>= 0
2707 ? (state
.instring
== ST_STRING_STYLE
2708 ? Qt
: make_number (state
.instring
)) : Qnil
,
2709 Fcons (state
.incomment
? Qt
: Qnil
,
2710 Fcons (state
.quoted
? Qt
: Qnil
,
2711 Fcons (make_number (state
.mindepth
),
2712 Fcons ((state
.comstyle
2713 ? (state
.comstyle
== ST_COMMENT_STYLE
2714 ? Qsyntax_table
: Qt
) :
2716 Fcons (((state
.incomment
2717 || (state
.instring
>= 0))
2718 ? make_number (state
.comstr_start
)
2720 Fcons (state
.levelstarts
, Qnil
))))))))));
2729 /* This has to be done here, before we call Fmake_char_table. */
2730 Qsyntax_table
= intern ("syntax-table");
2731 staticpro (&Qsyntax_table
);
2733 /* Intern this now in case it isn't already done.
2734 Setting this variable twice is harmless.
2735 But don't staticpro it here--that is done in alloc.c. */
2736 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
2738 /* Create objects which can be shared among syntax tables. */
2739 Vsyntax_code_object
= Fmake_vector (make_number (13), Qnil
);
2740 for (i
= 0; i
< XVECTOR (Vsyntax_code_object
)->size
; i
++)
2741 XVECTOR (Vsyntax_code_object
)->contents
[i
]
2742 = Fcons (make_number (i
), Qnil
);
2744 /* Now we are ready to set up this property, so we can
2745 create syntax tables. */
2746 Fput (Qsyntax_table
, Qchar_table_extra_slots
, make_number (0));
2748 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Swhitespace
];
2750 Vstandard_syntax_table
= Fmake_char_table (Qsyntax_table
, temp
);
2752 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Sword
];
2753 for (i
= 'a'; i
<= 'z'; i
++)
2754 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2755 for (i
= 'A'; i
<= 'Z'; i
++)
2756 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2757 for (i
= '0'; i
<= '9'; i
++)
2758 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2760 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '$', temp
);
2761 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '%', temp
);
2763 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '(',
2764 Fcons (make_number (Sopen
), make_number (')')));
2765 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ')',
2766 Fcons (make_number (Sclose
), make_number ('(')));
2767 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '[',
2768 Fcons (make_number (Sopen
), make_number (']')));
2769 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ']',
2770 Fcons (make_number (Sclose
), make_number ('[')));
2771 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '{',
2772 Fcons (make_number (Sopen
), make_number ('}')));
2773 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '}',
2774 Fcons (make_number (Sclose
), make_number ('{')));
2775 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '"',
2776 Fcons (make_number ((int) Sstring
), Qnil
));
2777 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '\\',
2778 Fcons (make_number ((int) Sescape
), Qnil
));
2780 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Ssymbol
];
2781 for (i
= 0; i
< 10; i
++)
2783 c
= "_-+*/&|<>="[i
];
2784 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2787 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Spunct
];
2788 for (i
= 0; i
< 12; i
++)
2790 c
= ".,;:?!#@~^'`"[i
];
2791 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2798 Qsyntax_table_p
= intern ("syntax-table-p");
2799 staticpro (&Qsyntax_table_p
);
2801 staticpro (&Vsyntax_code_object
);
2803 Qscan_error
= intern ("scan-error");
2804 staticpro (&Qscan_error
);
2805 Fput (Qscan_error
, Qerror_conditions
,
2806 Fcons (Qscan_error
, Fcons (Qerror
, Qnil
)));
2807 Fput (Qscan_error
, Qerror_message
,
2808 build_string ("Scan error"));
2810 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
2811 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
2813 DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties
,
2814 "Non-nil means `forward-sexp', etc., grant `syntax-table' property.\n\
2815 The value of this property should be either a syntax table, or a cons\n\
2816 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric\n\
2817 syntax code, MATCHCHAR being nil or the character to match (which is\n\
2818 relevant only for open/close type.");
2820 words_include_escapes
= 0;
2821 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
2822 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
2824 defsubr (&Ssyntax_table_p
);
2825 defsubr (&Ssyntax_table
);
2826 defsubr (&Sstandard_syntax_table
);
2827 defsubr (&Scopy_syntax_table
);
2828 defsubr (&Sset_syntax_table
);
2829 defsubr (&Schar_syntax
);
2830 defsubr (&Smatching_paren
);
2831 defsubr (&Smodify_syntax_entry
);
2832 defsubr (&Sdescribe_syntax
);
2834 defsubr (&Sforward_word
);
2836 defsubr (&Sskip_chars_forward
);
2837 defsubr (&Sskip_chars_backward
);
2838 defsubr (&Sskip_syntax_forward
);
2839 defsubr (&Sskip_syntax_backward
);
2841 defsubr (&Sforward_comment
);
2842 defsubr (&Sscan_lists
);
2843 defsubr (&Sscan_sexps
);
2844 defsubr (&Sbackward_prefix_chars
);
2845 defsubr (&Sparse_partial_sexp
);