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. */
69 /* These variables are a cache for finding the start of a defun.
70 find_start_pos is the place for which the defun start was found.
71 find_start_value is the defun start position found for it.
72 find_start_value_byte is the corresponding byte position.
73 find_start_buffer is the buffer it was found in.
74 find_start_begv is the BEGV value when it was found.
75 find_start_modiff is the value of MODIFF when it was found. */
77 static int find_start_pos
;
78 static int find_start_value
;
79 static int find_start_value_byte
;
80 static struct buffer
*find_start_buffer
;
81 static int find_start_begv
;
82 static int find_start_modiff
;
85 static int find_defun_start
P_ ((int, int));
86 static int back_comment
P_ ((int, int, int, int, int *, int *));
87 static int char_quoted
P_ ((int, int));
88 static Lisp_Object skip_chars
P_ ((int, int, Lisp_Object
, Lisp_Object
));
89 static Lisp_Object scan_lists
P_ ((int, int, int, int));
90 static void scan_sexps_forward
P_ ((struct lisp_parse_state
*,
92 int, Lisp_Object
, int));
95 struct gl_state_s gl_state
; /* Global state of syntax parser. */
97 INTERVAL
interval_of ();
98 #define INTERVALS_AT_ONCE 10 /* 1 + max-number of intervals
99 to scan to property-change. */
101 /* Update gl_state to an appropriate interval which contains CHARPOS. The
102 sign of COUNT give the relative position of CHARPOS wrt the previously
103 valid interval. If INIT, only [be]_property fields of gl_state are
104 valid at start, the rest is filled basing on OBJECT.
106 `gl_state.*_i' are the intervals, and CHARPOS is further in the search
107 direction than the intervals - or in an interval. We update the
108 current syntax-table basing on the property of this interval, and
109 update the interval to start further than CHARPOS - or be
110 NULL_INTERVAL. We also update lim_property to be the next value of
111 charpos to call this subroutine again - or be before/after the
112 start/end of OBJECT. */
115 update_syntax_table (charpos
, count
, init
, object
)
116 int charpos
, count
, init
;
119 Lisp_Object tmp_table
;
120 int cnt
= 0, doing_extra
= 0, invalidate
= 1;
125 gl_state
.start
= gl_state
.b_property
;
126 gl_state
.stop
= gl_state
.e_property
;
127 gl_state
.forward_i
= interval_of (charpos
, object
);
128 i
= gl_state
.backward_i
= gl_state
.forward_i
;
129 gl_state
.left_ok
= gl_state
.right_ok
= 1;
131 if (NULL_INTERVAL_P (i
))
133 /* interval_of () updates only ->position of the return value,
134 update the parents manually to speed up update_interval. */
135 while (!NULL_PARENT (i
))
137 if (AM_RIGHT_CHILD (i
))
138 i
->parent
->position
= i
->position
139 - LEFT_TOTAL_LENGTH (i
) + TOTAL_LENGTH (i
) /* right end */
140 - TOTAL_LENGTH (i
->parent
)
141 + LEFT_TOTAL_LENGTH (i
->parent
);
143 i
->parent
->position
= i
->position
- LEFT_TOTAL_LENGTH (i
)
147 i
= gl_state
.forward_i
;
148 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
149 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
152 oldi
= i
= count
> 0 ? gl_state
.forward_i
: gl_state
.backward_i
;
154 /* We are guarantied to be called with CHARPOS either in i,
156 if (NULL_INTERVAL_P (i
))
157 error ("Error in syntax_table logic for to-the-end intervals");
158 else if (charpos
< i
->position
) /* Move left. */
161 error ("Error in syntax_table logic for intervals <-.");
162 /* Update the interval. */
163 i
= update_interval (i
, charpos
);
164 if (oldi
->position
!= INTERVAL_LAST_POS (i
))
167 gl_state
.right_ok
= 1; /* Invalidate the other end. */
168 gl_state
.forward_i
= i
;
169 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
172 else if (charpos
>= INTERVAL_LAST_POS (i
)) /* Move right. */
175 error ("Error in syntax_table logic for intervals ->.");
176 /* Update the interval. */
177 i
= update_interval (i
, charpos
);
178 if (i
->position
!= INTERVAL_LAST_POS (oldi
))
181 gl_state
.left_ok
= 1; /* Invalidate the other end. */
182 gl_state
.backward_i
= i
;
183 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
186 else if (count
> 0 ? gl_state
.right_ok
: gl_state
.left_ok
)
188 /* We do not need to recalculate tmp_table. */
189 tmp_table
= gl_state
.old_prop
;
193 tmp_table
= textget (i
->plist
, Qsyntax_table
);
196 invalidate
= !EQ (tmp_table
, gl_state
.old_prop
); /* Need to invalidate? */
198 if (invalidate
) /* Did not get to adjacent interval. */
199 { /* with the same table => */
200 /* invalidate the old range. */
203 gl_state
.backward_i
= i
;
204 gl_state
.left_ok
= 1; /* Invalidate the other end. */
205 gl_state
.b_property
= i
->position
- 1 - gl_state
.offset
;
209 gl_state
.forward_i
= i
;
210 gl_state
.right_ok
= 1; /* Invalidate the other end. */
211 gl_state
.e_property
= INTERVAL_LAST_POS (i
) - gl_state
.offset
;
215 gl_state
.current_syntax_table
= tmp_table
;
216 gl_state
.old_prop
= tmp_table
;
217 if (EQ (Fsyntax_table_p (tmp_table
), Qt
))
219 gl_state
.use_global
= 0;
221 else if (CONSP (tmp_table
))
223 gl_state
.use_global
= 1;
224 gl_state
.global_code
= tmp_table
;
228 gl_state
.use_global
= 0;
229 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
232 while (!NULL_INTERVAL_P (i
))
234 if (cnt
&& !EQ (tmp_table
, textget (i
->plist
, Qsyntax_table
)))
237 gl_state
.right_ok
= 0;
239 gl_state
.left_ok
= 0;
242 else if (cnt
== INTERVALS_AT_ONCE
)
245 gl_state
.right_ok
= 1;
247 gl_state
.left_ok
= 1;
251 i
= count
> 0 ? next_interval (i
) : previous_interval (i
);
253 if (NULL_INTERVAL_P (i
))
254 { /* This property goes to the end. */
256 gl_state
.e_property
= gl_state
.stop
;
258 gl_state
.b_property
= gl_state
.start
;
264 gl_state
.e_property
= i
->position
- gl_state
.offset
;
265 gl_state
.forward_i
= i
;
269 gl_state
.b_property
= i
->position
+ LENGTH (i
) - 1 - gl_state
.offset
;
270 gl_state
.backward_i
= i
;
275 /* Returns TRUE if char at CHARPOS is quoted.
276 Global syntax-table data should be set up already to be good at CHARPOS
277 or after. On return global syntax data is good for lookup at CHARPOS. */
280 char_quoted (charpos
, bytepos
)
281 register int charpos
, bytepos
;
283 register enum syntaxcode code
;
284 register int beg
= BEGV
;
285 register int quoted
= 0;
288 DEC_BOTH (charpos
, bytepos
);
290 while (bytepos
>= beg
)
292 UPDATE_SYNTAX_TABLE_BACKWARD (charpos
);
293 code
= SYNTAX (FETCH_CHAR (bytepos
));
294 if (! (code
== Scharquote
|| code
== Sescape
))
297 DEC_BOTH (charpos
, bytepos
);
301 UPDATE_SYNTAX_TABLE (orig
);
305 /* Return the bytepos one character after BYTEPOS.
306 We assume that BYTEPOS is not at the end of the buffer. */
309 inc_bytepos (bytepos
)
312 if (NILP (current_buffer
->enable_multibyte_characters
))
319 /* Return the bytepos one character before BYTEPOS.
320 We assume that BYTEPOS is not at the start of the buffer. */
323 dec_bytepos (bytepos
)
326 if (NILP (current_buffer
->enable_multibyte_characters
))
333 /* Find a defun-start that is the last one before POS (or nearly the last).
334 We record what we find, so that another call in the same area
335 can return the same value right away.
337 There is no promise at which position the global syntax data is
338 valid on return from the subroutine, so the caller should explicitly
339 update the global data. */
342 find_defun_start (pos
, pos_byte
)
347 int opoint
= PT
, opoint_byte
= PT_BYTE
;
349 /* Use previous finding, if it's valid and applies to this inquiry. */
350 if (current_buffer
== find_start_buffer
351 /* Reuse the defun-start even if POS is a little farther on.
352 POS might be in the next defun, but that's ok.
353 Our value may not be the best possible, but will still be usable. */
354 && pos
<= find_start_pos
+ 1000
355 && pos
>= find_start_value
356 && BEGV
== find_start_begv
357 && MODIFF
== find_start_modiff
)
358 return find_start_value
;
360 /* Back up to start of line. */
361 scan_newline (pos
, pos_byte
, BEGV
, BEGV_BYTE
, -1, 1);
363 /* We optimize syntax-table lookup for rare updates. Thus we accept
364 only those `^\s(' which are good in global _and_ text-property
366 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
367 gl_state
.use_global
= 0;
370 /* Open-paren at start of line means we found our defun-start. */
371 if (SYNTAX (FETCH_CHAR (PT_BYTE
)) == Sopen
)
373 SETUP_SYNTAX_TABLE (PT
+ 1, -1); /* Try again... */
374 if (SYNTAX (FETCH_CHAR (PT_BYTE
)) == Sopen
)
376 /* Now fallback to the default value. */
377 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
378 gl_state
.use_global
= 0;
380 /* Move to beg of previous line. */
381 scan_newline (PT
, PT_BYTE
, BEGV
, BEGV_BYTE
, -2, 1);
384 /* Record what we found, for the next try. */
385 find_start_value
= PT
;
386 find_start_value_byte
= PT_BYTE
;
387 find_start_buffer
= current_buffer
;
388 find_start_modiff
= MODIFF
;
389 find_start_begv
= BEGV
;
390 find_start_pos
= pos
;
392 TEMP_SET_PT_BOTH (opoint
, opoint_byte
);
394 return find_start_value
;
397 /* Checks whether charpos FROM is at the end of a comment.
398 FROM_BYTE is the bytepos corresponding to FROM.
399 Do not move back before STOP.
401 Return a positive value if we find a comment ending at FROM/FROM_BYTE;
404 If successful, store the charpos of the comment's beginning
405 into *CHARPOS_PTR, and the bytepos into *BYTEPOS_PTR.
407 Global syntax data remains valid for backward search starting at
408 the returned value (or at FROM, if the search was not successful). */
411 back_comment (from
, from_byte
, stop
, comstyle
, charpos_ptr
, bytepos_ptr
)
412 int from
, from_byte
, stop
;
414 int *charpos_ptr
, *bytepos_ptr
;
416 /* Look back, counting the parity of string-quotes,
417 and recording the comment-starters seen.
418 When we reach a safe place, assume that's not in a string;
419 then step the main scan to the earliest comment-starter seen
420 an even number of string quotes away from the safe place.
422 OFROM[I] is position of the earliest comment-starter seen
423 which is I+2X quotes from the comment-end.
424 PARITY is current parity of quotes from the comment end. */
426 int my_stringend
= 0;
427 int string_lossage
= 0;
428 int comment_end
= from
;
429 int comment_end_byte
= from_byte
;
430 int comstart_pos
= 0;
432 /* Value that PARITY had, when we reached the position
434 int comstart_parity
= 0;
435 int scanstart
= from
- 1;
436 /* Place where the containing defun starts,
437 or 0 if we didn't come across it yet. */
439 int defun_start_byte
= 0;
440 register enum syntaxcode code
;
443 /* At beginning of range to scan, we're outside of strings;
444 that determines quote parity to the comment-end. */
449 /* Move back and examine a character. */
450 DEC_BOTH (from
, from_byte
);
451 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
453 c
= FETCH_CHAR (from_byte
);
456 /* If this char is the second of a 2-char comment end sequence,
457 back up and give the pair the appropriate syntax. */
458 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
459 && (temp_byte
= dec_bytepos (from_byte
),
460 SYNTAX_COMEND_FIRST (FETCH_CHAR (temp_byte
))))
463 DEC_BOTH (from
, from_byte
);
464 /* This is apparently the best we can do: */
465 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
466 c
= FETCH_CHAR (from_byte
);
469 /* If this char starts a 2-char comment start sequence,
470 treat it like a 1-char comment starter. */
471 if (from
< scanstart
&& SYNTAX_COMSTART_FIRST (c
)
472 && (temp_byte
= inc_bytepos (from_byte
),
473 (SYNTAX_COMSTART_SECOND (FETCH_CHAR (temp_byte
))
474 && comstyle
== SYNTAX_COMMENT_STYLE (FETCH_CHAR (temp_byte
)))))
477 /* Ignore escaped characters, except comment-enders. */
478 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
481 /* Track parity of quotes. */
485 if (my_stringend
== 0)
487 /* If we have two kinds of string delimiters.
488 There's no way to grok this scanning backwards. */
489 else if (my_stringend
!= c
)
493 if (code
== Sstring_fence
|| code
== Scomment_fence
)
496 if (my_stringend
== 0)
498 = code
== Sstring_fence
? ST_STRING_STYLE
: ST_COMMENT_STYLE
;
499 /* If we have two kinds of string delimiters.
500 There's no way to grok this scanning backwards. */
501 else if (my_stringend
!= (code
== Sstring_fence
502 ? ST_STRING_STYLE
: ST_COMMENT_STYLE
))
506 /* Record comment-starters according to that
507 quote-parity to the comment-end. */
508 if (code
== Scomment
)
510 comstart_parity
= parity
;
512 comstart_byte
= from_byte
;
515 /* If we find another earlier comment-ender,
516 any comment-starts earlier than that don't count
517 (because they go with the earlier comment-ender). */
518 if (code
== Sendcomment
519 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)) == comstyle
)
522 /* Assume a defun-start point is outside of strings. */
525 || (temp_byte
= dec_bytepos (from_byte
),
526 FETCH_CHAR (temp_byte
) == '\n')))
529 defun_start_byte
= from_byte
;
534 if (comstart_pos
== 0)
537 from_byte
= comment_end_byte
;
538 UPDATE_SYNTAX_TABLE_FORWARD (comment_end
- 1);
540 /* If the earliest comment starter
541 is followed by uniform paired string quotes or none,
542 we know it can't be inside a string
543 since if it were then the comment ender would be inside one.
544 So it does start a comment. Skip back to it. */
545 else if (comstart_parity
== 0 && !string_lossage
)
548 from_byte
= comstart_byte
;
549 /* Globals are correct now. */
553 /* We had two kinds of string delimiters mixed up
554 together. Decode this going forwards.
555 Scan fwd from the previous comment ender
556 to the one in question; this records where we
557 last passed a comment starter. */
558 struct lisp_parse_state state
;
559 /* If we did not already find the defun start, find it now. */
560 if (defun_start
== 0)
562 defun_start
= find_defun_start (comment_end
, comment_end_byte
);
563 defun_start_byte
= find_start_value_byte
;
565 scan_sexps_forward (&state
,
566 defun_start
, defun_start_byte
,
567 comment_end
- 1, -10000, 0, Qnil
, 0);
570 /* scan_sexps_forward changed the direction of search in
571 global variables, so we need to update it completely. */
573 from
= state
.comstr_start
;
579 from_byte
= CHAR_TO_BYTE (from
);
580 UPDATE_SYNTAX_TABLE_FORWARD (from
- 1);
584 *bytepos_ptr
= from_byte
;
589 DEFUN ("syntax-table-p", Fsyntax_table_p
, Ssyntax_table_p
, 1, 1, 0,
590 "Return t if OBJECT is a syntax table.\n\
591 Currently, any char-table counts as a syntax table.")
595 if (CHAR_TABLE_P (object
)
596 && EQ (XCHAR_TABLE (object
)->purpose
, Qsyntax_table
))
602 check_syntax_table (obj
)
605 if (!(CHAR_TABLE_P (obj
)
606 && EQ (XCHAR_TABLE (obj
)->purpose
, Qsyntax_table
)))
607 wrong_type_argument (Qsyntax_table_p
, obj
);
610 DEFUN ("syntax-table", Fsyntax_table
, Ssyntax_table
, 0, 0, 0,
611 "Return the current syntax table.\n\
612 This is the one specified by the current buffer.")
615 return current_buffer
->syntax_table
;
618 DEFUN ("standard-syntax-table", Fstandard_syntax_table
,
619 Sstandard_syntax_table
, 0, 0, 0,
620 "Return the standard syntax table.\n\
621 This is the one used for new buffers.")
624 return Vstandard_syntax_table
;
627 DEFUN ("copy-syntax-table", Fcopy_syntax_table
, Scopy_syntax_table
, 0, 1, 0,
628 "Construct a new syntax table and return it.\n\
629 It is a copy of the TABLE, which defaults to the standard syntax table.")
636 check_syntax_table (table
);
638 table
= Vstandard_syntax_table
;
640 copy
= Fcopy_sequence (table
);
642 /* Only the standard syntax table should have a default element.
643 Other syntax tables should inherit from parents instead. */
644 XCHAR_TABLE (copy
)->defalt
= Qnil
;
646 /* Copied syntax tables should all have parents.
647 If we copied one with no parent, such as the standard syntax table,
648 use the standard syntax table as the copy's parent. */
649 if (NILP (XCHAR_TABLE (copy
)->parent
))
650 Fset_char_table_parent (copy
, Vstandard_syntax_table
);
654 DEFUN ("set-syntax-table", Fset_syntax_table
, Sset_syntax_table
, 1, 1, 0,
655 "Select a new syntax table for the current buffer.\n\
656 One argument, a syntax table.")
660 check_syntax_table (table
);
661 current_buffer
->syntax_table
= table
;
662 /* Indicate that this buffer now has a specified syntax table. */
663 current_buffer
->local_var_flags
664 |= XFASTINT (buffer_local_flags
.syntax_table
);
668 /* Convert a letter which signifies a syntax code
669 into the code it signifies.
670 This is used by modify-syntax-entry, and other things. */
672 unsigned char syntax_spec_code
[0400] =
673 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
674 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
675 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
676 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
677 (char) Swhitespace
, (char) Scomment_fence
, (char) Sstring
, 0377,
678 (char) Smath
, 0377, 0377, (char) Squote
,
679 (char) Sopen
, (char) Sclose
, 0377, 0377,
680 0377, (char) Swhitespace
, (char) Spunct
, (char) Scharquote
,
681 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
682 0377, 0377, 0377, 0377,
683 (char) Scomment
, 0377, (char) Sendcomment
, 0377,
684 (char) Sinherit
, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */
685 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
686 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
687 0377, 0377, 0377, 0377, (char) Sescape
, 0377, 0377, (char) Ssymbol
,
688 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
689 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
690 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
691 0377, 0377, 0377, 0377, (char) Sstring_fence
, 0377, 0377, 0377
694 /* Indexed by syntax code, give the letter that describes it. */
696 char syntax_code_spec
[16] =
698 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@',
702 /* Indexed by syntax code, give the object (cons of syntax code and
703 nil) to be stored in syntax table. Since these objects can be
704 shared among syntax tables, we generate them in advance. By
705 sharing objects, the function `describe-syntax' can give a more
707 static Lisp_Object Vsyntax_code_object
;
710 /* Look up the value for CHARACTER in syntax table TABLE's parent
711 and its parents. SYNTAX_ENTRY calls this, when TABLE itself has nil
712 for CHARACTER. It's actually used only when not compiled with GCC. */
715 syntax_parent_lookup (table
, character
)
723 table
= XCHAR_TABLE (table
)->parent
;
727 value
= XCHAR_TABLE (table
)->contents
[character
];
733 DEFUN ("char-syntax", Fchar_syntax
, Schar_syntax
, 1, 1, 0,
734 "Return the syntax code of CHARACTER, described by a character.\n\
735 For example, if CHARACTER is a word constituent,\n\
736 the character `w' is returned.\n\
737 The characters that correspond to various syntax codes\n\
738 are listed in the documentation of `modify-syntax-entry'.")
740 Lisp_Object character
;
743 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
745 gl_state
.use_global
= 0;
746 CHECK_NUMBER (character
, 0);
747 char_int
= XINT (character
);
748 return make_number (syntax_code_spec
[(int) SYNTAX (char_int
)]);
751 DEFUN ("matching-paren", Fmatching_paren
, Smatching_paren
, 1, 1, 0,
752 "Return the matching parenthesis of CHARACTER, or nil if none.")
754 Lisp_Object character
;
757 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
758 gl_state
.use_global
= 0;
759 CHECK_NUMBER (character
, 0);
760 char_int
= XINT (character
);
761 code
= SYNTAX (char_int
);
762 if (code
== Sopen
|| code
== Sclose
)
763 return SYNTAX_MATCH (char_int
);
767 /* This comment supplies the doc string for modify-syntax-entry,
768 for make-docfile to see. We cannot put this in the real DEFUN
769 due to limits in the Unix cpp.
771 DEFUN ("modify-syntax-entry", foo, bar, 2, 3, 0,
772 "Set syntax for character CHAR according to string S.\n\
773 The syntax is changed only for table TABLE, which defaults to\n\
774 the current buffer's syntax table.\n\
775 The first character of S should be one of the following:\n\
776 Space or - whitespace syntax. w word constituent.\n\
777 _ symbol constituent. . punctuation.\n\
778 ( open-parenthesis. ) close-parenthesis.\n\
779 \" string quote. \\ escape.\n\
780 $ paired delimiter. ' expression quote or prefix operator.\n\
781 < comment starter. > comment ender.\n\
782 / character-quote. @ inherit from `standard-syntax-table'.\n\
784 Only single-character comment start and end sequences are represented thus.\n\
785 Two-character sequences are represented as described below.\n\
786 The second character of S is the matching parenthesis,\n\
787 used only if the first character is `(' or `)'.\n\
788 Any additional characters are flags.\n\
789 Defined flags are the characters 1, 2, 3, 4, b, and p.\n\
790 1 means CHAR is the start of a two-char comment start sequence.\n\
791 2 means CHAR is the second character of such a sequence.\n\
792 3 means CHAR is the start of a two-char comment end sequence.\n\
793 4 means CHAR is the second character of such a sequence.\n\
795 There can be up to two orthogonal comment sequences. This is to support\n\
796 language modes such as C++. By default, all comment sequences are of style\n\
797 a, but you can set the comment sequence style to b (on the second character\n\
798 of a comment-start, or the first character of a comment-end sequence) using\n\
800 b means CHAR is part of comment sequence b.\n\
802 p means CHAR is a prefix character for `backward-prefix-chars';\n\
803 such characters are treated as whitespace when they occur\n\
804 between expressions.")
808 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry
, Smodify_syntax_entry
, 2, 3,
809 /* I really don't know why this is interactive
810 help-form should at least be made useful whilst reading the second arg
812 "cSet syntax for character: \nsSet syntax for %s to: ",
813 0 /* See immediately above */)
814 (c
, newentry
, syntax_table
)
815 Lisp_Object c
, newentry
, syntax_table
;
817 register unsigned char *p
;
818 register enum syntaxcode code
;
823 CHECK_STRING (newentry
, 1);
825 if (NILP (syntax_table
))
826 syntax_table
= current_buffer
->syntax_table
;
828 check_syntax_table (syntax_table
);
830 p
= XSTRING (newentry
)->data
;
831 code
= (enum syntaxcode
) syntax_spec_code
[*p
++];
832 if (((int) code
& 0377) == 0377)
833 error ("invalid syntax description letter: %c", p
[-1]);
835 if (code
== Sinherit
)
837 SET_RAW_SYNTAX_ENTRY (syntax_table
, XINT (c
), Qnil
);
844 int character
= STRING_CHAR_AND_LENGTH (p
, XSTRING (newentry
)->size
- 1,
846 XSETINT (match
, character
);
847 if (XFASTINT (match
) == ' ')
883 if (val
< XVECTOR (Vsyntax_code_object
)->size
&& NILP (match
))
884 newentry
= XVECTOR (Vsyntax_code_object
)->contents
[val
];
886 /* Since we can't use a shared object, let's make a new one. */
887 newentry
= Fcons (make_number (val
), match
);
889 SET_RAW_SYNTAX_ENTRY (syntax_table
, XINT (c
), newentry
);
894 /* Dump syntax table to buffer in human-readable format */
897 describe_syntax (value
)
900 register enum syntaxcode code
;
901 char desc
, match
, start1
, start2
, end1
, end2
, prefix
, comstyle
;
903 Lisp_Object first
, match_lisp
;
905 Findent_to (make_number (16), make_number (1));
909 insert_string ("default\n");
913 if (CHAR_TABLE_P (value
))
915 insert_string ("deeper char-table ...\n");
921 insert_string ("invalid\n");
925 first
= XCONS (value
)->car
;
926 match_lisp
= XCONS (value
)->cdr
;
928 if (!INTEGERP (first
) || !(NILP (match_lisp
) || INTEGERP (match_lisp
)))
930 insert_string ("invalid\n");
934 code
= (enum syntaxcode
) (XINT (first
) & 0377);
935 start1
= (XINT (first
) >> 16) & 1;
936 start2
= (XINT (first
) >> 17) & 1;
937 end1
= (XINT (first
) >> 18) & 1;
938 end2
= (XINT (first
) >> 19) & 1;
939 prefix
= (XINT (first
) >> 20) & 1;
940 comstyle
= (XINT (first
) >> 21) & 1;
942 if ((int) code
< 0 || (int) code
>= (int) Smax
)
944 insert_string ("invalid");
947 desc
= syntax_code_spec
[(int) code
];
949 str
[0] = desc
, str
[1] = 0;
952 if (NILP (match_lisp
))
955 insert_char (XINT (match_lisp
));
972 insert_string ("\twhich means: ");
974 switch (SWITCH_ENUM_CAST (code
))
977 insert_string ("whitespace"); break;
979 insert_string ("punctuation"); break;
981 insert_string ("word"); break;
983 insert_string ("symbol"); break;
985 insert_string ("open"); break;
987 insert_string ("close"); break;
989 insert_string ("quote"); break;
991 insert_string ("string"); break;
993 insert_string ("math"); break;
995 insert_string ("escape"); break;
997 insert_string ("charquote"); break;
999 insert_string ("comment"); break;
1001 insert_string ("endcomment"); break;
1003 insert_string ("invalid");
1007 if (!NILP (match_lisp
))
1009 insert_string (", matches ");
1010 insert_char (XINT (match_lisp
));
1014 insert_string (",\n\t is the first character of a comment-start sequence");
1016 insert_string (",\n\t is the second character of a comment-start sequence");
1019 insert_string (",\n\t is the first character of a comment-end sequence");
1021 insert_string (",\n\t is the second character of a comment-end sequence");
1023 insert_string (" (comment style b)");
1026 insert_string (",\n\t is a prefix character for `backward-prefix-chars'");
1028 insert_string ("\n");
1032 describe_syntax_1 (vector
)
1035 struct buffer
*old
= current_buffer
;
1036 set_buffer_internal (XBUFFER (Vstandard_output
));
1037 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
, (int *) 0, 0);
1038 while (! NILP (XCHAR_TABLE (vector
)->parent
))
1040 vector
= XCHAR_TABLE (vector
)->parent
;
1041 insert_string ("\nThe parent syntax table is:");
1042 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
,
1046 call0 (intern ("help-mode"));
1047 set_buffer_internal (old
);
1051 DEFUN ("describe-syntax", Fdescribe_syntax
, Sdescribe_syntax
, 0, 0, "",
1052 "Describe the syntax specifications in the syntax table.\n\
1053 The descriptions are inserted in a buffer, which is then displayed.")
1056 internal_with_output_to_temp_buffer
1057 ("*Help*", describe_syntax_1
, current_buffer
->syntax_table
);
1062 int parse_sexp_ignore_comments
;
1064 /* Return the position across COUNT words from FROM.
1065 If that many words cannot be found before the end of the buffer, return 0.
1066 COUNT negative means scan backward and stop at word beginning. */
1069 scan_words (from
, count
)
1070 register int from
, count
;
1072 register int beg
= BEGV
;
1073 register int end
= ZV
;
1074 register int from_byte
= CHAR_TO_BYTE (from
);
1075 register enum syntaxcode code
;
1081 SETUP_SYNTAX_TABLE (from
, count
);
1092 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1093 ch0
= FETCH_CHAR (from_byte
);
1094 code
= SYNTAX (ch0
);
1095 INC_BOTH (from
, from_byte
);
1096 if (words_include_escapes
1097 && (code
== Sescape
|| code
== Scharquote
))
1102 /* Now CH0 is a character which begins a word and FROM is the
1103 position of the next character. */
1106 if (from
== end
) break;
1107 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1108 ch1
= FETCH_CHAR (from_byte
);
1109 code
= SYNTAX (ch1
);
1110 if (!(words_include_escapes
1111 && (code
== Sescape
|| code
== Scharquote
)))
1112 if (code
!= Sword
|| WORD_BOUNDARY_P (ch0
, ch1
))
1114 INC_BOTH (from
, from_byte
);
1128 DEC_BOTH (from
, from_byte
);
1129 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1130 ch1
= FETCH_CHAR (from_byte
);
1131 code
= SYNTAX (ch1
);
1132 if (words_include_escapes
1133 && (code
== Sescape
|| code
== Scharquote
))
1138 /* Now CH1 is a character which ends a word and FROM is the
1146 temp_byte
= dec_bytepos (from_byte
);
1147 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1148 ch0
= FETCH_CHAR (temp_byte
);
1149 code
= SYNTAX (ch0
);
1150 if (!(words_include_escapes
1151 && (code
== Sescape
|| code
== Scharquote
)))
1152 if (code
!= Sword
|| WORD_BOUNDARY_P (ch0
, ch1
))
1154 DEC_BOTH (from
, from_byte
);
1165 DEFUN ("forward-word", Fforward_word
, Sforward_word
, 1, 1, "p",
1166 "Move point forward ARG words (backward if ARG is negative).\n\
1167 Normally returns t.\n\
1168 If an edge of the buffer is reached, point is left there\n\
1169 and nil is returned.")
1174 CHECK_NUMBER (count
, 0);
1176 if (!(val
= scan_words (PT
, XINT (count
))))
1178 SET_PT (XINT (count
) > 0 ? ZV
: BEGV
);
1185 Lisp_Object
skip_chars ();
1187 DEFUN ("skip-chars-forward", Fskip_chars_forward
, Sskip_chars_forward
, 1, 2, 0,
1188 "Move point forward, stopping before a char not in STRING, or at pos LIM.\n\
1189 STRING is like the inside of a `[...]' in a regular expression\n\
1190 except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\
1191 Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
1192 With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\
1193 Returns the distance traveled, either zero or positive.")
1195 Lisp_Object string
, lim
;
1197 return skip_chars (1, 0, string
, lim
);
1200 DEFUN ("skip-chars-backward", Fskip_chars_backward
, Sskip_chars_backward
, 1, 2, 0,
1201 "Move point backward, stopping after a char not in STRING, or at pos LIM.\n\
1202 See `skip-chars-forward' for details.\n\
1203 Returns the distance traveled, either zero or negative.")
1205 Lisp_Object string
, lim
;
1207 return skip_chars (0, 0, string
, lim
);
1210 DEFUN ("skip-syntax-forward", Fskip_syntax_forward
, Sskip_syntax_forward
, 1, 2, 0,
1211 "Move point forward across chars in specified syntax classes.\n\
1212 SYNTAX is a string of syntax code characters.\n\
1213 Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\
1214 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1215 This function returns the distance traveled, either zero or positive.")
1217 Lisp_Object syntax
, lim
;
1219 return skip_chars (1, 1, syntax
, lim
);
1222 DEFUN ("skip-syntax-backward", Fskip_syntax_backward
, Sskip_syntax_backward
, 1, 2, 0,
1223 "Move point backward across chars in specified syntax classes.\n\
1224 SYNTAX is a string of syntax code characters.\n\
1225 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\
1226 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1227 This function returns the distance traveled, either zero or negative.")
1229 Lisp_Object syntax
, lim
;
1231 return skip_chars (0, 1, syntax
, lim
);
1235 skip_chars (forwardp
, syntaxp
, string
, lim
)
1236 int forwardp
, syntaxp
;
1237 Lisp_Object string
, lim
;
1239 register unsigned char *p
, *pend
;
1240 register unsigned int c
;
1242 unsigned char fastmap
[0400];
1243 /* If SYNTAXP is 0, STRING may contain multi-byte form of characters
1244 of which codes don't fit in FASTMAP. In that case, we set the
1245 first byte of multibyte form (i.e. base leading-code) in FASTMAP
1246 and set the actual ranges of characters in CHAR_RANGES. In the
1247 form "X-Y" of STRING, both X and Y must belong to the same
1248 character set because a range striding across character sets is
1251 int n_char_ranges
= 0;
1253 register int i
, i_byte
;
1254 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
1255 int string_multibyte
= STRING_MULTIBYTE (string
);
1257 CHECK_STRING (string
, 0);
1258 char_ranges
= (int *) alloca (XSTRING (string
)->size
* (sizeof (int)) * 2);
1261 XSETINT (lim
, forwardp
? ZV
: BEGV
);
1263 CHECK_NUMBER_COERCE_MARKER (lim
, 0);
1265 /* In any case, don't allow scan outside bounds of buffer. */
1266 if (XINT (lim
) > ZV
)
1267 XSETFASTINT (lim
, ZV
);
1268 if (XINT (lim
) < BEGV
)
1269 XSETFASTINT (lim
, BEGV
);
1271 bzero (fastmap
, sizeof fastmap
);
1275 if (i
< XSTRING (string
)->size
1276 && XSTRING (string
)->data
[0] == '^')
1278 negate
= 1; i
++, i_byte
++;
1281 /* Find the characters specified and set their elements of fastmap.
1282 If syntaxp, each character counts as itself.
1283 Otherwise, handle backslashes and ranges specially. */
1285 while (i
< XSTRING (string
)->size
)
1289 if (string_multibyte
)
1291 c_leading_code
= XSTRING (string
)->data
[i_byte
];
1292 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1295 c
= c_leading_code
= XSTRING (string
)->data
[i
++];
1297 /* Convert multibyteness between what the string has
1298 and what the buffer has. */
1300 c
= unibyte_char_to_multibyte (c
);
1305 fastmap
[syntax_spec_code
[c
& 0377]] = 1;
1310 if (i
== XSTRING (string
)->size
)
1313 if (string_multibyte
)
1314 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1316 c
= XSTRING (string
)->data
[i
++];
1318 if (i
< XSTRING (string
)->size
&& XSTRING (string
)->data
[i
] == '-')
1322 /* Skip over the dash. */
1325 if (i
== XSTRING (string
)->size
)
1328 /* Get the end of the range. */
1329 if (string_multibyte
)
1330 FETCH_STRING_CHAR_ADVANCE (c2
, string
, i
, i_byte
);
1332 c2
= XSTRING (string
)->data
[i
++];
1334 if (SINGLE_BYTE_CHAR_P (c
))
1342 fastmap
[c_leading_code
] = 1;
1345 char_ranges
[n_char_ranges
++] = c
;
1346 char_ranges
[n_char_ranges
++] = c2
;
1352 fastmap
[c_leading_code
] = 1;
1353 if (!SINGLE_BYTE_CHAR_P (c
))
1355 char_ranges
[n_char_ranges
++] = c
;
1356 char_ranges
[n_char_ranges
++] = c
;
1362 /* If ^ was the first character, complement the fastmap. In
1363 addition, as all multibyte characters have possibility of
1364 matching, set all entries for base leading codes, which is
1365 harmless even if SYNTAXP is 1. */
1368 for (i
= 0; i
< sizeof fastmap
; i
++)
1370 if (!multibyte
|| !BASE_LEADING_CODE_P (i
))
1377 int start_point
= PT
;
1379 int pos_byte
= PT_BYTE
;
1384 SETUP_SYNTAX_TABLE (pos
, forwardp
? 1 : -1);
1389 if (pos
< XINT (lim
))
1390 while (fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1392 /* Since we already checked for multibyteness,
1393 avoid using INC_BOTH which checks again. */
1396 if (pos
>= XINT (lim
))
1398 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1403 while (pos
< XINT (lim
)
1404 && fastmap
[(int) SYNTAX (FETCH_BYTE (pos
))])
1407 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1415 while (pos
> XINT (lim
))
1417 int savepos
= pos_byte
;
1418 /* Since we already checked for multibyteness,
1419 avoid using DEC_BOTH which checks again. */
1422 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
1423 if (!fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1433 if (pos
> XINT (lim
))
1434 while (fastmap
[(int) SYNTAX (FETCH_BYTE (pos
- 1))])
1437 if (pos
<= XINT (lim
))
1439 UPDATE_SYNTAX_TABLE_BACKWARD (pos
- 1);
1449 while (pos
< XINT (lim
) && fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1451 if (!BASE_LEADING_CODE_P (c
))
1452 INC_BOTH (pos
, pos_byte
);
1453 else if (n_char_ranges
)
1455 /* We much check CHAR_RANGES for a multibyte
1457 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1458 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1459 if ((ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1]))
1461 if (!(negate
^ (i
< n_char_ranges
)))
1464 INC_BOTH (pos
, pos_byte
);
1469 INC_BOTH (pos
, pos_byte
);
1473 while (pos
< XINT (lim
) && fastmap
[FETCH_BYTE (pos
)])
1479 while (pos
> XINT (lim
))
1481 int savepos
= pos_byte
;
1482 DEC_BOTH (pos
, pos_byte
);
1483 if (fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1485 if (!BASE_LEADING_CODE_P (c
))
1487 else if (n_char_ranges
)
1489 /* We much check CHAR_RANGES for a multibyte
1491 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1492 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1493 if (ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1])
1495 if (!(negate
^ (i
< n_char_ranges
)))
1518 while (pos
> XINT (lim
) && fastmap
[FETCH_BYTE (pos
- 1)])
1523 #if 0 /* Not needed now that a position in mid-character
1524 cannot be specified in Lisp. */
1526 /* INC_POS or DEC_POS might have moved POS over LIM. */
1527 && (forwardp
? (pos
> XINT (lim
)) : (pos
< XINT (lim
))))
1534 SET_PT_BOTH (pos
, pos_byte
);
1537 return make_number (PT
- start_point
);
1541 DEFUN ("forward-comment", Fforward_comment
, Sforward_comment
, 1, 1, 0,
1542 "Move forward across up to N comments. If N is negative, move backward.\n\
1543 Stop scanning if we find something other than a comment or whitespace.\n\
1544 Set point to where scanning stops.\n\
1545 If N comments are found as expected, with nothing except whitespace\n\
1546 between them, return t; otherwise return nil.")
1554 register enum syntaxcode code
;
1555 int comstyle
= 0; /* style of comment encountered */
1559 int out_charpos
, out_bytepos
;
1561 CHECK_NUMBER (count
, 0);
1562 count1
= XINT (count
);
1563 stop
= count1
> 0 ? ZV
: BEGV
;
1569 from_byte
= PT_BYTE
;
1571 SETUP_SYNTAX_TABLE (from
, count1
);
1578 SET_PT_BOTH (from
, from_byte
);
1582 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1583 c
= FETCH_CHAR (from_byte
);
1585 INC_BOTH (from
, from_byte
);
1587 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
1588 && (c1
= FETCH_CHAR (from_byte
),
1589 SYNTAX_COMSTART_SECOND (c1
)))
1591 /* We have encountered a comment start sequence and we
1592 are ignoring all text inside comments. We must record
1593 the comment style this sequence begins so that later,
1594 only a comment end of the same style actually ends
1595 the comment section. */
1597 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1598 INC_BOTH (from
, from_byte
);
1601 while (code
== Swhitespace
|| code
== Sendcomment
);
1603 if (code
!= Scomment
&& code
!= Scomment_fence
)
1606 DEC_BOTH (from
, from_byte
);
1607 SET_PT_BOTH (from
, from_byte
);
1610 /* We're at the start of a comment. */
1616 SET_PT_BOTH (from
, from_byte
);
1619 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1620 c
= FETCH_CHAR (from_byte
);
1621 INC_BOTH (from
, from_byte
);
1622 if (SYNTAX (c
) == Sendcomment
1623 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1624 /* we have encountered a comment end of the same style
1625 as the comment sequence which began this comment
1628 if (SYNTAX (c
) == Scomment_fence
1629 && comstyle
== ST_COMMENT_STYLE
)
1630 /* we have encountered a comment end of the same style
1631 as the comment sequence which began this comment
1634 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
1635 && (c1
= FETCH_CHAR (from_byte
),
1636 SYNTAX_COMEND_SECOND (c1
))
1637 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1638 /* we have encountered a comment end of the same style
1639 as the comment sequence which began this comment
1642 INC_BOTH (from
, from_byte
);
1646 /* We have skipped one comment. */
1657 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
1662 DEC_BOTH (from
, from_byte
);
1663 quoted
= char_quoted (from
, from_byte
);
1666 DEC_BOTH (from
, from_byte
);
1669 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1670 c
= FETCH_CHAR (from_byte
);
1673 if (code
== Sendcomment
)
1674 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1675 temp_pos
= dec_bytepos (from_byte
);
1676 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1677 && (c1
= FETCH_CHAR (temp_pos
),
1678 SYNTAX_COMEND_FIRST (c1
))
1679 && !char_quoted (from
- 1, temp_pos
))
1681 /* We must record the comment style encountered so that
1682 later, we can match only the proper comment begin
1683 sequence of the same style. */
1685 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1686 DEC_BOTH (from
, from_byte
);
1688 if (from
> stop
&& SYNTAX_COMSTART_SECOND (c
)
1689 && (c1
= FETCH_CHAR (temp_pos
),
1690 SYNTAX_COMSTART_FIRST (c1
))
1691 && !char_quoted (from
- 1, temp_pos
))
1693 /* We must record the comment style encountered so that
1694 later, we can match only the proper comment begin
1695 sequence of the same style. */
1697 DEC_BOTH (from
, from_byte
);
1700 if (code
== Scomment_fence
)
1702 /* Skip until first preceding unquoted comment_fence. */
1703 int found
= 0, ini
= from
, ini_byte
= from_byte
;
1707 DEC_BOTH (from
, from_byte
);
1710 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1711 c
= FETCH_CHAR (from_byte
);
1712 if (SYNTAX (c
) == Scomment_fence
1713 && !char_quoted (from
, from_byte
))
1721 from
= ini
; /* Set point to ini + 1. */
1722 from_byte
= ini_byte
;
1726 else if (code
== Sendcomment
)
1728 found
= back_comment (from
, from_byte
, stop
, comstyle
,
1729 &out_charpos
, &out_bytepos
);
1731 from
= out_charpos
, from_byte
= out_bytepos
;
1732 /* We have skipped one comment. */
1735 else if (code
!= Swhitespace
&& code
!= Scomment
)
1739 INC_BOTH (from
, from_byte
);
1740 SET_PT_BOTH (from
, from_byte
);
1748 SET_PT_BOTH (from
, from_byte
);
1754 scan_lists (from
, count
, depth
, sexpflag
)
1756 int count
, depth
, sexpflag
;
1759 register int stop
= count
> 0 ? ZV
: BEGV
;
1764 register enum syntaxcode code
, temp_code
;
1765 int min_depth
= depth
; /* Err out if depth gets less than this. */
1766 int comstyle
= 0; /* style of comment encountered */
1768 int last_good
= from
;
1770 int from_byte
= CHAR_TO_BYTE (from
);
1771 int out_bytepos
, out_charpos
;
1774 if (depth
> 0) min_depth
= 0;
1779 SETUP_SYNTAX_TABLE (from
, count
);
1784 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1785 c
= FETCH_CHAR (from_byte
);
1787 if (depth
== min_depth
)
1789 INC_BOTH (from
, from_byte
);
1790 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1791 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
1792 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
))
1793 && parse_sexp_ignore_comments
)
1795 /* we have encountered a comment start sequence and we
1796 are ignoring all text inside comments. We must record
1797 the comment style this sequence begins so that later,
1798 only a comment end of the same style actually ends
1799 the comment section */
1801 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
));
1802 INC_BOTH (from
, from_byte
);
1805 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1806 if (SYNTAX_PREFIX (c
))
1809 switch (SWITCH_ENUM_CAST (code
))
1813 if (from
== stop
) goto lose
;
1814 INC_BOTH (from
, from_byte
);
1815 /* treat following character as a word constituent */
1818 if (depth
|| !sexpflag
) break;
1819 /* This word counts as a sexp; return at end of it. */
1822 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1824 /* Some compilers can't handle this inside the switch. */
1825 temp
= SYNTAX (FETCH_CHAR (from_byte
));
1830 INC_BOTH (from
, from_byte
);
1831 if (from
== stop
) goto lose
;
1840 INC_BOTH (from
, from_byte
);
1845 case Scomment_fence
:
1846 if (!parse_sexp_ignore_comments
) break;
1855 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1856 c
= FETCH_CHAR (from_byte
);
1857 if (code
== Scomment
1858 ? (SYNTAX (c
) == Sendcomment
1859 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1860 : (SYNTAX (c
) == Scomment_fence
))
1861 /* we have encountered a comment end of the same style
1862 as the comment sequence which began this comment
1865 INC_BOTH (from
, from_byte
);
1866 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
1867 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from_byte
))
1868 && SYNTAX_COMMENT_STYLE (c
) == comstyle
1869 && code
== Scomment
)
1870 /* we have encountered a comment end of the same style
1871 as the comment sequence which began this comment
1874 INC_BOTH (from
, from_byte
);
1883 if (from
!= stop
&& c
== FETCH_CHAR (from_byte
))
1885 INC_BOTH (from
, from_byte
);
1895 if (!++depth
) goto done
;
1900 if (!--depth
) goto done
;
1901 if (depth
< min_depth
)
1902 Fsignal (Qscan_error
,
1903 Fcons (build_string ("Containing expression ends prematurely"),
1904 Fcons (make_number (last_good
),
1905 Fcons (make_number (from
), Qnil
))));
1910 temp_pos
= dec_bytepos (from_byte
);
1911 stringterm
= FETCH_CHAR (temp_pos
);
1914 if (from
>= stop
) goto lose
;
1915 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1917 ? (FETCH_CHAR (from_byte
) == stringterm
)
1918 : SYNTAX (FETCH_CHAR (from_byte
)) == Sstring_fence
)
1921 /* Some compilers can't handle this inside the switch. */
1922 temp
= SYNTAX (FETCH_CHAR (from_byte
));
1927 INC_BOTH (from
, from_byte
);
1929 INC_BOTH (from
, from_byte
);
1931 INC_BOTH (from
, from_byte
);
1932 if (!depth
&& sexpflag
) goto done
;
1937 /* Reached end of buffer. Error if within object, return nil if between */
1938 if (depth
) goto lose
;
1943 /* End of object reached */
1952 DEC_BOTH (from
, from_byte
);
1953 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1954 c
= FETCH_CHAR (from_byte
);
1956 if (depth
== min_depth
)
1959 if (code
== Sendcomment
)
1960 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1961 temp_pos
= from_byte
;
1962 if (! NILP (current_buffer
->enable_multibyte_characters
))
1966 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1967 && (c1
= FETCH_CHAR (temp_pos
), SYNTAX_COMEND_FIRST (c1
))
1968 && parse_sexp_ignore_comments
)
1970 /* we must record the comment style encountered so that
1971 later, we can match only the proper comment begin
1972 sequence of the same style */
1974 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1975 DEC_BOTH (from
, from_byte
);
1978 /* Quoting turns anything except a comment-ender
1979 into a word character. */
1980 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
1982 else if (SYNTAX_PREFIX (c
))
1985 switch (SWITCH_ENUM_CAST (code
))
1991 if (depth
|| !sexpflag
) break;
1992 /* This word counts as a sexp; count object finished
1993 after passing it. */
1996 temp_pos
= from_byte
;
1997 if (! NILP (current_buffer
->enable_multibyte_characters
))
2001 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2002 c1
= FETCH_CHAR (temp_pos
);
2003 temp_code
= SYNTAX (c1
);
2004 /* Don't allow comment-end to be quoted. */
2005 if (temp_code
== Sendcomment
)
2007 quoted
= char_quoted (from
- 1, temp_pos
);
2010 DEC_BOTH (from
, from_byte
);
2011 temp_pos
= dec_bytepos (temp_pos
);
2012 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2014 c1
= FETCH_CHAR (temp_pos
);
2015 temp_code
= SYNTAX (c1
);
2016 if (! (quoted
|| temp_code
== Sword
2017 || temp_code
== Ssymbol
2018 || temp_code
== Squote
))
2020 DEC_BOTH (from
, from_byte
);
2027 temp_pos
= dec_bytepos (from_byte
);
2028 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2029 if (from
!= stop
&& c
== FETCH_CHAR (temp_pos
))
2030 DEC_BOTH (from
, from_byte
);
2039 if (!++depth
) goto done2
;
2044 if (!--depth
) goto done2
;
2045 if (depth
< min_depth
)
2046 Fsignal (Qscan_error
,
2047 Fcons (build_string ("Containing expression ends prematurely"),
2048 Fcons (make_number (last_good
),
2049 Fcons (make_number (from
), Qnil
))));
2053 if (!parse_sexp_ignore_comments
)
2055 found
= back_comment (from
, from_byte
, stop
, comstyle
,
2056 &out_charpos
, &out_bytepos
);
2058 from
= out_charpos
, from_byte
= out_bytepos
;
2061 case Scomment_fence
:
2065 DEC_BOTH (from
, from_byte
);
2066 if (from
== stop
) goto lose
;
2067 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2068 if (!char_quoted (from
, from_byte
)
2069 && SYNTAX (FETCH_CHAR (from_byte
)) == code
)
2072 if (code
== Sstring_fence
&& !depth
&& sexpflag
) goto done2
;
2076 stringterm
= FETCH_CHAR (from_byte
);
2079 if (from
== stop
) goto lose
;
2080 temp_pos
= from_byte
;
2081 if (! NILP (current_buffer
->enable_multibyte_characters
))
2085 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2086 if (!char_quoted (from
- 1, temp_pos
)
2087 && stringterm
== FETCH_CHAR (temp_pos
))
2089 DEC_BOTH (from
, from_byte
);
2091 DEC_BOTH (from
, from_byte
);
2092 if (!depth
&& sexpflag
) goto done2
;
2097 /* Reached start of buffer. Error if within object, return nil if between */
2098 if (depth
) goto lose
;
2109 XSETFASTINT (val
, from
);
2113 Fsignal (Qscan_error
,
2114 Fcons (build_string ("Unbalanced parentheses"),
2115 Fcons (make_number (last_good
),
2116 Fcons (make_number (from
), Qnil
))));
2121 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
2122 "Scan from character number FROM by COUNT lists.\n\
2123 Returns the character number of the position thus found.\n\
2125 If DEPTH is nonzero, paren depth begins counting from that value,\n\
2126 only places where the depth in parentheses becomes zero\n\
2127 are candidates for stopping; COUNT such places are counted.\n\
2128 Thus, a positive value for DEPTH means go out levels.\n\
2130 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2132 If the beginning or end of (the accessible part of) the buffer is reached\n\
2133 and the depth is wrong, an error is signaled.\n\
2134 If the depth is right but the count is not used up, nil is returned.")
2135 (from
, count
, depth
)
2136 Lisp_Object from
, count
, depth
;
2138 CHECK_NUMBER (from
, 0);
2139 CHECK_NUMBER (count
, 1);
2140 CHECK_NUMBER (depth
, 2);
2142 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
2145 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
2146 "Scan from character number FROM by COUNT balanced expressions.\n\
2147 If COUNT is negative, scan backwards.\n\
2148 Returns the character number of the position thus found.\n\
2150 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2152 If the beginning or end of (the accessible part of) the buffer is reached\n\
2153 in the middle of a parenthetical grouping, an error is signaled.\n\
2154 If the beginning or end is reached between groupings\n\
2155 but before count is used up, nil is returned.")
2157 Lisp_Object from
, count
;
2159 CHECK_NUMBER (from
, 0);
2160 CHECK_NUMBER (count
, 1);
2162 return scan_lists (XINT (from
), XINT (count
), 0, 1);
2165 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
2167 "Move point backward over any number of chars with prefix syntax.\n\
2168 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
2173 int opoint_byte
= PT_BYTE
;
2175 int pos_byte
= PT_BYTE
;
2180 SETUP_SYNTAX_TABLE (pos
, -1);
2183 DEC_BOTH (pos
, pos_byte
);
2185 while (!char_quoted (pos
, pos_byte
)
2186 /* Previous statement updates syntax table. */
2187 && ((c
= FETCH_CHAR (pos_byte
), SYNTAX (c
) == Squote
)
2188 || SYNTAX_PREFIX (c
)))
2191 opoint_byte
= pos_byte
;
2194 DEC_BOTH (pos
, pos_byte
);
2197 SET_PT_BOTH (opoint
, opoint_byte
);
2202 /* Parse forward from FROM / FROM_BYTE to END,
2203 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
2204 and return a description of the state of the parse at END.
2205 If STOPBEFORE is nonzero, stop at the start of an atom.
2206 If COMMENTSTOP is 1, stop at the start of a comment.
2207 If COMMENTSTOP is -1, stop at the start or end of a comment,
2208 after the beginning of a string, or after the end of a string. */
2211 scan_sexps_forward (stateptr
, from
, from_byte
, end
, targetdepth
,
2212 stopbefore
, oldstate
, commentstop
)
2213 struct lisp_parse_state
*stateptr
;
2215 int end
, targetdepth
, stopbefore
;
2216 Lisp_Object oldstate
;
2219 struct lisp_parse_state state
;
2221 register enum syntaxcode code
;
2222 struct level
{ int last
, prev
; };
2223 struct level levelstart
[100];
2224 register struct level
*curlevel
= levelstart
;
2225 struct level
*endlevel
= levelstart
+ 100;
2227 register int depth
; /* Paren depth of current scanning location.
2228 level - levelstart equals this except
2229 when the depth becomes negative. */
2230 int mindepth
; /* Lowest DEPTH value seen. */
2231 int start_quoted
= 0; /* Nonzero means starting after a char quote */
2233 int prev_from
; /* Keep one character before FROM. */
2235 int prev_from_syntax
;
2236 int boundary_stop
= commentstop
== -1;
2241 prev_from_byte
= from_byte
;
2243 DEC_BOTH (prev_from
, prev_from_byte
);
2245 /* Use this macro instead of `from++'. */
2247 do { prev_from = from; \
2248 prev_from_byte = from_byte; \
2250 = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); \
2251 INC_BOTH (from, from_byte); \
2252 UPDATE_SYNTAX_TABLE_FORWARD (from); \
2258 if (NILP (oldstate
))
2261 state
.instring
= -1;
2262 state
.incomment
= 0;
2263 state
.comstyle
= 0; /* comment style a by default. */
2264 state
.comstr_start
= -1; /* no comment/string seen. */
2268 tem
= Fcar (oldstate
);
2274 oldstate
= Fcdr (oldstate
);
2275 oldstate
= Fcdr (oldstate
);
2276 oldstate
= Fcdr (oldstate
);
2277 tem
= Fcar (oldstate
);
2278 /* Check whether we are inside string_fence-style string: */
2279 state
.instring
= ( !NILP (tem
)
2280 ? ( INTEGERP (tem
) ? XINT (tem
) : ST_STRING_STYLE
)
2283 oldstate
= Fcdr (oldstate
);
2284 tem
= Fcar (oldstate
);
2285 state
.incomment
= !NILP (tem
);
2287 oldstate
= Fcdr (oldstate
);
2288 tem
= Fcar (oldstate
);
2289 start_quoted
= !NILP (tem
);
2291 /* if the eight element of the list is nil, we are in comment
2292 style a. If it is non-nil, we are in comment style b */
2293 oldstate
= Fcdr (oldstate
);
2294 oldstate
= Fcdr (oldstate
);
2295 tem
= Fcar (oldstate
);
2296 state
.comstyle
= NILP (tem
) ? 0 : ( EQ (tem
, Qsyntax_table
)
2297 ? ST_COMMENT_STYLE
: 1 );
2299 oldstate
= Fcdr (oldstate
);
2300 tem
= Fcar (oldstate
);
2301 state
.comstr_start
= NILP (tem
) ? -1 : XINT (tem
) ;
2306 curlevel
->prev
= -1;
2307 curlevel
->last
= -1;
2309 /* Enter the loop at a place appropriate for initial state. */
2311 if (state
.incomment
) goto startincomment
;
2312 if (state
.instring
>= 0)
2314 nofence
= state
.instring
!= ST_STRING_STYLE
;
2315 if (start_quoted
) goto startquotedinstring
;
2318 if (start_quoted
) goto startquoted
;
2321 SETUP_SYNTAX_TABLE (prev_from
, 1);
2322 prev_from_syntax
= SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte
));
2323 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2328 code
= prev_from_syntax
& 0xff;
2330 if (code
== Scomment
)
2331 state
.comstr_start
= prev_from
;
2332 else if (code
== Scomment_fence
)
2334 /* Record the comment style we have entered so that only
2335 the comment-end sequence of the same style actually
2336 terminates the comment section. */
2337 state
.comstyle
= ( code
== Scomment_fence
2339 : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)));
2340 state
.comstr_start
= prev_from
;
2341 if (code
!= Scomment_fence
)
2345 else if (from
< end
)
2346 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax
))
2347 if (SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
)))
2348 /* Duplicate code to avoid a complex if-expression
2349 which causes trouble for the SGI compiler. */
2351 /* Record the comment style we have entered so that only
2352 the comment-end sequence of the same style actually
2353 terminates the comment section. */
2354 state
.comstyle
= ( code
== Scomment_fence
2356 : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)));
2357 state
.comstr_start
= prev_from
;
2358 if (code
!= Scomment_fence
)
2363 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax
))
2365 switch (SWITCH_ENUM_CAST (code
))
2369 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2370 curlevel
->last
= prev_from
;
2372 if (from
== end
) goto endquoted
;
2375 /* treat following character as a word constituent */
2378 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2379 curlevel
->last
= prev_from
;
2383 /* Some compilers can't handle this inside the switch. */
2384 temp
= SYNTAX (FETCH_CHAR (from_byte
));
2390 if (from
== end
) goto endquoted
;
2402 curlevel
->prev
= curlevel
->last
;
2406 if (commentstop
== 1)
2410 /* Enter the loop in the middle so that we find
2411 a 2-char comment ender if we start in the middle of it. */
2412 goto startincomment_1
;
2414 /* At beginning of buffer, enter the loop the ordinary way. */
2415 state
.incomment
= 1;
2419 state
.incomment
= 1;
2420 if (commentstop
|| boundary_stop
) goto done
;
2424 if (from
== end
) goto done
;
2425 prev
= FETCH_CHAR (from_byte
);
2426 if (SYNTAX (prev
) == Sendcomment
2427 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
2428 /* Only terminate the comment section if the endcomment
2429 of the same style as the start sequence has been
2432 if (state
.comstyle
== ST_COMMENT_STYLE
2433 && SYNTAX (prev
) == Scomment_fence
)
2437 if (from
< end
&& SYNTAX_FLAGS_COMEND_FIRST (prev_from_syntax
)
2438 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from_byte
))
2439 && (SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax
)
2441 /* Only terminate the comment section if the end-comment
2442 sequence of the same style as the start sequence has
2443 been encountered. */
2447 state
.incomment
= 0;
2448 state
.comstyle
= 0; /* reset the comment style */
2449 if (boundary_stop
) goto done
;
2453 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2455 /* curlevel++->last ran into compiler bug on Apollo */
2456 curlevel
->last
= prev_from
;
2457 if (++curlevel
== endlevel
)
2458 error ("Nesting too deep for parser");
2459 curlevel
->prev
= -1;
2460 curlevel
->last
= -1;
2461 if (targetdepth
== depth
) goto done
;
2466 if (depth
< mindepth
)
2468 if (curlevel
!= levelstart
)
2470 curlevel
->prev
= curlevel
->last
;
2471 if (targetdepth
== depth
) goto done
;
2476 state
.comstr_start
= from
- 1;
2477 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2478 curlevel
->last
= prev_from
;
2479 state
.instring
= (code
== Sstring
2480 ? (FETCH_CHAR (prev_from_byte
))
2482 if (boundary_stop
) goto done
;
2485 nofence
= state
.instring
!= ST_STRING_STYLE
;
2491 if (from
>= end
) goto done
;
2492 c
= FETCH_CHAR (from_byte
);
2493 if (nofence
&& c
== state
.instring
) break;
2495 /* Some compilers can't handle this inside the switch. */
2500 if (!nofence
) goto string_end
;
2505 startquotedinstring
:
2506 if (from
>= end
) goto endquoted
;
2512 state
.instring
= -1;
2513 curlevel
->prev
= curlevel
->last
;
2515 if (boundary_stop
) goto done
;
2524 stop
: /* Here if stopping before start of sexp. */
2525 from
= prev_from
; /* We have just fetched the char that starts it; */
2526 goto done
; /* but return the position before it. */
2531 state
.depth
= depth
;
2532 state
.mindepth
= mindepth
;
2533 state
.thislevelstart
= curlevel
->prev
;
2534 state
.prevlevelstart
2535 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
2536 state
.location
= from
;
2542 /* This comment supplies the doc string for parse-partial-sexp,
2543 for make-docfile to see. We cannot put this in the real DEFUN
2544 due to limits in the Unix cpp.
2546 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
2547 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
2548 Parsing stops at TO or when certain criteria are met;\n\
2549 point is set to where parsing stops.\n\
2550 If fifth arg STATE is omitted or nil,\n\
2551 parsing assumes that FROM is the beginning of a function.\n\
2552 Value is a list of nine elements describing final state of parsing:\n\
2553 0. depth in parens.\n\
2554 1. character address of start of innermost containing list; nil if none.\n\
2555 2. character address of start of last complete sexp terminated.\n\
2556 3. non-nil if inside a string.\n\
2557 (it is the character that will terminate the string,\n\
2558 or t if the string should be terminated by a generic string delimiter.)\n\
2559 4. t if inside a comment.\n\
2560 5. t if following a quote character.\n\
2561 6. the minimum paren-depth encountered during this scan.\n\
2562 7. t if in a comment of style b; `syntax-table' if the comment\n\
2563 should be terminated by a generic comment delimiter.\n\
2564 8. character address of start of comment or string; nil if not in one.\n\
2565 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
2566 in parentheses becomes equal to TARGETDEPTH.\n\
2567 Fourth arg STOPBEFORE non-nil means stop when come to\n\
2568 any character that starts a sexp.\n\
2569 Fifth arg STATE is a nine-element list like what this function returns.\n\
2570 It is used to initialize the state of the parse. Elements number 1, 2, 6\n\
2571 and 8 are ignored; you can leave off element 8 (the last) entirely.\n\
2572 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.\n\
2573 If it is `syntax-table', stop after the start of a comment or a string,\n\
2574 or after end of a comment or a string.")
2575 (from, to, targetdepth, stopbefore, state, commentstop)
2578 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 6, 0,
2579 0 /* See immediately above */)
2580 (from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
)
2581 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
;
2583 struct lisp_parse_state state
;
2586 if (!NILP (targetdepth
))
2588 CHECK_NUMBER (targetdepth
, 3);
2589 target
= XINT (targetdepth
);
2592 target
= -100000; /* We won't reach this depth */
2594 validate_region (&from
, &to
);
2595 scan_sexps_forward (&state
, XINT (from
), CHAR_TO_BYTE (XINT (from
)),
2597 target
, !NILP (stopbefore
), oldstate
,
2599 ? 0 : (EQ (commentstop
, Qsyntax_table
) ? -1 : 1)));
2601 SET_PT (state
.location
);
2603 return Fcons (make_number (state
.depth
),
2604 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
2605 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
2606 Fcons (state
.instring
>= 0
2607 ? (state
.instring
== ST_STRING_STYLE
2608 ? Qt
: make_number (state
.instring
)) : Qnil
,
2609 Fcons (state
.incomment
? Qt
: Qnil
,
2610 Fcons (state
.quoted
? Qt
: Qnil
,
2611 Fcons (make_number (state
.mindepth
),
2612 Fcons ((state
.comstyle
2613 ? (state
.comstyle
== ST_COMMENT_STYLE
2614 ? Qsyntax_table
: Qt
) :
2616 Fcons ((state
.incomment
|| state
.instring
2617 ? make_number (state
.comstr_start
)
2628 /* This has to be done here, before we call Fmake_char_table. */
2629 Qsyntax_table
= intern ("syntax-table");
2630 staticpro (&Qsyntax_table
);
2632 /* Intern this now in case it isn't already done.
2633 Setting this variable twice is harmless.
2634 But don't staticpro it here--that is done in alloc.c. */
2635 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
2637 /* Create objects which can be shared among syntax tables. */
2638 Vsyntax_code_object
= Fmake_vector (make_number (13), Qnil
);
2639 for (i
= 0; i
< XVECTOR (Vsyntax_code_object
)->size
; i
++)
2640 XVECTOR (Vsyntax_code_object
)->contents
[i
]
2641 = Fcons (make_number (i
), Qnil
);
2643 /* Now we are ready to set up this property, so we can
2644 create syntax tables. */
2645 Fput (Qsyntax_table
, Qchar_table_extra_slots
, make_number (0));
2647 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Swhitespace
];
2649 Vstandard_syntax_table
= Fmake_char_table (Qsyntax_table
, temp
);
2651 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Sword
];
2652 for (i
= 'a'; i
<= 'z'; i
++)
2653 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2654 for (i
= 'A'; i
<= 'Z'; i
++)
2655 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2656 for (i
= '0'; i
<= '9'; i
++)
2657 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2659 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '$', temp
);
2660 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '%', temp
);
2662 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '(',
2663 Fcons (make_number (Sopen
), make_number (')')));
2664 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ')',
2665 Fcons (make_number (Sclose
), make_number ('(')));
2666 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '[',
2667 Fcons (make_number (Sopen
), make_number (']')));
2668 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ']',
2669 Fcons (make_number (Sclose
), make_number ('[')));
2670 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '{',
2671 Fcons (make_number (Sopen
), make_number ('}')));
2672 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '}',
2673 Fcons (make_number (Sclose
), make_number ('{')));
2674 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '"',
2675 Fcons (make_number ((int) Sstring
), Qnil
));
2676 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '\\',
2677 Fcons (make_number ((int) Sescape
), Qnil
));
2679 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Ssymbol
];
2680 for (i
= 0; i
< 10; i
++)
2682 c
= "_-+*/&|<>="[i
];
2683 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2686 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Spunct
];
2687 for (i
= 0; i
< 12; i
++)
2689 c
= ".,;:?!#@~^'`"[i
];
2690 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2697 Qsyntax_table_p
= intern ("syntax-table-p");
2698 staticpro (&Qsyntax_table_p
);
2700 staticpro (&Vsyntax_code_object
);
2702 Qscan_error
= intern ("scan-error");
2703 staticpro (&Qscan_error
);
2704 Fput (Qscan_error
, Qerror_conditions
,
2705 Fcons (Qerror
, Qnil
));
2706 Fput (Qscan_error
, Qerror_message
,
2707 build_string ("Scan error"));
2709 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
2710 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
2712 DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties
,
2713 "Non-nil means `forward-sexp', etc., grant `syntax-table' property.\n\
2714 The value of this property should be either a syntax table, or a cons\n\
2715 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric\n\
2716 syntax code, MATCHCHAR being nil or the character to match (which is\n\
2717 relevant only for open/close type.");
2719 words_include_escapes
= 0;
2720 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
2721 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
2723 defsubr (&Ssyntax_table_p
);
2724 defsubr (&Ssyntax_table
);
2725 defsubr (&Sstandard_syntax_table
);
2726 defsubr (&Scopy_syntax_table
);
2727 defsubr (&Sset_syntax_table
);
2728 defsubr (&Schar_syntax
);
2729 defsubr (&Smatching_paren
);
2730 defsubr (&Smodify_syntax_entry
);
2731 defsubr (&Sdescribe_syntax
);
2733 defsubr (&Sforward_word
);
2735 defsubr (&Sskip_chars_forward
);
2736 defsubr (&Sskip_chars_backward
);
2737 defsubr (&Sskip_syntax_forward
);
2738 defsubr (&Sskip_syntax_backward
);
2740 defsubr (&Sforward_comment
);
2741 defsubr (&Sscan_lists
);
2742 defsubr (&Sscan_sexps
);
2743 defsubr (&Sbackward_prefix_chars
);
2744 defsubr (&Sparse_partial_sexp
);