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
;
1830 int from_byte
= CHAR_TO_BYTE (from
);
1831 int out_bytepos
, out_charpos
;
1834 if (depth
> 0) min_depth
= 0;
1839 SETUP_SYNTAX_TABLE (from
, count
);
1844 int comstart_first
, prefix
;
1845 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1846 c
= FETCH_CHAR (from_byte
);
1848 comstart_first
= SYNTAX_COMSTART_FIRST (c
);
1849 prefix
= SYNTAX_PREFIX (c
);
1850 if (depth
== min_depth
)
1852 INC_BOTH (from
, from_byte
);
1853 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1854 if (from
< stop
&& comstart_first
1855 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
))
1856 && parse_sexp_ignore_comments
)
1858 /* we have encountered a comment start sequence and we
1859 are ignoring all text inside comments. We must record
1860 the comment style this sequence begins so that later,
1861 only a comment end of the same style actually ends
1862 the comment section */
1864 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
));
1865 INC_BOTH (from
, from_byte
);
1866 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1872 switch (SWITCH_ENUM_CAST (code
))
1876 if (from
== stop
) goto lose
;
1877 INC_BOTH (from
, from_byte
);
1878 /* treat following character as a word constituent */
1881 if (depth
|| !sexpflag
) break;
1882 /* This word counts as a sexp; return at end of it. */
1885 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1887 /* Some compilers can't handle this inside the switch. */
1888 temp
= SYNTAX (FETCH_CHAR (from_byte
));
1893 INC_BOTH (from
, from_byte
);
1894 if (from
== stop
) goto lose
;
1903 INC_BOTH (from
, from_byte
);
1908 case Scomment_fence
:
1909 if (!parse_sexp_ignore_comments
) break;
1918 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1919 c
= FETCH_CHAR (from_byte
);
1920 INC_BOTH (from
, from_byte
);
1921 if (code
== Scomment
1922 ? (SYNTAX (c
) == Sendcomment
1923 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1924 : (SYNTAX (c
) == Scomment_fence
))
1925 /* we have encountered a comment end of the same style
1926 as the comment sequence which began this comment
1929 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
1930 && SYNTAX_COMMENT_STYLE (c
) == comstyle
1931 && (UPDATE_SYNTAX_TABLE_FORWARD (from
),
1932 SYNTAX_COMEND_SECOND (FETCH_CHAR (from_byte
)))
1933 && code
== Scomment
)
1934 /* we have encountered a comment end of the same style
1935 as the comment sequence which began this comment
1938 INC_BOTH (from
, from_byte
);
1947 if (from
!= stop
&& c
== FETCH_CHAR (from_byte
))
1949 INC_BOTH (from
, from_byte
);
1959 if (!++depth
) goto done
;
1964 if (!--depth
) goto done
;
1965 if (depth
< min_depth
)
1966 Fsignal (Qscan_error
,
1967 Fcons (build_string ("Containing expression ends prematurely"),
1968 Fcons (make_number (last_good
),
1969 Fcons (make_number (from
), Qnil
))));
1974 temp_pos
= dec_bytepos (from_byte
);
1975 stringterm
= FETCH_CHAR (temp_pos
);
1978 if (from
>= stop
) goto lose
;
1979 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1981 ? (FETCH_CHAR (from_byte
) == stringterm
)
1982 : SYNTAX (FETCH_CHAR (from_byte
)) == Sstring_fence
)
1985 /* Some compilers can't handle this inside the switch. */
1986 temp
= SYNTAX (FETCH_CHAR (from_byte
));
1991 INC_BOTH (from
, from_byte
);
1993 INC_BOTH (from
, from_byte
);
1995 INC_BOTH (from
, from_byte
);
1996 if (!depth
&& sexpflag
) goto done
;
2001 /* Reached end of buffer. Error if within object, return nil if between */
2002 if (depth
) goto lose
;
2007 /* End of object reached */
2016 DEC_BOTH (from
, from_byte
);
2017 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2018 c
= FETCH_CHAR (from_byte
);
2020 if (depth
== min_depth
)
2023 if (code
== Sendcomment
)
2024 comstyle
= SYNTAX_COMMENT_STYLE (c
);
2025 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
2026 && prev_char_comend_first (from
, from_byte
)
2027 && parse_sexp_ignore_comments
)
2029 /* We must record the comment style encountered so that
2030 later, we can match only the proper comment begin
2031 sequence of the same style. */
2032 DEC_BOTH (from
, from_byte
);
2033 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2035 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
));
2038 /* Quoting turns anything except a comment-ender
2039 into a word character. Note that this if cannot be true
2040 if we decremented FROM in the if-statement above. */
2041 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
2043 else if (SYNTAX_PREFIX (c
))
2046 switch (SWITCH_ENUM_CAST (code
))
2052 if (depth
|| !sexpflag
) break;
2053 /* This word counts as a sexp; count object finished
2054 after passing it. */
2057 temp_pos
= from_byte
;
2058 if (! NILP (current_buffer
->enable_multibyte_characters
))
2062 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2063 c1
= FETCH_CHAR (temp_pos
);
2064 temp_code
= SYNTAX (c1
);
2065 /* Don't allow comment-end to be quoted. */
2066 if (temp_code
== Sendcomment
)
2068 quoted
= char_quoted (from
- 1, temp_pos
);
2071 DEC_BOTH (from
, from_byte
);
2072 temp_pos
= dec_bytepos (temp_pos
);
2073 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2075 c1
= FETCH_CHAR (temp_pos
);
2076 temp_code
= SYNTAX (c1
);
2077 if (! (quoted
|| temp_code
== Sword
2078 || temp_code
== Ssymbol
2079 || temp_code
== Squote
))
2081 DEC_BOTH (from
, from_byte
);
2088 temp_pos
= dec_bytepos (from_byte
);
2089 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2090 if (from
!= stop
&& c
== FETCH_CHAR (temp_pos
))
2091 DEC_BOTH (from
, from_byte
);
2100 if (!++depth
) goto done2
;
2105 if (!--depth
) goto done2
;
2106 if (depth
< min_depth
)
2107 Fsignal (Qscan_error
,
2108 Fcons (build_string ("Containing expression ends prematurely"),
2109 Fcons (make_number (last_good
),
2110 Fcons (make_number (from
), Qnil
))));
2114 if (!parse_sexp_ignore_comments
)
2116 found
= back_comment (from
, from_byte
, stop
, comstyle
,
2117 &out_charpos
, &out_bytepos
);
2119 from
= out_charpos
, from_byte
= out_bytepos
;
2122 case Scomment_fence
:
2126 DEC_BOTH (from
, from_byte
);
2127 if (from
== stop
) goto lose
;
2128 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2129 if (!char_quoted (from
, from_byte
)
2130 && SYNTAX (FETCH_CHAR (from_byte
)) == code
)
2133 if (code
== Sstring_fence
&& !depth
&& sexpflag
) goto done2
;
2137 stringterm
= FETCH_CHAR (from_byte
);
2140 if (from
== stop
) goto lose
;
2141 temp_pos
= from_byte
;
2142 if (! NILP (current_buffer
->enable_multibyte_characters
))
2146 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2147 if (!char_quoted (from
- 1, temp_pos
)
2148 && stringterm
== FETCH_CHAR (temp_pos
))
2150 DEC_BOTH (from
, from_byte
);
2152 DEC_BOTH (from
, from_byte
);
2153 if (!depth
&& sexpflag
) goto done2
;
2158 /* Reached start of buffer. Error if within object, return nil if between */
2159 if (depth
) goto lose
;
2170 XSETFASTINT (val
, from
);
2174 Fsignal (Qscan_error
,
2175 Fcons (build_string ("Unbalanced parentheses"),
2176 Fcons (make_number (last_good
),
2177 Fcons (make_number (from
), Qnil
))));
2182 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
2183 "Scan from character number FROM by COUNT lists.\n\
2184 Returns the character number of the position thus found.\n\
2186 If DEPTH is nonzero, paren depth begins counting from that value,\n\
2187 only places where the depth in parentheses becomes zero\n\
2188 are candidates for stopping; COUNT such places are counted.\n\
2189 Thus, a positive value for DEPTH means go out levels.\n\
2191 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2193 If the beginning or end of (the accessible part of) the buffer is reached\n\
2194 and the depth is wrong, an error is signaled.\n\
2195 If the depth is right but the count is not used up, nil is returned.")
2196 (from
, count
, depth
)
2197 Lisp_Object from
, count
, depth
;
2199 CHECK_NUMBER (from
, 0);
2200 CHECK_NUMBER (count
, 1);
2201 CHECK_NUMBER (depth
, 2);
2203 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
2206 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
2207 "Scan from character number FROM by COUNT balanced expressions.\n\
2208 If COUNT is negative, scan backwards.\n\
2209 Returns the character number of the position thus found.\n\
2211 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2213 If the beginning or end of (the accessible part of) the buffer is reached\n\
2214 in the middle of a parenthetical grouping, an error is signaled.\n\
2215 If the beginning or end is reached between groupings\n\
2216 but before count is used up, nil is returned.")
2218 Lisp_Object from
, count
;
2220 CHECK_NUMBER (from
, 0);
2221 CHECK_NUMBER (count
, 1);
2223 return scan_lists (XINT (from
), XINT (count
), 0, 1);
2226 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
2228 "Move point backward over any number of chars with prefix syntax.\n\
2229 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
2234 int opoint_byte
= PT_BYTE
;
2236 int pos_byte
= PT_BYTE
;
2241 SET_PT_BOTH (opoint
, opoint_byte
);
2246 SETUP_SYNTAX_TABLE (pos
, -1);
2248 DEC_BOTH (pos
, pos_byte
);
2250 while (!char_quoted (pos
, pos_byte
)
2251 /* Previous statement updates syntax table. */
2252 && ((c
= FETCH_CHAR (pos_byte
), SYNTAX (c
) == Squote
)
2253 || SYNTAX_PREFIX (c
)))
2256 opoint_byte
= pos_byte
;
2259 DEC_BOTH (pos
, pos_byte
);
2262 SET_PT_BOTH (opoint
, opoint_byte
);
2267 /* Parse forward from FROM / FROM_BYTE to END,
2268 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
2269 and return a description of the state of the parse at END.
2270 If STOPBEFORE is nonzero, stop at the start of an atom.
2271 If COMMENTSTOP is 1, stop at the start of a comment.
2272 If COMMENTSTOP is -1, stop at the start or end of a comment,
2273 after the beginning of a string, or after the end of a string. */
2276 scan_sexps_forward (stateptr
, from
, from_byte
, end
, targetdepth
,
2277 stopbefore
, oldstate
, commentstop
)
2278 struct lisp_parse_state
*stateptr
;
2280 int end
, targetdepth
, stopbefore
;
2281 Lisp_Object oldstate
;
2284 struct lisp_parse_state state
;
2286 register enum syntaxcode code
;
2287 struct level
{ int last
, prev
; };
2288 struct level levelstart
[100];
2289 register struct level
*curlevel
= levelstart
;
2290 struct level
*endlevel
= levelstart
+ 100;
2292 register int depth
; /* Paren depth of current scanning location.
2293 level - levelstart equals this except
2294 when the depth becomes negative. */
2295 int mindepth
; /* Lowest DEPTH value seen. */
2296 int start_quoted
= 0; /* Nonzero means starting after a char quote */
2298 int prev_from
; /* Keep one character before FROM. */
2300 int prev_from_syntax
;
2301 int boundary_stop
= commentstop
== -1;
2306 prev_from_byte
= from_byte
;
2308 DEC_BOTH (prev_from
, prev_from_byte
);
2310 /* Use this macro instead of `from++'. */
2312 do { prev_from = from; \
2313 prev_from_byte = from_byte; \
2315 = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); \
2316 INC_BOTH (from, from_byte); \
2317 UPDATE_SYNTAX_TABLE_FORWARD (from); \
2323 if (NILP (oldstate
))
2326 state
.instring
= -1;
2327 state
.incomment
= 0;
2328 state
.comstyle
= 0; /* comment style a by default. */
2329 state
.comstr_start
= -1; /* no comment/string seen. */
2333 tem
= Fcar (oldstate
);
2339 oldstate
= Fcdr (oldstate
);
2340 oldstate
= Fcdr (oldstate
);
2341 oldstate
= Fcdr (oldstate
);
2342 tem
= Fcar (oldstate
);
2343 /* Check whether we are inside string_fence-style string: */
2344 state
.instring
= ( !NILP (tem
)
2345 ? ( INTEGERP (tem
) ? XINT (tem
) : ST_STRING_STYLE
)
2348 oldstate
= Fcdr (oldstate
);
2349 tem
= Fcar (oldstate
);
2350 state
.incomment
= !NILP (tem
);
2352 oldstate
= Fcdr (oldstate
);
2353 tem
= Fcar (oldstate
);
2354 start_quoted
= !NILP (tem
);
2356 /* if the eight element of the list is nil, we are in comment
2357 style a. If it is non-nil, we are in comment style b */
2358 oldstate
= Fcdr (oldstate
);
2359 oldstate
= Fcdr (oldstate
);
2360 tem
= Fcar (oldstate
);
2361 state
.comstyle
= NILP (tem
) ? 0 : ( EQ (tem
, Qsyntax_table
)
2362 ? ST_COMMENT_STYLE
: 1 );
2364 oldstate
= Fcdr (oldstate
);
2365 tem
= Fcar (oldstate
);
2366 state
.comstr_start
= NILP (tem
) ? -1 : XINT (tem
) ;
2367 oldstate
= Fcdr (oldstate
);
2368 tem
= Fcar (oldstate
);
2369 while (!NILP (tem
)) /* >= second enclosing sexps. */
2371 /* curlevel++->last ran into compiler bug on Apollo */
2372 curlevel
->last
= XINT (Fcar (tem
));
2373 if (++curlevel
== endlevel
)
2374 error ("Nesting too deep for parser");
2375 curlevel
->prev
= -1;
2376 curlevel
->last
= -1;
2383 curlevel
->prev
= -1;
2384 curlevel
->last
= -1;
2386 /* Enter the loop at a place appropriate for initial state. */
2388 if (state
.incomment
) goto startincomment
;
2389 if (state
.instring
>= 0)
2391 nofence
= state
.instring
!= ST_STRING_STYLE
;
2392 if (start_quoted
) goto startquotedinstring
;
2395 if (start_quoted
) goto startquoted
;
2398 SETUP_SYNTAX_TABLE (prev_from
, 1);
2399 prev_from_syntax
= SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte
));
2400 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2405 code
= prev_from_syntax
& 0xff;
2407 if (code
== Scomment
)
2408 state
.comstr_start
= prev_from
;
2409 else if (code
== Scomment_fence
)
2411 /* Record the comment style we have entered so that only
2412 the comment-end sequence of the same style actually
2413 terminates the comment section. */
2414 state
.comstyle
= ( code
== Scomment_fence
2416 : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)));
2417 state
.comstr_start
= prev_from
;
2418 if (code
!= Scomment_fence
)
2422 else if (from
< end
)
2423 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax
))
2424 if (SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
)))
2425 /* Duplicate code to avoid a complex if-expression
2426 which causes trouble for the SGI compiler. */
2428 /* Record the comment style we have entered so that only
2429 the comment-end sequence of the same style actually
2430 terminates the comment section. */
2431 state
.comstyle
= ( code
== Scomment_fence
2433 : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)));
2434 state
.comstr_start
= prev_from
;
2435 if (code
!= Scomment_fence
)
2440 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax
))
2442 switch (SWITCH_ENUM_CAST (code
))
2446 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2447 curlevel
->last
= prev_from
;
2449 if (from
== end
) goto endquoted
;
2452 /* treat following character as a word constituent */
2455 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2456 curlevel
->last
= prev_from
;
2460 /* Some compilers can't handle this inside the switch. */
2461 temp
= SYNTAX (FETCH_CHAR (from_byte
));
2467 if (from
== end
) goto endquoted
;
2479 curlevel
->prev
= curlevel
->last
;
2483 if (commentstop
== 1)
2487 /* Enter the loop in the middle so that we find
2488 a 2-char comment ender if we start in the middle of it. */
2489 goto startincomment_1
;
2491 /* At beginning of buffer, enter the loop the ordinary way. */
2492 state
.incomment
= 1;
2496 state
.incomment
= 1;
2497 if (commentstop
|| boundary_stop
) goto done
;
2501 if (from
== end
) goto done
;
2502 prev
= FETCH_CHAR (from_byte
);
2503 if (SYNTAX (prev
) == Sendcomment
2504 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
2505 /* Only terminate the comment section if the endcomment
2506 of the same style as the start sequence has been
2509 if (state
.comstyle
== ST_COMMENT_STYLE
2510 && SYNTAX (prev
) == Scomment_fence
)
2514 if (from
< end
&& SYNTAX_FLAGS_COMEND_FIRST (prev_from_syntax
)
2515 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from_byte
))
2516 && (SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax
)
2518 /* Only terminate the comment section if the end-comment
2519 sequence of the same style as the start sequence has
2520 been encountered. */
2524 state
.incomment
= 0;
2525 state
.comstyle
= 0; /* reset the comment style */
2526 if (boundary_stop
) goto done
;
2530 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2532 /* curlevel++->last ran into compiler bug on Apollo */
2533 curlevel
->last
= prev_from
;
2534 if (++curlevel
== endlevel
)
2535 error ("Nesting too deep for parser");
2536 curlevel
->prev
= -1;
2537 curlevel
->last
= -1;
2538 if (targetdepth
== depth
) goto done
;
2543 if (depth
< mindepth
)
2545 if (curlevel
!= levelstart
)
2547 curlevel
->prev
= curlevel
->last
;
2548 if (targetdepth
== depth
) goto done
;
2553 state
.comstr_start
= from
- 1;
2554 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2555 curlevel
->last
= prev_from
;
2556 state
.instring
= (code
== Sstring
2557 ? (FETCH_CHAR (prev_from_byte
))
2559 if (boundary_stop
) goto done
;
2562 nofence
= state
.instring
!= ST_STRING_STYLE
;
2568 if (from
>= end
) goto done
;
2569 c
= FETCH_CHAR (from_byte
);
2570 if (nofence
&& c
== state
.instring
) break;
2572 /* Some compilers can't handle this inside the switch. */
2577 if (!nofence
) goto string_end
;
2582 startquotedinstring
:
2583 if (from
>= end
) goto endquoted
;
2589 state
.instring
= -1;
2590 curlevel
->prev
= curlevel
->last
;
2592 if (boundary_stop
) goto done
;
2601 stop
: /* Here if stopping before start of sexp. */
2602 from
= prev_from
; /* We have just fetched the char that starts it; */
2603 goto done
; /* but return the position before it. */
2608 state
.depth
= depth
;
2609 state
.mindepth
= mindepth
;
2610 state
.thislevelstart
= curlevel
->prev
;
2611 state
.prevlevelstart
2612 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
2613 state
.location
= from
;
2614 state
.levelstarts
= Qnil
;
2615 while (--curlevel
>= levelstart
)
2616 state
.levelstarts
= Fcons (make_number (curlevel
->last
),
2623 /* This comment supplies the doc string for parse-partial-sexp,
2624 for make-docfile to see. We cannot put this in the real DEFUN
2625 due to limits in the Unix cpp.
2627 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
2628 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
2629 Parsing stops at TO or when certain criteria are met;\n\
2630 point is set to where parsing stops.\n\
2631 If fifth arg STATE is omitted or nil,\n\
2632 parsing assumes that FROM is the beginning of a function.\n\
2633 Value is a list of ten elements describing final state of parsing:\n\
2634 0. depth in parens.\n\
2635 1. character address of start of innermost containing list; nil if none.\n\
2636 2. character address of start of last complete sexp terminated.\n\
2637 3. non-nil if inside a string.\n\
2638 (it is the character that will terminate the string,\n\
2639 or t if the string should be terminated by a generic string delimiter.)\n\
2640 4. t if inside a comment.\n\
2641 5. t if following a quote character.\n\
2642 6. the minimum paren-depth encountered during this scan.\n\
2643 7. t if in a comment of style b; `syntax-table' if the comment\n\
2644 should be terminated by a generic comment delimiter.\n\
2645 8. character address of start of comment or string; nil if not in one.\n\
2646 9. Intermediate data for continuation of parsing (subject to change).\n\
2647 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
2648 in parentheses becomes equal to TARGETDEPTH.\n\
2649 Fourth arg STOPBEFORE non-nil means stop when come to\n\
2650 any character that starts a sexp.\n\
2651 Fifth arg STATE is a nine-element list like what this function returns.\n\
2652 It is used to initialize the state of the parse. Elements number 1, 2, 6\n\
2653 and 8 are ignored; you can leave off element 8 (the last) entirely.\n\
2654 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.\n\
2655 If it is `syntax-table', stop after the start of a comment or a string,\n\
2656 or after end of a comment or a string.")
2657 (from, to, targetdepth, stopbefore, state, commentstop)
2660 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 6, 0,
2661 0 /* See immediately above */)
2662 (from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
)
2663 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
;
2665 struct lisp_parse_state state
;
2668 if (!NILP (targetdepth
))
2670 CHECK_NUMBER (targetdepth
, 3);
2671 target
= XINT (targetdepth
);
2674 target
= -100000; /* We won't reach this depth */
2676 validate_region (&from
, &to
);
2677 scan_sexps_forward (&state
, XINT (from
), CHAR_TO_BYTE (XINT (from
)),
2679 target
, !NILP (stopbefore
), oldstate
,
2681 ? 0 : (EQ (commentstop
, Qsyntax_table
) ? -1 : 1)));
2683 SET_PT (state
.location
);
2685 return Fcons (make_number (state
.depth
),
2686 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
2687 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
2688 Fcons (state
.instring
>= 0
2689 ? (state
.instring
== ST_STRING_STYLE
2690 ? Qt
: make_number (state
.instring
)) : Qnil
,
2691 Fcons (state
.incomment
? Qt
: Qnil
,
2692 Fcons (state
.quoted
? Qt
: Qnil
,
2693 Fcons (make_number (state
.mindepth
),
2694 Fcons ((state
.comstyle
2695 ? (state
.comstyle
== ST_COMMENT_STYLE
2696 ? Qsyntax_table
: Qt
) :
2698 Fcons ((state
.incomment
|| state
.instring
2699 ? make_number (state
.comstr_start
)
2701 Fcons (state
.levelstarts
, Qnil
))))))))));
2710 /* This has to be done here, before we call Fmake_char_table. */
2711 Qsyntax_table
= intern ("syntax-table");
2712 staticpro (&Qsyntax_table
);
2714 /* Intern this now in case it isn't already done.
2715 Setting this variable twice is harmless.
2716 But don't staticpro it here--that is done in alloc.c. */
2717 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
2719 /* Create objects which can be shared among syntax tables. */
2720 Vsyntax_code_object
= Fmake_vector (make_number (13), Qnil
);
2721 for (i
= 0; i
< XVECTOR (Vsyntax_code_object
)->size
; i
++)
2722 XVECTOR (Vsyntax_code_object
)->contents
[i
]
2723 = Fcons (make_number (i
), Qnil
);
2725 /* Now we are ready to set up this property, so we can
2726 create syntax tables. */
2727 Fput (Qsyntax_table
, Qchar_table_extra_slots
, make_number (0));
2729 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Swhitespace
];
2731 Vstandard_syntax_table
= Fmake_char_table (Qsyntax_table
, temp
);
2733 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Sword
];
2734 for (i
= 'a'; i
<= 'z'; i
++)
2735 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2736 for (i
= 'A'; i
<= 'Z'; i
++)
2737 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2738 for (i
= '0'; i
<= '9'; i
++)
2739 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2741 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '$', temp
);
2742 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '%', temp
);
2744 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '(',
2745 Fcons (make_number (Sopen
), make_number (')')));
2746 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ')',
2747 Fcons (make_number (Sclose
), make_number ('(')));
2748 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '[',
2749 Fcons (make_number (Sopen
), make_number (']')));
2750 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ']',
2751 Fcons (make_number (Sclose
), make_number ('[')));
2752 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '{',
2753 Fcons (make_number (Sopen
), make_number ('}')));
2754 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '}',
2755 Fcons (make_number (Sclose
), make_number ('{')));
2756 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '"',
2757 Fcons (make_number ((int) Sstring
), Qnil
));
2758 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '\\',
2759 Fcons (make_number ((int) Sescape
), Qnil
));
2761 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Ssymbol
];
2762 for (i
= 0; i
< 10; i
++)
2764 c
= "_-+*/&|<>="[i
];
2765 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2768 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Spunct
];
2769 for (i
= 0; i
< 12; i
++)
2771 c
= ".,;:?!#@~^'`"[i
];
2772 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2779 Qsyntax_table_p
= intern ("syntax-table-p");
2780 staticpro (&Qsyntax_table_p
);
2782 staticpro (&Vsyntax_code_object
);
2784 Qscan_error
= intern ("scan-error");
2785 staticpro (&Qscan_error
);
2786 Fput (Qscan_error
, Qerror_conditions
,
2787 Fcons (Qerror
, Qnil
));
2788 Fput (Qscan_error
, Qerror_message
,
2789 build_string ("Scan error"));
2791 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
2792 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
2794 DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties
,
2795 "Non-nil means `forward-sexp', etc., grant `syntax-table' property.\n\
2796 The value of this property should be either a syntax table, or a cons\n\
2797 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric\n\
2798 syntax code, MATCHCHAR being nil or the character to match (which is\n\
2799 relevant only for open/close type.");
2801 words_include_escapes
= 0;
2802 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
2803 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
2805 defsubr (&Ssyntax_table_p
);
2806 defsubr (&Ssyntax_table
);
2807 defsubr (&Sstandard_syntax_table
);
2808 defsubr (&Scopy_syntax_table
);
2809 defsubr (&Sset_syntax_table
);
2810 defsubr (&Schar_syntax
);
2811 defsubr (&Smatching_paren
);
2812 defsubr (&Smodify_syntax_entry
);
2813 defsubr (&Sdescribe_syntax
);
2815 defsubr (&Sforward_word
);
2817 defsubr (&Sskip_chars_forward
);
2818 defsubr (&Sskip_chars_backward
);
2819 defsubr (&Sskip_syntax_forward
);
2820 defsubr (&Sskip_syntax_backward
);
2822 defsubr (&Sforward_comment
);
2823 defsubr (&Sscan_lists
);
2824 defsubr (&Sscan_sexps
);
2825 defsubr (&Sbackward_prefix_chars
);
2826 defsubr (&Sparse_partial_sexp
);