428
+ − 1 /* XEmacs routines to deal with syntax tables; also word and list parsing.
+ − 2 Copyright (C) 1985-1994 Free Software Foundation, Inc.
+ − 3 Copyright (C) 1995 Sun Microsystems, Inc.
1296
+ − 4 Copyright (C) 2001, 2002, 2003 Ben Wing.
428
+ − 5
+ − 6 This file is part of XEmacs.
+ − 7
+ − 8 XEmacs is free software; you can redistribute it and/or modify it
+ − 9 under the terms of the GNU General Public License as published by the
+ − 10 Free Software Foundation; either version 2, or (at your option) any
+ − 11 later version.
+ − 12
+ − 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ − 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ − 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ − 16 for more details.
+ − 17
+ − 18 You should have received a copy of the GNU General Public License
+ − 19 along with XEmacs; see the file COPYING. If not, write to
+ − 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ − 21 Boston, MA 02111-1307, USA. */
+ − 22
+ − 23 /* Synched up with: FSF 19.28. */
+ − 24
+ − 25 /* This file has been Mule-ized. */
+ − 26
+ − 27 #include <config.h>
+ − 28 #include "lisp.h"
+ − 29
+ − 30 #include "buffer.h"
+ − 31 #include "syntax.h"
460
+ − 32 #include "extents.h"
428
+ − 33
460
+ − 34 #define ST_COMMENT_STYLE 0x101
+ − 35 #define ST_STRING_STYLE 0x102
+ − 36
+ − 37 Lisp_Object Qsyntax_table;
+ − 38 int lookup_syntax_properties;
+ − 39
428
+ − 40 Lisp_Object Qsyntax_table_p;
+ − 41
+ − 42 int words_include_escapes;
+ − 43
+ − 44 int parse_sexp_ignore_comments;
+ − 45
+ − 46 /* The following two variables are provided to tell additional information
+ − 47 to the regex routines. We do it this way rather than change the
+ − 48 arguments to re_search_2() in an attempt to maintain some call
+ − 49 compatibility with other versions of the regex code. */
+ − 50
+ − 51 /* Tell the regex routines not to QUIT. Normally there is a QUIT
+ − 52 each iteration in re_search_2(). */
+ − 53 int no_quit_in_re_search;
+ − 54
826
+ − 55 /* The standard syntax table is stored where it will automatically
+ − 56 be used in all new buffers. */
428
+ − 57 Lisp_Object Vstandard_syntax_table;
+ − 58
+ − 59 Lisp_Object Vsyntax_designator_chars_string;
+ − 60
826
+ − 61 Lisp_Object Vtemp_table_for_use_updating_syntax_tables;
+ − 62
1296
+ − 63 /* A value that is guaranteed not be in a syntax table. */
+ − 64 Lisp_Object Vbogus_syntax_table_value;
+ − 65
826
+ − 66 static void syntax_cache_table_was_changed (struct buffer *buf);
+ − 67
428
+ − 68 /* This is the internal form of the parse state used in parse-partial-sexp. */
+ − 69
+ − 70 struct lisp_parse_state
+ − 71 {
+ − 72 int depth; /* Depth at end of parsing */
867
+ − 73 Ichar instring; /* -1 if not within string, else desired terminator */
428
+ − 74 int incomment; /* Nonzero if within a comment at end of parsing */
460
+ − 75 int comstyle; /* comment style a=0, or b=1, or ST_COMMENT_STYLE */
428
+ − 76 int quoted; /* Nonzero if just after an escape char at end of
+ − 77 parsing */
665
+ − 78 Charbpos thislevelstart;/* Char number of most recent start-of-expression
428
+ − 79 at current level */
665
+ − 80 Charbpos prevlevelstart;/* Char number of start of containing expression */
+ − 81 Charbpos location; /* Char number at which parsing stopped */
428
+ − 82 int mindepth; /* Minimum depth seen while scanning */
826
+ − 83 Charbpos comstr_start;/* Position just after last comment/string starter */
+ − 84 Lisp_Object levelstarts;/* Char numbers of starts-of-expression
+ − 85 of levels (starting from outermost). */
428
+ − 86 };
+ − 87
+ − 88 /* These variables are a cache for finding the start of a defun.
+ − 89 find_start_pos is the place for which the defun start was found.
+ − 90 find_start_value is the defun start position found for it.
+ − 91 find_start_buffer is the buffer it was found in.
+ − 92 find_start_begv is the BEGV value when it was found.
+ − 93 find_start_modiff is the value of MODIFF when it was found. */
+ − 94
665
+ − 95 static Charbpos find_start_pos;
+ − 96 static Charbpos find_start_value;
428
+ − 97 static struct buffer *find_start_buffer;
665
+ − 98 static Charbpos find_start_begv;
428
+ − 99 static int find_start_modiff;
+ − 100
+ − 101 /* Find a defun-start that is the last one before POS (or nearly the last).
+ − 102 We record what we find, so that another call in the same area
+ − 103 can return the same value right away. */
+ − 104
665
+ − 105 static Charbpos
+ − 106 find_defun_start (struct buffer *buf, Charbpos pos)
428
+ − 107 {
665
+ − 108 Charbpos tem;
826
+ − 109 struct syntax_cache *scache;
+ − 110
428
+ − 111 /* Use previous finding, if it's valid and applies to this inquiry. */
+ − 112 if (buf == find_start_buffer
+ − 113 /* Reuse the defun-start even if POS is a little farther on.
+ − 114 POS might be in the next defun, but that's ok.
+ − 115 Our value may not be the best possible, but will still be usable. */
+ − 116 && pos <= find_start_pos + 1000
+ − 117 && pos >= find_start_value
+ − 118 && BUF_BEGV (buf) == find_start_begv
+ − 119 && BUF_MODIFF (buf) == find_start_modiff)
+ − 120 return find_start_value;
+ − 121
+ − 122 /* Back up to start of line. */
+ − 123 tem = find_next_newline (buf, pos, -1);
+ − 124
826
+ − 125 scache = setup_buffer_syntax_cache (buf, tem, 1);
428
+ − 126 while (tem > BUF_BEGV (buf))
+ − 127 {
826
+ − 128 UPDATE_SYNTAX_CACHE_BACKWARD (scache, tem);
460
+ − 129
428
+ − 130 /* Open-paren at start of line means we found our defun-start. */
826
+ − 131 if (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, tem)) == Sopen)
428
+ − 132 break;
+ − 133 /* Move to beg of previous line. */
+ − 134 tem = find_next_newline (buf, tem, -2);
+ − 135 }
+ − 136
+ − 137 /* Record what we found, for the next try. */
+ − 138 find_start_value = tem;
+ − 139 find_start_buffer = buf;
+ − 140 find_start_modiff = BUF_MODIFF (buf);
+ − 141 find_start_begv = BUF_BEGV (buf);
+ − 142 find_start_pos = pos;
+ − 143
+ − 144 return find_start_value;
+ − 145 }
+ − 146
+ − 147 DEFUN ("syntax-table-p", Fsyntax_table_p, 1, 1, 0, /*
444
+ − 148 Return t if OBJECT is a syntax table.
428
+ − 149 */
444
+ − 150 (object))
428
+ − 151 {
444
+ − 152 return (CHAR_TABLEP (object)
+ − 153 && XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_SYNTAX)
428
+ − 154 ? Qt : Qnil;
+ − 155 }
+ − 156
+ − 157 static Lisp_Object
+ − 158 check_syntax_table (Lisp_Object obj, Lisp_Object default_)
+ − 159 {
+ − 160 if (NILP (obj))
+ − 161 obj = default_;
+ − 162 while (NILP (Fsyntax_table_p (obj)))
+ − 163 obj = wrong_type_argument (Qsyntax_table_p, obj);
+ − 164 return obj;
+ − 165 }
+ − 166
+ − 167 DEFUN ("syntax-table", Fsyntax_table, 0, 1, 0, /*
+ − 168 Return the current syntax table.
+ − 169 This is the one specified by the current buffer, or by BUFFER if it
+ − 170 is non-nil.
+ − 171 */
+ − 172 (buffer))
+ − 173 {
+ − 174 return decode_buffer (buffer, 0)->syntax_table;
+ − 175 }
+ − 176
826
+ − 177 #ifdef DEBUG_XEMACS
+ − 178
+ − 179 DEFUN ("mirror-syntax-table", Fmirror_syntax_table, 0, 1, 0, /*
+ − 180 Return the current mirror syntax table, for debugging purposes.
+ − 181 This is the one specified by the current buffer, or by BUFFER if it
+ − 182 is non-nil.
+ − 183 */
+ − 184 (buffer))
+ − 185 {
+ − 186 return decode_buffer (buffer, 0)->mirror_syntax_table;
+ − 187 }
+ − 188
+ − 189 DEFUN ("syntax-cache-info", Fsyntax_cache_info, 0, 1, 0, /*
+ − 190 Return info about the syntax cache in BUFFER.
+ − 191 BUFFER defaults to the current buffer if nil.
+ − 192 */
+ − 193 (buffer))
+ − 194 {
+ − 195 struct buffer *buf = decode_buffer (buffer, 0);
+ − 196 struct syntax_cache *cache = buf->syntax_cache;
+ − 197 return list4 (cache->start, cache->end, make_int (cache->prev_change),
+ − 198 make_int (cache->next_change));
+ − 199 }
+ − 200
+ − 201 #endif /* DEBUG_XEMACS */
+ − 202
428
+ − 203 DEFUN ("standard-syntax-table", Fstandard_syntax_table, 0, 0, 0, /*
+ − 204 Return the standard syntax table.
+ − 205 This is the one used for new buffers.
+ − 206 */
+ − 207 ())
+ − 208 {
+ − 209 return Vstandard_syntax_table;
+ − 210 }
+ − 211
+ − 212 DEFUN ("copy-syntax-table", Fcopy_syntax_table, 0, 1, 0, /*
444
+ − 213 Return a new syntax table which is a copy of SYNTAX-TABLE.
+ − 214 SYNTAX-TABLE defaults to the standard syntax table.
428
+ − 215 */
444
+ − 216 (syntax_table))
428
+ − 217 {
+ − 218 if (NILP (Vstandard_syntax_table))
+ − 219 return Fmake_char_table (Qsyntax);
+ − 220
444
+ − 221 syntax_table = check_syntax_table (syntax_table, Vstandard_syntax_table);
+ − 222 return Fcopy_char_table (syntax_table);
428
+ − 223 }
+ − 224
+ − 225 DEFUN ("set-syntax-table", Fset_syntax_table, 1, 2, 0, /*
444
+ − 226 Select SYNTAX-TABLE as the new syntax table for BUFFER.
428
+ − 227 BUFFER defaults to the current buffer if omitted.
+ − 228 */
444
+ − 229 (syntax_table, buffer))
428
+ − 230 {
+ − 231 struct buffer *buf = decode_buffer (buffer, 0);
444
+ − 232 syntax_table = check_syntax_table (syntax_table, Qnil);
+ − 233 buf->syntax_table = syntax_table;
+ − 234 buf->mirror_syntax_table = XCHAR_TABLE (syntax_table)->mirror_table;
826
+ − 235 syntax_cache_table_was_changed (buf);
428
+ − 236 /* Indicate that this buffer now has a specified syntax table. */
+ − 237 buf->local_var_flags |= XINT (buffer_local_flags.syntax_table);
444
+ − 238 return syntax_table;
428
+ − 239 }
3252
+ − 240
+ − 241
428
+ − 242
3252
+ − 243 /*
+ − 244 * Syntax caching
+ − 245 */
+ − 246
+ − 247 /* syntax_cache object implementation */
+ − 248
+ − 249 static const struct memory_description syntax_cache_description_1 [] = {
+ − 250 { XD_LISP_OBJECT, offsetof (struct syntax_cache, object) },
+ − 251 { XD_LISP_OBJECT, offsetof (struct syntax_cache, buffer) },
+ − 252 { XD_LISP_OBJECT, offsetof (struct syntax_cache, syntax_table) },
+ − 253 { XD_LISP_OBJECT, offsetof (struct syntax_cache, mirror_table) },
+ − 254 { XD_LISP_OBJECT, offsetof (struct syntax_cache, start) },
+ − 255 { XD_LISP_OBJECT, offsetof (struct syntax_cache, end) },
+ − 256 { XD_END }
+ − 257 };
+ − 258
+ − 259 #ifdef NEW_GC
+ − 260 DEFINE_LRECORD_IMPLEMENTATION ("syntax-cache", syntax_cache,
+ − 261 1, /*dumpable-flag*/
+ − 262 0, 0, 0, 0, 0,
+ − 263 syntax_cache_description_1,
+ − 264 Lisp_Syntax_Cache);
+ − 265 #else /* not NEW_GC */
+ − 266
+ − 267 const struct sized_memory_description syntax_cache_description = {
+ − 268 sizeof (struct syntax_cache),
+ − 269 syntax_cache_description_1
+ − 270 };
+ − 271 #endif /* not NEW_GC */
+ − 272
+ − 273 /* static syntax cache utilities */
+ − 274
+ − 275 static void
+ − 276 syntax_cache_table_was_changed (struct buffer *buf)
+ − 277 {
+ − 278 struct syntax_cache *cache = buf->syntax_cache;
+ − 279 if (cache->no_syntax_table_prop)
+ − 280 {
+ − 281 cache->syntax_table =
+ − 282 BUFFER_SYNTAX_TABLE (buf);
+ − 283 cache->mirror_table =
+ − 284 BUFFER_MIRROR_SYNTAX_TABLE (buf);
+ − 285 }
+ − 286 }
+ − 287
+ − 288 static void
+ − 289 reset_buffer_syntax_cache_range (struct syntax_cache *cache,
+ − 290 Lisp_Object buffer, int infinite)
+ − 291 {
+ − 292 Fset_marker (cache->start, make_int (1), buffer);
+ − 293 Fset_marker (cache->end, make_int (1), buffer);
+ − 294 Fset_marker_insertion_type (cache->start, Qt);
+ − 295 Fset_marker_insertion_type (cache->end, Qnil);
+ − 296 /* #### Should we "cache->no_syntax_table_prop = 1;" here? */
+ − 297 /* #### Cf comment on INFINITE in init_syntax_cache. -- sjt */
+ − 298 if (infinite)
+ − 299 {
+ − 300 cache->prev_change = EMACS_INT_MIN;
+ − 301 cache->next_change = EMACS_INT_MAX;
+ − 302 }
+ − 303 else
+ − 304 {
+ − 305 cache->prev_change = -1;
+ − 306 cache->next_change = -1;
+ − 307 }
+ − 308 }
826
+ − 309
+ − 310 static void
+ − 311 init_syntax_cache (struct syntax_cache *cache, Lisp_Object object,
+ − 312 struct buffer *buffer, int infinite)
+ − 313 {
+ − 314 xzero (*cache);
+ − 315 cache->object = object;
+ − 316 cache->buffer = buffer;
+ − 317 cache->no_syntax_table_prop = 1;
1296
+ − 318 cache->syntax_table =
+ − 319 BUFFER_SYNTAX_TABLE (cache->buffer);
+ − 320 cache->mirror_table =
826
+ − 321 BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer);
+ − 322 cache->start = Qnil;
+ − 323 cache->end = Qnil;
3250
+ − 324 /* #### I'm not sure what INFINITE is for, but it's apparently needed by
+ − 325 setup_syntax_cache(). It looks like it's supposed to guarantee that
+ − 326 the test for POS outside of cache-valid range will never succeed, so
+ − 327 that update_syntax_cache won't get called, but it's hard to be sure.
+ − 328 Cf reset_buffer_syntax_cache_range. -- sjt */
826
+ − 329 if (infinite)
+ − 330 {
+ − 331 cache->prev_change = EMACS_INT_MIN;
+ − 332 cache->next_change = EMACS_INT_MAX;
+ − 333 }
+ − 334 else
+ − 335 {
+ − 336 cache->prev_change = -1;
+ − 337 cache->next_change = -1;
+ − 338 }
+ − 339 }
+ − 340
3252
+ − 341 /* external syntax cache API */
+ − 342
3250
+ − 343 /* #### This function and associated logic still needs work, and especially
+ − 344 documentation. */
+ − 345 struct syntax_cache * /* return CACHE or the cache of OBJECT */
+ − 346 setup_syntax_cache (struct syntax_cache *cache, /* syntax cache, may be NULL
+ − 347 if OBJECT is a buffer */
+ − 348 Lisp_Object object, /* the object (if any) cache
+ − 349 is associated with */
+ − 350 struct buffer *buffer, /* the buffer to use as source
+ − 351 of the syntax table */
+ − 352 Charxpos from, /* initial position of cache */
+ − 353 int count) /* direction? see code */
826
+ − 354 {
3250
+ − 355 /* If OBJECT is a buffer, use its cache. Initialize cache. Make it valid
+ − 356 for the whole buffer if the syntax-table property is not being respected.
+ − 357 Else if OBJECT is not a buffer, initialize the cache passed in CACHE.
+ − 358 If the syntax-table property is being respected, update the cache. */
826
+ − 359 if (BUFFERP (object))
3250
+ − 360 {
+ − 361 cache = XBUFFER (object)->syntax_cache;
+ − 362 if (!lookup_syntax_properties)
+ − 363 reset_buffer_syntax_cache_range (cache, object, 1);
+ − 364 }
+ − 365 else
826
+ − 366 init_syntax_cache (cache, object, buffer, 0);
+ − 367 if (lookup_syntax_properties)
+ − 368 {
+ − 369 if (count <= 0)
+ − 370 {
+ − 371 from--;
2167
+ − 372 from = buffer_or_string_clip_to_accessible_char (cache->object,
826
+ − 373 from);
+ − 374 }
+ − 375 if (!(from >= cache->prev_change && from < cache->next_change))
+ − 376 update_syntax_cache (cache, from, count);
+ − 377 }
1296
+ − 378 #ifdef NOT_WORTH_THE_EFFORT
+ − 379 update_mirror_syntax_if_dirty (cache->mirror_table);
+ − 380 #endif /* NOT_WORTH_THE_EFFORT */
826
+ − 381 return cache;
+ − 382 }
+ − 383
+ − 384 struct syntax_cache *
+ − 385 setup_buffer_syntax_cache (struct buffer *buffer, Charxpos from, int count)
+ − 386 {
+ − 387 return setup_syntax_cache (NULL, wrap_buffer (buffer), buffer, from, count);
+ − 388 }
+ − 389
460
+ − 390 /*
+ − 391 Update syntax_cache to an appropriate setting for position POS
+ − 392
+ − 393 The sign of COUNT gives the relative position of POS wrt the
+ − 394 previously valid interval. (not currently used)
+ − 395
+ − 396 `syntax_cache.*_change' are the next and previous positions at
+ − 397 which syntax_code and c_s_t will need to be recalculated.
+ − 398
3025
+ − 399 #### Currently this code uses `get-char-property', which will
460
+ − 400 return the "last smallest" extent at a given position. In cases
+ − 401 where overlapping extents are defined, this code will simply use
+ − 402 whatever is returned by get-char-property.
+ − 403
+ − 404 It might be worth it at some point to merge provided syntax tables
826
+ − 405 outward to the current buffer (#### rewrite in English please?!). */
460
+ − 406
+ − 407 void
2286
+ − 408 update_syntax_cache (struct syntax_cache *cache, Charxpos cpos,
+ − 409 int UNUSED (count))
460
+ − 410 {
+ − 411 Lisp_Object tmp_table;
826
+ − 412 Bytexpos pos;
+ − 413 Bytexpos lim;
+ − 414 Bytexpos next, prev;
+ − 415 int at_begin = 0, at_end = 0;
460
+ − 416
826
+ − 417 if (NILP (cache->object))
+ − 418 return;
+ − 419
+ − 420 pos = buffer_or_string_charxpos_to_bytexpos (cache->object, cpos);
+ − 421
+ − 422 tmp_table = get_char_property (pos, Qsyntax_table, cache->object,
+ − 423 EXTENT_AT_AFTER, 0);
2506
+ − 424 lim = next_previous_single_property_change (pos, Qsyntax_table,
+ − 425 cache->object, -1, 1, 0);
826
+ − 426 if (lim < 0)
460
+ − 427 {
826
+ − 428 next = buffer_or_string_absolute_end_byte (cache->object);
+ − 429 at_begin = 1;
460
+ − 430 }
826
+ − 431 else
+ − 432 next = lim;
460
+ − 433
826
+ − 434 if (pos < buffer_or_string_absolute_end_byte (cache->object))
+ − 435 pos = next_bytexpos (cache->object, pos);
2506
+ − 436 lim = next_previous_single_property_change (pos, Qsyntax_table,
+ − 437 cache->object, -1, 0, 0);
826
+ − 438 if (lim < 0)
460
+ − 439 {
826
+ − 440 prev = buffer_or_string_absolute_begin_byte (cache->object);
+ − 441 at_end = 1;
460
+ − 442 }
+ − 443 else
826
+ − 444 prev = lim;
460
+ − 445
826
+ − 446 cache->prev_change =
+ − 447 buffer_or_string_bytexpos_to_charxpos (cache->object, prev);
+ − 448 cache->next_change =
+ − 449 buffer_or_string_bytexpos_to_charxpos (cache->object, next);
460
+ − 450
826
+ − 451 if (BUFFERP (cache->object))
+ − 452 {
+ − 453 /* If we are at the beginning or end of buffer, check to see if there's
+ − 454 a zero-length `syntax-table' extent there (highly unlikely); if not,
+ − 455 then we can safely make the end closed, so it will take in newly
+ − 456 inserted text. (If such an extent is inserted, we will be informed
3250
+ − 457 through signal_syntax_cache_extent_changed().) */
826
+ − 458 Fset_marker (cache->start, make_int (cache->prev_change), cache->object);
+ − 459 Fset_marker_insertion_type
+ − 460 (cache->start,
+ − 461 at_begin && NILP (extent_at (prev, cache->object, Qsyntax_table,
+ − 462 NULL, EXTENT_AT_AT, 0))
+ − 463 ? Qnil : Qt);
+ − 464 Fset_marker (cache->end, make_int (cache->next_change), cache->object);
+ − 465 Fset_marker_insertion_type
+ − 466 (cache->end,
+ − 467 at_end && NILP (extent_at (next, cache->object, Qsyntax_table,
+ − 468 NULL, EXTENT_AT_AT, 0))
+ − 469 ? Qt : Qnil);
+ − 470 }
+ − 471
+ − 472 if (!NILP (Fsyntax_table_p (tmp_table)))
+ − 473 {
+ − 474 cache->use_code = 0;
1296
+ − 475 cache->syntax_table = tmp_table;
+ − 476 cache->mirror_table = XCHAR_TABLE (tmp_table)->mirror_table;
826
+ − 477 cache->no_syntax_table_prop = 0;
1296
+ − 478 #ifdef NOT_WORTH_THE_EFFORT
+ − 479 update_mirror_syntax_if_dirty (cache->mirror_table);
+ − 480 #endif /* NOT_WORTH_THE_EFFORT */
826
+ − 481 }
+ − 482 else if (CONSP (tmp_table) && INTP (XCAR (tmp_table)))
+ − 483 {
+ − 484 cache->use_code = 1;
+ − 485 cache->syntax_code = XINT (XCAR (tmp_table));
+ − 486 cache->no_syntax_table_prop = 0;
+ − 487 }
+ − 488 else
+ − 489 {
+ − 490 cache->use_code = 0;
+ − 491 cache->no_syntax_table_prop = 1;
1296
+ − 492 cache->syntax_table = BUFFER_SYNTAX_TABLE (cache->buffer);
+ − 493 cache->mirror_table = BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer);
+ − 494 #ifdef NOT_WORTH_THE_EFFORT
+ − 495 update_mirror_syntax_if_dirty (cache->mirror_table);
+ − 496 #endif /* NOT_WORTH_THE_EFFORT */
460
+ − 497 }
+ − 498 }
3252
+ − 499
+ − 500 /* buffer-specific APIs used in buffer.c
+ − 501 #### This is really unclean;
+ − 502 the syntax cache should just be a LISP object */
+ − 503
+ − 504 void
+ − 505 mark_buffer_syntax_cache (struct buffer *buf)
+ − 506 {
+ − 507 struct syntax_cache *cache = buf->syntax_cache;
+ − 508 if (!cache) /* Vbuffer_defaults and such don't have caches */
+ − 509 return;
+ − 510 mark_object (cache->object);
+ − 511 if (cache->buffer)
+ − 512 mark_object (wrap_buffer (cache->buffer));
+ − 513 mark_object (cache->syntax_table);
+ − 514 mark_object (cache->mirror_table);
+ − 515 mark_object (cache->start);
+ − 516 mark_object (cache->end);
+ − 517 }
+ − 518
+ − 519 void
+ − 520 init_buffer_syntax_cache (struct buffer *buf)
+ − 521 {
+ − 522 struct syntax_cache *cache;
+ − 523 #ifdef NEW_GC
+ − 524 buf->syntax_cache = alloc_lrecord_type (struct syntax_cache,
+ − 525 &lrecord_syntax_cache);
+ − 526 #else /* not NEW_GC */
+ − 527 buf->syntax_cache = xnew_and_zero (struct syntax_cache);
+ − 528 #endif /* not NEW_GC */
+ − 529 cache = buf->syntax_cache;
+ − 530 cache->object = wrap_buffer (buf);
+ − 531 cache->buffer = buf;
+ − 532 cache->no_syntax_table_prop = 1;
+ − 533 cache->syntax_table = BUFFER_SYNTAX_TABLE (cache->buffer);
+ − 534 cache->mirror_table = BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer);
+ − 535 cache->start = Fmake_marker ();
+ − 536 cache->end = Fmake_marker ();
+ − 537 reset_buffer_syntax_cache_range (cache, cache->object, 0);
+ − 538 }
+ − 539
+ − 540 /* finalize the syntax cache for BUF */
+ − 541
+ − 542 void
+ − 543 uninit_buffer_syntax_cache (struct buffer *buf)
+ − 544 {
4141
+ − 545 #ifndef NEW_GC
3252
+ − 546 xfree (buf->syntax_cache, struct syntax_cache *);
+ − 547 buf->syntax_cache = 0;
4141
+ − 548 #endif /* not NEW_GC */
3252
+ − 549 }
+ − 550
+ − 551 /* extent-specific APIs used in extents.c and insdel.c */
+ − 552
+ − 553 /* The syntax-table property on the range covered by EXTENT may be changing,
+ − 554 either because EXTENT has a syntax-table property and is being attached
+ − 555 or detached (this includes having its endpoints changed), or because
+ − 556 the value of EXTENT's syntax-table property is changing. */
+ − 557
+ − 558 void
+ − 559 signal_syntax_cache_extent_changed (EXTENT extent)
+ − 560 {
+ − 561 Lisp_Object buffer = Fextent_object (wrap_extent (extent));
+ − 562 if (BUFFERP (buffer))
+ − 563 {
+ − 564 /* This was getting called with the buffer's start and end null, eg in
+ − 565 cperl mode, which triggers an assert in byte_marker_position. Cf
+ − 566 thread rooted at <yxz7j7xzk97.fsf@gimli.holgi.priv> on xemacs-beta.
+ − 567 <yxzfymklb6p.fsf@gimli.holgi.priv> has a recipe, but you also need
+ − 568 to delete or type SPC to get the crash.
+ − 569 #### Delete this comment when setup_syntax_cache is made sane. */
+ − 570 struct syntax_cache *cache = XBUFFER (buffer)->syntax_cache;
+ − 571 /* #### would this be slower or less accurate in character terms? */
+ − 572 Bytexpos start = extent_endpoint_byte (extent, 0);
+ − 573 Bytexpos end = extent_endpoint_byte (extent, 1);
+ − 574 Bytexpos start2 = byte_marker_position (cache->start);
+ − 575 Bytexpos end2 = byte_marker_position (cache->end);
+ − 576 /* If the extent is entirely before or entirely after the cache
+ − 577 range, it doesn't overlap. Otherwise, invalidate the range. */
+ − 578 if (!(end < start2 || start > end2))
+ − 579 reset_buffer_syntax_cache_range (cache, buffer, 0);
+ − 580 }
+ − 581 }
+ − 582
+ − 583 /* Extents have been adjusted for insertion or deletion, so we need to
+ − 584 refetch the start and end position of the extent */
+ − 585 void
+ − 586 signal_syntax_cache_extent_adjust (struct buffer *buf)
+ − 587 {
+ − 588 struct syntax_cache *cache = buf->syntax_cache;
+ − 589 /* If the cache was invalid before, leave it that way. We only want
+ − 590 to update the limits of validity when they were actually valid. */
+ − 591 if (cache->prev_change < 0)
+ − 592 return;
+ − 593 cache->prev_change = marker_position (cache->start);
+ − 594 cache->next_change = marker_position (cache->end);
+ − 595 }
+ − 596
+ − 597
460
+ − 598
428
+ − 599 /* Convert a letter which signifies a syntax code
+ − 600 into the code it signifies.
+ − 601 This is used by modify-syntax-entry, and other things. */
+ − 602
442
+ − 603 const unsigned char syntax_spec_code[0400] =
428
+ − 604 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
+ − 605 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
+ − 606 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
+ − 607 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
+ − 608 (char) Swhitespace, 0377, (char) Sstring, 0377,
+ − 609 (char) Smath, 0377, 0377, (char) Squote,
+ − 610 (char) Sopen, (char) Sclose, 0377, 0377,
+ − 611 0377, (char) Swhitespace, (char) Spunct, (char) Scharquote,
+ − 612 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
+ − 613 0377, 0377, 0377, 0377,
+ − 614 (char) Scomment, 0377, (char) Sendcomment, 0377,
+ − 615 (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */
+ − 616 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
+ − 617 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
+ − 618 0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol,
+ − 619 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
+ − 620 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
+ − 621 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
460
+ − 622 0377, 0377, 0377, 0377, (char) Sstring_fence, 0377, 0377, 0377
428
+ − 623 };
+ − 624
460
+ − 625 const unsigned char syntax_code_spec[] = " .w_()'\"$\\/<>@!|";
428
+ − 626
+ − 627 DEFUN ("syntax-designator-chars", Fsyntax_designator_chars, 0, 0, 0, /*
+ − 628 Return a string of the recognized syntax designator chars.
+ − 629 The chars are ordered by their internal syntax codes, which are
+ − 630 numbered starting at 0.
+ − 631 */
+ − 632 ())
+ − 633 {
+ − 634 return Vsyntax_designator_chars_string;
+ − 635 }
+ − 636
+ − 637 DEFUN ("char-syntax", Fchar_syntax, 1, 2, 0, /*
444
+ − 638 Return the syntax code of CHARACTER, described by a character.
+ − 639 For example, if CHARACTER is a word constituent,
+ − 640 the character `?w' is returned.
428
+ − 641 The characters that correspond to various syntax codes
+ − 642 are listed in the documentation of `modify-syntax-entry'.
444
+ − 643 Optional second argument SYNTAX-TABLE defaults to the current buffer's
428
+ − 644 syntax table.
+ − 645 */
444
+ − 646 (character, syntax_table))
428
+ − 647 {
826
+ − 648 Lisp_Object mirrortab;
428
+ − 649
444
+ − 650 if (NILP (character))
428
+ − 651 {
444
+ − 652 character = make_char ('\000');
428
+ − 653 }
444
+ − 654 CHECK_CHAR_COERCE_INT (character);
826
+ − 655 syntax_table = check_syntax_table (syntax_table,
+ − 656 current_buffer->syntax_table);
+ − 657 mirrortab = XCHAR_TABLE (syntax_table)->mirror_table;
+ − 658 return make_char (syntax_code_spec[(int) SYNTAX (mirrortab,
+ − 659 XCHAR (character))]);
428
+ − 660 }
+ − 661
+ − 662 #ifdef MULE
+ − 663
+ − 664 enum syntaxcode
2286
+ − 665 charset_syntax (struct buffer *UNUSED (buf), Lisp_Object UNUSED (charset),
+ − 666 int *multi_p_out)
428
+ − 667 {
+ − 668 *multi_p_out = 1;
826
+ − 669 /* !!#### get this right */
3152
+ − 670 return Sword;
428
+ − 671 }
+ − 672
+ − 673 #endif
+ − 674
+ − 675 Lisp_Object
867
+ − 676 syntax_match (Lisp_Object syntax_table, Ichar ch)
428
+ − 677 {
826
+ − 678 Lisp_Object code = get_char_table (ch, syntax_table);
428
+ − 679 Lisp_Object code2 = code;
+ − 680
+ − 681 if (CONSP (code))
+ − 682 code2 = XCAR (code);
+ − 683 if (SYNTAX_FROM_CODE (XINT (code2)) == Sinherit)
826
+ − 684 code = get_char_table (ch, Vstandard_syntax_table);
428
+ − 685
+ − 686 return CONSP (code) ? XCDR (code) : Qnil;
+ − 687 }
+ − 688
+ − 689 DEFUN ("matching-paren", Fmatching_paren, 1, 2, 0, /*
444
+ − 690 Return the matching parenthesis of CHARACTER, or nil if none.
+ − 691 Optional second argument SYNTAX-TABLE defaults to the current buffer's
428
+ − 692 syntax table.
+ − 693 */
444
+ − 694 (character, syntax_table))
428
+ − 695 {
826
+ − 696 Lisp_Object mirrortab;
1315
+ − 697 enum syntaxcode code;
428
+ − 698
444
+ − 699 CHECK_CHAR_COERCE_INT (character);
826
+ − 700 syntax_table = check_syntax_table (syntax_table,
+ − 701 current_buffer->syntax_table);
+ − 702 mirrortab = XCHAR_TABLE (syntax_table)->mirror_table;
444
+ − 703 code = SYNTAX (mirrortab, XCHAR (character));
428
+ − 704 if (code == Sopen || code == Sclose || code == Sstring)
444
+ − 705 return syntax_match (syntax_table, XCHAR (character));
428
+ − 706 return Qnil;
+ − 707 }
+ − 708
+ − 709
+ − 710
+ − 711 #ifdef MULE
+ − 712 /* Return 1 if there is a word boundary between two word-constituent
+ − 713 characters C1 and C2 if they appear in this order, else return 0.
+ − 714 There is no word boundary between two word-constituent ASCII
+ − 715 characters. */
+ − 716 #define WORD_BOUNDARY_P(c1, c2) \
867
+ − 717 (!(ichar_ascii_p (c1) && ichar_ascii_p (c2)) \
428
+ − 718 && word_boundary_p (c1, c2))
+ − 719 #endif
+ − 720
+ − 721 /* Return the position across COUNT words from FROM.
+ − 722 If that many words cannot be found before the end of the buffer, return 0.
+ − 723 COUNT negative means scan backward and stop at word beginning. */
+ − 724
665
+ − 725 Charbpos
+ − 726 scan_words (struct buffer *buf, Charbpos from, int count)
428
+ − 727 {
665
+ − 728 Charbpos limit = count > 0 ? BUF_ZV (buf) : BUF_BEGV (buf);
867
+ − 729 Ichar ch0, ch1;
428
+ − 730 enum syntaxcode code;
826
+ − 731 struct syntax_cache *scache = setup_buffer_syntax_cache (buf, from, count);
460
+ − 732
428
+ − 733 /* #### is it really worth it to hand expand both cases? JV */
+ − 734 while (count > 0)
+ − 735 {
+ − 736 QUIT;
+ − 737
+ − 738 while (1)
+ − 739 {
+ − 740 if (from == limit)
+ − 741 return 0;
+ − 742
826
+ − 743 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
428
+ − 744 ch0 = BUF_FETCH_CHAR (buf, from);
826
+ − 745 code = SYNTAX_FROM_CACHE (scache, ch0);
428
+ − 746
442
+ − 747 from++;
428
+ − 748 if (words_include_escapes
+ − 749 && (code == Sescape || code == Scharquote))
+ − 750 break;
+ − 751 if (code == Sword)
+ − 752 break;
+ − 753 }
+ − 754
+ − 755 QUIT;
+ − 756
+ − 757 while (from != limit)
+ − 758 {
826
+ − 759 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
428
+ − 760 ch1 = BUF_FETCH_CHAR (buf, from);
826
+ − 761 code = SYNTAX_FROM_CACHE (scache, ch1);
428
+ − 762 if (!(words_include_escapes
+ − 763 && (code == Sescape || code == Scharquote)))
+ − 764 if (code != Sword
+ − 765 #ifdef MULE
+ − 766 || WORD_BOUNDARY_P (ch0, ch1)
434
+ − 767 #endif
428
+ − 768 )
+ − 769 break;
+ − 770 #ifdef MULE
+ − 771 ch0 = ch1;
434
+ − 772 #endif
428
+ − 773 from++;
+ − 774 }
+ − 775 count--;
+ − 776 }
+ − 777
+ − 778 while (count < 0)
+ − 779 {
+ − 780 QUIT;
+ − 781
+ − 782 while (1)
+ − 783 {
+ − 784 if (from == limit)
+ − 785 return 0;
+ − 786
826
+ − 787 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1);
428
+ − 788 ch1 = BUF_FETCH_CHAR (buf, from - 1);
826
+ − 789 code = SYNTAX_FROM_CACHE (scache, ch1);
460
+ − 790 from--;
442
+ − 791
428
+ − 792 if (words_include_escapes
+ − 793 && (code == Sescape || code == Scharquote))
+ − 794 break;
+ − 795 if (code == Sword)
+ − 796 break;
+ − 797 }
+ − 798
+ − 799 QUIT;
+ − 800
+ − 801 while (from != limit)
+ − 802 {
826
+ − 803 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1);
428
+ − 804 ch0 = BUF_FETCH_CHAR (buf, from - 1);
826
+ − 805 code = SYNTAX_FROM_CACHE (scache, ch0);
460
+ − 806
428
+ − 807 if (!(words_include_escapes
+ − 808 && (code == Sescape || code == Scharquote)))
+ − 809 if (code != Sword
+ − 810 #ifdef MULE
+ − 811 || WORD_BOUNDARY_P (ch0, ch1)
+ − 812 #endif
+ − 813 )
+ − 814 break;
+ − 815 #ifdef MULE
+ − 816 ch1 = ch0;
+ − 817 #endif
+ − 818 from--;
+ − 819 }
+ − 820 count++;
+ − 821 }
+ − 822
+ − 823 return from;
+ − 824 }
+ − 825
446
+ − 826 DEFUN ("forward-word", Fforward_word, 0, 2, "_p", /*
428
+ − 827 Move point forward COUNT words (backward if COUNT is negative).
446
+ − 828 Normally t is returned, but if an edge of the buffer is reached,
+ − 829 point is left there and nil is returned.
428
+ − 830
462
+ − 831 The characters that are moved over may be added to the current selection
+ − 832 \(i.e. active region) if the Shift key is held down, a motion key is used
+ − 833 to invoke this command, and `shifted-motion-keys-select-region' is t; see
+ − 834 the documentation for this variable for more details.
+ − 835
446
+ − 836 COUNT defaults to 1, and BUFFER defaults to the current buffer.
428
+ − 837 */
+ − 838 (count, buffer))
+ − 839 {
665
+ − 840 Charbpos val;
428
+ − 841 struct buffer *buf = decode_buffer (buffer, 0);
446
+ − 842 EMACS_INT n;
+ − 843
+ − 844 if (NILP (count))
+ − 845 n = 1;
+ − 846 else
+ − 847 {
+ − 848 CHECK_INT (count);
+ − 849 n = XINT (count);
+ − 850 }
428
+ − 851
446
+ − 852 val = scan_words (buf, BUF_PT (buf), n);
+ − 853 if (val)
428
+ − 854 {
446
+ − 855 BUF_SET_PT (buf, val);
+ − 856 return Qt;
+ − 857 }
+ − 858 else
+ − 859 {
+ − 860 BUF_SET_PT (buf, n > 0 ? BUF_ZV (buf) : BUF_BEGV (buf));
428
+ − 861 return Qnil;
+ − 862 }
+ − 863 }
+ − 864
+ − 865 static void scan_sexps_forward (struct buffer *buf,
+ − 866 struct lisp_parse_state *,
665
+ − 867 Charbpos from, Charbpos end,
428
+ − 868 int targetdepth, int stopbefore,
+ − 869 Lisp_Object oldstate,
+ − 870 int commentstop);
+ − 871
+ − 872 static int
665
+ − 873 find_start_of_comment (struct buffer *buf, Charbpos from, Charbpos stop,
460
+ − 874 int comstyle)
428
+ − 875 {
867
+ − 876 Ichar c;
428
+ − 877 enum syntaxcode code;
+ − 878
+ − 879 /* Look back, counting the parity of string-quotes,
+ − 880 and recording the comment-starters seen.
+ − 881 When we reach a safe place, assume that's not in a string;
+ − 882 then step the main scan to the earliest comment-starter seen
+ − 883 an even number of string quotes away from the safe place.
+ − 884
+ − 885 OFROM[I] is position of the earliest comment-starter seen
+ − 886 which is I+2X quotes from the comment-end.
+ − 887 PARITY is current parity of quotes from the comment end. */
+ − 888 int parity = 0;
867
+ − 889 Ichar my_stringend = 0;
428
+ − 890 int string_lossage = 0;
665
+ − 891 Charbpos comment_end = from;
+ − 892 Charbpos comstart_pos = 0;
428
+ − 893 int comstart_parity = 0;
+ − 894 int styles_match_p = 0;
460
+ − 895 /* mask to match comment styles against; for ST_COMMENT_STYLE, this
+ − 896 will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */
+ − 897 int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A;
826
+ − 898 struct syntax_cache *scache = buf->syntax_cache;
428
+ − 899
+ − 900 /* At beginning of range to scan, we're outside of strings;
+ − 901 that determines quote parity to the comment-end. */
+ − 902 while (from != stop)
+ − 903 {
460
+ − 904 int syncode;
+ − 905
428
+ − 906 /* Move back and examine a character. */
+ − 907 from--;
826
+ − 908 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from);
428
+ − 909
+ − 910 c = BUF_FETCH_CHAR (buf, from);
826
+ − 911 syncode = SYNTAX_CODE_FROM_CACHE (scache, c);
+ − 912 code = SYNTAX_FROM_CODE (syncode);
428
+ − 913
+ − 914 /* is this a 1-char comment end sequence? if so, try
+ − 915 to see if style matches previously extracted mask */
+ − 916 if (code == Sendcomment)
+ − 917 {
+ − 918 styles_match_p =
460
+ − 919 SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask;
428
+ − 920 }
+ − 921
+ − 922 /* or are we looking at a 1-char comment start sequence
+ − 923 of the style matching mask? */
460
+ − 924 else if (code == Scomment)
428
+ − 925 {
460
+ − 926 styles_match_p =
+ − 927 SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask;
428
+ − 928 }
+ − 929
460
+ − 930 /* otherwise, is this a 2-char comment end or start sequence? */
+ − 931 else if (from > stop)
+ − 932 do
+ − 933 {
+ − 934 /* 2-char comment end sequence? */
+ − 935 if (SYNTAX_CODE_END_SECOND_P (syncode))
+ − 936 {
+ − 937 int prev_syncode;
826
+ − 938 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1);
460
+ − 939 prev_syncode =
1315
+ − 940 SYNTAX_CODE_FROM_CACHE (scache,
+ − 941 BUF_FETCH_CHAR (buf, from - 1));
460
+ − 942
+ − 943 if (SYNTAX_CODES_END_P (prev_syncode, syncode))
+ − 944 {
+ − 945 code = Sendcomment;
+ − 946 styles_match_p =
826
+ − 947 SYNTAX_CODES_COMMENT_MASK_END (prev_syncode,
+ − 948 syncode) & mask;
460
+ − 949 from--;
826
+ − 950 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from);
460
+ − 951 c = BUF_FETCH_CHAR (buf, from);
+ − 952
+ − 953 /* Found a comment-end sequence, so skip past the
+ − 954 check for a comment-start */
+ − 955 break;
+ − 956 }
+ − 957 }
+ − 958
+ − 959 /* 2-char comment start sequence? */
+ − 960 if (SYNTAX_CODE_START_SECOND_P (syncode))
+ − 961 {
+ − 962 int prev_syncode;
826
+ − 963 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1);
460
+ − 964 prev_syncode =
1315
+ − 965 SYNTAX_CODE_FROM_CACHE (scache,
+ − 966 BUF_FETCH_CHAR (buf, from - 1));
460
+ − 967
+ − 968 if (SYNTAX_CODES_START_P (prev_syncode, syncode))
+ − 969 {
+ − 970 code = Scomment;
+ − 971 styles_match_p =
826
+ − 972 SYNTAX_CODES_COMMENT_MASK_START (prev_syncode,
+ − 973 syncode) & mask;
460
+ − 974 from--;
826
+ − 975 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from);
460
+ − 976 c = BUF_FETCH_CHAR (buf, from);
+ − 977 }
+ − 978 }
+ − 979 } while (0);
428
+ − 980
+ − 981 /* Ignore escaped characters. */
+ − 982 if (char_quoted (buf, from))
+ − 983 continue;
+ − 984
+ − 985 /* Track parity of quotes. */
+ − 986 if (code == Sstring)
+ − 987 {
+ − 988 parity ^= 1;
+ − 989 if (my_stringend == 0)
+ − 990 my_stringend = c;
+ − 991 /* If we have two kinds of string delimiters.
+ − 992 There's no way to grok this scanning backwards. */
+ − 993 else if (my_stringend != c)
+ − 994 string_lossage = 1;
+ − 995 }
+ − 996
460
+ − 997 if (code == Sstring_fence || code == Scomment_fence)
+ − 998 {
+ − 999 parity ^= 1;
+ − 1000 if (my_stringend == 0)
+ − 1001 my_stringend =
+ − 1002 code == Sstring_fence ? ST_STRING_STYLE : ST_COMMENT_STYLE;
+ − 1003 /* If we have two kinds of string delimiters.
+ − 1004 There's no way to grok this scanning backwards. */
+ − 1005 else if (my_stringend != (code == Sstring_fence
+ − 1006 ? ST_STRING_STYLE : ST_COMMENT_STYLE))
+ − 1007 string_lossage = 1;
+ − 1008 }
+ − 1009
428
+ − 1010 /* Record comment-starters according to that
+ − 1011 quote-parity to the comment-end. */
+ − 1012 if (code == Scomment && styles_match_p)
+ − 1013 {
+ − 1014 comstart_parity = parity;
+ − 1015 comstart_pos = from;
+ − 1016 }
+ − 1017
+ − 1018 /* If we find another earlier comment-ender,
+ − 1019 any comment-starts earlier than that don't count
+ − 1020 (because they go with the earlier comment-ender). */
+ − 1021 if (code == Sendcomment && styles_match_p)
+ − 1022 break;
+ − 1023
+ − 1024 /* Assume a defun-start point is outside of strings. */
+ − 1025 if (code == Sopen
+ − 1026 && (from == stop || BUF_FETCH_CHAR (buf, from - 1) == '\n'))
+ − 1027 break;
+ − 1028 }
+ − 1029
+ − 1030 if (comstart_pos == 0)
+ − 1031 from = comment_end;
+ − 1032 /* If the earliest comment starter
+ − 1033 is followed by uniform paired string quotes or none,
+ − 1034 we know it can't be inside a string
+ − 1035 since if it were then the comment ender would be inside one.
+ − 1036 So it does start a comment. Skip back to it. */
+ − 1037 else if (comstart_parity == 0 && !string_lossage)
+ − 1038 from = comstart_pos;
+ − 1039 else
+ − 1040 {
+ − 1041 /* We had two kinds of string delimiters mixed up
+ − 1042 together. Decode this going forwards.
+ − 1043 Scan fwd from the previous comment ender
+ − 1044 to the one in question; this records where we
+ − 1045 last passed a comment starter. */
+ − 1046
+ − 1047 struct lisp_parse_state state;
+ − 1048 scan_sexps_forward (buf, &state, find_defun_start (buf, comment_end),
+ − 1049 comment_end - 1, -10000, 0, Qnil, 0);
+ − 1050 if (state.incomment)
460
+ − 1051 from = state.comstr_start;
428
+ − 1052 else
+ − 1053 /* We can't grok this as a comment; scan it normally. */
+ − 1054 from = comment_end;
826
+ − 1055 UPDATE_SYNTAX_CACHE_FORWARD (scache, from - 1);
428
+ − 1056 }
+ − 1057 return from;
+ − 1058 }
+ − 1059
665
+ − 1060 static Charbpos
826
+ − 1061 find_end_of_comment (struct buffer *buf, Charbpos from, Charbpos stop,
+ − 1062 int comstyle)
428
+ − 1063 {
+ − 1064 int c;
460
+ − 1065 int prev_code;
+ − 1066 /* mask to match comment styles against; for ST_COMMENT_STYLE, this
+ − 1067 will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */
+ − 1068 int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A;
826
+ − 1069 struct syntax_cache *scache = buf->syntax_cache;
428
+ − 1070
460
+ − 1071 /* This is only called by functions which have already set up the
+ − 1072 syntax_cache and are keeping it up-to-date */
428
+ − 1073 while (1)
+ − 1074 {
+ − 1075 if (from == stop)
+ − 1076 {
+ − 1077 return -1;
+ − 1078 }
460
+ − 1079
826
+ − 1080 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
428
+ − 1081 c = BUF_FETCH_CHAR (buf, from);
460
+ − 1082
+ − 1083 /* Test for generic comments */
+ − 1084 if (comstyle == ST_COMMENT_STYLE)
+ − 1085 {
826
+ − 1086 if (SYNTAX_FROM_CACHE (scache, c) == Scomment_fence)
460
+ − 1087 {
+ − 1088 from++;
826
+ − 1089 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
460
+ − 1090 break;
+ − 1091 }
+ − 1092 from++;
+ − 1093 continue; /* No need to test other comment styles in a
+ − 1094 generic comment */
+ − 1095 }
+ − 1096 else
+ − 1097
826
+ − 1098 if (SYNTAX_FROM_CACHE (scache, c) == Sendcomment
460
+ − 1099 && SYNTAX_CODE_MATCHES_1CHAR_P
826
+ − 1100 (SYNTAX_CODE_FROM_CACHE (scache, c), mask))
428
+ − 1101 /* we have encountered a comment end of the same style
+ − 1102 as the comment sequence which began this comment
+ − 1103 section */
460
+ − 1104 {
+ − 1105 from++;
826
+ − 1106 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
460
+ − 1107 break;
+ − 1108 }
428
+ − 1109
826
+ − 1110 prev_code = SYNTAX_CODE_FROM_CACHE (scache, c);
428
+ − 1111 from++;
826
+ − 1112 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
428
+ − 1113 if (from < stop
460
+ − 1114 && SYNTAX_CODES_MATCH_END_P
+ − 1115 (prev_code,
826
+ − 1116 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)),
460
+ − 1117 mask)
+ − 1118
+ − 1119 )
428
+ − 1120 /* we have encountered a comment end of the same style
+ − 1121 as the comment sequence which began this comment
+ − 1122 section */
460
+ − 1123 {
+ − 1124 from++;
826
+ − 1125 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
460
+ − 1126 break;
+ − 1127 }
428
+ − 1128 }
+ − 1129 return from;
+ − 1130 }
+ − 1131
+ − 1132
+ − 1133 /* #### between FSF 19.23 and 19.28 there are some changes to the logic
+ − 1134 in this function (and minor changes to find_start_of_comment(),
+ − 1135 above, which is part of Fforward_comment() in FSF). Attempts to port
+ − 1136 that logic made this function break, so I'm leaving it out. If anyone
+ − 1137 ever complains about this function not working properly, take a look
+ − 1138 at those changes. --ben */
+ − 1139
446
+ − 1140 DEFUN ("forward-comment", Fforward_comment, 0, 2, 0, /*
444
+ − 1141 Move forward across up to COUNT comments, or backwards if COUNT is negative.
428
+ − 1142 Stop scanning if we find something other than a comment or whitespace.
+ − 1143 Set point to where scanning stops.
444
+ − 1144 If COUNT comments are found as expected, with nothing except whitespace
428
+ − 1145 between them, return t; otherwise return nil.
+ − 1146 Point is set in either case.
446
+ − 1147 COUNT defaults to 1, and BUFFER defaults to the current buffer.
428
+ − 1148 */
444
+ − 1149 (count, buffer))
428
+ − 1150 {
665
+ − 1151 Charbpos from;
+ − 1152 Charbpos stop;
867
+ − 1153 Ichar c;
428
+ − 1154 enum syntaxcode code;
460
+ − 1155 int syncode;
444
+ − 1156 EMACS_INT n;
428
+ − 1157 struct buffer *buf = decode_buffer (buffer, 0);
826
+ − 1158 struct syntax_cache *scache;
+ − 1159
446
+ − 1160 if (NILP (count))
+ − 1161 n = 1;
+ − 1162 else
+ − 1163 {
+ − 1164 CHECK_INT (count);
+ − 1165 n = XINT (count);
+ − 1166 }
428
+ − 1167
+ − 1168 from = BUF_PT (buf);
+ − 1169
826
+ − 1170 scache = setup_buffer_syntax_cache (buf, from, n);
444
+ − 1171 while (n > 0)
428
+ − 1172 {
+ − 1173 QUIT;
+ − 1174
+ − 1175 stop = BUF_ZV (buf);
+ − 1176 while (from < stop)
+ − 1177 {
460
+ − 1178 int comstyle = 0; /* mask for finding matching comment style */
428
+ − 1179
+ − 1180 if (char_quoted (buf, from))
+ − 1181 {
+ − 1182 from++;
+ − 1183 continue;
+ − 1184 }
+ − 1185
826
+ − 1186 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
428
+ − 1187 c = BUF_FETCH_CHAR (buf, from);
826
+ − 1188 syncode = SYNTAX_CODE_FROM_CACHE (scache, c);
+ − 1189 code = SYNTAX_FROM_CODE (syncode);
428
+ − 1190
+ − 1191 if (code == Scomment)
+ − 1192 {
+ − 1193 /* we have encountered a single character comment start
+ − 1194 sequence, and we are ignoring all text inside comments.
+ − 1195 we must record the comment style this character begins
+ − 1196 so that later, only a comment end of the same style actually
+ − 1197 ends the comment section */
460
+ − 1198 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
+ − 1199 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
428
+ − 1200 }
+ − 1201
460
+ − 1202 else if (code == Scomment_fence)
+ − 1203 {
+ − 1204 from++;
+ − 1205 code = Scomment;
+ − 1206 comstyle = ST_COMMENT_STYLE;
+ − 1207 }
+ − 1208
428
+ − 1209 else if (from < stop
460
+ − 1210 && SYNTAX_CODE_START_FIRST_P (syncode))
428
+ − 1211 {
460
+ − 1212 int next_syncode;
826
+ − 1213 UPDATE_SYNTAX_CACHE_FORWARD (scache, from + 1);
460
+ − 1214 next_syncode =
826
+ − 1215 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from + 1));
460
+ − 1216
+ − 1217 if (SYNTAX_CODES_START_P (syncode, next_syncode))
+ − 1218 {
+ − 1219 /* we have encountered a 2char comment start sequence and we
+ − 1220 are ignoring all text inside comments. we must record
+ − 1221 the comment style this sequence begins so that later,
+ − 1222 only a comment end of the same style actually ends
+ − 1223 the comment section */
+ − 1224 code = Scomment;
+ − 1225 comstyle =
+ − 1226 SYNTAX_CODES_COMMENT_MASK_START (syncode, next_syncode)
+ − 1227 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
+ − 1228 from++;
+ − 1229 }
428
+ − 1230 }
+ − 1231
+ − 1232 if (code == Scomment)
+ − 1233 {
826
+ − 1234 Charbpos newfrom = find_end_of_comment (buf, from, stop,
+ − 1235 comstyle);
428
+ − 1236 if (newfrom < 0)
+ − 1237 {
+ − 1238 /* we stopped because from==stop */
+ − 1239 BUF_SET_PT (buf, stop);
+ − 1240 return Qnil;
+ − 1241 }
+ − 1242 from = newfrom;
+ − 1243
+ − 1244 /* We have skipped one comment. */
+ − 1245 break;
+ − 1246 }
+ − 1247 else if (code != Swhitespace
+ − 1248 && code != Sendcomment
+ − 1249 && code != Scomment )
+ − 1250 {
+ − 1251 BUF_SET_PT (buf, from);
+ − 1252 return Qnil;
+ − 1253 }
+ − 1254 from++;
+ − 1255 }
+ − 1256
+ − 1257 /* End of comment reached */
444
+ − 1258 n--;
428
+ − 1259 }
+ − 1260
444
+ − 1261 while (n < 0)
428
+ − 1262 {
+ − 1263 QUIT;
+ − 1264
+ − 1265 stop = BUF_BEGV (buf);
+ − 1266 while (from > stop)
+ − 1267 {
460
+ − 1268 int comstyle = 0; /* mask for finding matching comment style */
428
+ − 1269
+ − 1270 from--;
+ − 1271 if (char_quoted (buf, from))
+ − 1272 {
+ − 1273 from--;
+ − 1274 continue;
+ − 1275 }
+ − 1276
+ − 1277 c = BUF_FETCH_CHAR (buf, from);
826
+ − 1278 syncode = SYNTAX_CODE_FROM_CACHE (scache, c);
+ − 1279 code = SYNTAX_FROM_CODE (syncode);
428
+ − 1280
+ − 1281 if (code == Sendcomment)
+ − 1282 {
+ − 1283 /* we have found a single char end comment. we must record
+ − 1284 the comment style encountered so that later, we can match
+ − 1285 only the proper comment begin sequence of the same style */
460
+ − 1286 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
+ − 1287 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
+ − 1288 }
+ − 1289
+ − 1290 else if (code == Scomment_fence)
+ − 1291 {
+ − 1292 code = Sendcomment;
+ − 1293 comstyle = ST_COMMENT_STYLE;
428
+ − 1294 }
+ − 1295
+ − 1296 else if (from > stop
460
+ − 1297 && SYNTAX_CODE_END_SECOND_P (syncode))
428
+ − 1298 {
460
+ − 1299 int prev_syncode;
826
+ − 1300 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1);
460
+ − 1301 prev_syncode =
826
+ − 1302 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1));
460
+ − 1303 if (SYNTAX_CODES_END_P (prev_syncode, syncode))
+ − 1304 {
+ − 1305 /* We must record the comment style encountered so that
+ − 1306 later, we can match only the proper comment begin
+ − 1307 sequence of the same style. */
+ − 1308 code = Sendcomment;
+ − 1309 comstyle = SYNTAX_CODES_COMMENT_MASK_END
+ − 1310 (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
+ − 1311 from--;
+ − 1312 }
428
+ − 1313 }
+ − 1314
+ − 1315 if (code == Sendcomment)
+ − 1316 {
460
+ − 1317 from = find_start_of_comment (buf, from, stop, comstyle);
428
+ − 1318 break;
+ − 1319 }
+ − 1320
+ − 1321 else if (code != Swhitespace
460
+ − 1322 && code != Scomment
+ − 1323 && code != Sendcomment)
428
+ − 1324 {
+ − 1325 BUF_SET_PT (buf, from + 1);
+ − 1326 return Qnil;
+ − 1327 }
+ − 1328 }
+ − 1329
444
+ − 1330 n++;
428
+ − 1331 }
+ − 1332
+ − 1333 BUF_SET_PT (buf, from);
+ − 1334 return Qt;
+ − 1335 }
+ − 1336
+ − 1337
+ − 1338 Lisp_Object
665
+ − 1339 scan_lists (struct buffer *buf, Charbpos from, int count, int depth,
444
+ − 1340 int sexpflag, int noerror)
428
+ − 1341 {
665
+ − 1342 Charbpos stop;
867
+ − 1343 Ichar c;
428
+ − 1344 int quoted;
+ − 1345 int mathexit = 0;
+ − 1346 enum syntaxcode code;
460
+ − 1347 int syncode;
428
+ − 1348 int min_depth = depth; /* Err out if depth gets less than this. */
826
+ − 1349 struct syntax_cache *scache;
+ − 1350
428
+ − 1351 if (depth > 0) min_depth = 0;
+ − 1352
826
+ − 1353 scache = setup_buffer_syntax_cache (buf, from, count);
428
+ − 1354 while (count > 0)
+ − 1355 {
+ − 1356 QUIT;
+ − 1357
+ − 1358 stop = BUF_ZV (buf);
+ − 1359 while (from < stop)
+ − 1360 {
460
+ − 1361 int comstyle = 0; /* mask for finding matching comment style */
428
+ − 1362
826
+ − 1363 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
428
+ − 1364 c = BUF_FETCH_CHAR (buf, from);
826
+ − 1365 syncode = SYNTAX_CODE_FROM_CACHE (scache, c);
+ − 1366 code = SYNTAX_FROM_CODE (syncode);
428
+ − 1367 from++;
+ − 1368
+ − 1369 /* a 1-char comment start sequence */
+ − 1370 if (code == Scomment && parse_sexp_ignore_comments)
+ − 1371 {
460
+ − 1372 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) ==
+ − 1373 SYNTAX_COMMENT_STYLE_A ? 0 : 1;
428
+ − 1374 }
+ − 1375
+ − 1376 /* else, a 2-char comment start sequence? */
+ − 1377 else if (from < stop
460
+ − 1378 && SYNTAX_CODE_START_FIRST_P (syncode)
428
+ − 1379 && parse_sexp_ignore_comments)
+ − 1380 {
460
+ − 1381 int next_syncode;
826
+ − 1382 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
460
+ − 1383 next_syncode =
826
+ − 1384 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from));
460
+ − 1385
+ − 1386 if (SYNTAX_CODES_START_P (syncode, next_syncode))
+ − 1387 {
826
+ − 1388 /* we have encountered a comment start sequence and we
+ − 1389 are ignoring all text inside comments. we must record
+ − 1390 the comment style this sequence begins so that later,
+ − 1391 only a comment end of the same style actually ends
+ − 1392 the comment section */
+ − 1393 code = Scomment;
460
+ − 1394 comstyle = SYNTAX_CODES_COMMENT_MASK_START
+ − 1395 (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
826
+ − 1396 from++;
+ − 1397 }
428
+ − 1398 }
826
+ − 1399 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
428
+ − 1400
460
+ − 1401 if (SYNTAX_CODE_PREFIX (syncode))
428
+ − 1402 continue;
+ − 1403
+ − 1404 switch (code)
+ − 1405 {
+ − 1406 case Sescape:
+ − 1407 case Scharquote:
+ − 1408 if (from == stop) goto lose;
+ − 1409 from++;
+ − 1410 /* treat following character as a word constituent */
+ − 1411 case Sword:
+ − 1412 case Ssymbol:
+ − 1413 if (depth || !sexpflag) break;
+ − 1414 /* This word counts as a sexp; return at end of it. */
+ − 1415 while (from < stop)
+ − 1416 {
826
+ − 1417 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
+ − 1418 switch (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)))
428
+ − 1419 {
+ − 1420 case Scharquote:
+ − 1421 case Sescape:
+ − 1422 from++;
+ − 1423 if (from == stop) goto lose;
+ − 1424 break;
+ − 1425 case Sword:
+ − 1426 case Ssymbol:
+ − 1427 case Squote:
+ − 1428 break;
+ − 1429 default:
+ − 1430 goto done;
+ − 1431 }
+ − 1432 from++;
+ − 1433 }
+ − 1434 goto done;
+ − 1435
460
+ − 1436 case Scomment_fence:
+ − 1437 comstyle = ST_COMMENT_STYLE;
428
+ − 1438 case Scomment:
+ − 1439 if (!parse_sexp_ignore_comments)
+ − 1440 break;
826
+ − 1441 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
428
+ − 1442 {
665
+ − 1443 Charbpos newfrom =
460
+ − 1444 find_end_of_comment (buf, from, stop, comstyle);
428
+ − 1445 if (newfrom < 0)
+ − 1446 {
+ − 1447 /* we stopped because from == stop in search forward */
+ − 1448 from = stop;
+ − 1449 if (depth == 0)
+ − 1450 goto done;
+ − 1451 goto lose;
+ − 1452 }
+ − 1453 from = newfrom;
+ − 1454 }
+ − 1455 break;
+ − 1456
+ − 1457 case Smath:
+ − 1458 if (!sexpflag)
+ − 1459 break;
+ − 1460 if (from != stop && c == BUF_FETCH_CHAR (buf, from))
+ − 1461 from++;
+ − 1462 if (mathexit)
+ − 1463 {
+ − 1464 mathexit = 0;
+ − 1465 goto close1;
+ − 1466 }
+ − 1467 mathexit = 1;
+ − 1468
+ − 1469 case Sopen:
+ − 1470 if (!++depth) goto done;
+ − 1471 break;
+ − 1472
+ − 1473 case Sclose:
+ − 1474 close1:
+ − 1475 if (!--depth) goto done;
+ − 1476 if (depth < min_depth)
+ − 1477 {
444
+ − 1478 if (noerror)
428
+ − 1479 return Qnil;
826
+ − 1480 syntax_error ("Containing expression ends prematurely",
+ − 1481 Qunbound);
428
+ − 1482 }
+ − 1483 break;
+ − 1484
460
+ − 1485 case Sstring_fence:
428
+ − 1486 case Sstring:
+ − 1487 {
867
+ − 1488 Ichar stringterm;
460
+ − 1489
+ − 1490 if (code != Sstring_fence)
+ − 1491 {
826
+ − 1492 /* XEmacs change: call syntax_match on character */
867
+ − 1493 Ichar ch = BUF_FETCH_CHAR (buf, from - 1);
460
+ − 1494 Lisp_Object stermobj =
1296
+ − 1495 syntax_match (scache->syntax_table, ch);
428
+ − 1496
+ − 1497 if (CHARP (stermobj))
+ − 1498 stringterm = XCHAR (stermobj);
+ − 1499 else
+ − 1500 stringterm = ch;
460
+ − 1501 }
+ − 1502 else
+ − 1503 stringterm = '\0'; /* avoid compiler warnings */
428
+ − 1504
+ − 1505 while (1)
+ − 1506 {
+ − 1507 if (from >= stop)
+ − 1508 goto lose;
826
+ − 1509 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
460
+ − 1510 c = BUF_FETCH_CHAR (buf, from);
+ − 1511 if (code == Sstring
+ − 1512 ? c == stringterm
826
+ − 1513 : SYNTAX_FROM_CACHE (scache, c) == Sstring_fence)
428
+ − 1514 break;
460
+ − 1515
826
+ − 1516 switch (SYNTAX_FROM_CACHE (scache, c))
428
+ − 1517 {
+ − 1518 case Scharquote:
+ − 1519 case Sescape:
+ − 1520 from++;
+ − 1521 break;
+ − 1522 default:
+ − 1523 break;
+ − 1524 }
+ − 1525 from++;
+ − 1526 }
+ − 1527 from++;
+ − 1528 if (!depth && sexpflag) goto done;
+ − 1529 break;
+ − 1530 }
+ − 1531
+ − 1532 default:
+ − 1533 break;
+ − 1534 }
+ − 1535 }
+ − 1536
+ − 1537 /* Reached end of buffer. Error if within object,
+ − 1538 return nil if between */
+ − 1539 if (depth) goto lose;
+ − 1540
+ − 1541 return Qnil;
+ − 1542
+ − 1543 /* End of object reached */
+ − 1544 done:
+ − 1545 count--;
+ − 1546 }
+ − 1547
+ − 1548 while (count < 0)
+ − 1549 {
+ − 1550 QUIT;
+ − 1551
+ − 1552 stop = BUF_BEGV (buf);
+ − 1553 while (from > stop)
+ − 1554 {
460
+ − 1555 int comstyle = 0; /* mask for finding matching comment style */
428
+ − 1556
+ − 1557 from--;
826
+ − 1558 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from);
428
+ − 1559 quoted = char_quoted (buf, from);
+ − 1560 if (quoted)
460
+ − 1561 {
428
+ − 1562 from--;
826
+ − 1563 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from);
460
+ − 1564 }
428
+ − 1565
+ − 1566 c = BUF_FETCH_CHAR (buf, from);
826
+ − 1567 syncode = SYNTAX_CODE_FROM_CACHE (scache, c);
+ − 1568 code = SYNTAX_FROM_CODE (syncode);
428
+ − 1569
+ − 1570 if (code == Sendcomment && parse_sexp_ignore_comments)
+ − 1571 {
+ − 1572 /* we have found a single char end comment. we must record
+ − 1573 the comment style encountered so that later, we can match
+ − 1574 only the proper comment begin sequence of the same style */
460
+ − 1575 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
+ − 1576 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
428
+ − 1577 }
+ − 1578
+ − 1579 else if (from > stop
460
+ − 1580 && SYNTAX_CODE_END_SECOND_P (syncode)
428
+ − 1581 && !char_quoted (buf, from - 1)
+ − 1582 && parse_sexp_ignore_comments)
+ − 1583 {
460
+ − 1584 int prev_syncode;
826
+ − 1585 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1);
+ − 1586 prev_syncode =
+ − 1587 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1));
460
+ − 1588
+ − 1589 if (SYNTAX_CODES_END_P (prev_syncode, syncode))
+ − 1590 {
428
+ − 1591 /* we must record the comment style encountered so that
+ − 1592 later, we can match only the proper comment begin
+ − 1593 sequence of the same style */
+ − 1594 code = Sendcomment;
460
+ − 1595 comstyle = SYNTAX_CODES_COMMENT_MASK_END
+ − 1596 (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
428
+ − 1597 from--;
+ − 1598 }
460
+ − 1599 }
428
+ − 1600
460
+ − 1601 if (SYNTAX_CODE_PREFIX (syncode))
428
+ − 1602 continue;
+ − 1603
434
+ − 1604 switch (quoted ? Sword : code)
428
+ − 1605 {
+ − 1606 case Sword:
+ − 1607 case Ssymbol:
+ − 1608 if (depth || !sexpflag) break;
+ − 1609 /* This word counts as a sexp; count object finished after
+ − 1610 passing it. */
+ − 1611 while (from > stop)
+ − 1612 {
826
+ − 1613 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from);
428
+ − 1614 quoted = char_quoted (buf, from - 1);
+ − 1615
+ − 1616 if (quoted)
+ − 1617 from--;
+ − 1618 if (! (quoted
+ − 1619 || (syncode =
826
+ − 1620 SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf,
+ − 1621 from - 1)))
428
+ − 1622 == Sword
+ − 1623 || syncode == Ssymbol
+ − 1624 || syncode == Squote))
+ − 1625 goto done2;
+ − 1626 from--;
+ − 1627 }
+ − 1628 goto done2;
+ − 1629
+ − 1630 case Smath:
+ − 1631 if (!sexpflag)
+ − 1632 break;
+ − 1633 if (from != stop && c == BUF_FETCH_CHAR (buf, from - 1))
+ − 1634 from--;
+ − 1635 if (mathexit)
+ − 1636 {
+ − 1637 mathexit = 0;
+ − 1638 goto open2;
+ − 1639 }
+ − 1640 mathexit = 1;
+ − 1641
+ − 1642 case Sclose:
+ − 1643 if (!++depth) goto done2;
+ − 1644 break;
+ − 1645
+ − 1646 case Sopen:
+ − 1647 open2:
+ − 1648 if (!--depth) goto done2;
+ − 1649 if (depth < min_depth)
+ − 1650 {
444
+ − 1651 if (noerror)
428
+ − 1652 return Qnil;
826
+ − 1653 syntax_error ("Containing expression ends prematurely",
+ − 1654 Qunbound);
428
+ − 1655 }
+ − 1656 break;
+ − 1657
460
+ − 1658 case Scomment_fence:
+ − 1659 comstyle = ST_COMMENT_STYLE;
428
+ − 1660 case Sendcomment:
+ − 1661 if (parse_sexp_ignore_comments)
460
+ − 1662 from = find_start_of_comment (buf, from, stop, comstyle);
428
+ − 1663 break;
+ − 1664
460
+ − 1665 case Sstring_fence:
428
+ − 1666 case Sstring:
+ − 1667 {
867
+ − 1668 Ichar stringterm;
460
+ − 1669
+ − 1670 if (code != Sstring_fence)
+ − 1671 {
428
+ − 1672 /* XEmacs change: call syntax_match() on character */
867
+ − 1673 Ichar ch = BUF_FETCH_CHAR (buf, from);
460
+ − 1674 Lisp_Object stermobj =
1296
+ − 1675 syntax_match (scache->syntax_table, ch);
428
+ − 1676
+ − 1677 if (CHARP (stermobj))
+ − 1678 stringterm = XCHAR (stermobj);
+ − 1679 else
+ − 1680 stringterm = ch;
460
+ − 1681 }
+ − 1682 else
+ − 1683 stringterm = '\0'; /* avoid compiler warnings */
428
+ − 1684
+ − 1685 while (1)
+ − 1686 {
+ − 1687 if (from == stop) goto lose;
460
+ − 1688
826
+ − 1689 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1);
460
+ − 1690 c = BUF_FETCH_CHAR (buf, from - 1);
+ − 1691
+ − 1692 if ((code == Sstring
+ − 1693 ? c == stringterm
826
+ − 1694 : SYNTAX_FROM_CACHE (scache, c) == Sstring_fence)
460
+ − 1695 && !char_quoted (buf, from - 1))
+ − 1696 {
428
+ − 1697 break;
460
+ − 1698 }
+ − 1699
428
+ − 1700 from--;
+ − 1701 }
+ − 1702 from--;
+ − 1703 if (!depth && sexpflag) goto done2;
+ − 1704 break;
+ − 1705 }
+ − 1706 }
+ − 1707 }
+ − 1708
+ − 1709 /* Reached start of buffer. Error if within object,
+ − 1710 return nil if between */
+ − 1711 if (depth) goto lose;
+ − 1712
+ − 1713 return Qnil;
+ − 1714
+ − 1715 done2:
+ − 1716 count++;
+ − 1717 }
+ − 1718
+ − 1719
+ − 1720 return (make_int (from));
+ − 1721
+ − 1722 lose:
444
+ − 1723 if (!noerror)
826
+ − 1724 syntax_error ("Unbalanced parentheses", Qunbound);
428
+ − 1725 return Qnil;
+ − 1726 }
+ − 1727
+ − 1728 int
665
+ − 1729 char_quoted (struct buffer *buf, Charbpos pos)
428
+ − 1730 {
+ − 1731 enum syntaxcode code;
665
+ − 1732 Charbpos beg = BUF_BEGV (buf);
428
+ − 1733 int quoted = 0;
665
+ − 1734 Charbpos startpos = pos;
826
+ − 1735 struct syntax_cache *scache = buf->syntax_cache;
460
+ − 1736
+ − 1737 while (pos > beg)
+ − 1738 {
826
+ − 1739 UPDATE_SYNTAX_CACHE_BACKWARD (scache, pos - 1);
+ − 1740 code = SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, pos - 1));
428
+ − 1741
460
+ − 1742 if (code != Scharquote && code != Sescape)
+ − 1743 break;
+ − 1744 pos--;
+ − 1745 quoted = !quoted;
+ − 1746 }
+ − 1747
826
+ − 1748 UPDATE_SYNTAX_CACHE (scache, startpos);
428
+ − 1749 return quoted;
+ − 1750 }
+ − 1751
+ − 1752 DEFUN ("scan-lists", Fscan_lists, 3, 5, 0, /*
+ − 1753 Scan from character number FROM by COUNT lists.
+ − 1754 Returns the character number of the position thus found.
+ − 1755
+ − 1756 If DEPTH is nonzero, paren depth begins counting from that value,
+ − 1757 only places where the depth in parentheses becomes zero
+ − 1758 are candidates for stopping; COUNT such places are counted.
+ − 1759 Thus, a positive value for DEPTH means go out levels.
+ − 1760
+ − 1761 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
+ − 1762
+ − 1763 If the beginning or end of (the accessible part of) the buffer is reached
+ − 1764 and the depth is wrong, an error is signaled.
+ − 1765 If the depth is right but the count is not used up, nil is returned.
+ − 1766
+ − 1767 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead
+ − 1768 of in the current buffer.
+ − 1769
+ − 1770 If optional arg NOERROR is non-nil, scan-lists will return nil instead of
+ − 1771 signalling an error.
+ − 1772 */
444
+ − 1773 (from, count, depth, buffer, noerror))
428
+ − 1774 {
+ − 1775 struct buffer *buf;
+ − 1776
+ − 1777 CHECK_INT (from);
+ − 1778 CHECK_INT (count);
+ − 1779 CHECK_INT (depth);
+ − 1780 buf = decode_buffer (buffer, 0);
+ − 1781
+ − 1782 return scan_lists (buf, XINT (from), XINT (count), XINT (depth), 0,
444
+ − 1783 !NILP (noerror));
428
+ − 1784 }
+ − 1785
+ − 1786 DEFUN ("scan-sexps", Fscan_sexps, 2, 4, 0, /*
+ − 1787 Scan from character number FROM by COUNT balanced expressions.
+ − 1788 If COUNT is negative, scan backwards.
+ − 1789 Returns the character number of the position thus found.
+ − 1790
+ − 1791 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
+ − 1792
+ − 1793 If the beginning or end of (the accessible part of) the buffer is reached
+ − 1794 in the middle of a parenthetical grouping, an error is signaled.
+ − 1795 If the beginning or end is reached between groupings
+ − 1796 but before count is used up, nil is returned.
+ − 1797
+ − 1798 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead
+ − 1799 of in the current buffer.
+ − 1800
+ − 1801 If optional arg NOERROR is non-nil, scan-sexps will return nil instead of
+ − 1802 signalling an error.
+ − 1803 */
444
+ − 1804 (from, count, buffer, noerror))
428
+ − 1805 {
+ − 1806 struct buffer *buf = decode_buffer (buffer, 0);
+ − 1807 CHECK_INT (from);
+ − 1808 CHECK_INT (count);
+ − 1809
444
+ − 1810 return scan_lists (buf, XINT (from), XINT (count), 0, 1, !NILP (noerror));
428
+ − 1811 }
+ − 1812
+ − 1813 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, 0, 1, 0, /*
+ − 1814 Move point backward over any number of chars with prefix syntax.
+ − 1815 This includes chars with "quote" or "prefix" syntax (' or p).
+ − 1816
+ − 1817 Optional arg BUFFER defaults to the current buffer.
+ − 1818 */
+ − 1819 (buffer))
+ − 1820 {
+ − 1821 struct buffer *buf = decode_buffer (buffer, 0);
665
+ − 1822 Charbpos beg = BUF_BEGV (buf);
+ − 1823 Charbpos pos = BUF_PT (buf);
867
+ − 1824 Ichar c = '\0'; /* initialize to avoid compiler warnings */
826
+ − 1825 struct syntax_cache *scache;
+ − 1826
+ − 1827 scache = setup_buffer_syntax_cache (buf, pos, -1);
428
+ − 1828
+ − 1829 while (pos > beg && !char_quoted (buf, pos - 1)
460
+ − 1830 /* Previous statement updates syntax table. */
826
+ − 1831 && (SYNTAX_FROM_CACHE (scache, c = BUF_FETCH_CHAR (buf, pos - 1)) == Squote
+ − 1832 || SYNTAX_CODE_PREFIX (SYNTAX_CODE_FROM_CACHE (scache, c))))
428
+ − 1833 pos--;
+ − 1834
+ − 1835 BUF_SET_PT (buf, pos);
+ − 1836
+ − 1837 return Qnil;
+ − 1838 }
+ − 1839
+ − 1840 /* Parse forward from FROM to END,
+ − 1841 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
+ − 1842 and return a description of the state of the parse at END.
+ − 1843 If STOPBEFORE is nonzero, stop at the start of an atom.
+ − 1844 If COMMENTSTOP is nonzero, stop at the start of a comment. */
+ − 1845
+ − 1846 static void
+ − 1847 scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr,
665
+ − 1848 Charbpos from, Charbpos end,
428
+ − 1849 int targetdepth, int stopbefore,
+ − 1850 Lisp_Object oldstate,
+ − 1851 int commentstop)
+ − 1852 {
+ − 1853 struct lisp_parse_state state;
+ − 1854
+ − 1855 enum syntaxcode code;
+ − 1856 struct level { int last, prev; };
+ − 1857 struct level levelstart[100];
+ − 1858 struct level *curlevel = levelstart;
+ − 1859 struct level *endlevel = levelstart + 100;
+ − 1860 int depth; /* Paren depth of current scanning location.
+ − 1861 level - levelstart equals this except
+ − 1862 when the depth becomes negative. */
+ − 1863 int mindepth; /* Lowest DEPTH value seen. */
+ − 1864 int start_quoted = 0; /* Nonzero means starting after a char quote */
460
+ − 1865 int boundary_stop = commentstop == -1;
428
+ − 1866 Lisp_Object tem;
826
+ − 1867 struct syntax_cache *scache;
+ − 1868
+ − 1869 scache = setup_buffer_syntax_cache (buf, from, 1);
428
+ − 1870 if (NILP (oldstate))
+ − 1871 {
+ − 1872 depth = 0;
+ − 1873 state.instring = -1;
+ − 1874 state.incomment = 0;
+ − 1875 state.comstyle = 0; /* comment style a by default */
460
+ − 1876 state.comstr_start = -1; /* no comment/string seen. */
428
+ − 1877 }
+ − 1878 else
+ − 1879 {
+ − 1880 tem = Fcar (oldstate); /* elt 0, depth */
+ − 1881 if (!NILP (tem))
+ − 1882 depth = XINT (tem);
+ − 1883 else
+ − 1884 depth = 0;
+ − 1885
+ − 1886 oldstate = Fcdr (oldstate);
+ − 1887 oldstate = Fcdr (oldstate);
+ − 1888 oldstate = Fcdr (oldstate);
+ − 1889 tem = Fcar (oldstate); /* elt 3, instring */
460
+ − 1890 state.instring = ( !NILP (tem)
+ − 1891 ? ( INTP (tem) ? XINT (tem) : ST_STRING_STYLE)
+ − 1892 : -1);
428
+ − 1893
460
+ − 1894 oldstate = Fcdr (oldstate);
+ − 1895 tem = Fcar (oldstate); /* elt 4, incomment */
428
+ − 1896 state.incomment = !NILP (tem);
+ − 1897
+ − 1898 oldstate = Fcdr (oldstate);
+ − 1899 tem = Fcar (oldstate); /* elt 5, follows-quote */
+ − 1900 start_quoted = !NILP (tem);
+ − 1901
+ − 1902 /* if the eighth element of the list is nil, we are in comment style
3025
+ − 1903 a; if it is t, we are in comment style b; if it is `syntax-table',
460
+ − 1904 we are in a generic comment */
428
+ − 1905 oldstate = Fcdr (oldstate);
+ − 1906 oldstate = Fcdr (oldstate);
460
+ − 1907 tem = Fcar (oldstate); /* elt 7, comment style a/b/fence */
+ − 1908 state.comstyle = NILP (tem) ? 0 : ( EQ (tem, Qsyntax_table)
+ − 1909 ? ST_COMMENT_STYLE : 1 );
+ − 1910
+ − 1911 oldstate = Fcdr (oldstate); /* elt 8, start of last comment/string */
+ − 1912 tem = Fcar (oldstate);
+ − 1913 state.comstr_start = NILP (tem) ? -1 : XINT (tem);
+ − 1914
+ − 1915 /* elt 9, char numbers of starts-of-expression of levels
+ − 1916 (starting from outermost). */
+ − 1917 oldstate = Fcdr (oldstate);
+ − 1918 tem = Fcar (oldstate); /* elt 9, intermediate data for
+ − 1919 continuation of parsing (subject
+ − 1920 to change). */
+ − 1921 while (!NILP (tem)) /* >= second enclosing sexps. */
+ − 1922 {
+ − 1923 curlevel->last = XINT (Fcar (tem));
+ − 1924 if (++curlevel == endlevel)
826
+ − 1925 stack_overflow ("Nesting too deep for parser",
+ − 1926 make_int (curlevel - levelstart));
460
+ − 1927 curlevel->prev = -1;
+ − 1928 curlevel->last = -1;
+ − 1929 tem = Fcdr (tem);
+ − 1930 }
428
+ − 1931 }
+ − 1932 state.quoted = 0;
+ − 1933 mindepth = depth;
+ − 1934
+ − 1935 curlevel->prev = -1;
+ − 1936 curlevel->last = -1;
+ − 1937
+ − 1938 /* Enter the loop at a place appropriate for initial state. */
+ − 1939
+ − 1940 if (state.incomment) goto startincomment;
+ − 1941 if (state.instring >= 0)
+ − 1942 {
+ − 1943 if (start_quoted) goto startquotedinstring;
+ − 1944 goto startinstring;
+ − 1945 }
+ − 1946 if (start_quoted) goto startquoted;
+ − 1947
+ − 1948 while (from < end)
+ − 1949 {
867
+ − 1950 Ichar c;
460
+ − 1951 int syncode;
+ − 1952
428
+ − 1953 QUIT;
+ − 1954
826
+ − 1955 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
460
+ − 1956 c = BUF_FETCH_CHAR (buf, from);
826
+ − 1957 syncode = SYNTAX_CODE_FROM_CACHE (scache, c);
+ − 1958 code = SYNTAX_FROM_CODE (syncode);
428
+ − 1959 from++;
+ − 1960
+ − 1961 /* record the comment style we have entered so that only the
+ − 1962 comment-ender sequence (or single char) of the same style
+ − 1963 actually terminates the comment section. */
460
+ − 1964 if (code == Scomment)
+ − 1965 {
+ − 1966 state.comstyle =
+ − 1967 SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
+ − 1968 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
+ − 1969 state.comstr_start = from - 1;
+ − 1970 }
+ − 1971
+ − 1972 /* a generic comment delimiter? */
+ − 1973 else if (code == Scomment_fence)
+ − 1974 {
+ − 1975 state.comstyle = ST_COMMENT_STYLE;
+ − 1976 state.comstr_start = from - 1;
+ − 1977 code = Scomment;
428
+ − 1978 }
+ − 1979
+ − 1980 else if (from < end &&
460
+ − 1981 SYNTAX_CODE_START_FIRST_P (syncode))
428
+ − 1982 {
460
+ − 1983 int next_syncode;
826
+ − 1984 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
460
+ − 1985 next_syncode =
826
+ − 1986 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from));
460
+ − 1987
+ − 1988 if (SYNTAX_CODES_START_P (syncode, next_syncode))
+ − 1989 {
428
+ − 1990 code = Scomment;
460
+ − 1991 state.comstyle = SYNTAX_CODES_COMMENT_MASK_START
+ − 1992 (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
+ − 1993 state.comstr_start = from - 1;
428
+ − 1994 from++;
826
+ − 1995 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
460
+ − 1996 }
428
+ − 1997 }
+ − 1998
460
+ − 1999 if (SYNTAX_CODE_PREFIX (syncode))
428
+ − 2000 continue;
+ − 2001 switch (code)
+ − 2002 {
+ − 2003 case Sescape:
+ − 2004 case Scharquote:
+ − 2005 if (stopbefore) goto stop; /* this arg means stop at sexp start */
+ − 2006 curlevel->last = from - 1;
+ − 2007 startquoted:
+ − 2008 if (from == end) goto endquoted;
+ − 2009 from++;
+ − 2010 goto symstarted;
+ − 2011 /* treat following character as a word constituent */
+ − 2012 case Sword:
+ − 2013 case Ssymbol:
+ − 2014 if (stopbefore) goto stop; /* this arg means stop at sexp start */
+ − 2015 curlevel->last = from - 1;
+ − 2016 symstarted:
+ − 2017 while (from < end)
+ − 2018 {
826
+ − 2019 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
+ − 2020 switch (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)))
428
+ − 2021 {
+ − 2022 case Scharquote:
+ − 2023 case Sescape:
+ − 2024 from++;
+ − 2025 if (from == end) goto endquoted;
+ − 2026 break;
+ − 2027 case Sword:
+ − 2028 case Ssymbol:
+ − 2029 case Squote:
+ − 2030 break;
+ − 2031 default:
+ − 2032 goto symdone;
+ − 2033 }
+ − 2034 from++;
+ − 2035 }
+ − 2036 symdone:
+ − 2037 curlevel->prev = curlevel->last;
+ − 2038 break;
+ − 2039
+ − 2040 case Scomment:
+ − 2041 state.incomment = 1;
460
+ − 2042 if (commentstop || boundary_stop) goto done;
428
+ − 2043 startincomment:
460
+ − 2044 if (commentstop == 1)
428
+ − 2045 goto done;
826
+ − 2046 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
428
+ − 2047 {
826
+ − 2048 Charbpos newfrom = find_end_of_comment (buf, from, end,
+ − 2049 state.comstyle);
428
+ − 2050 if (newfrom < 0)
+ − 2051 {
+ − 2052 /* we terminated search because from == end */
+ − 2053 from = end;
+ − 2054 goto done;
+ − 2055 }
+ − 2056 from = newfrom;
+ − 2057 }
+ − 2058 state.incomment = 0;
+ − 2059 state.comstyle = 0; /* reset the comment style */
460
+ − 2060 if (boundary_stop) goto done;
428
+ − 2061 break;
+ − 2062
+ − 2063 case Sopen:
+ − 2064 if (stopbefore) goto stop; /* this arg means stop at sexp start */
+ − 2065 depth++;
+ − 2066 /* curlevel++->last ran into compiler bug on Apollo */
+ − 2067 curlevel->last = from - 1;
+ − 2068 if (++curlevel == endlevel)
826
+ − 2069 stack_overflow ("Nesting too deep for parser",
+ − 2070 make_int (curlevel - levelstart));
428
+ − 2071 curlevel->prev = -1;
+ − 2072 curlevel->last = -1;
+ − 2073 if (targetdepth == depth) goto done;
+ − 2074 break;
+ − 2075
+ − 2076 case Sclose:
+ − 2077 depth--;
+ − 2078 if (depth < mindepth)
+ − 2079 mindepth = depth;
+ − 2080 if (curlevel != levelstart)
+ − 2081 curlevel--;
+ − 2082 curlevel->prev = curlevel->last;
+ − 2083 if (targetdepth == depth) goto done;
+ − 2084 break;
+ − 2085
+ − 2086 case Sstring:
460
+ − 2087 case Sstring_fence:
+ − 2088 state.comstr_start = from - 1;
428
+ − 2089 if (stopbefore) goto stop; /* this arg means stop at sexp start */
+ − 2090 curlevel->last = from - 1;
460
+ − 2091 if (code == Sstring_fence)
428
+ − 2092 {
460
+ − 2093 state.instring = ST_STRING_STYLE;
+ − 2094 }
+ − 2095 else
+ − 2096 {
+ − 2097 /* XEmacs change: call syntax_match() on character */
867
+ − 2098 Ichar ch = BUF_FETCH_CHAR (buf, from - 1);
460
+ − 2099 Lisp_Object stermobj =
1296
+ − 2100 syntax_match (scache->syntax_table, ch);
428
+ − 2101
+ − 2102 if (CHARP (stermobj))
+ − 2103 state.instring = XCHAR (stermobj);
+ − 2104 else
+ − 2105 state.instring = ch;
+ − 2106 }
460
+ − 2107 if (boundary_stop) goto done;
428
+ − 2108 startinstring:
+ − 2109 while (1)
+ − 2110 {
460
+ − 2111 enum syntaxcode temp_code;
+ − 2112
428
+ − 2113 if (from >= end) goto done;
460
+ − 2114
826
+ − 2115 UPDATE_SYNTAX_CACHE_FORWARD (scache, from);
460
+ − 2116 c = BUF_FETCH_CHAR (buf, from);
826
+ − 2117 temp_code = SYNTAX_FROM_CACHE (scache, c);
460
+ − 2118
+ − 2119 if (
+ − 2120 state.instring != ST_STRING_STYLE &&
+ − 2121 temp_code == Sstring &&
+ − 2122 c == state.instring) break;
+ − 2123
+ − 2124 switch (temp_code)
428
+ − 2125 {
460
+ − 2126 case Sstring_fence:
+ − 2127 if (state.instring == ST_STRING_STYLE)
+ − 2128 goto string_end;
+ − 2129 break;
428
+ − 2130 case Scharquote:
+ − 2131 case Sescape:
+ − 2132 {
+ − 2133 from++;
+ − 2134 startquotedinstring:
+ − 2135 if (from >= end) goto endquoted;
+ − 2136 break;
+ − 2137 }
+ − 2138 default:
+ − 2139 break;
+ − 2140 }
+ − 2141 from++;
+ − 2142 }
460
+ − 2143 string_end:
428
+ − 2144 state.instring = -1;
+ − 2145 curlevel->prev = curlevel->last;
+ − 2146 from++;
460
+ − 2147 if (boundary_stop) goto done;
428
+ − 2148 break;
+ − 2149
+ − 2150 case Smath:
+ − 2151 break;
+ − 2152
+ − 2153 case Swhitespace:
+ − 2154 case Spunct:
+ − 2155 case Squote:
+ − 2156 case Sendcomment:
460
+ − 2157 case Scomment_fence:
428
+ − 2158 case Sinherit:
+ − 2159 case Smax:
+ − 2160 break;
+ − 2161 }
+ − 2162 }
+ − 2163 goto done;
+ − 2164
+ − 2165 stop: /* Here if stopping before start of sexp. */
+ − 2166 from--; /* We have just fetched the char that starts it; */
+ − 2167 goto done; /* but return the position before it. */
+ − 2168
+ − 2169 endquoted:
+ − 2170 state.quoted = 1;
+ − 2171 done:
+ − 2172 state.depth = depth;
+ − 2173 state.mindepth = mindepth;
+ − 2174 state.thislevelstart = curlevel->prev;
+ − 2175 state.prevlevelstart
+ − 2176 = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
+ − 2177 state.location = from;
460
+ − 2178 state.levelstarts = Qnil;
+ − 2179 while (--curlevel >= levelstart)
+ − 2180 state.levelstarts = Fcons (make_int (curlevel->last),
+ − 2181 state.levelstarts);
428
+ − 2182
+ − 2183 *stateptr = state;
+ − 2184 }
+ − 2185
+ − 2186 DEFUN ("parse-partial-sexp", Fparse_partial_sexp, 2, 7, 0, /*
+ − 2187 Parse Lisp syntax starting at FROM until TO; return status of parse at TO.
+ − 2188 Parsing stops at TO or when certain criteria are met;
+ − 2189 point is set to where parsing stops.
444
+ − 2190 If fifth arg OLDSTATE is omitted or nil,
428
+ − 2191 parsing assumes that FROM is the beginning of a function.
460
+ − 2192 Value is a list of nine elements describing final state of parsing:
428
+ − 2193 0. depth in parens.
+ − 2194 1. character address of start of innermost containing list; nil if none.
+ − 2195 2. character address of start of last complete sexp terminated.
+ − 2196 3. non-nil if inside a string.
460
+ − 2197 (It is the character that will terminate the string,
+ − 2198 or t if the string should be terminated by an explicit
+ − 2199 `syntax-table' property.)
428
+ − 2200 4. t if inside a comment.
+ − 2201 5. t if following a quote character.
+ − 2202 6. the minimum paren-depth encountered during this scan.
460
+ − 2203 7. nil if in comment style a, or not in a comment; t if in comment style b;
+ − 2204 `syntax-table' if given by an explicit `syntax-table' property.
+ − 2205 8. character address of start of last comment or string; nil if none.
+ − 2206 9. Intermediate data for continuation of parsing (subject to change).
428
+ − 2207 If third arg TARGETDEPTH is non-nil, parsing stops if the depth
+ − 2208 in parentheses becomes equal to TARGETDEPTH.
+ − 2209 Fourth arg STOPBEFORE non-nil means stop when come to
+ − 2210 any character that starts a sexp.
460
+ − 2211 Fifth arg OLDSTATE is a nine-element list like what this function returns.
428
+ − 2212 It is used to initialize the state of the parse. Its second and third
+ − 2213 elements are ignored.
460
+ − 2214 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. If it
+ − 2215 is `syntax-table', stop after the start of a comment or a string, or after
+ − 2216 the end of a comment or string.
826
+ − 2217 Seventh arg BUFFER specifies the buffer to do the parsing in, and defaults
+ − 2218 to the current buffer.
428
+ − 2219 */
+ − 2220 (from, to, targetdepth, stopbefore, oldstate, commentstop, buffer))
+ − 2221 {
+ − 2222 struct lisp_parse_state state;
+ − 2223 int target;
665
+ − 2224 Charbpos start, end;
428
+ − 2225 struct buffer *buf = decode_buffer (buffer, 0);
+ − 2226 Lisp_Object val;
+ − 2227
+ − 2228 if (!NILP (targetdepth))
+ − 2229 {
+ − 2230 CHECK_INT (targetdepth);
+ − 2231 target = XINT (targetdepth);
+ − 2232 }
+ − 2233 else
+ − 2234 target = -100000; /* We won't reach this depth */
+ − 2235
+ − 2236 get_buffer_range_char (buf, from, to, &start, &end, 0);
+ − 2237 scan_sexps_forward (buf, &state, start, end,
+ − 2238 target, !NILP (stopbefore), oldstate,
460
+ − 2239 (NILP (commentstop)
+ − 2240 ? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1)));
428
+ − 2241 BUF_SET_PT (buf, state.location);
+ − 2242
+ − 2243 /* reverse order */
+ − 2244 val = Qnil;
460
+ − 2245 val = Fcons (state.levelstarts, val);
+ − 2246 val = Fcons ((state.incomment || (state.instring >= 0))
+ − 2247 ? make_int (state.comstr_start) : Qnil, val);
+ − 2248 val = Fcons (state.comstyle ? (state.comstyle == ST_COMMENT_STYLE
+ − 2249 ? Qsyntax_table : Qt) : Qnil, val);
428
+ − 2250 val = Fcons (make_int (state.mindepth), val);
+ − 2251 val = Fcons (state.quoted ? Qt : Qnil, val);
+ − 2252 val = Fcons (state.incomment ? Qt : Qnil, val);
460
+ − 2253 val = Fcons (state.instring < 0
+ − 2254 ? Qnil
+ − 2255 : (state.instring == ST_STRING_STYLE
+ − 2256 ? Qt : make_int (state.instring)), val);
826
+ − 2257 val = Fcons (state.thislevelstart < 0 ? Qnil :
+ − 2258 make_int (state.thislevelstart), val);
+ − 2259 val = Fcons (state.prevlevelstart < 0 ? Qnil :
+ − 2260 make_int (state.prevlevelstart), val);
428
+ − 2261 val = Fcons (make_int (state.depth), val);
+ − 2262
+ − 2263 return val;
+ − 2264 }
+ − 2265
+ − 2266
+ − 2267 /* Updating of the mirror syntax table.
+ − 2268
1296
+ − 2269 Each syntax table has a corresponding mirror table in it. Whenever we
+ − 2270 make a change to a syntax table, we set a dirty flag. When accessing a
+ − 2271 value from the mirror table and the table is dirty, we call
+ − 2272 update_syntax_table() to clean it up.
428
+ − 2273
+ − 2274 #### We really only need to map over the changed range.
+ − 2275
+ − 2276 If we change the standard syntax table, we need to map over
+ − 2277 all tables because any of them could be inheriting from the
+ − 2278 standard syntax table.
+ − 2279
+ − 2280 When `set-syntax-table' is called, we set the buffer's mirror
+ − 2281 syntax table as well.
+ − 2282 */
+ − 2283
826
+ − 2284 static int
2286
+ − 2285 copy_to_mirrortab (struct chartab_range *range, Lisp_Object UNUSED (table),
826
+ − 2286 Lisp_Object val, void *arg)
428
+ − 2287 {
826
+ − 2288 Lisp_Object mirrortab = VOID_TO_LISP (arg);
428
+ − 2289
+ − 2290 if (CONSP (val))
+ − 2291 val = XCAR (val);
826
+ − 2292 if (SYNTAX_FROM_CODE (XINT (val)) != Sinherit)
+ − 2293 put_char_table (mirrortab, range, val);
+ − 2294 return 0;
+ − 2295 }
+ − 2296
+ − 2297 static int
2286
+ − 2298 copy_if_not_already_present (struct chartab_range *range,
+ − 2299 Lisp_Object UNUSED (table),
826
+ − 2300 Lisp_Object val, void *arg)
+ − 2301 {
1296
+ − 2302 Lisp_Object mirrortab = VOID_TO_LISP (arg);
826
+ − 2303 if (CONSP (val))
+ − 2304 val = XCAR (val);
+ − 2305 if (SYNTAX_FROM_CODE (XINT (val)) != Sinherit)
+ − 2306 {
+ − 2307 Lisp_Object existing =
1296
+ − 2308 updating_mirror_get_range_char_table (range, mirrortab,
+ − 2309 Vbogus_syntax_table_value);
826
+ − 2310 if (NILP (existing))
+ − 2311 /* nothing at all */
1296
+ − 2312 put_char_table (mirrortab, range, val);
+ − 2313 else if (!EQ (existing, Vbogus_syntax_table_value))
826
+ − 2314 /* full */
+ − 2315 ;
+ − 2316 else
+ − 2317 {
+ − 2318 Freset_char_table (Vtemp_table_for_use_updating_syntax_tables);
+ − 2319 copy_char_table_range
1296
+ − 2320 (mirrortab, Vtemp_table_for_use_updating_syntax_tables, range);
+ − 2321 put_char_table (mirrortab, range, val);
826
+ − 2322 copy_char_table_range
1296
+ − 2323 (Vtemp_table_for_use_updating_syntax_tables, mirrortab, range);
826
+ − 2324 }
428
+ − 2325 }
826
+ − 2326
428
+ − 2327 return 0;
+ − 2328 }
+ − 2329
+ − 2330 static void
826
+ − 2331 update_just_this_syntax_table (Lisp_Object table)
428
+ − 2332 {
+ − 2333 struct chartab_range range;
826
+ − 2334 Lisp_Object mirrortab = XCHAR_TABLE (table)->mirror_table;
+ − 2335
1296
+ − 2336 assert (!XCHAR_TABLE (table)->mirror_table_p);
826
+ − 2337 range.type = CHARTAB_RANGE_ALL;
+ − 2338 Freset_char_table (mirrortab);
1296
+ − 2339
826
+ − 2340 /* First, copy the tables values other than inherit into the mirror
+ − 2341 table. Then, for tables other than the standard syntax table, map
+ − 2342 over the standard table, copying values into the mirror table only if
+ − 2343 entries don't already exist in that table. (The copying step requires
+ − 2344 another mapping.)
+ − 2345 */
428
+ − 2346
826
+ − 2347 map_char_table (table, &range, copy_to_mirrortab, LISP_TO_VOID (mirrortab));
+ − 2348 /* second clause catches bootstrapping problems when initializing the
+ − 2349 standard syntax table */
+ − 2350 if (!EQ (table, Vstandard_syntax_table) && !NILP (Vstandard_syntax_table))
1296
+ − 2351 map_char_table (Vstandard_syntax_table, &range,
+ − 2352 copy_if_not_already_present, LISP_TO_VOID (mirrortab));
3152
+ − 2353 /* The resetting made the default be Qnil. Put it back to Sword. */
+ − 2354 set_char_table_default (mirrortab, make_int (Sword));
1296
+ − 2355 XCHAR_TABLE (mirrortab)->dirty = 0;
428
+ − 2356 }
+ − 2357
+ − 2358 /* Called from chartab.c when a change is made to a syntax table.
+ − 2359 If this is the standard syntax table, we need to recompute
+ − 2360 *all* syntax tables (yuck). Otherwise we just recompute this
+ − 2361 one. */
+ − 2362
+ − 2363 void
826
+ − 2364 update_syntax_table (Lisp_Object table)
428
+ − 2365 {
1296
+ − 2366 Lisp_Object nonmirror = XCHAR_TABLE (table)->mirror_table;
+ − 2367 assert (XCHAR_TABLE (table)->mirror_table_p);
+ − 2368 if (EQ (nonmirror, Vstandard_syntax_table))
428
+ − 2369 {
+ − 2370 Lisp_Object syntab;
+ − 2371
+ − 2372 for (syntab = Vall_syntax_tables; !NILP (syntab);
+ − 2373 syntab = XCHAR_TABLE (syntab)->next_table)
826
+ − 2374 update_just_this_syntax_table (syntab);
428
+ − 2375 }
+ − 2376 else
1296
+ − 2377 update_just_this_syntax_table (nonmirror);
428
+ − 2378 }
+ − 2379
+ − 2380
+ − 2381 /************************************************************************/
+ − 2382 /* initialization */
+ − 2383 /************************************************************************/
+ − 2384
+ − 2385 void
+ − 2386 syms_of_syntax (void)
+ − 2387 {
3092
+ − 2388 #ifdef NEW_GC
+ − 2389 INIT_LRECORD_IMPLEMENTATION (syntax_cache);
+ − 2390 #endif /* NEW_GC */
563
+ − 2391 DEFSYMBOL (Qsyntax_table_p);
+ − 2392 DEFSYMBOL (Qsyntax_table);
428
+ − 2393
+ − 2394 DEFSUBR (Fsyntax_table_p);
+ − 2395 DEFSUBR (Fsyntax_table);
826
+ − 2396 #ifdef DEBUG_XEMACS
+ − 2397 DEFSUBR (Fmirror_syntax_table);
+ − 2398 DEFSUBR (Fsyntax_cache_info);
+ − 2399 #endif /* DEBUG_XEMACS */
428
+ − 2400 DEFSUBR (Fstandard_syntax_table);
+ − 2401 DEFSUBR (Fcopy_syntax_table);
+ − 2402 DEFSUBR (Fset_syntax_table);
+ − 2403 DEFSUBR (Fsyntax_designator_chars);
+ − 2404 DEFSUBR (Fchar_syntax);
+ − 2405 DEFSUBR (Fmatching_paren);
+ − 2406 /* DEFSUBR (Fmodify_syntax_entry); now in Lisp. */
+ − 2407 /* DEFSUBR (Fdescribe_syntax); now in Lisp. */
+ − 2408
+ − 2409 DEFSUBR (Fforward_word);
+ − 2410
+ − 2411 DEFSUBR (Fforward_comment);
+ − 2412 DEFSUBR (Fscan_lists);
+ − 2413 DEFSUBR (Fscan_sexps);
+ − 2414 DEFSUBR (Fbackward_prefix_chars);
+ − 2415 DEFSUBR (Fparse_partial_sexp);
+ − 2416 }
+ − 2417
+ − 2418 void
+ − 2419 vars_of_syntax (void)
+ − 2420 {
+ − 2421 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments /*
+ − 2422 Non-nil means `forward-sexp', etc., should treat comments as whitespace.
+ − 2423 */ );
434
+ − 2424 parse_sexp_ignore_comments = 0;
428
+ − 2425
460
+ − 2426 DEFVAR_BOOL ("lookup-syntax-properties", &lookup_syntax_properties /*
826
+ − 2427 Non-nil means `forward-sexp', etc., respect the `syntax-table' property.
+ − 2428 This property can be placed on buffers or strings and can be used to explicitly
+ − 2429 specify the syntax table to be used for looking up the syntax of the chars
+ − 2430 having this property, or to directly specify the syntax of the chars.
+ − 2431
460
+ − 2432 The value of this property should be either a syntax table, or a cons
+ − 2433 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric
+ − 2434 syntax code, MATCHCHAR being nil or the character to match (which is
826
+ − 2435 relevant only when the syntax code is open/close-type).
460
+ − 2436 */ );
+ − 2437 lookup_syntax_properties = 1;
+ − 2438
428
+ − 2439 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes /*
+ − 2440 Non-nil means `forward-word', etc., should treat escape chars part of words.
+ − 2441 */ );
434
+ − 2442 words_include_escapes = 0;
428
+ − 2443
+ − 2444 no_quit_in_re_search = 0;
1296
+ − 2445
+ − 2446 Vbogus_syntax_table_value = make_float (0.0);
+ − 2447 staticpro (&Vbogus_syntax_table_value);
428
+ − 2448 }
+ − 2449
+ − 2450 static void
3540
+ − 2451 define_standard_syntax (const UExtbyte *p, enum syntaxcode syn)
428
+ − 2452 {
+ − 2453 for (; *p; p++)
+ − 2454 Fput_char_table (make_char (*p), make_int (syn), Vstandard_syntax_table);
+ − 2455 }
+ − 2456
+ − 2457 void
+ − 2458 complex_vars_of_syntax (void)
+ − 2459 {
867
+ − 2460 Ichar i;
3540
+ − 2461 const UExtbyte *p; /* Latin-1, not internal format. */
+ − 2462
+ − 2463 #define SET_RANGE_SYNTAX(start, end, syntax) \
+ − 2464 do { \
+ − 2465 for (i = start; i <= end; i++) \
+ − 2466 Fput_char_table(make_char(i), make_int(syntax), \
+ − 2467 Vstandard_syntax_table); \
+ − 2468 } while (0)
+ − 2469
+ − 2470 /* Set this now, so first buffer creation can refer to it.
+ − 2471
+ − 2472 Make it nil before calling copy-syntax-table so that copy-syntax-table
+ − 2473 will know not to try to copy from garbage */
428
+ − 2474 Vstandard_syntax_table = Qnil;
+ − 2475 Vstandard_syntax_table = Fcopy_syntax_table (Qnil);
+ − 2476 staticpro (&Vstandard_syntax_table);
+ − 2477
826
+ − 2478 Vtemp_table_for_use_updating_syntax_tables = Fmake_char_table (Qgeneric);
+ − 2479 staticpro (&Vtemp_table_for_use_updating_syntax_tables);
+ − 2480
428
+ − 2481 Vsyntax_designator_chars_string = make_string_nocopy (syntax_code_spec,
+ − 2482 Smax);
+ − 2483 staticpro (&Vsyntax_designator_chars_string);
+ − 2484
3540
+ − 2485 /* Default character syntax is word. */
3152
+ − 2486 set_char_table_default (Vstandard_syntax_table, make_int (Sword));
428
+ − 2487
3540
+ − 2488 /* Control 0; treat as punctuation */
+ − 2489 SET_RANGE_SYNTAX(0, 32, Spunct);
428
+ − 2490
3544
+ − 2491 /* The whitespace--overwriting some of the above changes.
+ − 2492
+ − 2493 String literals are const char *s, not const unsigned char *s. */
+ − 2494 define_standard_syntax((const UExtbyte *)" \t\015\014", Swhitespace);
3540
+ − 2495
+ − 2496 /* DEL plus Control 1 */
+ − 2497 SET_RANGE_SYNTAX(127, 159, Spunct);
+ − 2498
3544
+ − 2499 define_standard_syntax ((const UExtbyte *)"\"", Sstring);
+ − 2500 define_standard_syntax ((const UExtbyte *)"\\", Sescape);
+ − 2501 define_standard_syntax ((const UExtbyte *)"_-+*/&|<>=", Ssymbol);
+ − 2502 define_standard_syntax ((const UExtbyte *)".,;:?!#@~^'`", Spunct);
428
+ − 2503
3544
+ − 2504 for (p = (const UExtbyte *)"()[]{}"; *p; p+=2)
428
+ − 2505 {
+ − 2506 Fput_char_table (make_char (p[0]),
+ − 2507 Fcons (make_int (Sopen), make_char (p[1])),
+ − 2508 Vstandard_syntax_table);
+ − 2509 Fput_char_table (make_char (p[1]),
+ − 2510 Fcons (make_int (Sclose), make_char (p[0])),
+ − 2511 Vstandard_syntax_table);
+ − 2512 }
3540
+ − 2513
+ − 2514 /* Latin 1 "symbols." This contrasts with the FSF, where they're word
+ − 2515 constituents. */
+ − 2516 SET_RANGE_SYNTAX(0240, 0277, Ssymbol);
+ − 2517
+ − 2518 /* The guillemets. These are not parentheses, in contrast to what the old
+ − 2519 code did. */
3569
+ − 2520 define_standard_syntax((const UExtbyte *)"\253\273", Spunct);
3540
+ − 2521
+ − 2522 /* The inverted exclamation mark, and the multiplication and division
+ − 2523 signs. */
3544
+ − 2524 define_standard_syntax((const UExtbyte *)"\241\327\367", Spunct);
3540
+ − 2525
+ − 2526 #undef SET_RANGE_SYNTAX
428
+ − 2527 }