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 (but not as the end of a range; quoting is never needed there).\n\
1192 Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
1193 With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\
1194 Returns the distance traveled, either zero or positive.")
1196 Lisp_Object string
, lim
;
1198 return skip_chars (1, 0, string
, lim
);
1201 DEFUN ("skip-chars-backward", Fskip_chars_backward
, Sskip_chars_backward
, 1, 2, 0,
1202 "Move point backward, stopping after a char not in STRING, or at pos LIM.\n\
1203 See `skip-chars-forward' for details.\n\
1204 Returns the distance traveled, either zero or negative.")
1206 Lisp_Object string
, lim
;
1208 return skip_chars (0, 0, string
, lim
);
1211 DEFUN ("skip-syntax-forward", Fskip_syntax_forward
, Sskip_syntax_forward
, 1, 2, 0,
1212 "Move point forward across chars in specified syntax classes.\n\
1213 SYNTAX is a string of syntax code characters.\n\
1214 Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\
1215 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1216 This function returns the distance traveled, either zero or positive.")
1218 Lisp_Object syntax
, lim
;
1220 return skip_chars (1, 1, syntax
, lim
);
1223 DEFUN ("skip-syntax-backward", Fskip_syntax_backward
, Sskip_syntax_backward
, 1, 2, 0,
1224 "Move point backward across chars in specified syntax classes.\n\
1225 SYNTAX is a string of syntax code characters.\n\
1226 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\
1227 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1228 This function returns the distance traveled, either zero or negative.")
1230 Lisp_Object syntax
, lim
;
1232 return skip_chars (0, 1, syntax
, lim
);
1236 skip_chars (forwardp
, syntaxp
, string
, lim
)
1237 int forwardp
, syntaxp
;
1238 Lisp_Object string
, lim
;
1240 register unsigned char *p
, *pend
;
1241 register unsigned int c
;
1243 unsigned char fastmap
[0400];
1244 /* If SYNTAXP is 0, STRING may contain multi-byte form of characters
1245 of which codes don't fit in FASTMAP. In that case, we set the
1246 first byte of multibyte form (i.e. base leading-code) in FASTMAP
1247 and set the actual ranges of characters in CHAR_RANGES. In the
1248 form "X-Y" of STRING, both X and Y must belong to the same
1249 character set because a range striding across character sets is
1252 int n_char_ranges
= 0;
1254 register int i
, i_byte
;
1255 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
1256 int string_multibyte
= STRING_MULTIBYTE (string
);
1257 int size_byte
= STRING_BYTES (XSTRING (string
));
1259 CHECK_STRING (string
, 0);
1260 char_ranges
= (int *) alloca (XSTRING (string
)->size
* (sizeof (int)) * 2);
1263 XSETINT (lim
, forwardp
? ZV
: BEGV
);
1265 CHECK_NUMBER_COERCE_MARKER (lim
, 0);
1267 /* In any case, don't allow scan outside bounds of buffer. */
1268 if (XINT (lim
) > ZV
)
1269 XSETFASTINT (lim
, ZV
);
1270 if (XINT (lim
) < BEGV
)
1271 XSETFASTINT (lim
, BEGV
);
1273 bzero (fastmap
, sizeof fastmap
);
1277 if (i_byte
< size_byte
1278 && XSTRING (string
)->data
[0] == '^')
1280 negate
= 1; i
++, i_byte
++;
1283 /* Find the characters specified and set their elements of fastmap.
1284 If syntaxp, each character counts as itself.
1285 Otherwise, handle backslashes and ranges specially. */
1287 while (i_byte
< size_byte
)
1291 if (string_multibyte
)
1293 c_leading_code
= XSTRING (string
)->data
[i_byte
];
1294 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1297 c
= c_leading_code
= XSTRING (string
)->data
[i_byte
++];
1299 /* Convert multibyteness between what the string has
1300 and what the buffer has. */
1302 c
= unibyte_char_to_multibyte (c
);
1307 fastmap
[syntax_spec_code
[c
& 0377]] = 1;
1312 if (i_byte
== size_byte
)
1315 if (string_multibyte
)
1317 c_leading_code
= XSTRING (string
)->data
[i_byte
];
1318 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1321 c
= c_leading_code
= XSTRING (string
)->data
[i_byte
++];
1323 if (i_byte
< size_byte
1324 && XSTRING (string
)->data
[i_byte
] == '-')
1326 unsigned int c2
, c2_leading_code
;
1328 /* Skip over the dash. */
1331 if (i_byte
== size_byte
)
1334 /* Get the end of the range. */
1335 if (string_multibyte
)
1337 c2_leading_code
= XSTRING (string
)->data
[i_byte
];
1338 FETCH_STRING_CHAR_ADVANCE (c2
, string
, i
, i_byte
);
1341 c2
= XSTRING (string
)->data
[i_byte
++];
1343 if (SINGLE_BYTE_CHAR_P (c
))
1345 if (! SINGLE_BYTE_CHAR_P (c2
))
1346 error ("Invalid charcter range: %s",
1347 XSTRING (string
)->data
);
1356 if (c_leading_code
!= c2_leading_code
)
1357 error ("Invalid charcter range: %s",
1358 XSTRING (string
)->data
);
1359 fastmap
[c_leading_code
] = 1;
1362 char_ranges
[n_char_ranges
++] = c
;
1363 char_ranges
[n_char_ranges
++] = c2
;
1369 fastmap
[c_leading_code
] = 1;
1370 if (!SINGLE_BYTE_CHAR_P (c
))
1372 char_ranges
[n_char_ranges
++] = c
;
1373 char_ranges
[n_char_ranges
++] = c
;
1379 /* If ^ was the first character, complement the fastmap. In
1380 addition, as all multibyte characters have possibility of
1381 matching, set all entries for base leading codes, which is
1382 harmless even if SYNTAXP is 1. */
1385 for (i
= 0; i
< sizeof fastmap
; i
++)
1387 if (!multibyte
|| !BASE_LEADING_CODE_P (i
))
1394 int start_point
= PT
;
1396 int pos_byte
= PT_BYTE
;
1401 SETUP_SYNTAX_TABLE (pos
, forwardp
? 1 : -1);
1406 if (pos
< XINT (lim
))
1407 while (fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1409 /* Since we already checked for multibyteness,
1410 avoid using INC_BOTH which checks again. */
1413 if (pos
>= XINT (lim
))
1415 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1420 while (pos
< XINT (lim
)
1421 && fastmap
[(int) SYNTAX (FETCH_BYTE (pos
))])
1424 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1432 while (pos
> XINT (lim
))
1434 int savepos
= pos_byte
;
1435 /* Since we already checked for multibyteness,
1436 avoid using DEC_BOTH which checks again. */
1439 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
1440 if (!fastmap
[(int) SYNTAX (FETCH_CHAR (pos_byte
))])
1450 if (pos
> XINT (lim
))
1451 while (fastmap
[(int) SYNTAX (FETCH_BYTE (pos
- 1))])
1454 if (pos
<= XINT (lim
))
1456 UPDATE_SYNTAX_TABLE_BACKWARD (pos
- 1);
1466 while (pos
< XINT (lim
) && fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1468 if (!BASE_LEADING_CODE_P (c
))
1469 INC_BOTH (pos
, pos_byte
);
1470 else if (n_char_ranges
)
1472 /* We much check CHAR_RANGES for a multibyte
1474 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1475 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1476 if ((ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1]))
1478 if (!(negate
^ (i
< n_char_ranges
)))
1481 INC_BOTH (pos
, pos_byte
);
1486 INC_BOTH (pos
, pos_byte
);
1490 while (pos
< XINT (lim
) && fastmap
[FETCH_BYTE (pos
)])
1496 while (pos
> XINT (lim
))
1498 int savepos
= pos_byte
;
1499 DEC_BOTH (pos
, pos_byte
);
1500 if (fastmap
[(c
= FETCH_BYTE (pos_byte
))])
1502 if (!BASE_LEADING_CODE_P (c
))
1504 else if (n_char_ranges
)
1506 /* We much check CHAR_RANGES for a multibyte
1508 ch
= FETCH_MULTIBYTE_CHAR (pos_byte
);
1509 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1510 if (ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1])
1512 if (!(negate
^ (i
< n_char_ranges
)))
1535 while (pos
> XINT (lim
) && fastmap
[FETCH_BYTE (pos
- 1)])
1540 #if 0 /* Not needed now that a position in mid-character
1541 cannot be specified in Lisp. */
1543 /* INC_POS or DEC_POS might have moved POS over LIM. */
1544 && (forwardp
? (pos
> XINT (lim
)) : (pos
< XINT (lim
))))
1551 SET_PT_BOTH (pos
, pos_byte
);
1554 return make_number (PT
- start_point
);
1558 DEFUN ("forward-comment", Fforward_comment
, Sforward_comment
, 1, 1, 0,
1559 "Move forward across up to N comments. If N is negative, move backward.\n\
1560 Stop scanning if we find something other than a comment or whitespace.\n\
1561 Set point to where scanning stops.\n\
1562 If N comments are found as expected, with nothing except whitespace\n\
1563 between them, return t; otherwise return nil.")
1571 register enum syntaxcode code
;
1572 int comstyle
= 0; /* style of comment encountered */
1576 int out_charpos
, out_bytepos
;
1578 CHECK_NUMBER (count
, 0);
1579 count1
= XINT (count
);
1580 stop
= count1
> 0 ? ZV
: BEGV
;
1586 from_byte
= PT_BYTE
;
1588 SETUP_SYNTAX_TABLE (from
, count1
);
1595 SET_PT_BOTH (from
, from_byte
);
1599 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1600 c
= FETCH_CHAR (from_byte
);
1602 INC_BOTH (from
, from_byte
);
1604 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
1605 && (c1
= FETCH_CHAR (from_byte
),
1606 SYNTAX_COMSTART_SECOND (c1
)))
1608 /* We have encountered a comment start sequence and we
1609 are ignoring all text inside comments. We must record
1610 the comment style this sequence begins so that later,
1611 only a comment end of the same style actually ends
1612 the comment section. */
1614 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1615 INC_BOTH (from
, from_byte
);
1618 while (code
== Swhitespace
|| code
== Sendcomment
);
1620 if (code
!= Scomment
&& code
!= Scomment_fence
)
1623 DEC_BOTH (from
, from_byte
);
1624 SET_PT_BOTH (from
, from_byte
);
1627 /* We're at the start of a comment. */
1633 SET_PT_BOTH (from
, from_byte
);
1636 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1637 c
= FETCH_CHAR (from_byte
);
1638 INC_BOTH (from
, from_byte
);
1639 if (SYNTAX (c
) == Sendcomment
1640 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1641 /* we have encountered a comment end of the same style
1642 as the comment sequence which began this comment
1645 if (SYNTAX (c
) == Scomment_fence
1646 && comstyle
== ST_COMMENT_STYLE
)
1647 /* we have encountered a comment end of the same style
1648 as the comment sequence which began this comment
1651 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
1652 && (c1
= FETCH_CHAR (from_byte
),
1653 SYNTAX_COMEND_SECOND (c1
))
1654 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1655 /* we have encountered a comment end of the same style
1656 as the comment sequence which began this comment
1659 INC_BOTH (from
, from_byte
);
1663 /* We have skipped one comment. */
1674 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
1679 DEC_BOTH (from
, from_byte
);
1680 quoted
= char_quoted (from
, from_byte
);
1683 DEC_BOTH (from
, from_byte
);
1686 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1687 c
= FETCH_CHAR (from_byte
);
1690 if (code
== Sendcomment
)
1691 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1692 temp_pos
= dec_bytepos (from_byte
);
1693 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1694 && (c1
= FETCH_CHAR (temp_pos
),
1695 SYNTAX_COMEND_FIRST (c1
))
1696 && !char_quoted (from
- 1, temp_pos
))
1698 /* We must record the comment style encountered so that
1699 later, we can match only the proper comment begin
1700 sequence of the same style. */
1702 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1703 DEC_BOTH (from
, from_byte
);
1705 if (from
> stop
&& SYNTAX_COMSTART_SECOND (c
)
1706 && (c1
= FETCH_CHAR (temp_pos
),
1707 SYNTAX_COMSTART_FIRST (c1
))
1708 && !char_quoted (from
- 1, temp_pos
))
1710 /* We must record the comment style encountered so that
1711 later, we can match only the proper comment begin
1712 sequence of the same style. */
1714 DEC_BOTH (from
, from_byte
);
1717 if (code
== Scomment_fence
)
1719 /* Skip until first preceding unquoted comment_fence. */
1720 int found
= 0, ini
= from
, ini_byte
= from_byte
;
1724 DEC_BOTH (from
, from_byte
);
1727 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1728 c
= FETCH_CHAR (from_byte
);
1729 if (SYNTAX (c
) == Scomment_fence
1730 && !char_quoted (from
, from_byte
))
1738 from
= ini
; /* Set point to ini + 1. */
1739 from_byte
= ini_byte
;
1743 else if (code
== Sendcomment
)
1745 found
= back_comment (from
, from_byte
, stop
, comstyle
,
1746 &out_charpos
, &out_bytepos
);
1748 from
= out_charpos
, from_byte
= out_bytepos
;
1749 /* We have skipped one comment. */
1752 else if (code
!= Swhitespace
&& code
!= Scomment
)
1756 INC_BOTH (from
, from_byte
);
1757 SET_PT_BOTH (from
, from_byte
);
1765 SET_PT_BOTH (from
, from_byte
);
1771 scan_lists (from
, count
, depth
, sexpflag
)
1773 int count
, depth
, sexpflag
;
1776 register int stop
= count
> 0 ? ZV
: BEGV
;
1781 register enum syntaxcode code
, temp_code
;
1782 int min_depth
= depth
; /* Err out if depth gets less than this. */
1783 int comstyle
= 0; /* style of comment encountered */
1785 int last_good
= from
;
1787 int from_byte
= CHAR_TO_BYTE (from
);
1788 int out_bytepos
, out_charpos
;
1791 if (depth
> 0) min_depth
= 0;
1796 SETUP_SYNTAX_TABLE (from
, count
);
1801 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1802 c
= FETCH_CHAR (from_byte
);
1804 if (depth
== min_depth
)
1806 INC_BOTH (from
, from_byte
);
1807 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1808 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
1809 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
))
1810 && parse_sexp_ignore_comments
)
1812 /* we have encountered a comment start sequence and we
1813 are ignoring all text inside comments. We must record
1814 the comment style this sequence begins so that later,
1815 only a comment end of the same style actually ends
1816 the comment section */
1818 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
));
1819 INC_BOTH (from
, from_byte
);
1822 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1823 if (SYNTAX_PREFIX (c
))
1826 switch (SWITCH_ENUM_CAST (code
))
1830 if (from
== stop
) goto lose
;
1831 INC_BOTH (from
, from_byte
);
1832 /* treat following character as a word constituent */
1835 if (depth
|| !sexpflag
) break;
1836 /* This word counts as a sexp; return at end of it. */
1839 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1841 /* Some compilers can't handle this inside the switch. */
1842 temp
= SYNTAX (FETCH_CHAR (from_byte
));
1847 INC_BOTH (from
, from_byte
);
1848 if (from
== stop
) goto lose
;
1857 INC_BOTH (from
, from_byte
);
1862 case Scomment_fence
:
1863 if (!parse_sexp_ignore_comments
) break;
1872 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1873 c
= FETCH_CHAR (from_byte
);
1874 if (code
== Scomment
1875 ? (SYNTAX (c
) == Sendcomment
1876 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1877 : (SYNTAX (c
) == Scomment_fence
))
1878 /* we have encountered a comment end of the same style
1879 as the comment sequence which began this comment
1882 INC_BOTH (from
, from_byte
);
1883 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
1884 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from_byte
))
1885 && SYNTAX_COMMENT_STYLE (c
) == comstyle
1886 && code
== Scomment
)
1887 /* we have encountered a comment end of the same style
1888 as the comment sequence which began this comment
1891 INC_BOTH (from
, from_byte
);
1900 if (from
!= stop
&& c
== FETCH_CHAR (from_byte
))
1902 INC_BOTH (from
, from_byte
);
1912 if (!++depth
) goto done
;
1917 if (!--depth
) goto done
;
1918 if (depth
< min_depth
)
1919 Fsignal (Qscan_error
,
1920 Fcons (build_string ("Containing expression ends prematurely"),
1921 Fcons (make_number (last_good
),
1922 Fcons (make_number (from
), Qnil
))));
1927 temp_pos
= dec_bytepos (from_byte
);
1928 stringterm
= FETCH_CHAR (temp_pos
);
1931 if (from
>= stop
) goto lose
;
1932 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1934 ? (FETCH_CHAR (from_byte
) == stringterm
)
1935 : SYNTAX (FETCH_CHAR (from_byte
)) == Sstring_fence
)
1938 /* Some compilers can't handle this inside the switch. */
1939 temp
= SYNTAX (FETCH_CHAR (from_byte
));
1944 INC_BOTH (from
, from_byte
);
1946 INC_BOTH (from
, from_byte
);
1948 INC_BOTH (from
, from_byte
);
1949 if (!depth
&& sexpflag
) goto done
;
1954 /* Reached end of buffer. Error if within object, return nil if between */
1955 if (depth
) goto lose
;
1960 /* End of object reached */
1969 DEC_BOTH (from
, from_byte
);
1970 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1971 c
= FETCH_CHAR (from_byte
);
1973 if (depth
== min_depth
)
1976 if (code
== Sendcomment
)
1977 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1978 temp_pos
= from_byte
;
1979 if (! NILP (current_buffer
->enable_multibyte_characters
))
1983 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1984 && (c1
= FETCH_CHAR (temp_pos
), SYNTAX_COMEND_FIRST (c1
))
1985 && parse_sexp_ignore_comments
)
1987 /* we must record the comment style encountered so that
1988 later, we can match only the proper comment begin
1989 sequence of the same style */
1991 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1992 DEC_BOTH (from
, from_byte
);
1995 /* Quoting turns anything except a comment-ender
1996 into a word character. */
1997 if (code
!= Sendcomment
&& char_quoted (from
, from_byte
))
1999 else if (SYNTAX_PREFIX (c
))
2002 switch (SWITCH_ENUM_CAST (code
))
2008 if (depth
|| !sexpflag
) break;
2009 /* This word counts as a sexp; count object finished
2010 after passing it. */
2013 temp_pos
= from_byte
;
2014 if (! NILP (current_buffer
->enable_multibyte_characters
))
2018 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2019 c1
= FETCH_CHAR (temp_pos
);
2020 temp_code
= SYNTAX (c1
);
2021 /* Don't allow comment-end to be quoted. */
2022 if (temp_code
== Sendcomment
)
2024 quoted
= char_quoted (from
- 1, temp_pos
);
2027 DEC_BOTH (from
, from_byte
);
2028 temp_pos
= dec_bytepos (temp_pos
);
2029 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2031 c1
= FETCH_CHAR (temp_pos
);
2032 temp_code
= SYNTAX (c1
);
2033 if (! (quoted
|| temp_code
== Sword
2034 || temp_code
== Ssymbol
2035 || temp_code
== Squote
))
2037 DEC_BOTH (from
, from_byte
);
2044 temp_pos
= dec_bytepos (from_byte
);
2045 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2046 if (from
!= stop
&& c
== FETCH_CHAR (temp_pos
))
2047 DEC_BOTH (from
, from_byte
);
2056 if (!++depth
) goto done2
;
2061 if (!--depth
) goto done2
;
2062 if (depth
< min_depth
)
2063 Fsignal (Qscan_error
,
2064 Fcons (build_string ("Containing expression ends prematurely"),
2065 Fcons (make_number (last_good
),
2066 Fcons (make_number (from
), Qnil
))));
2070 if (!parse_sexp_ignore_comments
)
2072 found
= back_comment (from
, from_byte
, stop
, comstyle
,
2073 &out_charpos
, &out_bytepos
);
2075 from
= out_charpos
, from_byte
= out_bytepos
;
2078 case Scomment_fence
:
2082 DEC_BOTH (from
, from_byte
);
2083 if (from
== stop
) goto lose
;
2084 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2085 if (!char_quoted (from
, from_byte
)
2086 && SYNTAX (FETCH_CHAR (from_byte
)) == code
)
2089 if (code
== Sstring_fence
&& !depth
&& sexpflag
) goto done2
;
2093 stringterm
= FETCH_CHAR (from_byte
);
2096 if (from
== stop
) goto lose
;
2097 temp_pos
= from_byte
;
2098 if (! NILP (current_buffer
->enable_multibyte_characters
))
2102 UPDATE_SYNTAX_TABLE_BACKWARD (from
- 1);
2103 if (!char_quoted (from
- 1, temp_pos
)
2104 && stringterm
== FETCH_CHAR (temp_pos
))
2106 DEC_BOTH (from
, from_byte
);
2108 DEC_BOTH (from
, from_byte
);
2109 if (!depth
&& sexpflag
) goto done2
;
2114 /* Reached start of buffer. Error if within object, return nil if between */
2115 if (depth
) goto lose
;
2126 XSETFASTINT (val
, from
);
2130 Fsignal (Qscan_error
,
2131 Fcons (build_string ("Unbalanced parentheses"),
2132 Fcons (make_number (last_good
),
2133 Fcons (make_number (from
), Qnil
))));
2138 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
2139 "Scan from character number FROM by COUNT lists.\n\
2140 Returns the character number of the position thus found.\n\
2142 If DEPTH is nonzero, paren depth begins counting from that value,\n\
2143 only places where the depth in parentheses becomes zero\n\
2144 are candidates for stopping; COUNT such places are counted.\n\
2145 Thus, a positive value for DEPTH means go out levels.\n\
2147 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2149 If the beginning or end of (the accessible part of) the buffer is reached\n\
2150 and the depth is wrong, an error is signaled.\n\
2151 If the depth is right but the count is not used up, nil is returned.")
2152 (from
, count
, depth
)
2153 Lisp_Object from
, count
, depth
;
2155 CHECK_NUMBER (from
, 0);
2156 CHECK_NUMBER (count
, 1);
2157 CHECK_NUMBER (depth
, 2);
2159 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
2162 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
2163 "Scan from character number FROM by COUNT balanced expressions.\n\
2164 If COUNT is negative, scan backwards.\n\
2165 Returns the character number of the position thus found.\n\
2167 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2169 If the beginning or end of (the accessible part of) the buffer is reached\n\
2170 in the middle of a parenthetical grouping, an error is signaled.\n\
2171 If the beginning or end is reached between groupings\n\
2172 but before count is used up, nil is returned.")
2174 Lisp_Object from
, count
;
2176 CHECK_NUMBER (from
, 0);
2177 CHECK_NUMBER (count
, 1);
2179 return scan_lists (XINT (from
), XINT (count
), 0, 1);
2182 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
2184 "Move point backward over any number of chars with prefix syntax.\n\
2185 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
2190 int opoint_byte
= PT_BYTE
;
2192 int pos_byte
= PT_BYTE
;
2197 SETUP_SYNTAX_TABLE (pos
, -1);
2200 DEC_BOTH (pos
, pos_byte
);
2202 while (!char_quoted (pos
, pos_byte
)
2203 /* Previous statement updates syntax table. */
2204 && ((c
= FETCH_CHAR (pos_byte
), SYNTAX (c
) == Squote
)
2205 || SYNTAX_PREFIX (c
)))
2208 opoint_byte
= pos_byte
;
2211 DEC_BOTH (pos
, pos_byte
);
2214 SET_PT_BOTH (opoint
, opoint_byte
);
2219 /* Parse forward from FROM / FROM_BYTE to END,
2220 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
2221 and return a description of the state of the parse at END.
2222 If STOPBEFORE is nonzero, stop at the start of an atom.
2223 If COMMENTSTOP is 1, stop at the start of a comment.
2224 If COMMENTSTOP is -1, stop at the start or end of a comment,
2225 after the beginning of a string, or after the end of a string. */
2228 scan_sexps_forward (stateptr
, from
, from_byte
, end
, targetdepth
,
2229 stopbefore
, oldstate
, commentstop
)
2230 struct lisp_parse_state
*stateptr
;
2232 int end
, targetdepth
, stopbefore
;
2233 Lisp_Object oldstate
;
2236 struct lisp_parse_state state
;
2238 register enum syntaxcode code
;
2239 struct level
{ int last
, prev
; };
2240 struct level levelstart
[100];
2241 register struct level
*curlevel
= levelstart
;
2242 struct level
*endlevel
= levelstart
+ 100;
2244 register int depth
; /* Paren depth of current scanning location.
2245 level - levelstart equals this except
2246 when the depth becomes negative. */
2247 int mindepth
; /* Lowest DEPTH value seen. */
2248 int start_quoted
= 0; /* Nonzero means starting after a char quote */
2250 int prev_from
; /* Keep one character before FROM. */
2252 int prev_from_syntax
;
2253 int boundary_stop
= commentstop
== -1;
2258 prev_from_byte
= from_byte
;
2260 DEC_BOTH (prev_from
, prev_from_byte
);
2262 /* Use this macro instead of `from++'. */
2264 do { prev_from = from; \
2265 prev_from_byte = from_byte; \
2267 = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); \
2268 INC_BOTH (from, from_byte); \
2269 UPDATE_SYNTAX_TABLE_FORWARD (from); \
2275 if (NILP (oldstate
))
2278 state
.instring
= -1;
2279 state
.incomment
= 0;
2280 state
.comstyle
= 0; /* comment style a by default. */
2281 state
.comstr_start
= -1; /* no comment/string seen. */
2285 tem
= Fcar (oldstate
);
2291 oldstate
= Fcdr (oldstate
);
2292 oldstate
= Fcdr (oldstate
);
2293 oldstate
= Fcdr (oldstate
);
2294 tem
= Fcar (oldstate
);
2295 /* Check whether we are inside string_fence-style string: */
2296 state
.instring
= ( !NILP (tem
)
2297 ? ( INTEGERP (tem
) ? XINT (tem
) : ST_STRING_STYLE
)
2300 oldstate
= Fcdr (oldstate
);
2301 tem
= Fcar (oldstate
);
2302 state
.incomment
= !NILP (tem
);
2304 oldstate
= Fcdr (oldstate
);
2305 tem
= Fcar (oldstate
);
2306 start_quoted
= !NILP (tem
);
2308 /* if the eight element of the list is nil, we are in comment
2309 style a. If it is non-nil, we are in comment style b */
2310 oldstate
= Fcdr (oldstate
);
2311 oldstate
= Fcdr (oldstate
);
2312 tem
= Fcar (oldstate
);
2313 state
.comstyle
= NILP (tem
) ? 0 : ( EQ (tem
, Qsyntax_table
)
2314 ? ST_COMMENT_STYLE
: 1 );
2316 oldstate
= Fcdr (oldstate
);
2317 tem
= Fcar (oldstate
);
2318 state
.comstr_start
= NILP (tem
) ? -1 : XINT (tem
) ;
2323 curlevel
->prev
= -1;
2324 curlevel
->last
= -1;
2326 /* Enter the loop at a place appropriate for initial state. */
2328 if (state
.incomment
) goto startincomment
;
2329 if (state
.instring
>= 0)
2331 nofence
= state
.instring
!= ST_STRING_STYLE
;
2332 if (start_quoted
) goto startquotedinstring
;
2335 if (start_quoted
) goto startquoted
;
2338 SETUP_SYNTAX_TABLE (prev_from
, 1);
2339 prev_from_syntax
= SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte
));
2340 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2345 code
= prev_from_syntax
& 0xff;
2347 if (code
== Scomment
)
2348 state
.comstr_start
= prev_from
;
2349 else if (code
== Scomment_fence
)
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
)
2362 else if (from
< end
)
2363 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax
))
2364 if (SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte
)))
2365 /* Duplicate code to avoid a complex if-expression
2366 which causes trouble for the SGI compiler. */
2368 /* Record the comment style we have entered so that only
2369 the comment-end sequence of the same style actually
2370 terminates the comment section. */
2371 state
.comstyle
= ( code
== Scomment_fence
2373 : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte
)));
2374 state
.comstr_start
= prev_from
;
2375 if (code
!= Scomment_fence
)
2380 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax
))
2382 switch (SWITCH_ENUM_CAST (code
))
2386 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2387 curlevel
->last
= prev_from
;
2389 if (from
== end
) goto endquoted
;
2392 /* treat following character as a word constituent */
2395 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2396 curlevel
->last
= prev_from
;
2400 /* Some compilers can't handle this inside the switch. */
2401 temp
= SYNTAX (FETCH_CHAR (from_byte
));
2407 if (from
== end
) goto endquoted
;
2419 curlevel
->prev
= curlevel
->last
;
2423 if (commentstop
== 1)
2427 /* Enter the loop in the middle so that we find
2428 a 2-char comment ender if we start in the middle of it. */
2429 goto startincomment_1
;
2431 /* At beginning of buffer, enter the loop the ordinary way. */
2432 state
.incomment
= 1;
2436 state
.incomment
= 1;
2437 if (commentstop
|| boundary_stop
) goto done
;
2441 if (from
== end
) goto done
;
2442 prev
= FETCH_CHAR (from_byte
);
2443 if (SYNTAX (prev
) == Sendcomment
2444 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
2445 /* Only terminate the comment section if the endcomment
2446 of the same style as the start sequence has been
2449 if (state
.comstyle
== ST_COMMENT_STYLE
2450 && SYNTAX (prev
) == Scomment_fence
)
2454 if (from
< end
&& SYNTAX_FLAGS_COMEND_FIRST (prev_from_syntax
)
2455 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from_byte
))
2456 && (SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax
)
2458 /* Only terminate the comment section if the end-comment
2459 sequence of the same style as the start sequence has
2460 been encountered. */
2464 state
.incomment
= 0;
2465 state
.comstyle
= 0; /* reset the comment style */
2466 if (boundary_stop
) goto done
;
2470 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2472 /* curlevel++->last ran into compiler bug on Apollo */
2473 curlevel
->last
= prev_from
;
2474 if (++curlevel
== endlevel
)
2475 error ("Nesting too deep for parser");
2476 curlevel
->prev
= -1;
2477 curlevel
->last
= -1;
2478 if (targetdepth
== depth
) goto done
;
2483 if (depth
< mindepth
)
2485 if (curlevel
!= levelstart
)
2487 curlevel
->prev
= curlevel
->last
;
2488 if (targetdepth
== depth
) goto done
;
2493 state
.comstr_start
= from
- 1;
2494 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2495 curlevel
->last
= prev_from
;
2496 state
.instring
= (code
== Sstring
2497 ? (FETCH_CHAR (prev_from_byte
))
2499 if (boundary_stop
) goto done
;
2502 nofence
= state
.instring
!= ST_STRING_STYLE
;
2508 if (from
>= end
) goto done
;
2509 c
= FETCH_CHAR (from_byte
);
2510 if (nofence
&& c
== state
.instring
) break;
2512 /* Some compilers can't handle this inside the switch. */
2517 if (!nofence
) goto string_end
;
2522 startquotedinstring
:
2523 if (from
>= end
) goto endquoted
;
2529 state
.instring
= -1;
2530 curlevel
->prev
= curlevel
->last
;
2532 if (boundary_stop
) goto done
;
2541 stop
: /* Here if stopping before start of sexp. */
2542 from
= prev_from
; /* We have just fetched the char that starts it; */
2543 goto done
; /* but return the position before it. */
2548 state
.depth
= depth
;
2549 state
.mindepth
= mindepth
;
2550 state
.thislevelstart
= curlevel
->prev
;
2551 state
.prevlevelstart
2552 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
2553 state
.location
= from
;
2559 /* This comment supplies the doc string for parse-partial-sexp,
2560 for make-docfile to see. We cannot put this in the real DEFUN
2561 due to limits in the Unix cpp.
2563 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
2564 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
2565 Parsing stops at TO or when certain criteria are met;\n\
2566 point is set to where parsing stops.\n\
2567 If fifth arg STATE is omitted or nil,\n\
2568 parsing assumes that FROM is the beginning of a function.\n\
2569 Value is a list of nine elements describing final state of parsing:\n\
2570 0. depth in parens.\n\
2571 1. character address of start of innermost containing list; nil if none.\n\
2572 2. character address of start of last complete sexp terminated.\n\
2573 3. non-nil if inside a string.\n\
2574 (it is the character that will terminate the string,\n\
2575 or t if the string should be terminated by a generic string delimiter.)\n\
2576 4. t if inside a comment.\n\
2577 5. t if following a quote character.\n\
2578 6. the minimum paren-depth encountered during this scan.\n\
2579 7. t if in a comment of style b; `syntax-table' if the comment\n\
2580 should be terminated by a generic comment delimiter.\n\
2581 8. character address of start of comment or string; nil if not in one.\n\
2582 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
2583 in parentheses becomes equal to TARGETDEPTH.\n\
2584 Fourth arg STOPBEFORE non-nil means stop when come to\n\
2585 any character that starts a sexp.\n\
2586 Fifth arg STATE is a nine-element list like what this function returns.\n\
2587 It is used to initialize the state of the parse. Elements number 1, 2, 6\n\
2588 and 8 are ignored; you can leave off element 8 (the last) entirely.\n\
2589 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.\n\
2590 If it is `syntax-table', stop after the start of a comment or a string,\n\
2591 or after end of a comment or a string.")
2592 (from, to, targetdepth, stopbefore, state, commentstop)
2595 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 6, 0,
2596 0 /* See immediately above */)
2597 (from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
)
2598 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
;
2600 struct lisp_parse_state state
;
2603 if (!NILP (targetdepth
))
2605 CHECK_NUMBER (targetdepth
, 3);
2606 target
= XINT (targetdepth
);
2609 target
= -100000; /* We won't reach this depth */
2611 validate_region (&from
, &to
);
2612 scan_sexps_forward (&state
, XINT (from
), CHAR_TO_BYTE (XINT (from
)),
2614 target
, !NILP (stopbefore
), oldstate
,
2616 ? 0 : (EQ (commentstop
, Qsyntax_table
) ? -1 : 1)));
2618 SET_PT (state
.location
);
2620 return Fcons (make_number (state
.depth
),
2621 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
2622 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
2623 Fcons (state
.instring
>= 0
2624 ? (state
.instring
== ST_STRING_STYLE
2625 ? Qt
: make_number (state
.instring
)) : Qnil
,
2626 Fcons (state
.incomment
? Qt
: Qnil
,
2627 Fcons (state
.quoted
? Qt
: Qnil
,
2628 Fcons (make_number (state
.mindepth
),
2629 Fcons ((state
.comstyle
2630 ? (state
.comstyle
== ST_COMMENT_STYLE
2631 ? Qsyntax_table
: Qt
) :
2633 Fcons ((state
.incomment
|| state
.instring
2634 ? make_number (state
.comstr_start
)
2645 /* This has to be done here, before we call Fmake_char_table. */
2646 Qsyntax_table
= intern ("syntax-table");
2647 staticpro (&Qsyntax_table
);
2649 /* Intern this now in case it isn't already done.
2650 Setting this variable twice is harmless.
2651 But don't staticpro it here--that is done in alloc.c. */
2652 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
2654 /* Create objects which can be shared among syntax tables. */
2655 Vsyntax_code_object
= Fmake_vector (make_number (13), Qnil
);
2656 for (i
= 0; i
< XVECTOR (Vsyntax_code_object
)->size
; i
++)
2657 XVECTOR (Vsyntax_code_object
)->contents
[i
]
2658 = Fcons (make_number (i
), Qnil
);
2660 /* Now we are ready to set up this property, so we can
2661 create syntax tables. */
2662 Fput (Qsyntax_table
, Qchar_table_extra_slots
, make_number (0));
2664 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Swhitespace
];
2666 Vstandard_syntax_table
= Fmake_char_table (Qsyntax_table
, temp
);
2668 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Sword
];
2669 for (i
= 'a'; i
<= 'z'; i
++)
2670 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2671 for (i
= 'A'; i
<= 'Z'; i
++)
2672 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2673 for (i
= '0'; i
<= '9'; i
++)
2674 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2676 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '$', temp
);
2677 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '%', temp
);
2679 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '(',
2680 Fcons (make_number (Sopen
), make_number (')')));
2681 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ')',
2682 Fcons (make_number (Sclose
), make_number ('(')));
2683 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '[',
2684 Fcons (make_number (Sopen
), make_number (']')));
2685 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ']',
2686 Fcons (make_number (Sclose
), make_number ('[')));
2687 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '{',
2688 Fcons (make_number (Sopen
), make_number ('}')));
2689 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '}',
2690 Fcons (make_number (Sclose
), make_number ('{')));
2691 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '"',
2692 Fcons (make_number ((int) Sstring
), Qnil
));
2693 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '\\',
2694 Fcons (make_number ((int) Sescape
), Qnil
));
2696 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Ssymbol
];
2697 for (i
= 0; i
< 10; i
++)
2699 c
= "_-+*/&|<>="[i
];
2700 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2703 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Spunct
];
2704 for (i
= 0; i
< 12; i
++)
2706 c
= ".,;:?!#@~^'`"[i
];
2707 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2714 Qsyntax_table_p
= intern ("syntax-table-p");
2715 staticpro (&Qsyntax_table_p
);
2717 staticpro (&Vsyntax_code_object
);
2719 Qscan_error
= intern ("scan-error");
2720 staticpro (&Qscan_error
);
2721 Fput (Qscan_error
, Qerror_conditions
,
2722 Fcons (Qerror
, Qnil
));
2723 Fput (Qscan_error
, Qerror_message
,
2724 build_string ("Scan error"));
2726 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
2727 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
2729 DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties
,
2730 "Non-nil means `forward-sexp', etc., grant `syntax-table' property.\n\
2731 The value of this property should be either a syntax table, or a cons\n\
2732 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric\n\
2733 syntax code, MATCHCHAR being nil or the character to match (which is\n\
2734 relevant only for open/close type.");
2736 words_include_escapes
= 0;
2737 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
2738 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
2740 defsubr (&Ssyntax_table_p
);
2741 defsubr (&Ssyntax_table
);
2742 defsubr (&Sstandard_syntax_table
);
2743 defsubr (&Scopy_syntax_table
);
2744 defsubr (&Sset_syntax_table
);
2745 defsubr (&Schar_syntax
);
2746 defsubr (&Smatching_paren
);
2747 defsubr (&Smodify_syntax_entry
);
2748 defsubr (&Sdescribe_syntax
);
2750 defsubr (&Sforward_word
);
2752 defsubr (&Sskip_chars_forward
);
2753 defsubr (&Sskip_chars_backward
);
2754 defsubr (&Sskip_syntax_forward
);
2755 defsubr (&Sskip_syntax_backward
);
2757 defsubr (&Sforward_comment
);
2758 defsubr (&Sscan_lists
);
2759 defsubr (&Sscan_sexps
);
2760 defsubr (&Sbackward_prefix_chars
);
2761 defsubr (&Sparse_partial_sexp
);