1 /* GNU Emacs routines to deal with syntax tables; also word and list parsing.
2 Copyright (C) 1985, 87, 93, 94, 95, 1997 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 static void scan_sexps_forward ();
46 static int char_quoted ();
48 int words_include_escapes
;
49 int parse_sexp_lookup_properties
;
51 /* Used as a temporary in SYNTAX_ENTRY and other macros in syntax.h,
52 if not compiled with GCC. No need to mark it, since it is used
53 only very temporarily. */
54 Lisp_Object syntax_temp
;
56 /* This is the internal form of the parse state used in parse-partial-sexp. */
58 struct lisp_parse_state
60 int depth
; /* Depth at end of parsing. */
61 int instring
; /* -1 if not within string, else desired terminator. */
62 int incomment
; /* Nonzero if within a comment at end of parsing. */
63 int comstyle
; /* comment style a=0, or b=1, or ST_COMMENT_STYLE. */
64 int quoted
; /* Nonzero if just after an escape char at end of parsing */
65 int thislevelstart
; /* Char number of most recent start-of-expression at current level */
66 int prevlevelstart
; /* Char number of start of containing expression */
67 int location
; /* Char number at which parsing stopped. */
68 int mindepth
; /* Minimum depth seen while scanning. */
69 int comstr_start
; /* Position just after last comment/string starter. */
72 /* These variables are a cache for finding the start of a defun.
73 find_start_pos is the place for which the defun start was found.
74 find_start_value is the defun start position found for it.
75 find_start_buffer is the buffer it was found in.
76 find_start_begv is the BEGV value when it was found.
77 find_start_modiff is the value of MODIFF when it was found. */
79 static int find_start_pos
;
80 static int find_start_value
;
81 static struct buffer
*find_start_buffer
;
82 static int find_start_begv
;
83 static int find_start_modiff
;
86 struct gl_state_s gl_state
; /* Global state of syntax parser. */
88 INTERVAL
interval_of ();
89 #define INTERVALS_AT_ONCE 10 /* 1 + max-number of intervals
90 to scan to property-change. */
93 Update gl_state to an appropriate interval which contains POS. The
94 sign of COUNT give the relative position of POS wrt the previously
95 valid interval. If INIT, only [be]_property fields of gl_state are
96 valid at start, the rest is filled basing on OBJECT.
98 `gl_state.*_i' are the intervals, and pos is further in the search
99 direction than the intervals - or in an interval. We update the
100 current syntax-table basing on the property of this interval, and
101 update the interval to start further than POS - or be
102 NULL_INTERVAL. We also update lim_property to be the next value of
103 pos to call this subroutine again - or be before/after the
104 start/end of OBJECT. */
107 update_syntax_table (pos
, count
, init
, object
)
108 int pos
, count
, init
;
111 Lisp_Object tmp_table
;
112 int cnt
= 0, doing_extra
= 0, invalidate
= 1;
117 gl_state
.start
= gl_state
.b_property
;
118 gl_state
.stop
= gl_state
.e_property
;
119 gl_state
.forward_i
= interval_of (pos
, object
);
120 i
= gl_state
.backward_i
= gl_state
.forward_i
;
121 gl_state
.left_ok
= gl_state
.right_ok
= 1;
123 if (NULL_INTERVAL_P (i
))
125 gl_state
.b_property
= i
->position
- 1;
126 gl_state
.e_property
= INTERVAL_LAST_POS (i
);
129 oldi
= i
= count
> 0 ? gl_state
.forward_i
: gl_state
.backward_i
;
131 /* We are guarantied to be called with pos either in i, of further off. */
132 if (NULL_INTERVAL_P (i
))
133 error ("Error in syntax_table logic for to-the-end intervals");
134 else if (pos
< i
->position
) /* Move left. */
137 error ("Error in syntax_table logic for intervals <-.");
138 /* Update the interval. */
139 i
= update_interval (i
, pos
);
140 if (oldi
->position
!= INTERVAL_LAST_POS (i
))
143 gl_state
.right_ok
= 1; /* Invalidate the other end. */
144 gl_state
.forward_i
= i
;
145 gl_state
.e_property
= INTERVAL_LAST_POS (i
);
148 else if (pos
>= INTERVAL_LAST_POS (i
)) /* Move right. */
151 error ("Error in syntax_table logic for intervals ->.");
152 /* Update the interval. */
153 i
= update_interval (i
, pos
);
154 if (i
->position
!= INTERVAL_LAST_POS (oldi
))
157 gl_state
.left_ok
= 1; /* Invalidate the other end. */
158 gl_state
.backward_i
= i
;
159 gl_state
.b_property
= i
->position
- 1;
162 else if (count
> 0 ? gl_state
.right_ok
: gl_state
.left_ok
)
164 /* We do not need to recalculate tmp_table. */
165 tmp_table
= gl_state
.old_prop
;
169 tmp_table
= textget (i
->plist
, Qsyntax_table
);
172 invalidate
= !EQ (tmp_table
, gl_state
.old_prop
); /* Need to invalidate? */
174 if (invalidate
) /* Did not get to adjacent interval. */
175 { /* with the same table => */
176 /* invalidate the old range. */
179 gl_state
.backward_i
= i
;
180 gl_state
.left_ok
= 1; /* Invalidate the other end. */
181 gl_state
.b_property
= i
->position
- 1;
185 gl_state
.forward_i
= i
;
186 gl_state
.right_ok
= 1; /* Invalidate the other end. */
187 gl_state
.e_property
= INTERVAL_LAST_POS (i
);
191 gl_state
.current_syntax_table
= tmp_table
;
192 gl_state
.old_prop
= tmp_table
;
193 if (EQ (Fsyntax_table_p (tmp_table
), Qt
))
195 gl_state
.use_global
= 0;
197 else if (CONSP (tmp_table
))
199 gl_state
.use_global
= 1;
200 gl_state
.global_code
= tmp_table
;
204 gl_state
.use_global
= 0;
205 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
208 while (!NULL_INTERVAL_P (i
))
210 if (cnt
&& !EQ (tmp_table
, textget (i
->plist
, Qsyntax_table
)))
213 gl_state
.right_ok
= 0;
215 gl_state
.left_ok
= 0;
218 else if (cnt
== INTERVALS_AT_ONCE
)
221 gl_state
.right_ok
= 1;
223 gl_state
.left_ok
= 1;
227 i
= count
> 0 ? next_interval (i
) : previous_interval (i
);
229 if (NULL_INTERVAL_P (i
))
230 { /* This property goes to the end. */
232 gl_state
.e_property
= gl_state
.stop
;
234 gl_state
.b_property
= gl_state
.start
;
240 gl_state
.e_property
= i
->position
;
241 gl_state
.forward_i
= i
;
245 gl_state
.b_property
= i
->position
+ LENGTH (i
) - 1;
246 gl_state
.backward_i
= i
;
251 /* Returns TRUE if char at POS is quoted.
252 Global syntax-table data should be set up already to be good at pos
253 or after. On return global syntax data is good for lookup at POS. */
259 register enum syntaxcode code
;
260 register int beg
= BEGV
;
261 register int quoted
= 0;
265 while (temp_pos
>= beg
266 && ( UPDATE_SYNTAX_TABLE_BACKWARD (temp_pos
), 1)
267 && ((code
= SYNTAX (FETCH_CHAR (temp_pos
))) == Scharquote
270 temp_pos
--, quoted
= !quoted
;
272 UPDATE_SYNTAX_TABLE (pos
);
276 /* Find a defun-start that is the last one before POS (or nearly the last).
277 We record what we find, so that another call in the same area
278 can return the same value right away.
280 There is no promise at which position the global syntax data is
281 valid on return from the subroutine, so the caller should explicitly
282 update the global data. */
285 find_defun_start (pos
)
291 /* Use previous finding, if it's valid and applies to this inquiry. */
292 if (current_buffer
== find_start_buffer
293 /* Reuse the defun-start even if POS is a little farther on.
294 POS might be in the next defun, but that's ok.
295 Our value may not be the best possible, but will still be usable. */
296 && pos
<= find_start_pos
+ 1000
297 && pos
>= find_start_value
298 && BEGV
== find_start_begv
299 && MODIFF
== find_start_modiff
)
300 return find_start_value
;
302 /* Back up to start of line. */
303 tem
= scan_buffer ('\n', pos
, BEGV
, -1, &shortage
, 1);
305 /* We optimize syntax-table lookup for rare updates. Thus we accept
306 only those `^\s(' which are good in global _and_ text-property
308 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
309 gl_state
.use_global
= 0;
312 /* Open-paren at start of line means we found our defun-start. */
313 if (SYNTAX (FETCH_CHAR (tem
)) == Sopen
)
315 SETUP_SYNTAX_TABLE (tem
+ 1, -1); /* Try again... */
316 if (SYNTAX (FETCH_CHAR (tem
)) == Sopen
)
318 /* Now fallback to the default value. */
319 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
320 gl_state
.use_global
= 0;
322 /* Move to beg of previous line. */
323 tem
= scan_buffer ('\n', tem
, BEGV
, -2, &shortage
, 1);
326 /* Record what we found, for the next try. */
327 find_start_value
= tem
;
328 find_start_buffer
= current_buffer
;
329 find_start_modiff
= MODIFF
;
330 find_start_begv
= BEGV
;
331 find_start_pos
= pos
;
333 return find_start_value
;
336 /* Checks whether FROM is the end of comment. Does not try to
337 fallback more than to STOP.
338 Returns -1 if cannot find comment ending at from, otherwise start
339 of comment. Global syntax data remains valid for
340 backward search starting at the returned value (or at FROM, if
341 the search was not successful). */
344 back_comment (from
, stop
, comstyle
)
345 int from
, stop
, comstyle
;
347 /* Look back, counting the parity of string-quotes,
348 and recording the comment-starters seen.
349 When we reach a safe place, assume that's not in a string;
350 then step the main scan to the earliest comment-starter seen
351 an even number of string quotes away from the safe place.
353 OFROM[I] is position of the earliest comment-starter seen
354 which is I+2X quotes from the comment-end.
355 PARITY is current parity of quotes from the comment end. */
357 int my_stringend
= 0;
358 int string_lossage
= 0;
359 int comment_end
= from
;
360 int comstart_pos
= 0;
361 int comstart_parity
= 0;
362 int scanstart
= from
- 1;
363 register enum syntaxcode code
;
366 /* At beginning of range to scan, we're outside of strings;
367 that determines quote parity to the comment-end. */
370 /* Move back and examine a character. */
372 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
374 c
= FETCH_CHAR (from
);
377 /* If this char is the second of a 2-char comment sequence,
378 back up and give the pair the appropriate syntax. */
379 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
380 && SYNTAX_COMEND_FIRST (FETCH_CHAR (from
- 1)))
384 /* This is apparently the best we can do: */
385 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
386 c
= FETCH_CHAR (from
);
389 /* If this char starts a 2-char comment start sequence,
390 treat it like a 1-char comment starter. */
391 if (from
< scanstart
&& SYNTAX_COMSTART_SECOND (c
)
392 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
- 1))
393 && comstyle
== SYNTAX_COMMENT_STYLE (c
))
397 /* This is apparently the best we can do: */
398 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
399 c
= FETCH_CHAR (from
);
402 /* Ignore escaped characters. */
403 if (char_quoted (from
))
406 /* Track parity of quotes. */
410 if (my_stringend
== 0)
412 /* If we have two kinds of string delimiters.
413 There's no way to grok this scanning backwards. */
414 else if (my_stringend
!= c
)
418 if (code
== Sstring_fence
|| code
== Scomment_fence
)
421 if (my_stringend
== 0)
423 code
== Sstring_fence
? ST_STRING_STYLE
: ST_COMMENT_STYLE
;
424 /* If we have two kinds of string delimiters.
425 There's no way to grok this scanning backwards. */
426 else if (my_stringend
!= (code
== Sstring_fence
427 ? ST_STRING_STYLE
: ST_COMMENT_STYLE
))
431 /* Record comment-starters according to that
432 quote-parity to the comment-end. */
433 if (code
== Scomment
)
435 comstart_parity
= parity
;
439 /* If we find another earlier comment-ender,
440 any comment-starts earlier than that don't count
441 (because they go with the earlier comment-ender). */
442 if (code
== Sendcomment
443 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
)) == comstyle
)
446 /* Assume a defun-start point is outside of strings. */
448 && (from
== stop
|| FETCH_CHAR (from
- 1) == '\n'))
452 if (comstart_pos
== 0)
455 UPDATE_SYNTAX_TABLE_FORWARD (comment_end
- 1);
457 /* If the earliest comment starter
458 is followed by uniform paired string quotes or none,
459 we know it can't be inside a string
460 since if it were then the comment ender would be inside one.
461 So it does start a comment. Skip back to it. */
462 else if (comstart_parity
== 0 && !string_lossage
)
465 /* Globals are correct now. */
469 /* We had two kinds of string delimiters mixed up
470 together. Decode this going forwards.
471 Scan fwd from the previous comment ender
472 to the one in question; this records where we
473 last passed a comment starter. */
474 struct lisp_parse_state state
;
475 scan_sexps_forward (&state
, find_defun_start (comment_end
),
476 comment_end
- 1, -10000, 0, Qnil
, 0);
479 /* scan_sexps_forward changed the direction of search in
480 global variables, so we need to update it completely. */
482 from
= state
.comstr_start
;
488 UPDATE_SYNTAX_TABLE_FORWARD (from
- 1);
494 DEFUN ("syntax-table-p", Fsyntax_table_p
, Ssyntax_table_p
, 1, 1, 0,
495 "Return t if OBJECT is a syntax table.\n\
496 Currently, any char-table counts as a syntax table.")
500 if (CHAR_TABLE_P (object
)
501 && EQ (XCHAR_TABLE (object
)->purpose
, Qsyntax_table
))
507 check_syntax_table (obj
)
510 if (!(CHAR_TABLE_P (obj
)
511 && EQ (XCHAR_TABLE (obj
)->purpose
, Qsyntax_table
)))
512 wrong_type_argument (Qsyntax_table_p
, obj
);
515 DEFUN ("syntax-table", Fsyntax_table
, Ssyntax_table
, 0, 0, 0,
516 "Return the current syntax table.\n\
517 This is the one specified by the current buffer.")
520 return current_buffer
->syntax_table
;
523 DEFUN ("standard-syntax-table", Fstandard_syntax_table
,
524 Sstandard_syntax_table
, 0, 0, 0,
525 "Return the standard syntax table.\n\
526 This is the one used for new buffers.")
529 return Vstandard_syntax_table
;
532 DEFUN ("copy-syntax-table", Fcopy_syntax_table
, Scopy_syntax_table
, 0, 1, 0,
533 "Construct a new syntax table and return it.\n\
534 It is a copy of the TABLE, which defaults to the standard syntax table.")
541 check_syntax_table (table
);
543 table
= Vstandard_syntax_table
;
545 copy
= Fcopy_sequence (table
);
547 /* Only the standard syntax table should have a default element.
548 Other syntax tables should inherit from parents instead. */
549 XCHAR_TABLE (copy
)->defalt
= Qnil
;
551 /* Copied syntax tables should all have parents.
552 If we copied one with no parent, such as the standard syntax table,
553 use the standard syntax table as the copy's parent. */
554 if (NILP (XCHAR_TABLE (copy
)->parent
))
555 Fset_char_table_parent (copy
, Vstandard_syntax_table
);
559 DEFUN ("set-syntax-table", Fset_syntax_table
, Sset_syntax_table
, 1, 1, 0,
560 "Select a new syntax table for the current buffer.\n\
561 One argument, a syntax table.")
565 check_syntax_table (table
);
566 current_buffer
->syntax_table
= table
;
567 /* Indicate that this buffer now has a specified syntax table. */
568 current_buffer
->local_var_flags
569 |= XFASTINT (buffer_local_flags
.syntax_table
);
573 /* Convert a letter which signifies a syntax code
574 into the code it signifies.
575 This is used by modify-syntax-entry, and other things. */
577 unsigned char syntax_spec_code
[0400] =
578 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
579 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
580 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
581 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
582 (char) Swhitespace
, (char) Scomment_fence
, (char) Sstring
, 0377,
583 (char) Smath
, 0377, 0377, (char) Squote
,
584 (char) Sopen
, (char) Sclose
, 0377, 0377,
585 0377, (char) Swhitespace
, (char) Spunct
, (char) Scharquote
,
586 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
587 0377, 0377, 0377, 0377,
588 (char) Scomment
, 0377, (char) Sendcomment
, 0377,
589 (char) Sinherit
, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */
590 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
591 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
592 0377, 0377, 0377, 0377, (char) Sescape
, 0377, 0377, (char) Ssymbol
,
593 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
594 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
595 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword
,
596 0377, 0377, 0377, 0377, (char) Sstring_fence
, 0377, 0377, 0377
599 /* Indexed by syntax code, give the letter that describes it. */
601 char syntax_code_spec
[16] =
603 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@',
607 /* Indexed by syntax code, give the object (cons of syntax code and
608 nil) to be stored in syntax table. Since these objects can be
609 shared among syntax tables, we generate them in advance. By
610 sharing objects, the function `describe-syntax' can give a more
612 static Lisp_Object Vsyntax_code_object
;
615 /* Look up the value for CHARACTER in syntax table TABLE's parent
616 and its parents. SYNTAX_ENTRY calls this, when TABLE itself has nil
617 for CHARACTER. It's actually used only when not compiled with GCC. */
620 syntax_parent_lookup (table
, character
)
628 table
= XCHAR_TABLE (table
)->parent
;
632 value
= XCHAR_TABLE (table
)->contents
[character
];
638 DEFUN ("char-syntax", Fchar_syntax
, Schar_syntax
, 1, 1, 0,
639 "Return the syntax code of CHARACTER, described by a character.\n\
640 For example, if CHARACTER is a word constituent,\n\
641 the character `w' is returned.\n\
642 The characters that correspond to various syntax codes\n\
643 are listed in the documentation of `modify-syntax-entry'.")
645 Lisp_Object character
;
648 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
650 gl_state
.use_global
= 0;
651 CHECK_NUMBER (character
, 0);
652 char_int
= XINT (character
);
653 return make_number (syntax_code_spec
[(int) SYNTAX (char_int
)]);
656 DEFUN ("matching-paren", Fmatching_paren
, Smatching_paren
, 1, 1, 0,
657 "Return the matching parenthesis of CHARACTER, or nil if none.")
659 Lisp_Object character
;
662 gl_state
.current_syntax_table
= current_buffer
->syntax_table
;
663 gl_state
.use_global
= 0;
664 CHECK_NUMBER (character
, 0);
665 char_int
= XINT (character
);
666 code
= SYNTAX (char_int
);
667 if (code
== Sopen
|| code
== Sclose
)
668 return SYNTAX_MATCH (char_int
);
672 /* This comment supplies the doc string for modify-syntax-entry,
673 for make-docfile to see. We cannot put this in the real DEFUN
674 due to limits in the Unix cpp.
676 DEFUN ("modify-syntax-entry", foo, bar, 2, 3, 0,
677 "Set syntax for character CHAR according to string S.\n\
678 The syntax is changed only for table TABLE, which defaults to\n\
679 the current buffer's syntax table.\n\
680 The first character of S should be one of the following:\n\
681 Space or - whitespace syntax. w word constituent.\n\
682 _ symbol constituent. . punctuation.\n\
683 ( open-parenthesis. ) close-parenthesis.\n\
684 \" string quote. \\ escape.\n\
685 $ paired delimiter. ' expression quote or prefix operator.\n\
686 < comment starter. > comment ender.\n\
687 / character-quote. @ inherit from `standard-syntax-table'.\n\
689 Only single-character comment start and end sequences are represented thus.\n\
690 Two-character sequences are represented as described below.\n\
691 The second character of S is the matching parenthesis,\n\
692 used only if the first character is `(' or `)'.\n\
693 Any additional characters are flags.\n\
694 Defined flags are the characters 1, 2, 3, 4, b, and p.\n\
695 1 means CHAR is the start of a two-char comment start sequence.\n\
696 2 means CHAR is the second character of such a sequence.\n\
697 3 means CHAR is the start of a two-char comment end sequence.\n\
698 4 means CHAR is the second character of such a sequence.\n\
700 There can be up to two orthogonal comment sequences. This is to support\n\
701 language modes such as C++. By default, all comment sequences are of style\n\
702 a, but you can set the comment sequence style to b (on the second character\n\
703 of a comment-start, or the first character of a comment-end sequence) using\n\
705 b means CHAR is part of comment sequence b.\n\
707 p means CHAR is a prefix character for `backward-prefix-chars';\n\
708 such characters are treated as whitespace when they occur\n\
709 between expressions.")
713 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry
, Smodify_syntax_entry
, 2, 3,
714 /* I really don't know why this is interactive
715 help-form should at least be made useful whilst reading the second arg
717 "cSet syntax for character: \nsSet syntax for %s to: ",
718 0 /* See immediately above */)
719 (c
, newentry
, syntax_table
)
720 Lisp_Object c
, newentry
, syntax_table
;
722 register unsigned char *p
;
723 register enum syntaxcode code
;
728 CHECK_STRING (newentry
, 1);
730 if (NILP (syntax_table
))
731 syntax_table
= current_buffer
->syntax_table
;
733 check_syntax_table (syntax_table
);
735 p
= XSTRING (newentry
)->data
;
736 code
= (enum syntaxcode
) syntax_spec_code
[*p
++];
737 if (((int) code
& 0377) == 0377)
738 error ("invalid syntax description letter: %c", p
[-1]);
740 if (code
== Sinherit
)
742 SET_RAW_SYNTAX_ENTRY (syntax_table
, XINT (c
), Qnil
);
749 int character
= STRING_CHAR_AND_LENGTH (p
, XSTRING (newentry
)->size
- 1,
751 XSETINT (match
, character
);
752 if (XFASTINT (match
) == ' ')
788 if (val
< XVECTOR (Vsyntax_code_object
)->size
&& NILP (match
))
789 newentry
= XVECTOR (Vsyntax_code_object
)->contents
[val
];
791 /* Since we can't use a shared object, let's make a new one. */
792 newentry
= Fcons (make_number (val
), match
);
794 SET_RAW_SYNTAX_ENTRY (syntax_table
, XINT (c
), newentry
);
799 /* Dump syntax table to buffer in human-readable format */
802 describe_syntax (value
)
805 register enum syntaxcode code
;
806 char desc
, match
, start1
, start2
, end1
, end2
, prefix
, comstyle
;
808 Lisp_Object first
, match_lisp
;
810 Findent_to (make_number (16), make_number (1));
814 insert_string ("default\n");
818 if (CHAR_TABLE_P (value
))
820 insert_string ("deeper char-table ...\n");
826 insert_string ("invalid\n");
830 first
= XCONS (value
)->car
;
831 match_lisp
= XCONS (value
)->cdr
;
833 if (!INTEGERP (first
) || !(NILP (match_lisp
) || INTEGERP (match_lisp
)))
835 insert_string ("invalid\n");
839 code
= (enum syntaxcode
) (XINT (first
) & 0377);
840 start1
= (XINT (first
) >> 16) & 1;
841 start2
= (XINT (first
) >> 17) & 1;
842 end1
= (XINT (first
) >> 18) & 1;
843 end2
= (XINT (first
) >> 19) & 1;
844 prefix
= (XINT (first
) >> 20) & 1;
845 comstyle
= (XINT (first
) >> 21) & 1;
847 if ((int) code
< 0 || (int) code
>= (int) Smax
)
849 insert_string ("invalid");
852 desc
= syntax_code_spec
[(int) code
];
854 str
[0] = desc
, str
[1] = 0;
857 if (NILP (match_lisp
))
860 insert_char (XINT (match_lisp
));
877 insert_string ("\twhich means: ");
879 switch (SWITCH_ENUM_CAST (code
))
882 insert_string ("whitespace"); break;
884 insert_string ("punctuation"); break;
886 insert_string ("word"); break;
888 insert_string ("symbol"); break;
890 insert_string ("open"); break;
892 insert_string ("close"); break;
894 insert_string ("quote"); break;
896 insert_string ("string"); break;
898 insert_string ("math"); break;
900 insert_string ("escape"); break;
902 insert_string ("charquote"); break;
904 insert_string ("comment"); break;
906 insert_string ("endcomment"); break;
908 insert_string ("invalid");
912 if (!NILP (match_lisp
))
914 insert_string (", matches ");
915 insert_char (XINT (match_lisp
));
919 insert_string (",\n\t is the first character of a comment-start sequence");
921 insert_string (",\n\t is the second character of a comment-start sequence");
924 insert_string (",\n\t is the first character of a comment-end sequence");
926 insert_string (",\n\t is the second character of a comment-end sequence");
928 insert_string (" (comment style b)");
931 insert_string (",\n\t is a prefix character for `backward-prefix-chars'");
933 insert_string ("\n");
937 describe_syntax_1 (vector
)
940 struct buffer
*old
= current_buffer
;
941 set_buffer_internal (XBUFFER (Vstandard_output
));
942 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
, (int *) 0, 0);
943 while (! NILP (XCHAR_TABLE (vector
)->parent
))
945 vector
= XCHAR_TABLE (vector
)->parent
;
946 insert_string ("\nThe parent syntax table is:");
947 describe_vector (vector
, Qnil
, describe_syntax
, 0, Qnil
, Qnil
,
951 call0 (intern ("help-mode"));
952 set_buffer_internal (old
);
956 DEFUN ("describe-syntax", Fdescribe_syntax
, Sdescribe_syntax
, 0, 0, "",
957 "Describe the syntax specifications in the syntax table.\n\
958 The descriptions are inserted in a buffer, which is then displayed.")
961 internal_with_output_to_temp_buffer
962 ("*Help*", describe_syntax_1
, current_buffer
->syntax_table
);
967 int parse_sexp_ignore_comments
;
969 /* Return the position across COUNT words from FROM.
970 If that many words cannot be found before the end of the buffer, return 0.
971 COUNT negative means scan backward and stop at word beginning. */
973 scan_words (from
, count
)
974 register int from
, count
;
976 register int beg
= BEGV
;
977 register int end
= ZV
;
978 register enum syntaxcode code
;
985 SETUP_SYNTAX_TABLE (from
, count
);
996 UPDATE_SYNTAX_TABLE_FORWARD (from
);
997 ch0
= FETCH_CHAR (from
);
1000 if (words_include_escapes
1001 && (code
== Sescape
|| code
== Scharquote
))
1006 /* Now CH0 is a character which begins a word and FROM is the
1007 position of the next character. */
1010 if (from
== end
) break;
1011 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1012 ch1
= FETCH_CHAR (from
);
1013 code
= SYNTAX (ch1
);
1014 if (!(words_include_escapes
1015 && (code
== Sescape
|| code
== Scharquote
)))
1016 if (code
!= Sword
|| WORD_BOUNDARY_P (ch0
, ch1
))
1033 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1034 ch1
= FETCH_CHAR (from
);
1035 code
= SYNTAX (ch1
);
1036 if (words_include_escapes
1037 && (code
== Sescape
|| code
== Scharquote
))
1042 /* Now CH1 is a character which ends a word and FROM is the
1046 if (from
== beg
) break;
1049 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1050 ch0
= FETCH_CHAR (temp_pos
);
1051 code
= SYNTAX (ch0
);
1052 if (!(words_include_escapes
1053 && (code
== Sescape
|| code
== Scharquote
)))
1054 if (code
!= Sword
|| WORD_BOUNDARY_P (ch0
, ch1
))
1067 DEFUN ("forward-word", Fforward_word
, Sforward_word
, 1, 1, "p",
1068 "Move point forward ARG words (backward if ARG is negative).\n\
1069 Normally returns t.\n\
1070 If an edge of the buffer is reached, point is left there\n\
1071 and nil is returned.")
1076 CHECK_NUMBER (count
, 0);
1078 if (!(val
= scan_words (PT
, XINT (count
))))
1080 SET_PT (XINT (count
) > 0 ? ZV
: BEGV
);
1087 Lisp_Object
skip_chars ();
1089 DEFUN ("skip-chars-forward", Fskip_chars_forward
, Sskip_chars_forward
, 1, 2, 0,
1090 "Move point forward, stopping before a char not in STRING, or at pos LIM.\n\
1091 STRING is like the inside of a `[...]' in a regular expression\n\
1092 except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\
1093 Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
1094 With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\
1095 Returns the distance traveled, either zero or positive.")
1097 Lisp_Object string
, lim
;
1099 return skip_chars (1, 0, string
, lim
);
1102 DEFUN ("skip-chars-backward", Fskip_chars_backward
, Sskip_chars_backward
, 1, 2, 0,
1103 "Move point backward, stopping after a char not in STRING, or at pos LIM.\n\
1104 See `skip-chars-forward' for details.\n\
1105 Returns the distance traveled, either zero or negative.")
1107 Lisp_Object string
, lim
;
1109 return skip_chars (0, 0, string
, lim
);
1112 DEFUN ("skip-syntax-forward", Fskip_syntax_forward
, Sskip_syntax_forward
, 1, 2, 0,
1113 "Move point forward across chars in specified syntax classes.\n\
1114 SYNTAX is a string of syntax code characters.\n\
1115 Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\
1116 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1117 This function returns the distance traveled, either zero or positive.")
1119 Lisp_Object syntax
, lim
;
1121 return skip_chars (1, 1, syntax
, lim
);
1124 DEFUN ("skip-syntax-backward", Fskip_syntax_backward
, Sskip_syntax_backward
, 1, 2, 0,
1125 "Move point backward across chars in specified syntax classes.\n\
1126 SYNTAX is a string of syntax code characters.\n\
1127 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\
1128 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
1129 This function returns the distance traveled, either zero or negative.")
1131 Lisp_Object syntax
, lim
;
1133 return skip_chars (0, 1, syntax
, lim
);
1137 skip_chars (forwardp
, syntaxp
, string
, lim
)
1138 int forwardp
, syntaxp
;
1139 Lisp_Object string
, lim
;
1141 register unsigned char *p
, *pend
;
1142 register unsigned int c
;
1144 unsigned char fastmap
[0400];
1145 /* If SYNTAXP is 0, STRING may contain multi-byte form of characters
1146 of which codes don't fit in FASTMAP. In that case, we set the
1147 first byte of multibyte form (i.e. base leading-code) in FASTMAP
1148 and set the actual ranges of characters in CHAR_RANGES. In the
1149 form "X-Y" of STRING, both X and Y must belong to the same
1150 character set because a range striding across character sets is
1153 = (int *) alloca (XSTRING (string
)->size
* (sizeof (int)) * 2);
1154 int n_char_ranges
= 0;
1157 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
1159 CHECK_STRING (string
, 0);
1162 XSETINT (lim
, forwardp
? ZV
: BEGV
);
1164 CHECK_NUMBER_COERCE_MARKER (lim
, 1);
1166 /* In any case, don't allow scan outside bounds of buffer. */
1167 /* jla turned this off, for no known reason.
1168 bfox turned the ZV part on, and rms turned the
1169 BEGV part back on. */
1170 if (XINT (lim
) > ZV
)
1171 XSETFASTINT (lim
, ZV
);
1172 if (XINT (lim
) < BEGV
)
1173 XSETFASTINT (lim
, BEGV
);
1175 p
= XSTRING (string
)->data
;
1176 pend
= p
+ XSTRING (string
)->size
;
1177 bzero (fastmap
, sizeof fastmap
);
1179 if (p
!= pend
&& *p
== '^')
1184 /* Find the characters specified and set their elements of fastmap.
1185 If syntaxp, each character counts as itself.
1186 Otherwise, handle backslashes and ranges specially. */
1193 ch
= STRING_CHAR (p
, pend
- p
);
1194 p
+= BYTES_BY_CHAR_HEAD (*p
);
1202 fastmap
[syntax_spec_code
[c
]] = 1;
1207 if (p
== pend
) break;
1210 if (p
!= pend
&& *p
== '-')
1215 if (p
== pend
) break;
1216 if (SINGLE_BYTE_CHAR_P (ch
))
1224 fastmap
[c
] = 1; /* C is the base leading-code. */
1225 ch2
= STRING_CHAR (p
, pend
- p
);
1227 char_ranges
[n_char_ranges
++] = ch
,
1228 char_ranges
[n_char_ranges
++] = ch2
;
1230 p
+= multibyte
? BYTES_BY_CHAR_HEAD (*p
) : 1;
1235 if (!SINGLE_BYTE_CHAR_P (ch
))
1237 char_ranges
[n_char_ranges
++] = ch
;
1238 char_ranges
[n_char_ranges
++] = ch
;
1244 /* If ^ was the first character, complement the fastmap. In
1245 addition, as all multibyte characters have possibility of
1246 matching, set all entries for base leading codes, which is
1247 harmless even if SYNTAXP is 1. */
1250 for (i
= 0; i
< sizeof fastmap
; i
++)
1252 if (!multibyte
|| !BASE_LEADING_CODE_P (i
))
1259 int start_point
= PT
;
1265 SETUP_SYNTAX_TABLE (pos
, forwardp
? 1 : -1);
1270 while (pos
< XINT (lim
)
1271 && fastmap
[(int) SYNTAX (FETCH_CHAR (pos
))])
1274 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1279 while (pos
< XINT (lim
)
1280 && fastmap
[(int) SYNTAX (FETCH_BYTE (pos
))])
1283 UPDATE_SYNTAX_TABLE_FORWARD (pos
);
1291 while (pos
> XINT (lim
))
1295 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
1296 if (!fastmap
[(int) SYNTAX (FETCH_CHAR (pos
))])
1305 while (pos
> XINT (lim
))
1308 UPDATE_SYNTAX_TABLE_BACKWARD (pos
);
1309 if (!fastmap
[(int) SYNTAX (FETCH_BYTE (pos
))])
1323 while (pos
< XINT (lim
) && fastmap
[(c
= FETCH_BYTE (pos
))])
1325 if (!BASE_LEADING_CODE_P (c
))
1327 else if (n_char_ranges
)
1329 /* We much check CHAR_RANGES for a multibyte
1331 ch
= FETCH_MULTIBYTE_CHAR (pos
);
1332 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1333 if ((ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1]))
1335 if (!(negate
^ (i
< n_char_ranges
)))
1347 while (pos
< XINT (lim
) && fastmap
[FETCH_BYTE (pos
)])
1353 while (pos
> XINT (lim
))
1357 if (fastmap
[(c
= FETCH_BYTE (pos
))])
1359 if (!BASE_LEADING_CODE_P (c
))
1361 else if (n_char_ranges
)
1363 /* We much check CHAR_RANGES for a multibyte
1365 ch
= FETCH_MULTIBYTE_CHAR (pos
);
1366 for (i
= 0; i
< n_char_ranges
; i
+= 2)
1367 if (ch
>= char_ranges
[i
] && ch
<= char_ranges
[i
+ 1])
1369 if (!(negate
^ (i
< n_char_ranges
)))
1389 while (pos
> XINT (lim
) && fastmap
[FETCH_BYTE (pos
- 1)])
1395 /* INC_POS or DEC_POS might have moved POS over LIM. */
1396 && (forwardp
? (pos
> XINT (lim
)) : (pos
< XINT (lim
))))
1402 return make_number (PT
- start_point
);
1406 DEFUN ("forward-comment", Fforward_comment
, Sforward_comment
, 1, 1, 0,
1407 "Move forward across up to N comments. If N is negative, move backward.\n\
1408 Stop scanning if we find something other than a comment or whitespace.\n\
1409 Set point to where scanning stops.\n\
1410 If N comments are found as expected, with nothing except whitespace\n\
1411 between them, return t; otherwise return nil.")
1418 register enum syntaxcode code
;
1419 int comstyle
= 0; /* style of comment encountered */
1424 CHECK_NUMBER (count
, 0);
1425 count1
= XINT (count
);
1426 stop
= count1
> 0 ? ZV
: BEGV
;
1433 SETUP_SYNTAX_TABLE (from
, count1
);
1444 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1445 c
= FETCH_CHAR (from
);
1449 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
1450 && (c1
= FETCH_CHAR (from
),
1451 SYNTAX_COMSTART_SECOND (c1
)))
1453 /* We have encountered a comment start sequence and we
1454 are ignoring all text inside comments. We must record
1455 the comment style this sequence begins so that later,
1456 only a comment end of the same style actually ends
1457 the comment section. */
1459 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1463 while (code
== Swhitespace
|| code
== Sendcomment
);
1464 if (code
!= Scomment
&& code
!= Scomment_fence
)
1471 /* We're at the start of a comment. */
1480 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1481 c
= FETCH_CHAR (from
);
1483 if (SYNTAX (c
) == Sendcomment
1484 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1485 /* we have encountered a comment end of the same style
1486 as the comment sequence which began this comment
1489 if (SYNTAX (c
) == Scomment_fence
1490 && comstyle
== ST_COMMENT_STYLE
)
1491 /* we have encountered a comment end of the same style
1492 as the comment sequence which began this comment
1495 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
1496 && (c1
= FETCH_CHAR (from
),
1497 SYNTAX_COMEND_SECOND (c1
))
1498 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1499 /* we have encountered a comment end of the same style
1500 as the comment sequence which began this comment
1502 { INC_POS (from
); break; }
1504 /* We have skipped one comment. */
1515 quoted
= char_quoted (from
);
1519 goto leave
; /* ????? XXXXX */
1521 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1522 c
= FETCH_CHAR (from
);
1525 if (code
== Sendcomment
)
1526 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1529 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1530 && (c1
= FETCH_CHAR (temp_pos
),
1531 SYNTAX_COMEND_FIRST (c1
))
1532 && !char_quoted (temp_pos
))
1534 /* We must record the comment style encountered so that
1535 later, we can match only the proper comment begin
1536 sequence of the same style. */
1538 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1541 if (from
> stop
&& SYNTAX_COMSTART_SECOND (c
)
1542 && (c1
= FETCH_CHAR (temp_pos
),
1543 SYNTAX_COMSTART_FIRST (c1
))
1544 && !char_quoted (temp_pos
))
1546 /* We must record the comment style encountered so that
1547 later, we can match only the proper comment begin
1548 sequence of the same style. */
1553 if (code
== Scomment_fence
)
1555 /* Skip until first preceding unquoted comment_fence. */
1556 int found
= 0, ini
= from
;
1558 while (--from
!= stop
)
1560 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1561 c
= FETCH_CHAR (from
);
1562 if (SYNTAX (c
) == Scomment_fence
&& !char_quoted (from
))
1570 from
= ini
; /* Set point to ini + 1. */
1574 else if (code
== Sendcomment
)
1577 if (code
!= SYNTAX (c
))
1578 /* For a two-char comment ender, we can assume
1579 it does end a comment. So scan back in a simple way. */
1581 if (from
!= stop
) DEC_POS (from
);
1584 if ((c
= FETCH_CHAR (from
),
1585 SYNTAX (c
) == Scomment
)
1586 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1595 if (SYNTAX_COMSTART_SECOND (c
)
1596 && (c1
= FETCH_CHAR (from
),
1597 SYNTAX_COMSTART_FIRST (c1
))
1598 && SYNTAX_COMMENT_STYLE (c
) == comstyle
1599 && !char_quoted (from
))
1605 found
= back_comment (from
, stop
, comstyle
);
1606 if (found
!= -1) from
= found
;
1608 /* Look back, counting the parity of string-quotes,
1609 and recording the comment-starters seen.
1610 When we reach a safe place, assume that's not in a string;
1611 then step the main scan to the earliest comment-starter seen
1612 an even number of string quotes away from the safe place.
1614 OFROM[I] is position of the earliest comment-starter seen
1615 which is I+2X quotes from the comment-end.
1616 PARITY is current parity of quotes from the comment end. */
1619 char my_stringend
= 0;
1620 int string_lossage
= 0;
1621 int comment_end
= from
;
1622 int comstart_pos
= 0;
1623 int comstart_parity
= 0;
1624 int scanstart
= from
;
1626 DEC_POS (scanstart
);
1627 /* At beginning of range to scan, we're outside of strings;
1628 that determines quote parity to the comment-end. */
1629 while (from
!= stop
)
1631 /* Move back and examine a character. */
1634 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1635 c
= FETCH_CHAR (from
);
1638 /* If this char is the second of a 2-char comment sequence,
1639 back up and give the pair the appropriate syntax. */
1642 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1643 && (c1
= FETCH_CHAR (temp_pos
),
1644 SYNTAX_COMEND_FIRST (c1
)))
1653 /* If this char starts a 2-char comment start sequence,
1654 treat it like a 1-char comment starter. */
1655 if (from
< scanstart
&& SYNTAX_COMSTART_FIRST (c
)
1656 && (c1
= FETCH_CHAR (temp_pos
),
1657 SYNTAX_COMSTART_SECOND (c1
))
1658 && comstyle
== SYNTAX_COMMENT_STYLE (c1
))
1661 /* Ignore escaped characters. */
1662 if (char_quoted (from
))
1665 /* Track parity of quotes. */
1666 if (code
== Sstring
)
1669 if (my_stringend
== 0)
1671 /* If we have two kinds of string delimiters.
1672 There's no way to grok this scanning backwards. */
1673 else if (my_stringend
!= c
)
1677 /* Record comment-starters according to that
1678 quote-parity to the comment-end. */
1679 if (code
== Scomment
)
1681 comstart_parity
= parity
;
1682 comstart_pos
= from
;
1685 /* If we find another earlier comment-ender,
1686 any comment-starts earlier than that don't count
1687 (because they go with the earlier comment-ender). */
1688 if (code
== Sendcomment
1689 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
)) == comstyle
)
1692 /* Assume a defun-start point is outside of strings. */
1694 && (from
== stop
|| FETCH_BYTE (from
- 1) == '\n'))
1698 if (comstart_pos
== 0)
1700 /* If the earliest comment starter
1701 is followed by uniform paired string quotes or none,
1702 we know it can't be inside a string
1703 since if it were then the comment ender would be inside one.
1704 So it does start a comment. Skip back to it. */
1705 else if (comstart_parity
== 0 && !string_lossage
)
1706 from
= comstart_pos
;
1709 /* We had two kinds of string delimiters mixed up
1710 together. Decode this going forwards.
1711 Scan fwd from the previous comment ender
1712 to the one in question; this records where we
1713 last passed a comment starter. */
1714 struct lisp_parse_state state
;
1715 scan_sexps_forward (&state
, find_defun_start (comment_end
),
1716 comment_end
- 1, -10000, 0, Qnil
, 0);
1717 if (state
.incomment
)
1718 from
= state
.comstr_start
;
1720 /* We can't grok this as a comment; scan it normally. */
1725 /* We have skipped one comment. */
1728 else if (code
!= Swhitespace
&& code
!= Scomment
)
1747 scan_lists (from
, count
, depth
, sexpflag
)
1749 int count
, depth
, sexpflag
;
1752 register int stop
= count
> 0 ? ZV
: BEGV
;
1757 register enum syntaxcode code
, temp_code
;
1758 int min_depth
= depth
; /* Err out if depth gets less than this. */
1759 int comstyle
= 0; /* style of comment encountered */
1761 int last_good
= from
;
1764 if (depth
> 0) min_depth
= 0;
1769 SETUP_SYNTAX_TABLE (from
, count
);
1774 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1775 c
= FETCH_CHAR (from
);
1777 if (depth
== min_depth
)
1780 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1781 if (from
< stop
&& SYNTAX_COMSTART_FIRST (c
)
1782 && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
))
1783 && parse_sexp_ignore_comments
)
1785 /* we have encountered a comment start sequence and we
1786 are ignoring all text inside comments. We must record
1787 the comment style this sequence begins so that later,
1788 only a comment end of the same style actually ends
1789 the comment section */
1791 comstyle
= SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
));
1795 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1796 if (SYNTAX_PREFIX (c
))
1799 switch (SWITCH_ENUM_CAST (code
))
1803 if (from
== stop
) goto lose
;
1805 /* treat following character as a word constituent */
1808 if (depth
|| !sexpflag
) break;
1809 /* This word counts as a sexp; return at end of it. */
1812 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1813 switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from
))))
1818 if (from
== stop
) goto lose
;
1832 case Scomment_fence
:
1833 if (!parse_sexp_ignore_comments
) break;
1842 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1843 c
= FETCH_CHAR (from
);
1844 if (code
== Scomment
1845 ? (SYNTAX (c
) == Sendcomment
1846 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
1847 : (SYNTAX (c
) == Scomment_fence
))
1848 /* we have encountered a comment end of the same style
1849 as the comment sequence which began this comment
1853 if (from
< stop
&& SYNTAX_COMEND_FIRST (c
)
1854 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
))
1855 && SYNTAX_COMMENT_STYLE (c
) == comstyle
1856 && code
== Scomment
)
1857 /* we have encountered a comment end of the same style
1858 as the comment sequence which began this comment
1860 { INC_POS (from
); break; }
1867 if (from
!= stop
&& c
== FETCH_CHAR (from
))
1877 if (!++depth
) goto done
;
1882 if (!--depth
) goto done
;
1883 if (depth
< min_depth
)
1884 Fsignal (Qscan_error
,
1885 Fcons (build_string ("Containing expression ends prematurely"),
1886 Fcons (make_number (last_good
),
1887 Fcons (make_number (from
), Qnil
))));
1894 stringterm
= FETCH_CHAR (temp_pos
);
1897 if (from
>= stop
) goto lose
;
1898 UPDATE_SYNTAX_TABLE_FORWARD (from
);
1900 ? (FETCH_CHAR (from
) == stringterm
)
1901 : SYNTAX (FETCH_CHAR (from
)) == Sstring_fence
)
1903 switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from
))))
1912 if (!depth
&& sexpflag
) goto done
;
1917 /* Reached end of buffer. Error if within object, return nil if between */
1918 if (depth
) goto lose
;
1923 /* End of object reached */
1933 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1934 if (quoted
= char_quoted (from
))
1937 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
1939 c
= FETCH_CHAR (from
);
1941 if (depth
== min_depth
)
1944 if (code
== Sendcomment
)
1945 comstyle
= SYNTAX_COMMENT_STYLE (c
);
1948 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
1949 && (c1
= FETCH_CHAR (temp_pos
), SYNTAX_COMEND_FIRST (c1
))
1950 && !char_quoted (temp_pos
)
1951 && parse_sexp_ignore_comments
)
1953 /* we must record the comment style encountered so that
1954 later, we can match only the proper comment begin
1955 sequence of the same style */
1957 comstyle
= SYNTAX_COMMENT_STYLE (c1
);
1961 if (SYNTAX_PREFIX (c
))
1964 switch (SWITCH_ENUM_CAST (quoted
? Sword
: code
))
1968 if (depth
|| !sexpflag
) break;
1969 /* This word counts as a sexp; count object finished
1970 after passing it. */
1975 UPDATE_SYNTAX_TABLE_BACKWARD (temp_pos
);
1976 quoted
= char_quoted (temp_pos
);
1981 UPDATE_SYNTAX_TABLE_BACKWARD (temp_pos
);
1983 c1
= FETCH_CHAR (temp_pos
);
1984 temp_code
= SYNTAX (c1
);
1985 if (! (quoted
|| temp_code
== Sword
1986 || temp_code
== Ssymbol
1987 || temp_code
== Squote
))
1998 UPDATE_SYNTAX_TABLE_BACKWARD (temp_pos
);
1999 if (from
!= stop
&& c
== FETCH_CHAR (temp_pos
))
2009 if (!++depth
) goto done2
;
2014 if (!--depth
) goto done2
;
2015 if (depth
< min_depth
)
2016 Fsignal (Qscan_error
,
2017 Fcons (build_string ("Containing expression ends prematurely"),
2018 Fcons (make_number (last_good
),
2019 Fcons (make_number (from
), Qnil
))));
2023 if (!parse_sexp_ignore_comments
)
2026 if (code
!= SYNTAX (c
))
2027 /* For a two-char comment ender, we can assume
2028 it does end a comment. So scan back in a simple way. */
2030 if (from
!= stop
) DEC_POS (from
);
2033 if (SYNTAX (c
= FETCH_CHAR (from
)) == Scomment
2034 && SYNTAX_COMMENT_STYLE (c
) == comstyle
)
2043 if (SYNTAX_COMSTART_SECOND (c
)
2044 && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from
))
2045 && SYNTAX_COMMENT_STYLE (c
) == comstyle
2046 && !char_quoted (from
))
2052 found
= back_comment (from
, stop
, comstyle
);
2053 if (found
!= -1) from
= found
;
2055 /* Look back, counting the parity of string-quotes,
2056 and recording the comment-starters seen.
2057 When we reach a safe place, assume that's not in a string;
2058 then step the main scan to the earliest comment-starter seen
2059 an even number of string quotes away from the safe place.
2061 OFROM[I] is position of the earliest comment-starter seen
2062 which is I+2X quotes from the comment-end.
2063 PARITY is current parity of quotes from the comment end. */
2066 char my_stringend
= 0;
2067 int string_lossage
= 0;
2068 int comment_end
= from
;
2069 int comstart_pos
= 0;
2070 int comstart_parity
= 0;
2071 int scanstart
= from
;
2073 DEC_POS (scanstart
);
2075 /* At beginning of range to scan, we're outside of strings;
2076 that determines quote parity to the comment-end. */
2077 while (from
!= stop
)
2079 /* Move back and examine a character. */
2082 c
= FETCH_CHAR (from
);
2085 /* If this char is the second of a 2-char comment sequence,
2086 back up and give the pair the appropriate syntax. */
2089 if (from
> stop
&& SYNTAX_COMEND_SECOND (c
)
2090 && (c1
= FETCH_CHAR (temp_pos
),
2091 SYNTAX_COMEND_FIRST (c1
)))
2098 /* If this char starts a 2-char comment start sequence,
2099 treat it like a 1-char comment starter. */
2102 if (from
< scanstart
&& SYNTAX_COMSTART_FIRST (c
)
2103 && (c1
= FETCH_CHAR (temp_pos
),
2104 SYNTAX_COMSTART_SECOND (c1
))
2105 && comstyle
== SYNTAX_COMMENT_STYLE (c1
))
2108 /* Ignore escaped characters. */
2109 if (char_quoted (from
))
2112 /* Track parity of quotes. */
2113 if (code
== Sstring
)
2116 if (my_stringend
== 0)
2118 /* If we have two kinds of string delimiters.
2119 There's no way to grok this scanning backwards. */
2120 else if (my_stringend
!= c
)
2124 /* Record comment-starters according to that
2125 quote-parity to the comment-end. */
2126 if (code
== Scomment
)
2128 comstart_parity
= parity
;
2129 comstart_pos
= from
;
2132 /* If we find another earlier comment-ender,
2133 any comment-starts earlier than that don't count
2134 (because they go with the earlier comment-ender). */
2135 if (code
== Sendcomment
2136 && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
)) == comstyle
)
2139 /* Assume a defun-start point is outside of strings. */
2141 && (from
== stop
|| FETCH_BYTE (from
- 1) == '\n'))
2145 if (comstart_pos
== 0)
2147 /* If the earliest comment starter
2148 is followed by uniform paired string quotes or none,
2149 we know it can't be inside a string
2150 since if it were then the comment ender would be inside one.
2151 So it does start a comment. Skip back to it. */
2152 else if (comstart_parity
== 0 && !string_lossage
)
2153 from
= comstart_pos
;
2156 /* We had two kinds of string delimiters mixed up
2157 together. Decode this going forwards.
2158 Scan fwd from the previous comment ender
2159 to the one in question; this records where we
2160 last passed a comment starter. */
2161 struct lisp_parse_state state
;
2162 scan_sexps_forward (&state
, find_defun_start (comment_end
),
2163 comment_end
- 1, -10000, 0, Qnil
, 0);
2164 if (state
.incomment
)
2165 from
= state
.comstr_start
;
2167 /* We can't grok this as a comment; scan it normally. */
2174 case Scomment_fence
:
2179 if (from
== stop
) goto lose
;
2180 UPDATE_SYNTAX_TABLE_BACKWARD (from
);
2181 if (!char_quoted (from
)
2182 && SYNTAX (FETCH_CHAR (from
)) == code
)
2185 if (code
== Sstring_fence
&& !depth
&& sexpflag
) goto done2
;
2189 stringterm
= FETCH_CHAR (from
);
2192 if (from
== stop
) goto lose
;
2195 UPDATE_SYNTAX_TABLE_BACKWARD (temp_pos
);
2196 if (!char_quoted (temp_pos
)
2197 && stringterm
== FETCH_CHAR (temp_pos
))
2202 if (!depth
&& sexpflag
) goto done2
;
2207 /* Reached start of buffer. Error if within object, return nil if between */
2208 if (depth
) goto lose
;
2219 XSETFASTINT (val
, from
);
2223 Fsignal (Qscan_error
,
2224 Fcons (build_string ("Unbalanced parentheses"),
2225 Fcons (make_number (last_good
),
2226 Fcons (make_number (from
), Qnil
))));
2231 DEFUN ("scan-lists", Fscan_lists
, Sscan_lists
, 3, 3, 0,
2232 "Scan from character number FROM by COUNT lists.\n\
2233 Returns the character number of the position thus found.\n\
2235 If DEPTH is nonzero, paren depth begins counting from that value,\n\
2236 only places where the depth in parentheses becomes zero\n\
2237 are candidates for stopping; COUNT such places are counted.\n\
2238 Thus, a positive value for DEPTH means go out levels.\n\
2240 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2242 If the beginning or end of (the accessible part of) the buffer is reached\n\
2243 and the depth is wrong, an error is signaled.\n\
2244 If the depth is right but the count is not used up, nil is returned.")
2245 (from
, count
, depth
)
2246 Lisp_Object from
, count
, depth
;
2248 CHECK_NUMBER (from
, 0);
2249 CHECK_NUMBER (count
, 1);
2250 CHECK_NUMBER (depth
, 2);
2252 return scan_lists (XINT (from
), XINT (count
), XINT (depth
), 0);
2255 DEFUN ("scan-sexps", Fscan_sexps
, Sscan_sexps
, 2, 2, 0,
2256 "Scan from character number FROM by COUNT balanced expressions.\n\
2257 If COUNT is negative, scan backwards.\n\
2258 Returns the character number of the position thus found.\n\
2260 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\
2262 If the beginning or end of (the accessible part of) the buffer is reached\n\
2263 in the middle of a parenthetical grouping, an error is signaled.\n\
2264 If the beginning or end is reached between groupings\n\
2265 but before count is used up, nil is returned.")
2267 Lisp_Object from
, count
;
2269 CHECK_NUMBER (from
, 0);
2270 CHECK_NUMBER (count
, 1);
2272 return scan_lists (XINT (from
), XINT (count
), 0, 1);
2275 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars
, Sbackward_prefix_chars
,
2277 "Move point backward over any number of chars with prefix syntax.\n\
2278 This includes chars with \"quote\" or \"prefix\" syntax (' or p).")
2288 SETUP_SYNTAX_TABLE (pos
, -1);
2292 while (pos
> beg
&& !char_quoted (temp_pos
)
2293 /* Previous statement updates syntax table. */
2294 && ((c
= FETCH_CHAR (temp_pos
), SYNTAX (c
) == Squote
)
2295 || SYNTAX_PREFIX (c
)))
2306 /* Parse forward from FROM to END,
2307 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
2308 and return a description of the state of the parse at END.
2309 If STOPBEFORE is nonzero, stop at the start of an atom.
2310 If COMMENTSTOP is nonzero, stop at the start of a comment. */
2313 scan_sexps_forward (stateptr
, from
, end
, targetdepth
,
2314 stopbefore
, oldstate
, commentstop
)
2315 struct lisp_parse_state
*stateptr
;
2317 int end
, targetdepth
, stopbefore
;
2318 Lisp_Object oldstate
;
2321 struct lisp_parse_state state
;
2323 register enum syntaxcode code
;
2324 struct level
{ int last
, prev
; };
2325 struct level levelstart
[100];
2326 register struct level
*curlevel
= levelstart
;
2327 struct level
*endlevel
= levelstart
+ 100;
2329 register int depth
; /* Paren depth of current scanning location.
2330 level - levelstart equals this except
2331 when the depth becomes negative. */
2332 int mindepth
; /* Lowest DEPTH value seen. */
2333 int start_quoted
= 0; /* Nonzero means starting after a char quote */
2335 int prev_from
; /* Keep one character before FROM. */
2336 int boundary_stop
= commentstop
== -1;
2340 DEC_POS (prev_from
);
2342 /* Use this macro instead of `from++'. */
2343 #define INC_FROM do { prev_from = from; INC_POS (from); } while (0)
2348 SETUP_SYNTAX_TABLE (from
, 1);
2350 if (NILP (oldstate
))
2353 state
.instring
= -1;
2354 state
.incomment
= 0;
2355 state
.comstyle
= 0; /* comment style a by default. */
2356 state
.comstr_start
= -1; /* no comment/string seen. */
2360 tem
= Fcar (oldstate
);
2366 oldstate
= Fcdr (oldstate
);
2367 oldstate
= Fcdr (oldstate
);
2368 oldstate
= Fcdr (oldstate
);
2369 tem
= Fcar (oldstate
);
2370 /* Check whether we are inside string_fence-style string: */
2371 state
.instring
= ( !NILP (tem
)
2372 ? ( INTEGERP (tem
) ? XINT (tem
) : ST_STRING_STYLE
)
2375 oldstate
= Fcdr (oldstate
);
2376 tem
= Fcar (oldstate
);
2377 state
.incomment
= !NILP (tem
);
2379 oldstate
= Fcdr (oldstate
);
2380 tem
= Fcar (oldstate
);
2381 start_quoted
= !NILP (tem
);
2383 /* if the eight element of the list is nil, we are in comment
2384 style a. If it is non-nil, we are in comment style b */
2385 oldstate
= Fcdr (oldstate
);
2386 oldstate
= Fcdr (oldstate
);
2387 tem
= Fcar (oldstate
);
2388 state
.comstyle
= NILP (tem
) ? 0 : ( EQ (tem
, Qsyntax_table
)
2389 ? ST_COMMENT_STYLE
: 1 );
2391 oldstate
= Fcdr (oldstate
);
2392 tem
= Fcar (oldstate
);
2393 state
.comstr_start
= NILP (tem
) ? -1 : XINT (tem
) ;
2398 curlevel
->prev
= -1;
2399 curlevel
->last
= -1;
2401 /* Enter the loop at a place appropriate for initial state. */
2403 if (state
.incomment
) goto startincomment
;
2404 if (state
.instring
>= 0)
2406 nofence
= state
.instring
!= ST_STRING_STYLE
;
2407 if (start_quoted
) goto startquotedinstring
;
2410 if (start_quoted
) goto startquoted
;
2414 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2415 code
= SYNTAX (FETCH_CHAR (from
));
2418 if (code
== Scomment
)
2419 state
.comstr_start
= prev_from
;
2420 else if (code
== Scomment_fence
)
2422 /* Record the comment style we have entered so that only
2423 the comment-end sequence of the same style actually
2424 terminates the comment section. */
2425 state
.comstyle
= ( code
== Scomment_fence
2427 : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
)));
2428 state
.comstr_start
= prev_from
;
2429 if (code
!= Scomment_fence
) INC_FROM
;
2432 else if (from
< end
)
2433 if (SYNTAX_COMSTART_FIRST (FETCH_CHAR (prev_from
)))
2434 if (SYNTAX_COMSTART_SECOND (FETCH_CHAR (from
)))
2435 /* Duplicate code to avoid a very complex if-expression
2436 which causes trouble for the SGI compiler. */
2438 /* Record the comment style we have entered so that only
2439 the comment-end sequence of the same style actually
2440 terminates the comment section. */
2441 state
.comstyle
= ( code
== Scomment_fence
2443 : SYNTAX_COMMENT_STYLE (FETCH_CHAR (from
)));
2444 state
.comstr_start
= prev_from
;
2445 if (code
!= Scomment_fence
) INC_FROM
;
2449 if (SYNTAX_PREFIX (FETCH_CHAR (prev_from
)))
2451 switch (SWITCH_ENUM_CAST (code
))
2455 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2456 curlevel
->last
= prev_from
;
2458 if (from
== end
) goto endquoted
;
2461 /* treat following character as a word constituent */
2464 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2465 curlevel
->last
= prev_from
;
2469 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2470 switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from
))))
2475 if (from
== end
) goto endquoted
;
2487 curlevel
->prev
= curlevel
->last
;
2491 if (commentstop
== 1)
2495 /* Enter the loop in the middle so that we find
2496 a 2-char comment ender if we start in the middle of it. */
2497 prev
= FETCH_CHAR (prev_from
);
2498 goto startincomment_1
;
2500 /* At beginning of buffer, enter the loop the ordinary way. */
2501 state
.incomment
= 1;
2505 state
.incomment
= 1;
2506 if (commentstop
|| boundary_stop
) goto done
;
2510 if (from
== end
) goto done
;
2511 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2512 prev
= FETCH_CHAR (from
);
2513 if (SYNTAX (prev
) == Sendcomment
2514 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
2515 /* Only terminate the comment section if the endcomment
2516 of the same style as the start sequence has been
2519 if (state
.comstyle
== ST_COMMENT_STYLE
2520 && SYNTAX (prev
) == Scomment_fence
)
2524 if (from
< end
&& SYNTAX_COMEND_FIRST (prev
)
2525 && SYNTAX_COMEND_SECOND (FETCH_CHAR (from
))
2526 && SYNTAX_COMMENT_STYLE (prev
) == state
.comstyle
)
2527 /* Only terminate the comment section if the end-comment
2528 sequence of the same style as the start sequence has
2529 been encountered. */
2533 state
.incomment
= 0;
2534 state
.comstyle
= 0; /* reset the comment style */
2535 if (boundary_stop
) goto done
;
2539 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2541 /* curlevel++->last ran into compiler bug on Apollo */
2542 curlevel
->last
= prev_from
;
2543 if (++curlevel
== endlevel
)
2544 error ("Nesting too deep for parser");
2545 curlevel
->prev
= -1;
2546 curlevel
->last
= -1;
2547 if (targetdepth
== depth
) goto done
;
2552 if (depth
< mindepth
)
2554 if (curlevel
!= levelstart
)
2556 curlevel
->prev
= curlevel
->last
;
2557 if (targetdepth
== depth
) goto done
;
2562 state
.comstr_start
= from
- 1;
2563 if (stopbefore
) goto stop
; /* this arg means stop at sexp start */
2564 curlevel
->last
= prev_from
;
2565 state
.instring
= (code
== Sstring
2566 ? (FETCH_CHAR (prev_from
))
2568 if (boundary_stop
) goto done
;
2571 nofence
= state
.instring
!= ST_STRING_STYLE
;
2577 if (from
>= end
) goto done
;
2578 c
= FETCH_CHAR (from
);
2579 if (nofence
&& c
== state
.instring
) break;
2580 UPDATE_SYNTAX_TABLE_FORWARD (from
);
2581 switch (SWITCH_ENUM_CAST (SYNTAX (c
)))
2584 if (!nofence
) goto string_end
;
2589 startquotedinstring
:
2590 if (from
>= end
) goto endquoted
;
2596 state
.instring
= -1;
2597 curlevel
->prev
= curlevel
->last
;
2599 if (boundary_stop
) goto done
;
2608 stop
: /* Here if stopping before start of sexp. */
2609 from
= prev_from
; /* We have just fetched the char that starts it; */
2610 goto done
; /* but return the position before it. */
2615 state
.depth
= depth
;
2616 state
.mindepth
= mindepth
;
2617 state
.thislevelstart
= curlevel
->prev
;
2618 state
.prevlevelstart
2619 = (curlevel
== levelstart
) ? -1 : (curlevel
- 1)->last
;
2620 state
.location
= from
;
2626 /* This comment supplies the doc string for parse-partial-sexp,
2627 for make-docfile to see. We cannot put this in the real DEFUN
2628 due to limits in the Unix cpp.
2630 DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0,
2631 "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
2632 Parsing stops at TO or when certain criteria are met;\n\
2633 point is set to where parsing stops.\n\
2634 If fifth arg STATE is omitted or nil,\n\
2635 parsing assumes that FROM is the beginning of a function.\n\
2636 Value is a list of nine elements describing final state of parsing:\n\
2637 0. depth in parens.\n\
2638 1. character address of start of innermost containing list; nil if none.\n\
2639 2. character address of start of last complete sexp terminated.\n\
2640 3. non-nil if inside a string.\n\
2641 (it is the character that will terminate the string,\n\
2642 or t if the string should be terminated by an explicit\n\
2643 `syntax-table' property.)\n\
2644 4. t if inside a comment.\n\
2645 5. t if following a quote character.\n\
2646 6. the minimum paren-depth encountered during this scan.\n\
2647 7. t if in a comment of style `b'; `syntax-table' if given by an explicit\n\
2648 `syntax-table' property.\n\
2649 8. character address of start of last comment or string; nil if none.\n\
2650 If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
2651 in parentheses becomes equal to TARGETDEPTH.\n\
2652 Fourth arg STOPBEFORE non-nil means stop when come to\n\
2653 any character that starts a sexp.\n\
2654 Fifth arg STATE is an eight-list like what this function returns.\n\
2655 It is used to initialize the state of the parse. Its second and third
2656 elements are ignored.
2657 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. If\n\
2658 it is `syntax-table', stop after the start of a comment or a string, or\n\
2659 after end of a comment or a string.")
2660 (from, to, targetdepth, stopbefore, state, commentstop)
2663 DEFUN ("parse-partial-sexp", Fparse_partial_sexp
, Sparse_partial_sexp
, 2, 6, 0,
2664 0 /* See immediately above */)
2665 (from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
)
2666 Lisp_Object from
, to
, targetdepth
, stopbefore
, oldstate
, commentstop
;
2668 struct lisp_parse_state state
;
2671 if (!NILP (targetdepth
))
2673 CHECK_NUMBER (targetdepth
, 3);
2674 target
= XINT (targetdepth
);
2677 target
= -100000; /* We won't reach this depth */
2679 validate_region (&from
, &to
);
2680 scan_sexps_forward (&state
, XINT (from
), XINT (to
),
2681 target
, !NILP (stopbefore
), oldstate
,
2683 ? 0 : (EQ (commentstop
, Qsyntax_table
) ? -1 : 1)));
2685 SET_PT (state
.location
);
2687 return Fcons (make_number (state
.depth
),
2688 Fcons (state
.prevlevelstart
< 0 ? Qnil
: make_number (state
.prevlevelstart
),
2689 Fcons (state
.thislevelstart
< 0 ? Qnil
: make_number (state
.thislevelstart
),
2690 Fcons (state
.instring
>= 0
2691 ? (state
.instring
== ST_STRING_STYLE
2692 ? Qt
: make_number (state
.instring
)) : Qnil
,
2693 Fcons (state
.incomment
? Qt
: Qnil
,
2694 Fcons (state
.quoted
? Qt
: Qnil
,
2695 Fcons (make_number (state
.mindepth
),
2696 Fcons (state
.comstyle
2697 ? (state
.comstyle
== ST_COMMENT_STYLE
2698 ? Qsyntax_table
: Qt
) : Qnil
,
2699 Fcons (state
.comstr_start
!= -1 ? make_number (state
.comstr_start
) : Qnil
,
2708 /* This has to be done here, before we call Fmake_char_table. */
2709 Qsyntax_table
= intern ("syntax-table");
2710 staticpro (&Qsyntax_table
);
2712 /* Intern this now in case it isn't already done.
2713 Setting this variable twice is harmless.
2714 But don't staticpro it here--that is done in alloc.c. */
2715 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
2717 /* Create objects which can be shared among syntax tables. */
2718 Vsyntax_code_object
= Fmake_vector (make_number (13), Qnil
);
2719 for (i
= 0; i
< XVECTOR (Vsyntax_code_object
)->size
; i
++)
2720 XVECTOR (Vsyntax_code_object
)->contents
[i
]
2721 = Fcons (make_number (i
), Qnil
);
2723 /* Now we are ready to set up this property, so we can
2724 create syntax tables. */
2725 Fput (Qsyntax_table
, Qchar_table_extra_slots
, make_number (0));
2727 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Swhitespace
];
2729 Vstandard_syntax_table
= Fmake_char_table (Qsyntax_table
, temp
);
2731 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Sword
];
2732 for (i
= 'a'; i
<= 'z'; i
++)
2733 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2734 for (i
= 'A'; i
<= 'Z'; i
++)
2735 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2736 for (i
= '0'; i
<= '9'; i
++)
2737 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, i
, temp
);
2739 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '$', temp
);
2740 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '%', temp
);
2742 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '(',
2743 Fcons (make_number (Sopen
), make_number (')')));
2744 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ')',
2745 Fcons (make_number (Sclose
), make_number ('(')));
2746 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '[',
2747 Fcons (make_number (Sopen
), make_number (']')));
2748 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, ']',
2749 Fcons (make_number (Sclose
), make_number ('[')));
2750 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '{',
2751 Fcons (make_number (Sopen
), make_number ('}')));
2752 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '}',
2753 Fcons (make_number (Sclose
), make_number ('{')));
2754 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '"',
2755 Fcons (make_number ((int) Sstring
), Qnil
));
2756 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, '\\',
2757 Fcons (make_number ((int) Sescape
), Qnil
));
2759 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Ssymbol
];
2760 for (i
= 0; i
< 10; i
++)
2762 c
= "_-+*/&|<>="[i
];
2763 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2766 temp
= XVECTOR (Vsyntax_code_object
)->contents
[(int) Spunct
];
2767 for (i
= 0; i
< 12; i
++)
2769 c
= ".,;:?!#@~^'`"[i
];
2770 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table
, c
, temp
);
2776 Qsyntax_table_p
= intern ("syntax-table-p");
2777 staticpro (&Qsyntax_table_p
);
2779 staticpro (&Vsyntax_code_object
);
2781 Qscan_error
= intern ("scan-error");
2782 staticpro (&Qscan_error
);
2783 Fput (Qscan_error
, Qerror_conditions
,
2784 Fcons (Qerror
, Qnil
));
2785 Fput (Qscan_error
, Qerror_message
,
2786 build_string ("Scan error"));
2788 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments
,
2789 "Non-nil means `forward-sexp', etc., should treat comments as whitespace.");
2791 DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties
,
2792 "Non-nil means `forward-sexp', etc., grant `syntax-table' property.\n\
2793 The value of this property should be either a syntax table, or a cons\n\
2794 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric\n\
2795 syntax code, MATCHCHAR being nil or the character to match (which is\n\
2796 relevant only for open/close type.");
2798 words_include_escapes
= 0;
2799 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes
,
2800 "Non-nil means `forward-word', etc., should treat escape chars part of words.");
2802 defsubr (&Ssyntax_table_p
);
2803 defsubr (&Ssyntax_table
);
2804 defsubr (&Sstandard_syntax_table
);
2805 defsubr (&Scopy_syntax_table
);
2806 defsubr (&Sset_syntax_table
);
2807 defsubr (&Schar_syntax
);
2808 defsubr (&Smatching_paren
);
2809 defsubr (&Smodify_syntax_entry
);
2810 defsubr (&Sdescribe_syntax
);
2812 defsubr (&Sforward_word
);
2814 defsubr (&Sskip_chars_forward
);
2815 defsubr (&Sskip_chars_backward
);
2816 defsubr (&Sskip_syntax_forward
);
2817 defsubr (&Sskip_syntax_backward
);
2819 defsubr (&Sforward_comment
);
2820 defsubr (&Sscan_lists
);
2821 defsubr (&Sscan_sexps
);
2822 defsubr (&Sbackward_prefix_chars
);
2823 defsubr (&Sparse_partial_sexp
);