Mercurial > hg > xemacs-beta
annotate src/syntax.c @ 5518:3cc7470ea71c
gnuclient: if TMPDIR was set and connect failed, try again with /tmp
2011-06-03 Aidan Kehoe <kehoea@parhasard.net>
* gnuslib.c (connect_to_unix_server):
Retry with /tmp as a directory in which to search for Unix sockets
if an attempt to connect with some other directory failed (which
may be because gnuclient and gnuserv don't share an environment
value for TMPDIR, or because gnuserv was compiled with USE_TMPDIR
turned off).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 03 Jun 2011 18:40:57 +0100 |
| parents | 308d34e9f07d |
| children | dab422055bab |
| rev | line source |
|---|---|
| 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. | |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
4 Copyright (C) 2001, 2002, 2003, 2010 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5169
diff
changeset
|
8 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 9 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5169
diff
changeset
|
10 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5169
diff
changeset
|
11 option) any later version. |
| 428 | 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5169
diff
changeset
|
19 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 20 |
| 21 /* Synched up with: FSF 19.28. */ | |
| 22 | |
| 23 /* This file has been Mule-ized. */ | |
| 24 | |
| 25 #include <config.h> | |
| 26 #include "lisp.h" | |
| 27 | |
| 28 #include "buffer.h" | |
| 29 #include "syntax.h" | |
| 460 | 30 #include "extents.h" |
| 428 | 31 |
| 460 | 32 #define ST_COMMENT_STYLE 0x101 |
| 33 #define ST_STRING_STYLE 0x102 | |
| 34 | |
| 35 Lisp_Object Qsyntax_table; | |
| 36 int lookup_syntax_properties; | |
| 37 | |
| 428 | 38 Lisp_Object Qsyntax_table_p; |
| 39 | |
| 40 int words_include_escapes; | |
| 41 | |
| 42 int parse_sexp_ignore_comments; | |
| 43 | |
| 44 /* The following two variables are provided to tell additional information | |
| 45 to the regex routines. We do it this way rather than change the | |
| 46 arguments to re_search_2() in an attempt to maintain some call | |
| 47 compatibility with other versions of the regex code. */ | |
| 48 | |
| 49 /* Tell the regex routines not to QUIT. Normally there is a QUIT | |
| 50 each iteration in re_search_2(). */ | |
| 51 int no_quit_in_re_search; | |
| 52 | |
| 826 | 53 /* The standard syntax table is stored where it will automatically |
| 54 be used in all new buffers. */ | |
| 428 | 55 Lisp_Object Vstandard_syntax_table; |
| 56 | |
| 57 Lisp_Object Vsyntax_designator_chars_string; | |
| 58 | |
| 826 | 59 Lisp_Object Vtemp_table_for_use_updating_syntax_tables; |
| 60 | |
| 1296 | 61 /* A value that is guaranteed not be in a syntax table. */ |
| 62 Lisp_Object Vbogus_syntax_table_value; | |
| 63 | |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
64 Lisp_Object Qscan_error; |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
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 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
260 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("syntax-cache", syntax_cache, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
261 0, syntax_cache_description_1, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
262 Lisp_Syntax_Cache); |
| 3252 | 263 #else /* not NEW_GC */ |
| 264 | |
| 265 const struct sized_memory_description syntax_cache_description = { | |
| 266 sizeof (struct syntax_cache), | |
| 267 syntax_cache_description_1 | |
| 268 }; | |
| 269 #endif /* not NEW_GC */ | |
| 270 | |
| 271 /* static syntax cache utilities */ | |
| 272 | |
| 273 static void | |
| 274 syntax_cache_table_was_changed (struct buffer *buf) | |
| 275 { | |
| 276 struct syntax_cache *cache = buf->syntax_cache; | |
| 277 if (cache->no_syntax_table_prop) | |
| 278 { | |
| 279 cache->syntax_table = | |
| 280 BUFFER_SYNTAX_TABLE (buf); | |
| 281 cache->mirror_table = | |
| 282 BUFFER_MIRROR_SYNTAX_TABLE (buf); | |
| 283 } | |
| 284 } | |
| 285 | |
| 286 static void | |
| 287 reset_buffer_syntax_cache_range (struct syntax_cache *cache, | |
| 288 Lisp_Object buffer, int infinite) | |
| 289 { | |
| 290 Fset_marker (cache->start, make_int (1), buffer); | |
| 291 Fset_marker (cache->end, make_int (1), buffer); | |
| 292 Fset_marker_insertion_type (cache->start, Qt); | |
| 293 Fset_marker_insertion_type (cache->end, Qnil); | |
| 294 /* #### Should we "cache->no_syntax_table_prop = 1;" here? */ | |
| 295 /* #### Cf comment on INFINITE in init_syntax_cache. -- sjt */ | |
| 296 if (infinite) | |
| 297 { | |
| 298 cache->prev_change = EMACS_INT_MIN; | |
| 299 cache->next_change = EMACS_INT_MAX; | |
| 300 } | |
| 301 else | |
| 302 { | |
| 303 cache->prev_change = -1; | |
| 304 cache->next_change = -1; | |
| 305 } | |
| 306 } | |
| 826 | 307 |
| 308 static void | |
| 309 init_syntax_cache (struct syntax_cache *cache, Lisp_Object object, | |
| 310 struct buffer *buffer, int infinite) | |
| 311 { | |
| 312 xzero (*cache); | |
| 313 cache->object = object; | |
| 314 cache->buffer = buffer; | |
| 315 cache->no_syntax_table_prop = 1; | |
| 1296 | 316 cache->syntax_table = |
| 317 BUFFER_SYNTAX_TABLE (cache->buffer); | |
| 318 cache->mirror_table = | |
| 826 | 319 BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer); |
| 320 cache->start = Qnil; | |
| 321 cache->end = Qnil; | |
| 3250 | 322 /* #### I'm not sure what INFINITE is for, but it's apparently needed by |
| 323 setup_syntax_cache(). It looks like it's supposed to guarantee that | |
| 324 the test for POS outside of cache-valid range will never succeed, so | |
| 325 that update_syntax_cache won't get called, but it's hard to be sure. | |
| 326 Cf reset_buffer_syntax_cache_range. -- sjt */ | |
| 826 | 327 if (infinite) |
| 328 { | |
| 329 cache->prev_change = EMACS_INT_MIN; | |
| 330 cache->next_change = EMACS_INT_MAX; | |
| 331 } | |
| 332 else | |
| 333 { | |
| 334 cache->prev_change = -1; | |
| 335 cache->next_change = -1; | |
| 336 } | |
| 337 } | |
| 338 | |
| 3252 | 339 /* external syntax cache API */ |
| 340 | |
| 3250 | 341 /* #### This function and associated logic still needs work, and especially |
| 342 documentation. */ | |
| 343 struct syntax_cache * /* return CACHE or the cache of OBJECT */ | |
| 344 setup_syntax_cache (struct syntax_cache *cache, /* syntax cache, may be NULL | |
| 345 if OBJECT is a buffer */ | |
| 346 Lisp_Object object, /* the object (if any) cache | |
| 347 is associated with */ | |
| 348 struct buffer *buffer, /* the buffer to use as source | |
| 349 of the syntax table */ | |
| 350 Charxpos from, /* initial position of cache */ | |
| 351 int count) /* direction? see code */ | |
| 826 | 352 { |
| 3250 | 353 /* If OBJECT is a buffer, use its cache. Initialize cache. Make it valid |
| 354 for the whole buffer if the syntax-table property is not being respected. | |
| 355 Else if OBJECT is not a buffer, initialize the cache passed in CACHE. | |
| 356 If the syntax-table property is being respected, update the cache. */ | |
| 826 | 357 if (BUFFERP (object)) |
| 3250 | 358 { |
| 359 cache = XBUFFER (object)->syntax_cache; | |
| 360 if (!lookup_syntax_properties) | |
| 361 reset_buffer_syntax_cache_range (cache, object, 1); | |
| 362 } | |
| 363 else | |
| 826 | 364 init_syntax_cache (cache, object, buffer, 0); |
| 365 if (lookup_syntax_properties) | |
| 366 { | |
| 367 if (count <= 0) | |
| 368 { | |
| 369 from--; | |
| 2167 | 370 from = buffer_or_string_clip_to_accessible_char (cache->object, |
| 826 | 371 from); |
| 372 } | |
| 373 if (!(from >= cache->prev_change && from < cache->next_change)) | |
| 374 update_syntax_cache (cache, from, count); | |
| 375 } | |
| 1296 | 376 #ifdef NOT_WORTH_THE_EFFORT |
| 377 update_mirror_syntax_if_dirty (cache->mirror_table); | |
| 378 #endif /* NOT_WORTH_THE_EFFORT */ | |
| 826 | 379 return cache; |
| 380 } | |
| 381 | |
| 382 struct syntax_cache * | |
| 383 setup_buffer_syntax_cache (struct buffer *buffer, Charxpos from, int count) | |
| 384 { | |
| 385 return setup_syntax_cache (NULL, wrap_buffer (buffer), buffer, from, count); | |
| 386 } | |
| 387 | |
| 460 | 388 /* |
| 389 Update syntax_cache to an appropriate setting for position POS | |
| 390 | |
| 391 The sign of COUNT gives the relative position of POS wrt the | |
| 392 previously valid interval. (not currently used) | |
| 393 | |
| 394 `syntax_cache.*_change' are the next and previous positions at | |
| 395 which syntax_code and c_s_t will need to be recalculated. | |
| 396 | |
| 3025 | 397 #### Currently this code uses `get-char-property', which will |
| 460 | 398 return the "last smallest" extent at a given position. In cases |
| 399 where overlapping extents are defined, this code will simply use | |
| 400 whatever is returned by get-char-property. | |
| 401 | |
| 402 It might be worth it at some point to merge provided syntax tables | |
| 826 | 403 outward to the current buffer (#### rewrite in English please?!). */ |
| 460 | 404 |
| 405 void | |
| 2286 | 406 update_syntax_cache (struct syntax_cache *cache, Charxpos cpos, |
| 407 int UNUSED (count)) | |
| 460 | 408 { |
| 409 Lisp_Object tmp_table; | |
| 826 | 410 Bytexpos pos; |
| 411 Bytexpos lim; | |
| 412 Bytexpos next, prev; | |
| 413 int at_begin = 0, at_end = 0; | |
| 460 | 414 |
| 826 | 415 if (NILP (cache->object)) |
| 416 return; | |
| 417 | |
| 418 pos = buffer_or_string_charxpos_to_bytexpos (cache->object, cpos); | |
| 419 | |
| 420 tmp_table = get_char_property (pos, Qsyntax_table, cache->object, | |
| 421 EXTENT_AT_AFTER, 0); | |
| 2506 | 422 lim = next_previous_single_property_change (pos, Qsyntax_table, |
| 423 cache->object, -1, 1, 0); | |
| 826 | 424 if (lim < 0) |
| 460 | 425 { |
| 826 | 426 next = buffer_or_string_absolute_end_byte (cache->object); |
| 427 at_begin = 1; | |
| 460 | 428 } |
| 826 | 429 else |
| 430 next = lim; | |
| 460 | 431 |
| 826 | 432 if (pos < buffer_or_string_absolute_end_byte (cache->object)) |
| 433 pos = next_bytexpos (cache->object, pos); | |
| 2506 | 434 lim = next_previous_single_property_change (pos, Qsyntax_table, |
| 435 cache->object, -1, 0, 0); | |
| 826 | 436 if (lim < 0) |
| 460 | 437 { |
| 826 | 438 prev = buffer_or_string_absolute_begin_byte (cache->object); |
| 439 at_end = 1; | |
| 460 | 440 } |
| 441 else | |
| 826 | 442 prev = lim; |
| 460 | 443 |
| 826 | 444 cache->prev_change = |
| 445 buffer_or_string_bytexpos_to_charxpos (cache->object, prev); | |
| 446 cache->next_change = | |
| 447 buffer_or_string_bytexpos_to_charxpos (cache->object, next); | |
| 460 | 448 |
| 826 | 449 if (BUFFERP (cache->object)) |
| 450 { | |
| 451 /* If we are at the beginning or end of buffer, check to see if there's | |
| 452 a zero-length `syntax-table' extent there (highly unlikely); if not, | |
| 453 then we can safely make the end closed, so it will take in newly | |
| 454 inserted text. (If such an extent is inserted, we will be informed | |
| 3250 | 455 through signal_syntax_cache_extent_changed().) */ |
| 826 | 456 Fset_marker (cache->start, make_int (cache->prev_change), cache->object); |
| 457 Fset_marker_insertion_type | |
| 458 (cache->start, | |
| 459 at_begin && NILP (extent_at (prev, cache->object, Qsyntax_table, | |
| 460 NULL, EXTENT_AT_AT, 0)) | |
| 461 ? Qnil : Qt); | |
| 462 Fset_marker (cache->end, make_int (cache->next_change), cache->object); | |
| 463 Fset_marker_insertion_type | |
| 464 (cache->end, | |
| 465 at_end && NILP (extent_at (next, cache->object, Qsyntax_table, | |
| 466 NULL, EXTENT_AT_AT, 0)) | |
| 467 ? Qt : Qnil); | |
| 468 } | |
| 469 | |
| 470 if (!NILP (Fsyntax_table_p (tmp_table))) | |
| 471 { | |
| 472 cache->use_code = 0; | |
| 1296 | 473 cache->syntax_table = tmp_table; |
| 474 cache->mirror_table = XCHAR_TABLE (tmp_table)->mirror_table; | |
| 826 | 475 cache->no_syntax_table_prop = 0; |
| 1296 | 476 #ifdef NOT_WORTH_THE_EFFORT |
| 477 update_mirror_syntax_if_dirty (cache->mirror_table); | |
| 478 #endif /* NOT_WORTH_THE_EFFORT */ | |
| 826 | 479 } |
| 480 else if (CONSP (tmp_table) && INTP (XCAR (tmp_table))) | |
| 481 { | |
| 482 cache->use_code = 1; | |
| 483 cache->syntax_code = XINT (XCAR (tmp_table)); | |
| 484 cache->no_syntax_table_prop = 0; | |
| 485 } | |
| 486 else | |
| 487 { | |
| 488 cache->use_code = 0; | |
| 489 cache->no_syntax_table_prop = 1; | |
| 1296 | 490 cache->syntax_table = BUFFER_SYNTAX_TABLE (cache->buffer); |
| 491 cache->mirror_table = BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer); | |
| 492 #ifdef NOT_WORTH_THE_EFFORT | |
| 493 update_mirror_syntax_if_dirty (cache->mirror_table); | |
| 494 #endif /* NOT_WORTH_THE_EFFORT */ | |
| 460 | 495 } |
| 496 } | |
| 3252 | 497 |
| 498 /* buffer-specific APIs used in buffer.c | |
| 499 #### This is really unclean; | |
| 500 the syntax cache should just be a LISP object */ | |
| 501 | |
| 502 void | |
| 503 mark_buffer_syntax_cache (struct buffer *buf) | |
| 504 { | |
| 505 struct syntax_cache *cache = buf->syntax_cache; | |
| 506 if (!cache) /* Vbuffer_defaults and such don't have caches */ | |
| 507 return; | |
| 508 mark_object (cache->object); | |
| 509 if (cache->buffer) | |
| 510 mark_object (wrap_buffer (cache->buffer)); | |
| 511 mark_object (cache->syntax_table); | |
| 512 mark_object (cache->mirror_table); | |
| 513 mark_object (cache->start); | |
| 514 mark_object (cache->end); | |
| 515 } | |
| 516 | |
| 517 void | |
| 518 init_buffer_syntax_cache (struct buffer *buf) | |
| 519 { | |
| 520 struct syntax_cache *cache; | |
| 521 #ifdef NEW_GC | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
522 buf->syntax_cache = XSYNTAX_CACHE (ALLOC_NORMAL_LISP_OBJECT (syntax_cache)); |
| 3252 | 523 #else /* not NEW_GC */ |
| 524 buf->syntax_cache = xnew_and_zero (struct syntax_cache); | |
| 525 #endif /* not NEW_GC */ | |
| 526 cache = buf->syntax_cache; | |
| 527 cache->object = wrap_buffer (buf); | |
| 528 cache->buffer = buf; | |
| 529 cache->no_syntax_table_prop = 1; | |
| 530 cache->syntax_table = BUFFER_SYNTAX_TABLE (cache->buffer); | |
| 531 cache->mirror_table = BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer); | |
| 532 cache->start = Fmake_marker (); | |
| 533 cache->end = Fmake_marker (); | |
| 534 reset_buffer_syntax_cache_range (cache, cache->object, 0); | |
| 535 } | |
| 536 | |
| 537 /* finalize the syntax cache for BUF */ | |
| 538 | |
| 539 void | |
|
4710
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4653
diff
changeset
|
540 uninit_buffer_syntax_cache (struct buffer *UNUSED_IF_NEW_GC (buf)) |
| 3252 | 541 { |
| 4141 | 542 #ifndef NEW_GC |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
543 if (buf->syntax_cache) |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
544 { |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
545 xfree (buf->syntax_cache); |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
546 buf->syntax_cache = 0; |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
547 } |
| 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; |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1350 Charbpos last_good = from; |
| 826 | 1351 |
| 428 | 1352 if (depth > 0) min_depth = 0; |
| 1353 | |
| 826 | 1354 scache = setup_buffer_syntax_cache (buf, from, count); |
| 428 | 1355 while (count > 0) |
| 1356 { | |
| 1357 QUIT; | |
| 1358 | |
| 1359 stop = BUF_ZV (buf); | |
| 1360 while (from < stop) | |
| 1361 { | |
| 460 | 1362 int comstyle = 0; /* mask for finding matching comment style */ |
| 428 | 1363 |
| 826 | 1364 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1365 c = BUF_FETCH_CHAR (buf, from); |
| 826 | 1366 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 1367 code = SYNTAX_FROM_CODE (syncode); | |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1368 if (depth == min_depth) |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1369 last_good = from; |
| 428 | 1370 from++; |
| 1371 | |
| 1372 /* a 1-char comment start sequence */ | |
| 1373 if (code == Scomment && parse_sexp_ignore_comments) | |
| 1374 { | |
| 460 | 1375 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) == |
| 1376 SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 428 | 1377 } |
| 1378 | |
| 1379 /* else, a 2-char comment start sequence? */ | |
| 1380 else if (from < stop | |
| 460 | 1381 && SYNTAX_CODE_START_FIRST_P (syncode) |
| 428 | 1382 && parse_sexp_ignore_comments) |
| 1383 { | |
| 460 | 1384 int next_syncode; |
| 826 | 1385 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1386 next_syncode = |
| 826 | 1387 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)); |
| 460 | 1388 |
| 1389 if (SYNTAX_CODES_START_P (syncode, next_syncode)) | |
| 1390 { | |
| 826 | 1391 /* we have encountered a comment start sequence and we |
| 1392 are ignoring all text inside comments. we must record | |
| 1393 the comment style this sequence begins so that later, | |
| 1394 only a comment end of the same style actually ends | |
| 1395 the comment section */ | |
| 1396 code = Scomment; | |
| 460 | 1397 comstyle = SYNTAX_CODES_COMMENT_MASK_START |
| 1398 (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 826 | 1399 from++; |
| 1400 } | |
| 428 | 1401 } |
| 826 | 1402 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1403 |
| 460 | 1404 if (SYNTAX_CODE_PREFIX (syncode)) |
| 428 | 1405 continue; |
| 1406 | |
| 1407 switch (code) | |
| 1408 { | |
| 1409 case Sescape: | |
| 1410 case Scharquote: | |
| 1411 if (from == stop) goto lose; | |
| 1412 from++; | |
| 1413 /* treat following character as a word constituent */ | |
| 1414 case Sword: | |
| 1415 case Ssymbol: | |
| 1416 if (depth || !sexpflag) break; | |
| 1417 /* This word counts as a sexp; return at end of it. */ | |
| 1418 while (from < stop) | |
| 1419 { | |
| 826 | 1420 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 1421 switch (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from))) | |
| 428 | 1422 { |
| 1423 case Scharquote: | |
| 1424 case Sescape: | |
| 1425 from++; | |
| 1426 if (from == stop) goto lose; | |
| 1427 break; | |
| 1428 case Sword: | |
| 1429 case Ssymbol: | |
| 1430 case Squote: | |
| 1431 break; | |
| 1432 default: | |
| 1433 goto done; | |
| 1434 } | |
| 1435 from++; | |
| 1436 } | |
| 1437 goto done; | |
| 1438 | |
| 460 | 1439 case Scomment_fence: |
| 1440 comstyle = ST_COMMENT_STYLE; | |
| 428 | 1441 case Scomment: |
| 1442 if (!parse_sexp_ignore_comments) | |
| 1443 break; | |
| 826 | 1444 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1445 { |
| 665 | 1446 Charbpos newfrom = |
| 460 | 1447 find_end_of_comment (buf, from, stop, comstyle); |
| 428 | 1448 if (newfrom < 0) |
| 1449 { | |
| 1450 /* we stopped because from == stop in search forward */ | |
| 1451 from = stop; | |
| 1452 if (depth == 0) | |
| 1453 goto done; | |
| 1454 goto lose; | |
| 1455 } | |
| 1456 from = newfrom; | |
| 1457 } | |
| 1458 break; | |
| 1459 | |
| 1460 case Smath: | |
| 1461 if (!sexpflag) | |
| 1462 break; | |
| 1463 if (from != stop && c == BUF_FETCH_CHAR (buf, from)) | |
| 1464 from++; | |
| 1465 if (mathexit) | |
| 1466 { | |
| 1467 mathexit = 0; | |
| 1468 goto close1; | |
| 1469 } | |
| 1470 mathexit = 1; | |
| 1471 | |
| 1472 case Sopen: | |
| 1473 if (!++depth) goto done; | |
| 1474 break; | |
| 1475 | |
| 1476 case Sclose: | |
| 1477 close1: | |
| 1478 if (!--depth) goto done; | |
| 1479 if (depth < min_depth) | |
| 1480 { | |
| 444 | 1481 if (noerror) |
| 428 | 1482 return Qnil; |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1483 signal_error_2 (Qscan_error, |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1484 "Containing expression ends prematurely", |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1485 make_int (last_good), make_int (from)); |
| 428 | 1486 } |
| 1487 break; | |
| 1488 | |
| 460 | 1489 case Sstring_fence: |
| 428 | 1490 case Sstring: |
| 1491 { | |
| 867 | 1492 Ichar stringterm; |
| 460 | 1493 |
| 1494 if (code != Sstring_fence) | |
| 1495 { | |
| 826 | 1496 /* XEmacs change: call syntax_match on character */ |
| 867 | 1497 Ichar ch = BUF_FETCH_CHAR (buf, from - 1); |
| 460 | 1498 Lisp_Object stermobj = |
| 1296 | 1499 syntax_match (scache->syntax_table, ch); |
| 428 | 1500 |
| 1501 if (CHARP (stermobj)) | |
| 1502 stringterm = XCHAR (stermobj); | |
| 1503 else | |
| 1504 stringterm = ch; | |
| 460 | 1505 } |
| 1506 else | |
| 1507 stringterm = '\0'; /* avoid compiler warnings */ | |
| 428 | 1508 |
| 1509 while (1) | |
| 1510 { | |
| 1511 if (from >= stop) | |
| 1512 goto lose; | |
| 826 | 1513 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1514 c = BUF_FETCH_CHAR (buf, from); |
| 1515 if (code == Sstring | |
| 1516 ? c == stringterm | |
| 826 | 1517 : SYNTAX_FROM_CACHE (scache, c) == Sstring_fence) |
| 428 | 1518 break; |
| 460 | 1519 |
| 826 | 1520 switch (SYNTAX_FROM_CACHE (scache, c)) |
| 428 | 1521 { |
| 1522 case Scharquote: | |
| 1523 case Sescape: | |
| 1524 from++; | |
| 1525 break; | |
| 1526 default: | |
| 1527 break; | |
| 1528 } | |
| 1529 from++; | |
| 1530 } | |
| 1531 from++; | |
| 1532 if (!depth && sexpflag) goto done; | |
| 1533 break; | |
| 1534 } | |
| 1535 | |
| 1536 default: | |
| 1537 break; | |
| 1538 } | |
| 1539 } | |
| 1540 | |
| 1541 /* Reached end of buffer. Error if within object, | |
| 1542 return nil if between */ | |
| 1543 if (depth) goto lose; | |
| 1544 | |
| 1545 return Qnil; | |
| 1546 | |
| 1547 /* End of object reached */ | |
| 1548 done: | |
| 1549 count--; | |
| 1550 } | |
| 1551 | |
| 1552 while (count < 0) | |
| 1553 { | |
| 1554 QUIT; | |
| 1555 | |
| 1556 stop = BUF_BEGV (buf); | |
| 1557 while (from > stop) | |
| 1558 { | |
| 460 | 1559 int comstyle = 0; /* mask for finding matching comment style */ |
| 428 | 1560 |
| 1561 from--; | |
| 826 | 1562 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 428 | 1563 quoted = char_quoted (buf, from); |
| 1564 if (quoted) | |
| 460 | 1565 { |
| 428 | 1566 from--; |
| 826 | 1567 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 460 | 1568 } |
| 428 | 1569 |
| 1570 c = BUF_FETCH_CHAR (buf, from); | |
| 826 | 1571 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 1572 code = SYNTAX_FROM_CODE (syncode); | |
| 428 | 1573 |
| 1574 if (code == Sendcomment && parse_sexp_ignore_comments) | |
| 1575 { | |
| 1576 /* we have found a single char end comment. we must record | |
| 1577 the comment style encountered so that later, we can match | |
| 1578 only the proper comment begin sequence of the same style */ | |
| 460 | 1579 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) |
| 1580 == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 428 | 1581 } |
| 1582 | |
| 1583 else if (from > stop | |
| 460 | 1584 && SYNTAX_CODE_END_SECOND_P (syncode) |
| 428 | 1585 && !char_quoted (buf, from - 1) |
| 1586 && parse_sexp_ignore_comments) | |
| 1587 { | |
| 460 | 1588 int prev_syncode; |
| 826 | 1589 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 1590 prev_syncode = | |
| 1591 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1)); | |
| 460 | 1592 |
| 1593 if (SYNTAX_CODES_END_P (prev_syncode, syncode)) | |
| 1594 { | |
| 428 | 1595 /* we must record the comment style encountered so that |
| 1596 later, we can match only the proper comment begin | |
| 1597 sequence of the same style */ | |
| 1598 code = Sendcomment; | |
| 460 | 1599 comstyle = SYNTAX_CODES_COMMENT_MASK_END |
| 1600 (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 428 | 1601 from--; |
| 1602 } | |
| 460 | 1603 } |
| 428 | 1604 |
| 460 | 1605 if (SYNTAX_CODE_PREFIX (syncode)) |
| 428 | 1606 continue; |
| 1607 | |
| 434 | 1608 switch (quoted ? Sword : code) |
| 428 | 1609 { |
| 1610 case Sword: | |
| 1611 case Ssymbol: | |
| 1612 if (depth || !sexpflag) break; | |
| 1613 /* This word counts as a sexp; count object finished after | |
| 1614 passing it. */ | |
| 1615 while (from > stop) | |
| 1616 { | |
| 826 | 1617 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 428 | 1618 quoted = char_quoted (buf, from - 1); |
| 1619 | |
| 1620 if (quoted) | |
| 1621 from--; | |
| 1622 if (! (quoted | |
| 1623 || (syncode = | |
| 826 | 1624 SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, |
| 1625 from - 1))) | |
| 428 | 1626 == Sword |
| 1627 || syncode == Ssymbol | |
| 1628 || syncode == Squote)) | |
| 1629 goto done2; | |
| 1630 from--; | |
| 1631 } | |
| 1632 goto done2; | |
| 1633 | |
| 1634 case Smath: | |
| 1635 if (!sexpflag) | |
| 1636 break; | |
| 1637 if (from != stop && c == BUF_FETCH_CHAR (buf, from - 1)) | |
| 1638 from--; | |
| 1639 if (mathexit) | |
| 1640 { | |
| 1641 mathexit = 0; | |
| 1642 goto open2; | |
| 1643 } | |
| 1644 mathexit = 1; | |
| 1645 | |
| 1646 case Sclose: | |
| 1647 if (!++depth) goto done2; | |
| 1648 break; | |
| 1649 | |
| 1650 case Sopen: | |
| 1651 open2: | |
| 1652 if (!--depth) goto done2; | |
| 1653 if (depth < min_depth) | |
| 1654 { | |
| 444 | 1655 if (noerror) |
| 428 | 1656 return Qnil; |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1657 signal_error_2 (Qscan_error, |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1658 "Containing expression ends prematurely", |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1659 make_int (last_good), make_int (from)); |
| 428 | 1660 } |
| 1661 break; | |
| 1662 | |
| 460 | 1663 case Scomment_fence: |
| 1664 comstyle = ST_COMMENT_STYLE; | |
| 428 | 1665 case Sendcomment: |
| 1666 if (parse_sexp_ignore_comments) | |
| 460 | 1667 from = find_start_of_comment (buf, from, stop, comstyle); |
| 428 | 1668 break; |
| 1669 | |
| 460 | 1670 case Sstring_fence: |
| 428 | 1671 case Sstring: |
| 1672 { | |
| 867 | 1673 Ichar stringterm; |
| 460 | 1674 |
| 1675 if (code != Sstring_fence) | |
| 1676 { | |
| 428 | 1677 /* XEmacs change: call syntax_match() on character */ |
| 867 | 1678 Ichar ch = BUF_FETCH_CHAR (buf, from); |
| 460 | 1679 Lisp_Object stermobj = |
| 1296 | 1680 syntax_match (scache->syntax_table, ch); |
| 428 | 1681 |
| 1682 if (CHARP (stermobj)) | |
| 1683 stringterm = XCHAR (stermobj); | |
| 1684 else | |
| 1685 stringterm = ch; | |
| 460 | 1686 } |
| 1687 else | |
| 1688 stringterm = '\0'; /* avoid compiler warnings */ | |
| 428 | 1689 |
| 1690 while (1) | |
| 1691 { | |
| 1692 if (from == stop) goto lose; | |
| 460 | 1693 |
| 826 | 1694 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 460 | 1695 c = BUF_FETCH_CHAR (buf, from - 1); |
| 1696 | |
| 1697 if ((code == Sstring | |
| 1698 ? c == stringterm | |
| 826 | 1699 : SYNTAX_FROM_CACHE (scache, c) == Sstring_fence) |
| 460 | 1700 && !char_quoted (buf, from - 1)) |
| 1701 { | |
| 428 | 1702 break; |
| 460 | 1703 } |
| 1704 | |
| 428 | 1705 from--; |
| 1706 } | |
| 1707 from--; | |
| 1708 if (!depth && sexpflag) goto done2; | |
| 1709 break; | |
| 1710 } | |
| 1711 } | |
| 1712 } | |
| 1713 | |
| 1714 /* Reached start of buffer. Error if within object, | |
| 1715 return nil if between */ | |
| 1716 if (depth) goto lose; | |
| 1717 | |
| 1718 return Qnil; | |
| 1719 | |
| 1720 done2: | |
| 1721 count++; | |
| 1722 } | |
| 1723 | |
| 1724 | |
| 1725 return (make_int (from)); | |
| 1726 | |
| 1727 lose: | |
| 444 | 1728 if (!noerror) |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1729 signal_error_2 (Qscan_error, "Unbalanced parentheses", |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1730 make_int (last_good), make_int (from)); |
| 428 | 1731 return Qnil; |
| 1732 } | |
| 1733 | |
| 1734 int | |
| 665 | 1735 char_quoted (struct buffer *buf, Charbpos pos) |
| 428 | 1736 { |
| 1737 enum syntaxcode code; | |
| 665 | 1738 Charbpos beg = BUF_BEGV (buf); |
| 428 | 1739 int quoted = 0; |
| 665 | 1740 Charbpos startpos = pos; |
| 826 | 1741 struct syntax_cache *scache = buf->syntax_cache; |
| 460 | 1742 |
| 1743 while (pos > beg) | |
| 1744 { | |
| 826 | 1745 UPDATE_SYNTAX_CACHE_BACKWARD (scache, pos - 1); |
| 1746 code = SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, pos - 1)); | |
| 428 | 1747 |
| 460 | 1748 if (code != Scharquote && code != Sescape) |
| 1749 break; | |
| 1750 pos--; | |
| 1751 quoted = !quoted; | |
| 1752 } | |
| 1753 | |
| 826 | 1754 UPDATE_SYNTAX_CACHE (scache, startpos); |
| 428 | 1755 return quoted; |
| 1756 } | |
| 1757 | |
| 1758 DEFUN ("scan-lists", Fscan_lists, 3, 5, 0, /* | |
| 1759 Scan from character number FROM by COUNT lists. | |
| 1760 Returns the character number of the position thus found. | |
| 1761 | |
| 1762 If DEPTH is nonzero, paren depth begins counting from that value, | |
| 1763 only places where the depth in parentheses becomes zero | |
| 1764 are candidates for stopping; COUNT such places are counted. | |
| 1765 Thus, a positive value for DEPTH means go out levels. | |
| 1766 | |
| 1767 Comments are ignored if `parse-sexp-ignore-comments' is non-nil. | |
| 1768 | |
| 1769 If the beginning or end of (the accessible part of) the buffer is reached | |
| 1770 and the depth is wrong, an error is signaled. | |
| 1771 If the depth is right but the count is not used up, nil is returned. | |
| 1772 | |
| 1773 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead | |
| 1774 of in the current buffer. | |
| 1775 | |
| 1776 If optional arg NOERROR is non-nil, scan-lists will return nil instead of | |
| 1777 signalling an error. | |
| 1778 */ | |
| 444 | 1779 (from, count, depth, buffer, noerror)) |
| 428 | 1780 { |
| 1781 struct buffer *buf; | |
| 1782 | |
| 1783 CHECK_INT (from); | |
| 1784 CHECK_INT (count); | |
| 1785 CHECK_INT (depth); | |
| 1786 buf = decode_buffer (buffer, 0); | |
| 1787 | |
| 1788 return scan_lists (buf, XINT (from), XINT (count), XINT (depth), 0, | |
| 444 | 1789 !NILP (noerror)); |
| 428 | 1790 } |
| 1791 | |
| 1792 DEFUN ("scan-sexps", Fscan_sexps, 2, 4, 0, /* | |
| 1793 Scan from character number FROM by COUNT balanced expressions. | |
| 1794 If COUNT is negative, scan backwards. | |
| 1795 Returns the character number of the position thus found. | |
| 1796 | |
| 1797 Comments are ignored if `parse-sexp-ignore-comments' is non-nil. | |
| 1798 | |
| 1799 If the beginning or end of (the accessible part of) the buffer is reached | |
| 1800 in the middle of a parenthetical grouping, an error is signaled. | |
| 1801 If the beginning or end is reached between groupings | |
| 1802 but before count is used up, nil is returned. | |
| 1803 | |
| 1804 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead | |
| 1805 of in the current buffer. | |
| 1806 | |
| 1807 If optional arg NOERROR is non-nil, scan-sexps will return nil instead of | |
| 1808 signalling an error. | |
| 1809 */ | |
| 444 | 1810 (from, count, buffer, noerror)) |
| 428 | 1811 { |
| 1812 struct buffer *buf = decode_buffer (buffer, 0); | |
| 1813 CHECK_INT (from); | |
| 1814 CHECK_INT (count); | |
| 1815 | |
| 444 | 1816 return scan_lists (buf, XINT (from), XINT (count), 0, 1, !NILP (noerror)); |
| 428 | 1817 } |
| 1818 | |
| 1819 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, 0, 1, 0, /* | |
| 1820 Move point backward over any number of chars with prefix syntax. | |
| 1821 This includes chars with "quote" or "prefix" syntax (' or p). | |
| 1822 | |
| 1823 Optional arg BUFFER defaults to the current buffer. | |
| 1824 */ | |
| 1825 (buffer)) | |
| 1826 { | |
| 1827 struct buffer *buf = decode_buffer (buffer, 0); | |
| 665 | 1828 Charbpos beg = BUF_BEGV (buf); |
| 1829 Charbpos pos = BUF_PT (buf); | |
| 867 | 1830 Ichar c = '\0'; /* initialize to avoid compiler warnings */ |
| 826 | 1831 struct syntax_cache *scache; |
| 1832 | |
| 1833 scache = setup_buffer_syntax_cache (buf, pos, -1); | |
| 428 | 1834 |
| 1835 while (pos > beg && !char_quoted (buf, pos - 1) | |
| 460 | 1836 /* Previous statement updates syntax table. */ |
| 826 | 1837 && (SYNTAX_FROM_CACHE (scache, c = BUF_FETCH_CHAR (buf, pos - 1)) == Squote |
| 1838 || SYNTAX_CODE_PREFIX (SYNTAX_CODE_FROM_CACHE (scache, c)))) | |
| 428 | 1839 pos--; |
| 1840 | |
| 1841 BUF_SET_PT (buf, pos); | |
| 1842 | |
| 1843 return Qnil; | |
| 1844 } | |
| 1845 | |
| 1846 /* Parse forward from FROM to END, | |
| 1847 assuming that FROM has state OLDSTATE (nil means FROM is start of function), | |
| 1848 and return a description of the state of the parse at END. | |
| 1849 If STOPBEFORE is nonzero, stop at the start of an atom. | |
| 1850 If COMMENTSTOP is nonzero, stop at the start of a comment. */ | |
| 1851 | |
| 1852 static void | |
| 1853 scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr, | |
| 665 | 1854 Charbpos from, Charbpos end, |
| 428 | 1855 int targetdepth, int stopbefore, |
| 1856 Lisp_Object oldstate, | |
| 1857 int commentstop) | |
| 1858 { | |
| 1859 struct lisp_parse_state state; | |
| 1860 | |
| 1861 enum syntaxcode code; | |
| 1862 struct level { int last, prev; }; | |
| 1863 struct level levelstart[100]; | |
| 1864 struct level *curlevel = levelstart; | |
| 1865 struct level *endlevel = levelstart + 100; | |
| 1866 int depth; /* Paren depth of current scanning location. | |
| 1867 level - levelstart equals this except | |
| 1868 when the depth becomes negative. */ | |
| 1869 int mindepth; /* Lowest DEPTH value seen. */ | |
| 1870 int start_quoted = 0; /* Nonzero means starting after a char quote */ | |
| 460 | 1871 int boundary_stop = commentstop == -1; |
| 428 | 1872 Lisp_Object tem; |
| 826 | 1873 struct syntax_cache *scache; |
| 1874 | |
| 1875 scache = setup_buffer_syntax_cache (buf, from, 1); | |
| 428 | 1876 if (NILP (oldstate)) |
| 1877 { | |
| 1878 depth = 0; | |
| 1879 state.instring = -1; | |
| 1880 state.incomment = 0; | |
| 1881 state.comstyle = 0; /* comment style a by default */ | |
| 460 | 1882 state.comstr_start = -1; /* no comment/string seen. */ |
| 428 | 1883 } |
| 1884 else | |
| 1885 { | |
| 1886 tem = Fcar (oldstate); /* elt 0, depth */ | |
| 1887 if (!NILP (tem)) | |
| 1888 depth = XINT (tem); | |
| 1889 else | |
| 1890 depth = 0; | |
| 1891 | |
| 1892 oldstate = Fcdr (oldstate); | |
| 1893 oldstate = Fcdr (oldstate); | |
| 1894 oldstate = Fcdr (oldstate); | |
| 1895 tem = Fcar (oldstate); /* elt 3, instring */ | |
| 460 | 1896 state.instring = ( !NILP (tem) |
| 1897 ? ( INTP (tem) ? XINT (tem) : ST_STRING_STYLE) | |
| 1898 : -1); | |
| 428 | 1899 |
| 460 | 1900 oldstate = Fcdr (oldstate); |
| 1901 tem = Fcar (oldstate); /* elt 4, incomment */ | |
| 428 | 1902 state.incomment = !NILP (tem); |
| 1903 | |
| 1904 oldstate = Fcdr (oldstate); | |
| 1905 tem = Fcar (oldstate); /* elt 5, follows-quote */ | |
| 1906 start_quoted = !NILP (tem); | |
| 1907 | |
| 1908 /* if the eighth element of the list is nil, we are in comment style | |
| 3025 | 1909 a; if it is t, we are in comment style b; if it is `syntax-table', |
| 460 | 1910 we are in a generic comment */ |
| 428 | 1911 oldstate = Fcdr (oldstate); |
| 1912 oldstate = Fcdr (oldstate); | |
| 460 | 1913 tem = Fcar (oldstate); /* elt 7, comment style a/b/fence */ |
| 1914 state.comstyle = NILP (tem) ? 0 : ( EQ (tem, Qsyntax_table) | |
| 1915 ? ST_COMMENT_STYLE : 1 ); | |
| 1916 | |
| 1917 oldstate = Fcdr (oldstate); /* elt 8, start of last comment/string */ | |
| 1918 tem = Fcar (oldstate); | |
| 1919 state.comstr_start = NILP (tem) ? -1 : XINT (tem); | |
| 1920 | |
| 1921 /* elt 9, char numbers of starts-of-expression of levels | |
| 1922 (starting from outermost). */ | |
| 1923 oldstate = Fcdr (oldstate); | |
| 1924 tem = Fcar (oldstate); /* elt 9, intermediate data for | |
| 1925 continuation of parsing (subject | |
| 1926 to change). */ | |
| 1927 while (!NILP (tem)) /* >= second enclosing sexps. */ | |
| 1928 { | |
| 1929 curlevel->last = XINT (Fcar (tem)); | |
| 1930 if (++curlevel == endlevel) | |
| 826 | 1931 stack_overflow ("Nesting too deep for parser", |
| 1932 make_int (curlevel - levelstart)); | |
| 460 | 1933 curlevel->prev = -1; |
| 1934 curlevel->last = -1; | |
| 1935 tem = Fcdr (tem); | |
| 1936 } | |
| 428 | 1937 } |
| 1938 state.quoted = 0; | |
| 1939 mindepth = depth; | |
| 1940 | |
| 1941 curlevel->prev = -1; | |
| 1942 curlevel->last = -1; | |
| 1943 | |
| 1944 /* Enter the loop at a place appropriate for initial state. */ | |
| 1945 | |
| 1946 if (state.incomment) goto startincomment; | |
| 1947 if (state.instring >= 0) | |
| 1948 { | |
| 1949 if (start_quoted) goto startquotedinstring; | |
| 1950 goto startinstring; | |
| 1951 } | |
| 1952 if (start_quoted) goto startquoted; | |
| 1953 | |
| 1954 while (from < end) | |
| 1955 { | |
| 867 | 1956 Ichar c; |
| 460 | 1957 int syncode; |
| 1958 | |
| 428 | 1959 QUIT; |
| 1960 | |
| 826 | 1961 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1962 c = BUF_FETCH_CHAR (buf, from); |
| 826 | 1963 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 1964 code = SYNTAX_FROM_CODE (syncode); | |
| 428 | 1965 from++; |
| 1966 | |
| 1967 /* record the comment style we have entered so that only the | |
| 1968 comment-ender sequence (or single char) of the same style | |
| 1969 actually terminates the comment section. */ | |
| 460 | 1970 if (code == Scomment) |
| 1971 { | |
| 1972 state.comstyle = | |
| 1973 SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) | |
| 1974 == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 1975 state.comstr_start = from - 1; | |
| 1976 } | |
| 1977 | |
| 1978 /* a generic comment delimiter? */ | |
| 1979 else if (code == Scomment_fence) | |
| 1980 { | |
| 1981 state.comstyle = ST_COMMENT_STYLE; | |
| 1982 state.comstr_start = from - 1; | |
| 1983 code = Scomment; | |
| 428 | 1984 } |
| 1985 | |
| 1986 else if (from < end && | |
| 460 | 1987 SYNTAX_CODE_START_FIRST_P (syncode)) |
| 428 | 1988 { |
| 460 | 1989 int next_syncode; |
| 826 | 1990 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1991 next_syncode = |
| 826 | 1992 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)); |
| 460 | 1993 |
| 1994 if (SYNTAX_CODES_START_P (syncode, next_syncode)) | |
| 1995 { | |
| 428 | 1996 code = Scomment; |
| 460 | 1997 state.comstyle = SYNTAX_CODES_COMMENT_MASK_START |
| 1998 (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 1999 state.comstr_start = from - 1; | |
| 428 | 2000 from++; |
| 826 | 2001 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 2002 } |
| 428 | 2003 } |
| 2004 | |
| 460 | 2005 if (SYNTAX_CODE_PREFIX (syncode)) |
| 428 | 2006 continue; |
| 2007 switch (code) | |
| 2008 { | |
| 2009 case Sescape: | |
| 2010 case Scharquote: | |
| 2011 if (stopbefore) goto stop; /* this arg means stop at sexp start */ | |
| 2012 curlevel->last = from - 1; | |
| 2013 startquoted: | |
| 2014 if (from == end) goto endquoted; | |
| 2015 from++; | |
| 2016 goto symstarted; | |
| 2017 /* treat following character as a word constituent */ | |
| 2018 case Sword: | |
| 2019 case Ssymbol: | |
| 2020 if (stopbefore) goto stop; /* this arg means stop at sexp start */ | |
| 2021 curlevel->last = from - 1; | |
| 2022 symstarted: | |
| 2023 while (from < end) | |
| 2024 { | |
| 826 | 2025 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 2026 switch (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from))) | |
| 428 | 2027 { |
| 2028 case Scharquote: | |
| 2029 case Sescape: | |
| 2030 from++; | |
| 2031 if (from == end) goto endquoted; | |
| 2032 break; | |
| 2033 case Sword: | |
| 2034 case Ssymbol: | |
| 2035 case Squote: | |
| 2036 break; | |
| 2037 default: | |
| 2038 goto symdone; | |
| 2039 } | |
| 2040 from++; | |
| 2041 } | |
| 2042 symdone: | |
| 2043 curlevel->prev = curlevel->last; | |
| 2044 break; | |
| 2045 | |
| 2046 case Scomment: | |
| 2047 state.incomment = 1; | |
| 460 | 2048 if (commentstop || boundary_stop) goto done; |
| 428 | 2049 startincomment: |
| 460 | 2050 if (commentstop == 1) |
| 428 | 2051 goto done; |
| 826 | 2052 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 2053 { |
| 826 | 2054 Charbpos newfrom = find_end_of_comment (buf, from, end, |
| 2055 state.comstyle); | |
| 428 | 2056 if (newfrom < 0) |
| 2057 { | |
| 2058 /* we terminated search because from == end */ | |
| 2059 from = end; | |
| 2060 goto done; | |
| 2061 } | |
| 2062 from = newfrom; | |
| 2063 } | |
| 2064 state.incomment = 0; | |
| 2065 state.comstyle = 0; /* reset the comment style */ | |
| 460 | 2066 if (boundary_stop) goto done; |
| 428 | 2067 break; |
| 2068 | |
| 2069 case Sopen: | |
| 2070 if (stopbefore) goto stop; /* this arg means stop at sexp start */ | |
| 2071 depth++; | |
| 2072 curlevel->last = from - 1; | |
| 2073 if (++curlevel == endlevel) | |
| 826 | 2074 stack_overflow ("Nesting too deep for parser", |
| 2075 make_int (curlevel - levelstart)); | |
| 428 | 2076 curlevel->prev = -1; |
| 2077 curlevel->last = -1; | |
| 2078 if (targetdepth == depth) goto done; | |
| 2079 break; | |
| 2080 | |
| 2081 case Sclose: | |
| 2082 depth--; | |
| 2083 if (depth < mindepth) | |
| 2084 mindepth = depth; | |
| 2085 if (curlevel != levelstart) | |
| 2086 curlevel--; | |
| 2087 curlevel->prev = curlevel->last; | |
| 2088 if (targetdepth == depth) goto done; | |
| 2089 break; | |
| 2090 | |
| 2091 case Sstring: | |
| 460 | 2092 case Sstring_fence: |
| 2093 state.comstr_start = from - 1; | |
| 428 | 2094 if (stopbefore) goto stop; /* this arg means stop at sexp start */ |
| 2095 curlevel->last = from - 1; | |
| 460 | 2096 if (code == Sstring_fence) |
| 428 | 2097 { |
| 460 | 2098 state.instring = ST_STRING_STYLE; |
| 2099 } | |
| 2100 else | |
| 2101 { | |
| 2102 /* XEmacs change: call syntax_match() on character */ | |
| 867 | 2103 Ichar ch = BUF_FETCH_CHAR (buf, from - 1); |
| 460 | 2104 Lisp_Object stermobj = |
| 1296 | 2105 syntax_match (scache->syntax_table, ch); |
| 428 | 2106 |
| 2107 if (CHARP (stermobj)) | |
| 2108 state.instring = XCHAR (stermobj); | |
| 2109 else | |
| 2110 state.instring = ch; | |
| 2111 } | |
| 460 | 2112 if (boundary_stop) goto done; |
| 428 | 2113 startinstring: |
| 2114 while (1) | |
| 2115 { | |
| 460 | 2116 enum syntaxcode temp_code; |
| 2117 | |
| 428 | 2118 if (from >= end) goto done; |
| 460 | 2119 |
| 826 | 2120 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 2121 c = BUF_FETCH_CHAR (buf, from); |
| 826 | 2122 temp_code = SYNTAX_FROM_CACHE (scache, c); |
| 460 | 2123 |
| 2124 if ( | |
| 2125 state.instring != ST_STRING_STYLE && | |
| 2126 temp_code == Sstring && | |
| 2127 c == state.instring) break; | |
| 2128 | |
| 2129 switch (temp_code) | |
| 428 | 2130 { |
| 460 | 2131 case Sstring_fence: |
| 2132 if (state.instring == ST_STRING_STYLE) | |
| 2133 goto string_end; | |
| 2134 break; | |
| 428 | 2135 case Scharquote: |
| 2136 case Sescape: | |
| 2137 { | |
| 2138 from++; | |
| 2139 startquotedinstring: | |
| 2140 if (from >= end) goto endquoted; | |
| 2141 break; | |
| 2142 } | |
| 2143 default: | |
| 2144 break; | |
| 2145 } | |
| 2146 from++; | |
| 2147 } | |
| 460 | 2148 string_end: |
| 428 | 2149 state.instring = -1; |
| 2150 curlevel->prev = curlevel->last; | |
| 2151 from++; | |
| 460 | 2152 if (boundary_stop) goto done; |
| 428 | 2153 break; |
| 2154 | |
| 2155 case Smath: | |
| 2156 break; | |
| 2157 | |
| 2158 case Swhitespace: | |
| 2159 case Spunct: | |
| 2160 case Squote: | |
| 2161 case Sendcomment: | |
| 460 | 2162 case Scomment_fence: |
| 428 | 2163 case Sinherit: |
| 2164 case Smax: | |
| 2165 break; | |
| 2166 } | |
| 2167 } | |
| 2168 goto done; | |
| 2169 | |
| 2170 stop: /* Here if stopping before start of sexp. */ | |
| 2171 from--; /* We have just fetched the char that starts it; */ | |
| 2172 goto done; /* but return the position before it. */ | |
| 2173 | |
| 2174 endquoted: | |
| 2175 state.quoted = 1; | |
| 2176 done: | |
| 2177 state.depth = depth; | |
| 2178 state.mindepth = mindepth; | |
| 2179 state.thislevelstart = curlevel->prev; | |
| 2180 state.prevlevelstart | |
| 2181 = (curlevel == levelstart) ? -1 : (curlevel - 1)->last; | |
| 2182 state.location = from; | |
| 460 | 2183 state.levelstarts = Qnil; |
| 2184 while (--curlevel >= levelstart) | |
| 2185 state.levelstarts = Fcons (make_int (curlevel->last), | |
| 2186 state.levelstarts); | |
| 428 | 2187 |
| 2188 *stateptr = state; | |
| 2189 } | |
| 2190 | |
| 2191 DEFUN ("parse-partial-sexp", Fparse_partial_sexp, 2, 7, 0, /* | |
| 2192 Parse Lisp syntax starting at FROM until TO; return status of parse at TO. | |
| 2193 Parsing stops at TO or when certain criteria are met; | |
| 2194 point is set to where parsing stops. | |
| 444 | 2195 If fifth arg OLDSTATE is omitted or nil, |
| 428 | 2196 parsing assumes that FROM is the beginning of a function. |
| 460 | 2197 Value is a list of nine elements describing final state of parsing: |
| 428 | 2198 0. depth in parens. |
| 2199 1. character address of start of innermost containing list; nil if none. | |
| 2200 2. character address of start of last complete sexp terminated. | |
| 2201 3. non-nil if inside a string. | |
| 460 | 2202 (It is the character that will terminate the string, |
| 2203 or t if the string should be terminated by an explicit | |
| 2204 `syntax-table' property.) | |
| 428 | 2205 4. t if inside a comment. |
| 2206 5. t if following a quote character. | |
| 2207 6. the minimum paren-depth encountered during this scan. | |
| 460 | 2208 7. nil if in comment style a, or not in a comment; t if in comment style b; |
| 2209 `syntax-table' if given by an explicit `syntax-table' property. | |
| 2210 8. character address of start of last comment or string; nil if none. | |
| 2211 9. Intermediate data for continuation of parsing (subject to change). | |
| 428 | 2212 If third arg TARGETDEPTH is non-nil, parsing stops if the depth |
| 2213 in parentheses becomes equal to TARGETDEPTH. | |
| 2214 Fourth arg STOPBEFORE non-nil means stop when come to | |
| 2215 any character that starts a sexp. | |
| 460 | 2216 Fifth arg OLDSTATE is a nine-element list like what this function returns. |
| 428 | 2217 It is used to initialize the state of the parse. Its second and third |
| 2218 elements are ignored. | |
| 460 | 2219 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. If it |
| 2220 is `syntax-table', stop after the start of a comment or a string, or after | |
| 2221 the end of a comment or string. | |
| 826 | 2222 Seventh arg BUFFER specifies the buffer to do the parsing in, and defaults |
| 2223 to the current buffer. | |
| 428 | 2224 */ |
| 2225 (from, to, targetdepth, stopbefore, oldstate, commentstop, buffer)) | |
| 2226 { | |
| 2227 struct lisp_parse_state state; | |
| 2228 int target; | |
| 665 | 2229 Charbpos start, end; |
| 428 | 2230 struct buffer *buf = decode_buffer (buffer, 0); |
| 2231 Lisp_Object val; | |
| 2232 | |
| 2233 if (!NILP (targetdepth)) | |
| 2234 { | |
| 2235 CHECK_INT (targetdepth); | |
| 2236 target = XINT (targetdepth); | |
| 2237 } | |
| 2238 else | |
| 2239 target = -100000; /* We won't reach this depth */ | |
| 2240 | |
| 2241 get_buffer_range_char (buf, from, to, &start, &end, 0); | |
| 2242 scan_sexps_forward (buf, &state, start, end, | |
| 2243 target, !NILP (stopbefore), oldstate, | |
| 460 | 2244 (NILP (commentstop) |
| 2245 ? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1))); | |
| 428 | 2246 BUF_SET_PT (buf, state.location); |
| 2247 | |
| 2248 /* reverse order */ | |
| 2249 val = Qnil; | |
| 460 | 2250 val = Fcons (state.levelstarts, val); |
| 2251 val = Fcons ((state.incomment || (state.instring >= 0)) | |
| 2252 ? make_int (state.comstr_start) : Qnil, val); | |
| 2253 val = Fcons (state.comstyle ? (state.comstyle == ST_COMMENT_STYLE | |
| 2254 ? Qsyntax_table : Qt) : Qnil, val); | |
| 428 | 2255 val = Fcons (make_int (state.mindepth), val); |
| 2256 val = Fcons (state.quoted ? Qt : Qnil, val); | |
| 2257 val = Fcons (state.incomment ? Qt : Qnil, val); | |
| 460 | 2258 val = Fcons (state.instring < 0 |
| 2259 ? Qnil | |
| 2260 : (state.instring == ST_STRING_STYLE | |
| 2261 ? Qt : make_int (state.instring)), val); | |
| 826 | 2262 val = Fcons (state.thislevelstart < 0 ? Qnil : |
| 2263 make_int (state.thislevelstart), val); | |
| 2264 val = Fcons (state.prevlevelstart < 0 ? Qnil : | |
| 2265 make_int (state.prevlevelstart), val); | |
| 428 | 2266 val = Fcons (make_int (state.depth), val); |
| 2267 | |
| 2268 return val; | |
| 2269 } | |
| 2270 | |
| 2271 | |
| 2272 /* Updating of the mirror syntax table. | |
| 2273 | |
| 1296 | 2274 Each syntax table has a corresponding mirror table in it. Whenever we |
| 2275 make a change to a syntax table, we set a dirty flag. When accessing a | |
| 2276 value from the mirror table and the table is dirty, we call | |
| 2277 update_syntax_table() to clean it up. | |
| 428 | 2278 |
| 2279 #### We really only need to map over the changed range. | |
| 2280 | |
| 2281 If we change the standard syntax table, we need to map over | |
| 2282 all tables because any of them could be inheriting from the | |
| 2283 standard syntax table. | |
| 2284 | |
| 2285 When `set-syntax-table' is called, we set the buffer's mirror | |
| 2286 syntax table as well. | |
| 2287 */ | |
| 2288 | |
| 826 | 2289 static int |
| 2286 | 2290 copy_to_mirrortab (struct chartab_range *range, Lisp_Object UNUSED (table), |
| 826 | 2291 Lisp_Object val, void *arg) |
| 428 | 2292 { |
| 5013 | 2293 Lisp_Object mirrortab = GET_LISP_FROM_VOID (arg); |
| 428 | 2294 |
| 2295 if (CONSP (val)) | |
| 2296 val = XCAR (val); | |
| 826 | 2297 if (SYNTAX_FROM_CODE (XINT (val)) != Sinherit) |
| 2298 put_char_table (mirrortab, range, val); | |
| 2299 return 0; | |
| 2300 } | |
| 2301 | |
| 2302 static int | |
| 2286 | 2303 copy_if_not_already_present (struct chartab_range *range, |
| 2304 Lisp_Object UNUSED (table), | |
| 826 | 2305 Lisp_Object val, void *arg) |
| 2306 { | |
| 5013 | 2307 Lisp_Object mirrortab = GET_LISP_FROM_VOID (arg); |
| 826 | 2308 if (CONSP (val)) |
| 2309 val = XCAR (val); | |
| 2310 if (SYNTAX_FROM_CODE (XINT (val)) != Sinherit) | |
| 2311 { | |
| 2312 Lisp_Object existing = | |
| 1296 | 2313 updating_mirror_get_range_char_table (range, mirrortab, |
| 2314 Vbogus_syntax_table_value); | |
| 826 | 2315 if (NILP (existing)) |
| 2316 /* nothing at all */ | |
| 1296 | 2317 put_char_table (mirrortab, range, val); |
| 2318 else if (!EQ (existing, Vbogus_syntax_table_value)) | |
| 826 | 2319 /* full */ |
| 2320 ; | |
| 2321 else | |
| 2322 { | |
| 2323 Freset_char_table (Vtemp_table_for_use_updating_syntax_tables); | |
| 2324 copy_char_table_range | |
| 1296 | 2325 (mirrortab, Vtemp_table_for_use_updating_syntax_tables, range); |
| 2326 put_char_table (mirrortab, range, val); | |
| 826 | 2327 copy_char_table_range |
| 1296 | 2328 (Vtemp_table_for_use_updating_syntax_tables, mirrortab, range); |
| 826 | 2329 } |
| 428 | 2330 } |
| 826 | 2331 |
| 428 | 2332 return 0; |
| 2333 } | |
| 2334 | |
| 2335 static void | |
| 826 | 2336 update_just_this_syntax_table (Lisp_Object table) |
| 428 | 2337 { |
| 2338 struct chartab_range range; | |
| 826 | 2339 Lisp_Object mirrortab = XCHAR_TABLE (table)->mirror_table; |
| 2340 | |
| 1296 | 2341 assert (!XCHAR_TABLE (table)->mirror_table_p); |
| 826 | 2342 range.type = CHARTAB_RANGE_ALL; |
| 2343 Freset_char_table (mirrortab); | |
| 1296 | 2344 |
| 826 | 2345 /* First, copy the tables values other than inherit into the mirror |
| 2346 table. Then, for tables other than the standard syntax table, map | |
| 2347 over the standard table, copying values into the mirror table only if | |
| 2348 entries don't already exist in that table. (The copying step requires | |
| 2349 another mapping.) | |
| 2350 */ | |
| 428 | 2351 |
| 5013 | 2352 map_char_table (table, &range, copy_to_mirrortab, STORE_LISP_IN_VOID (mirrortab)); |
| 826 | 2353 /* second clause catches bootstrapping problems when initializing the |
| 2354 standard syntax table */ | |
| 2355 if (!EQ (table, Vstandard_syntax_table) && !NILP (Vstandard_syntax_table)) | |
| 1296 | 2356 map_char_table (Vstandard_syntax_table, &range, |
| 5013 | 2357 copy_if_not_already_present, STORE_LISP_IN_VOID (mirrortab)); |
| 3152 | 2358 /* The resetting made the default be Qnil. Put it back to Sword. */ |
| 2359 set_char_table_default (mirrortab, make_int (Sword)); | |
| 1296 | 2360 XCHAR_TABLE (mirrortab)->dirty = 0; |
| 428 | 2361 } |
| 2362 | |
| 2363 /* Called from chartab.c when a change is made to a syntax table. | |
| 2364 If this is the standard syntax table, we need to recompute | |
| 2365 *all* syntax tables (yuck). Otherwise we just recompute this | |
| 2366 one. */ | |
| 2367 | |
| 2368 void | |
| 826 | 2369 update_syntax_table (Lisp_Object table) |
| 428 | 2370 { |
| 1296 | 2371 Lisp_Object nonmirror = XCHAR_TABLE (table)->mirror_table; |
| 2372 assert (XCHAR_TABLE (table)->mirror_table_p); | |
| 2373 if (EQ (nonmirror, Vstandard_syntax_table)) | |
| 428 | 2374 { |
| 2375 Lisp_Object syntab; | |
| 2376 | |
| 2377 for (syntab = Vall_syntax_tables; !NILP (syntab); | |
| 2378 syntab = XCHAR_TABLE (syntab)->next_table) | |
| 826 | 2379 update_just_this_syntax_table (syntab); |
| 428 | 2380 } |
| 2381 else | |
| 1296 | 2382 update_just_this_syntax_table (nonmirror); |
| 428 | 2383 } |
| 2384 | |
| 2385 | |
| 2386 /************************************************************************/ | |
| 2387 /* initialization */ | |
| 2388 /************************************************************************/ | |
| 2389 | |
| 2390 void | |
| 2391 syms_of_syntax (void) | |
| 2392 { | |
| 3092 | 2393 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
2394 INIT_LISP_OBJECT (syntax_cache); |
| 3092 | 2395 #endif /* NEW_GC */ |
| 563 | 2396 DEFSYMBOL (Qsyntax_table_p); |
| 2397 DEFSYMBOL (Qsyntax_table); | |
| 428 | 2398 |
| 2399 DEFSUBR (Fsyntax_table_p); | |
| 2400 DEFSUBR (Fsyntax_table); | |
| 826 | 2401 #ifdef DEBUG_XEMACS |
| 2402 DEFSUBR (Fmirror_syntax_table); | |
| 2403 DEFSUBR (Fsyntax_cache_info); | |
| 2404 #endif /* DEBUG_XEMACS */ | |
| 428 | 2405 DEFSUBR (Fstandard_syntax_table); |
| 2406 DEFSUBR (Fcopy_syntax_table); | |
| 2407 DEFSUBR (Fset_syntax_table); | |
| 2408 DEFSUBR (Fsyntax_designator_chars); | |
| 2409 DEFSUBR (Fchar_syntax); | |
| 2410 DEFSUBR (Fmatching_paren); | |
| 2411 /* DEFSUBR (Fmodify_syntax_entry); now in Lisp. */ | |
| 2412 /* DEFSUBR (Fdescribe_syntax); now in Lisp. */ | |
| 2413 | |
| 2414 DEFSUBR (Fforward_word); | |
| 2415 | |
| 2416 DEFSUBR (Fforward_comment); | |
| 2417 DEFSUBR (Fscan_lists); | |
| 2418 DEFSUBR (Fscan_sexps); | |
| 2419 DEFSUBR (Fbackward_prefix_chars); | |
| 2420 DEFSUBR (Fparse_partial_sexp); | |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
2421 |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
2422 DEFERROR_STANDARD (Qscan_error, Qsyntax_error); |
| 428 | 2423 } |
| 2424 | |
| 2425 void | |
| 2426 vars_of_syntax (void) | |
| 2427 { | |
| 2428 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments /* | |
| 2429 Non-nil means `forward-sexp', etc., should treat comments as whitespace. | |
| 2430 */ ); | |
| 434 | 2431 parse_sexp_ignore_comments = 0; |
| 428 | 2432 |
| 460 | 2433 DEFVAR_BOOL ("lookup-syntax-properties", &lookup_syntax_properties /* |
| 826 | 2434 Non-nil means `forward-sexp', etc., respect the `syntax-table' property. |
| 2435 This property can be placed on buffers or strings and can be used to explicitly | |
| 2436 specify the syntax table to be used for looking up the syntax of the chars | |
| 2437 having this property, or to directly specify the syntax of the chars. | |
| 2438 | |
| 460 | 2439 The value of this property should be either a syntax table, or a cons |
| 2440 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric | |
| 2441 syntax code, MATCHCHAR being nil or the character to match (which is | |
| 826 | 2442 relevant only when the syntax code is open/close-type). |
| 460 | 2443 */ ); |
| 2444 lookup_syntax_properties = 1; | |
| 2445 | |
| 428 | 2446 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes /* |
| 2447 Non-nil means `forward-word', etc., should treat escape chars part of words. | |
| 2448 */ ); | |
| 434 | 2449 words_include_escapes = 0; |
| 428 | 2450 |
| 2451 no_quit_in_re_search = 0; | |
| 1296 | 2452 |
| 2453 Vbogus_syntax_table_value = make_float (0.0); | |
| 2454 staticpro (&Vbogus_syntax_table_value); | |
| 428 | 2455 } |
| 2456 | |
| 2457 static void | |
| 3540 | 2458 define_standard_syntax (const UExtbyte *p, enum syntaxcode syn) |
| 428 | 2459 { |
| 2460 for (; *p; p++) | |
| 2461 Fput_char_table (make_char (*p), make_int (syn), Vstandard_syntax_table); | |
| 2462 } | |
| 2463 | |
| 2464 void | |
| 2465 complex_vars_of_syntax (void) | |
| 2466 { | |
| 867 | 2467 Ichar i; |
| 3540 | 2468 const UExtbyte *p; /* Latin-1, not internal format. */ |
| 2469 | |
| 2470 #define SET_RANGE_SYNTAX(start, end, syntax) \ | |
| 2471 do { \ | |
| 2472 for (i = start; i <= end; i++) \ | |
| 2473 Fput_char_table(make_char(i), make_int(syntax), \ | |
| 2474 Vstandard_syntax_table); \ | |
| 2475 } while (0) | |
| 2476 | |
| 2477 /* Set this now, so first buffer creation can refer to it. | |
| 2478 | |
| 2479 Make it nil before calling copy-syntax-table so that copy-syntax-table | |
| 2480 will know not to try to copy from garbage */ | |
| 428 | 2481 Vstandard_syntax_table = Qnil; |
| 2482 Vstandard_syntax_table = Fcopy_syntax_table (Qnil); | |
| 2483 staticpro (&Vstandard_syntax_table); | |
| 2484 | |
| 826 | 2485 Vtemp_table_for_use_updating_syntax_tables = Fmake_char_table (Qgeneric); |
| 2486 staticpro (&Vtemp_table_for_use_updating_syntax_tables); | |
| 2487 | |
| 428 | 2488 Vsyntax_designator_chars_string = make_string_nocopy (syntax_code_spec, |
| 2489 Smax); | |
| 2490 staticpro (&Vsyntax_designator_chars_string); | |
| 2491 | |
| 3540 | 2492 /* Default character syntax is word. */ |
| 3152 | 2493 set_char_table_default (Vstandard_syntax_table, make_int (Sword)); |
| 428 | 2494 |
| 3540 | 2495 /* Control 0; treat as punctuation */ |
| 2496 SET_RANGE_SYNTAX(0, 32, Spunct); | |
| 428 | 2497 |
| 3544 | 2498 /* The whitespace--overwriting some of the above changes. |
| 2499 | |
| 2500 String literals are const char *s, not const unsigned char *s. */ | |
|
4653
25e5e5346d31
?\012 is whitespace, as it always should have been, thank you Karl Kleinpaste.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2501 define_standard_syntax((const UExtbyte *)" \t\015\014\012", Swhitespace); |
| 3540 | 2502 |
| 2503 /* DEL plus Control 1 */ | |
| 2504 SET_RANGE_SYNTAX(127, 159, Spunct); | |
| 2505 | |
| 3544 | 2506 define_standard_syntax ((const UExtbyte *)"\"", Sstring); |
| 2507 define_standard_syntax ((const UExtbyte *)"\\", Sescape); | |
| 2508 define_standard_syntax ((const UExtbyte *)"_-+*/&|<>=", Ssymbol); | |
| 2509 define_standard_syntax ((const UExtbyte *)".,;:?!#@~^'`", Spunct); | |
| 428 | 2510 |
| 3544 | 2511 for (p = (const UExtbyte *)"()[]{}"; *p; p+=2) |
| 428 | 2512 { |
| 2513 Fput_char_table (make_char (p[0]), | |
| 2514 Fcons (make_int (Sopen), make_char (p[1])), | |
| 2515 Vstandard_syntax_table); | |
| 2516 Fput_char_table (make_char (p[1]), | |
| 2517 Fcons (make_int (Sclose), make_char (p[0])), | |
| 2518 Vstandard_syntax_table); | |
| 2519 } | |
| 3540 | 2520 |
| 2521 /* Latin 1 "symbols." This contrasts with the FSF, where they're word | |
| 2522 constituents. */ | |
| 2523 SET_RANGE_SYNTAX(0240, 0277, Ssymbol); | |
| 2524 | |
| 2525 /* The guillemets. These are not parentheses, in contrast to what the old | |
| 2526 code did. */ | |
| 3569 | 2527 define_standard_syntax((const UExtbyte *)"\253\273", Spunct); |
| 3540 | 2528 |
| 2529 /* The inverted exclamation mark, and the multiplication and division | |
| 2530 signs. */ | |
| 3544 | 2531 define_standard_syntax((const UExtbyte *)"\241\327\367", Spunct); |
| 3540 | 2532 |
| 2533 #undef SET_RANGE_SYNTAX | |
| 428 | 2534 } |