Mercurial > hg > xemacs-beta
annotate src/syntax.c @ 4792:95b04754ea8c
Make #'equalp more compatible with CL; add a compiler macro, test & doc it.
lisp/ChangeLog addition:
2009-11-08 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (cl-string-vector-equalp)
(cl-bit-vector-vector-equalp, cl-vector-array-equalp)
(cl-hash-table-contents-equalp): New functions, to implement
equalp treating arrays with identical contents as equivalent, as
specified by Common Lisp.
(equalp): Revise this function to implement array equivalence,
and the hash-table equalp behaviour specified by CL.
* cl-macs.el (equalp): Add a compiler macro for this function,
used when one of the arguments is constant, and as such, its type
is known at compile time.
man/ChangeLog addition:
2009-11-08 Aidan Kehoe <kehoea@parhasard.net>
* lispref/objects.texi (Equality Predicates):
Document #'equalp here, as well as #'equal and #'eq.
tests/ChangeLog addition:
2009-12-31 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test much of the functionality of equalp; add a pointer to Paul
Dietz' ANSI test suite for this function, converted to Emacs
Lisp. Not including the tests themselves in XEmacs because who
owns the copyright on the files is unclear and the GCL people
didn't respond to my queries.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Thu, 31 Dec 2009 15:09:41 +0000 |
| parents | aa5ed11f473b |
| children | e99033b7e05c e0db3c197671 |
| 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. | |
| 1296 | 4 Copyright (C) 2001, 2002, 2003 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 23 /* Synched up with: FSF 19.28. */ | |
| 24 | |
| 25 /* This file has been Mule-ized. */ | |
| 26 | |
| 27 #include <config.h> | |
| 28 #include "lisp.h" | |
| 29 | |
| 30 #include "buffer.h" | |
| 31 #include "syntax.h" | |
| 460 | 32 #include "extents.h" |
| 428 | 33 |
|
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
|
34 #ifdef NEW_GC |
|
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4653
diff
changeset
|
35 # define UNUSED_IF_NEW_GC(decl) UNUSED (decl) |
|
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4653
diff
changeset
|
36 #else |
|
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4653
diff
changeset
|
37 # define UNUSED_IF_NEW_GC(decl) decl |
|
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4653
diff
changeset
|
38 #endif |
|
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4653
diff
changeset
|
39 |
| 460 | 40 #define ST_COMMENT_STYLE 0x101 |
| 41 #define ST_STRING_STYLE 0x102 | |
| 42 | |
| 43 Lisp_Object Qsyntax_table; | |
| 44 int lookup_syntax_properties; | |
| 45 | |
| 428 | 46 Lisp_Object Qsyntax_table_p; |
| 47 | |
| 48 int words_include_escapes; | |
| 49 | |
| 50 int parse_sexp_ignore_comments; | |
| 51 | |
| 52 /* The following two variables are provided to tell additional information | |
| 53 to the regex routines. We do it this way rather than change the | |
| 54 arguments to re_search_2() in an attempt to maintain some call | |
| 55 compatibility with other versions of the regex code. */ | |
| 56 | |
| 57 /* Tell the regex routines not to QUIT. Normally there is a QUIT | |
| 58 each iteration in re_search_2(). */ | |
| 59 int no_quit_in_re_search; | |
| 60 | |
| 826 | 61 /* The standard syntax table is stored where it will automatically |
| 62 be used in all new buffers. */ | |
| 428 | 63 Lisp_Object Vstandard_syntax_table; |
| 64 | |
| 65 Lisp_Object Vsyntax_designator_chars_string; | |
| 66 | |
| 826 | 67 Lisp_Object Vtemp_table_for_use_updating_syntax_tables; |
| 68 | |
| 1296 | 69 /* A value that is guaranteed not be in a syntax table. */ |
| 70 Lisp_Object Vbogus_syntax_table_value; | |
| 71 | |
| 826 | 72 static void syntax_cache_table_was_changed (struct buffer *buf); |
| 73 | |
| 428 | 74 /* This is the internal form of the parse state used in parse-partial-sexp. */ |
| 75 | |
| 76 struct lisp_parse_state | |
| 77 { | |
| 78 int depth; /* Depth at end of parsing */ | |
| 867 | 79 Ichar instring; /* -1 if not within string, else desired terminator */ |
| 428 | 80 int incomment; /* Nonzero if within a comment at end of parsing */ |
| 460 | 81 int comstyle; /* comment style a=0, or b=1, or ST_COMMENT_STYLE */ |
| 428 | 82 int quoted; /* Nonzero if just after an escape char at end of |
| 83 parsing */ | |
| 665 | 84 Charbpos thislevelstart;/* Char number of most recent start-of-expression |
| 428 | 85 at current level */ |
| 665 | 86 Charbpos prevlevelstart;/* Char number of start of containing expression */ |
| 87 Charbpos location; /* Char number at which parsing stopped */ | |
| 428 | 88 int mindepth; /* Minimum depth seen while scanning */ |
| 826 | 89 Charbpos comstr_start;/* Position just after last comment/string starter */ |
| 90 Lisp_Object levelstarts;/* Char numbers of starts-of-expression | |
| 91 of levels (starting from outermost). */ | |
| 428 | 92 }; |
| 93 | |
| 94 /* These variables are a cache for finding the start of a defun. | |
| 95 find_start_pos is the place for which the defun start was found. | |
| 96 find_start_value is the defun start position found for it. | |
| 97 find_start_buffer is the buffer it was found in. | |
| 98 find_start_begv is the BEGV value when it was found. | |
| 99 find_start_modiff is the value of MODIFF when it was found. */ | |
| 100 | |
| 665 | 101 static Charbpos find_start_pos; |
| 102 static Charbpos find_start_value; | |
| 428 | 103 static struct buffer *find_start_buffer; |
| 665 | 104 static Charbpos find_start_begv; |
| 428 | 105 static int find_start_modiff; |
| 106 | |
| 107 /* Find a defun-start that is the last one before POS (or nearly the last). | |
| 108 We record what we find, so that another call in the same area | |
| 109 can return the same value right away. */ | |
| 110 | |
| 665 | 111 static Charbpos |
| 112 find_defun_start (struct buffer *buf, Charbpos pos) | |
| 428 | 113 { |
| 665 | 114 Charbpos tem; |
| 826 | 115 struct syntax_cache *scache; |
| 116 | |
| 428 | 117 /* Use previous finding, if it's valid and applies to this inquiry. */ |
| 118 if (buf == find_start_buffer | |
| 119 /* Reuse the defun-start even if POS is a little farther on. | |
| 120 POS might be in the next defun, but that's ok. | |
| 121 Our value may not be the best possible, but will still be usable. */ | |
| 122 && pos <= find_start_pos + 1000 | |
| 123 && pos >= find_start_value | |
| 124 && BUF_BEGV (buf) == find_start_begv | |
| 125 && BUF_MODIFF (buf) == find_start_modiff) | |
| 126 return find_start_value; | |
| 127 | |
| 128 /* Back up to start of line. */ | |
| 129 tem = find_next_newline (buf, pos, -1); | |
| 130 | |
| 826 | 131 scache = setup_buffer_syntax_cache (buf, tem, 1); |
| 428 | 132 while (tem > BUF_BEGV (buf)) |
| 133 { | |
| 826 | 134 UPDATE_SYNTAX_CACHE_BACKWARD (scache, tem); |
| 460 | 135 |
| 428 | 136 /* Open-paren at start of line means we found our defun-start. */ |
| 826 | 137 if (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, tem)) == Sopen) |
| 428 | 138 break; |
| 139 /* Move to beg of previous line. */ | |
| 140 tem = find_next_newline (buf, tem, -2); | |
| 141 } | |
| 142 | |
| 143 /* Record what we found, for the next try. */ | |
| 144 find_start_value = tem; | |
| 145 find_start_buffer = buf; | |
| 146 find_start_modiff = BUF_MODIFF (buf); | |
| 147 find_start_begv = BUF_BEGV (buf); | |
| 148 find_start_pos = pos; | |
| 149 | |
| 150 return find_start_value; | |
| 151 } | |
| 152 | |
| 153 DEFUN ("syntax-table-p", Fsyntax_table_p, 1, 1, 0, /* | |
| 444 | 154 Return t if OBJECT is a syntax table. |
| 428 | 155 */ |
| 444 | 156 (object)) |
| 428 | 157 { |
| 444 | 158 return (CHAR_TABLEP (object) |
| 159 && XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_SYNTAX) | |
| 428 | 160 ? Qt : Qnil; |
| 161 } | |
| 162 | |
| 163 static Lisp_Object | |
| 164 check_syntax_table (Lisp_Object obj, Lisp_Object default_) | |
| 165 { | |
| 166 if (NILP (obj)) | |
| 167 obj = default_; | |
| 168 while (NILP (Fsyntax_table_p (obj))) | |
| 169 obj = wrong_type_argument (Qsyntax_table_p, obj); | |
| 170 return obj; | |
| 171 } | |
| 172 | |
| 173 DEFUN ("syntax-table", Fsyntax_table, 0, 1, 0, /* | |
| 174 Return the current syntax table. | |
| 175 This is the one specified by the current buffer, or by BUFFER if it | |
| 176 is non-nil. | |
| 177 */ | |
| 178 (buffer)) | |
| 179 { | |
| 180 return decode_buffer (buffer, 0)->syntax_table; | |
| 181 } | |
| 182 | |
| 826 | 183 #ifdef DEBUG_XEMACS |
| 184 | |
| 185 DEFUN ("mirror-syntax-table", Fmirror_syntax_table, 0, 1, 0, /* | |
| 186 Return the current mirror syntax table, for debugging purposes. | |
| 187 This is the one specified by the current buffer, or by BUFFER if it | |
| 188 is non-nil. | |
| 189 */ | |
| 190 (buffer)) | |
| 191 { | |
| 192 return decode_buffer (buffer, 0)->mirror_syntax_table; | |
| 193 } | |
| 194 | |
| 195 DEFUN ("syntax-cache-info", Fsyntax_cache_info, 0, 1, 0, /* | |
| 196 Return info about the syntax cache in BUFFER. | |
| 197 BUFFER defaults to the current buffer if nil. | |
| 198 */ | |
| 199 (buffer)) | |
| 200 { | |
| 201 struct buffer *buf = decode_buffer (buffer, 0); | |
| 202 struct syntax_cache *cache = buf->syntax_cache; | |
| 203 return list4 (cache->start, cache->end, make_int (cache->prev_change), | |
| 204 make_int (cache->next_change)); | |
| 205 } | |
| 206 | |
| 207 #endif /* DEBUG_XEMACS */ | |
| 208 | |
| 428 | 209 DEFUN ("standard-syntax-table", Fstandard_syntax_table, 0, 0, 0, /* |
| 210 Return the standard syntax table. | |
| 211 This is the one used for new buffers. | |
| 212 */ | |
| 213 ()) | |
| 214 { | |
| 215 return Vstandard_syntax_table; | |
| 216 } | |
| 217 | |
| 218 DEFUN ("copy-syntax-table", Fcopy_syntax_table, 0, 1, 0, /* | |
| 444 | 219 Return a new syntax table which is a copy of SYNTAX-TABLE. |
| 220 SYNTAX-TABLE defaults to the standard syntax table. | |
| 428 | 221 */ |
| 444 | 222 (syntax_table)) |
| 428 | 223 { |
| 224 if (NILP (Vstandard_syntax_table)) | |
| 225 return Fmake_char_table (Qsyntax); | |
| 226 | |
| 444 | 227 syntax_table = check_syntax_table (syntax_table, Vstandard_syntax_table); |
| 228 return Fcopy_char_table (syntax_table); | |
| 428 | 229 } |
| 230 | |
| 231 DEFUN ("set-syntax-table", Fset_syntax_table, 1, 2, 0, /* | |
| 444 | 232 Select SYNTAX-TABLE as the new syntax table for BUFFER. |
| 428 | 233 BUFFER defaults to the current buffer if omitted. |
| 234 */ | |
| 444 | 235 (syntax_table, buffer)) |
| 428 | 236 { |
| 237 struct buffer *buf = decode_buffer (buffer, 0); | |
| 444 | 238 syntax_table = check_syntax_table (syntax_table, Qnil); |
| 239 buf->syntax_table = syntax_table; | |
| 240 buf->mirror_syntax_table = XCHAR_TABLE (syntax_table)->mirror_table; | |
| 826 | 241 syntax_cache_table_was_changed (buf); |
| 428 | 242 /* Indicate that this buffer now has a specified syntax table. */ |
| 243 buf->local_var_flags |= XINT (buffer_local_flags.syntax_table); | |
| 444 | 244 return syntax_table; |
| 428 | 245 } |
| 3252 | 246 |
| 247 | |
| 428 | 248 |
| 3252 | 249 /* |
| 250 * Syntax caching | |
| 251 */ | |
| 252 | |
| 253 /* syntax_cache object implementation */ | |
| 254 | |
| 255 static const struct memory_description syntax_cache_description_1 [] = { | |
| 256 { XD_LISP_OBJECT, offsetof (struct syntax_cache, object) }, | |
| 257 { XD_LISP_OBJECT, offsetof (struct syntax_cache, buffer) }, | |
| 258 { XD_LISP_OBJECT, offsetof (struct syntax_cache, syntax_table) }, | |
| 259 { XD_LISP_OBJECT, offsetof (struct syntax_cache, mirror_table) }, | |
| 260 { XD_LISP_OBJECT, offsetof (struct syntax_cache, start) }, | |
| 261 { XD_LISP_OBJECT, offsetof (struct syntax_cache, end) }, | |
| 262 { XD_END } | |
| 263 }; | |
| 264 | |
| 265 #ifdef NEW_GC | |
| 266 DEFINE_LRECORD_IMPLEMENTATION ("syntax-cache", syntax_cache, | |
| 267 1, /*dumpable-flag*/ | |
| 268 0, 0, 0, 0, 0, | |
| 269 syntax_cache_description_1, | |
| 270 Lisp_Syntax_Cache); | |
| 271 #else /* not NEW_GC */ | |
| 272 | |
| 273 const struct sized_memory_description syntax_cache_description = { | |
| 274 sizeof (struct syntax_cache), | |
| 275 syntax_cache_description_1 | |
| 276 }; | |
| 277 #endif /* not NEW_GC */ | |
| 278 | |
| 279 /* static syntax cache utilities */ | |
| 280 | |
| 281 static void | |
| 282 syntax_cache_table_was_changed (struct buffer *buf) | |
| 283 { | |
| 284 struct syntax_cache *cache = buf->syntax_cache; | |
| 285 if (cache->no_syntax_table_prop) | |
| 286 { | |
| 287 cache->syntax_table = | |
| 288 BUFFER_SYNTAX_TABLE (buf); | |
| 289 cache->mirror_table = | |
| 290 BUFFER_MIRROR_SYNTAX_TABLE (buf); | |
| 291 } | |
| 292 } | |
| 293 | |
| 294 static void | |
| 295 reset_buffer_syntax_cache_range (struct syntax_cache *cache, | |
| 296 Lisp_Object buffer, int infinite) | |
| 297 { | |
| 298 Fset_marker (cache->start, make_int (1), buffer); | |
| 299 Fset_marker (cache->end, make_int (1), buffer); | |
| 300 Fset_marker_insertion_type (cache->start, Qt); | |
| 301 Fset_marker_insertion_type (cache->end, Qnil); | |
| 302 /* #### Should we "cache->no_syntax_table_prop = 1;" here? */ | |
| 303 /* #### Cf comment on INFINITE in init_syntax_cache. -- sjt */ | |
| 304 if (infinite) | |
| 305 { | |
| 306 cache->prev_change = EMACS_INT_MIN; | |
| 307 cache->next_change = EMACS_INT_MAX; | |
| 308 } | |
| 309 else | |
| 310 { | |
| 311 cache->prev_change = -1; | |
| 312 cache->next_change = -1; | |
| 313 } | |
| 314 } | |
| 826 | 315 |
| 316 static void | |
| 317 init_syntax_cache (struct syntax_cache *cache, Lisp_Object object, | |
| 318 struct buffer *buffer, int infinite) | |
| 319 { | |
| 320 xzero (*cache); | |
| 321 cache->object = object; | |
| 322 cache->buffer = buffer; | |
| 323 cache->no_syntax_table_prop = 1; | |
| 1296 | 324 cache->syntax_table = |
| 325 BUFFER_SYNTAX_TABLE (cache->buffer); | |
| 326 cache->mirror_table = | |
| 826 | 327 BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer); |
| 328 cache->start = Qnil; | |
| 329 cache->end = Qnil; | |
| 3250 | 330 /* #### I'm not sure what INFINITE is for, but it's apparently needed by |
| 331 setup_syntax_cache(). It looks like it's supposed to guarantee that | |
| 332 the test for POS outside of cache-valid range will never succeed, so | |
| 333 that update_syntax_cache won't get called, but it's hard to be sure. | |
| 334 Cf reset_buffer_syntax_cache_range. -- sjt */ | |
| 826 | 335 if (infinite) |
| 336 { | |
| 337 cache->prev_change = EMACS_INT_MIN; | |
| 338 cache->next_change = EMACS_INT_MAX; | |
| 339 } | |
| 340 else | |
| 341 { | |
| 342 cache->prev_change = -1; | |
| 343 cache->next_change = -1; | |
| 344 } | |
| 345 } | |
| 346 | |
| 3252 | 347 /* external syntax cache API */ |
| 348 | |
| 3250 | 349 /* #### This function and associated logic still needs work, and especially |
| 350 documentation. */ | |
| 351 struct syntax_cache * /* return CACHE or the cache of OBJECT */ | |
| 352 setup_syntax_cache (struct syntax_cache *cache, /* syntax cache, may be NULL | |
| 353 if OBJECT is a buffer */ | |
| 354 Lisp_Object object, /* the object (if any) cache | |
| 355 is associated with */ | |
| 356 struct buffer *buffer, /* the buffer to use as source | |
| 357 of the syntax table */ | |
| 358 Charxpos from, /* initial position of cache */ | |
| 359 int count) /* direction? see code */ | |
| 826 | 360 { |
| 3250 | 361 /* If OBJECT is a buffer, use its cache. Initialize cache. Make it valid |
| 362 for the whole buffer if the syntax-table property is not being respected. | |
| 363 Else if OBJECT is not a buffer, initialize the cache passed in CACHE. | |
| 364 If the syntax-table property is being respected, update the cache. */ | |
| 826 | 365 if (BUFFERP (object)) |
| 3250 | 366 { |
| 367 cache = XBUFFER (object)->syntax_cache; | |
| 368 if (!lookup_syntax_properties) | |
| 369 reset_buffer_syntax_cache_range (cache, object, 1); | |
| 370 } | |
| 371 else | |
| 826 | 372 init_syntax_cache (cache, object, buffer, 0); |
| 373 if (lookup_syntax_properties) | |
| 374 { | |
| 375 if (count <= 0) | |
| 376 { | |
| 377 from--; | |
| 2167 | 378 from = buffer_or_string_clip_to_accessible_char (cache->object, |
| 826 | 379 from); |
| 380 } | |
| 381 if (!(from >= cache->prev_change && from < cache->next_change)) | |
| 382 update_syntax_cache (cache, from, count); | |
| 383 } | |
| 1296 | 384 #ifdef NOT_WORTH_THE_EFFORT |
| 385 update_mirror_syntax_if_dirty (cache->mirror_table); | |
| 386 #endif /* NOT_WORTH_THE_EFFORT */ | |
| 826 | 387 return cache; |
| 388 } | |
| 389 | |
| 390 struct syntax_cache * | |
| 391 setup_buffer_syntax_cache (struct buffer *buffer, Charxpos from, int count) | |
| 392 { | |
| 393 return setup_syntax_cache (NULL, wrap_buffer (buffer), buffer, from, count); | |
| 394 } | |
| 395 | |
| 460 | 396 /* |
| 397 Update syntax_cache to an appropriate setting for position POS | |
| 398 | |
| 399 The sign of COUNT gives the relative position of POS wrt the | |
| 400 previously valid interval. (not currently used) | |
| 401 | |
| 402 `syntax_cache.*_change' are the next and previous positions at | |
| 403 which syntax_code and c_s_t will need to be recalculated. | |
| 404 | |
| 3025 | 405 #### Currently this code uses `get-char-property', which will |
| 460 | 406 return the "last smallest" extent at a given position. In cases |
| 407 where overlapping extents are defined, this code will simply use | |
| 408 whatever is returned by get-char-property. | |
| 409 | |
| 410 It might be worth it at some point to merge provided syntax tables | |
| 826 | 411 outward to the current buffer (#### rewrite in English please?!). */ |
| 460 | 412 |
| 413 void | |
| 2286 | 414 update_syntax_cache (struct syntax_cache *cache, Charxpos cpos, |
| 415 int UNUSED (count)) | |
| 460 | 416 { |
| 417 Lisp_Object tmp_table; | |
| 826 | 418 Bytexpos pos; |
| 419 Bytexpos lim; | |
| 420 Bytexpos next, prev; | |
| 421 int at_begin = 0, at_end = 0; | |
| 460 | 422 |
| 826 | 423 if (NILP (cache->object)) |
| 424 return; | |
| 425 | |
| 426 pos = buffer_or_string_charxpos_to_bytexpos (cache->object, cpos); | |
| 427 | |
| 428 tmp_table = get_char_property (pos, Qsyntax_table, cache->object, | |
| 429 EXTENT_AT_AFTER, 0); | |
| 2506 | 430 lim = next_previous_single_property_change (pos, Qsyntax_table, |
| 431 cache->object, -1, 1, 0); | |
| 826 | 432 if (lim < 0) |
| 460 | 433 { |
| 826 | 434 next = buffer_or_string_absolute_end_byte (cache->object); |
| 435 at_begin = 1; | |
| 460 | 436 } |
| 826 | 437 else |
| 438 next = lim; | |
| 460 | 439 |
| 826 | 440 if (pos < buffer_or_string_absolute_end_byte (cache->object)) |
| 441 pos = next_bytexpos (cache->object, pos); | |
| 2506 | 442 lim = next_previous_single_property_change (pos, Qsyntax_table, |
| 443 cache->object, -1, 0, 0); | |
| 826 | 444 if (lim < 0) |
| 460 | 445 { |
| 826 | 446 prev = buffer_or_string_absolute_begin_byte (cache->object); |
| 447 at_end = 1; | |
| 460 | 448 } |
| 449 else | |
| 826 | 450 prev = lim; |
| 460 | 451 |
| 826 | 452 cache->prev_change = |
| 453 buffer_or_string_bytexpos_to_charxpos (cache->object, prev); | |
| 454 cache->next_change = | |
| 455 buffer_or_string_bytexpos_to_charxpos (cache->object, next); | |
| 460 | 456 |
| 826 | 457 if (BUFFERP (cache->object)) |
| 458 { | |
| 459 /* If we are at the beginning or end of buffer, check to see if there's | |
| 460 a zero-length `syntax-table' extent there (highly unlikely); if not, | |
| 461 then we can safely make the end closed, so it will take in newly | |
| 462 inserted text. (If such an extent is inserted, we will be informed | |
| 3250 | 463 through signal_syntax_cache_extent_changed().) */ |
| 826 | 464 Fset_marker (cache->start, make_int (cache->prev_change), cache->object); |
| 465 Fset_marker_insertion_type | |
| 466 (cache->start, | |
| 467 at_begin && NILP (extent_at (prev, cache->object, Qsyntax_table, | |
| 468 NULL, EXTENT_AT_AT, 0)) | |
| 469 ? Qnil : Qt); | |
| 470 Fset_marker (cache->end, make_int (cache->next_change), cache->object); | |
| 471 Fset_marker_insertion_type | |
| 472 (cache->end, | |
| 473 at_end && NILP (extent_at (next, cache->object, Qsyntax_table, | |
| 474 NULL, EXTENT_AT_AT, 0)) | |
| 475 ? Qt : Qnil); | |
| 476 } | |
| 477 | |
| 478 if (!NILP (Fsyntax_table_p (tmp_table))) | |
| 479 { | |
| 480 cache->use_code = 0; | |
| 1296 | 481 cache->syntax_table = tmp_table; |
| 482 cache->mirror_table = XCHAR_TABLE (tmp_table)->mirror_table; | |
| 826 | 483 cache->no_syntax_table_prop = 0; |
| 1296 | 484 #ifdef NOT_WORTH_THE_EFFORT |
| 485 update_mirror_syntax_if_dirty (cache->mirror_table); | |
| 486 #endif /* NOT_WORTH_THE_EFFORT */ | |
| 826 | 487 } |
| 488 else if (CONSP (tmp_table) && INTP (XCAR (tmp_table))) | |
| 489 { | |
| 490 cache->use_code = 1; | |
| 491 cache->syntax_code = XINT (XCAR (tmp_table)); | |
| 492 cache->no_syntax_table_prop = 0; | |
| 493 } | |
| 494 else | |
| 495 { | |
| 496 cache->use_code = 0; | |
| 497 cache->no_syntax_table_prop = 1; | |
| 1296 | 498 cache->syntax_table = BUFFER_SYNTAX_TABLE (cache->buffer); |
| 499 cache->mirror_table = BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer); | |
| 500 #ifdef NOT_WORTH_THE_EFFORT | |
| 501 update_mirror_syntax_if_dirty (cache->mirror_table); | |
| 502 #endif /* NOT_WORTH_THE_EFFORT */ | |
| 460 | 503 } |
| 504 } | |
| 3252 | 505 |
| 506 /* buffer-specific APIs used in buffer.c | |
| 507 #### This is really unclean; | |
| 508 the syntax cache should just be a LISP object */ | |
| 509 | |
| 510 void | |
| 511 mark_buffer_syntax_cache (struct buffer *buf) | |
| 512 { | |
| 513 struct syntax_cache *cache = buf->syntax_cache; | |
| 514 if (!cache) /* Vbuffer_defaults and such don't have caches */ | |
| 515 return; | |
| 516 mark_object (cache->object); | |
| 517 if (cache->buffer) | |
| 518 mark_object (wrap_buffer (cache->buffer)); | |
| 519 mark_object (cache->syntax_table); | |
| 520 mark_object (cache->mirror_table); | |
| 521 mark_object (cache->start); | |
| 522 mark_object (cache->end); | |
| 523 } | |
| 524 | |
| 525 void | |
| 526 init_buffer_syntax_cache (struct buffer *buf) | |
| 527 { | |
| 528 struct syntax_cache *cache; | |
| 529 #ifdef NEW_GC | |
| 530 buf->syntax_cache = alloc_lrecord_type (struct syntax_cache, | |
| 531 &lrecord_syntax_cache); | |
| 532 #else /* not NEW_GC */ | |
| 533 buf->syntax_cache = xnew_and_zero (struct syntax_cache); | |
| 534 #endif /* not NEW_GC */ | |
| 535 cache = buf->syntax_cache; | |
| 536 cache->object = wrap_buffer (buf); | |
| 537 cache->buffer = buf; | |
| 538 cache->no_syntax_table_prop = 1; | |
| 539 cache->syntax_table = BUFFER_SYNTAX_TABLE (cache->buffer); | |
| 540 cache->mirror_table = BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer); | |
| 541 cache->start = Fmake_marker (); | |
| 542 cache->end = Fmake_marker (); | |
| 543 reset_buffer_syntax_cache_range (cache, cache->object, 0); | |
| 544 } | |
| 545 | |
| 546 /* finalize the syntax cache for BUF */ | |
| 547 | |
| 548 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
|
549 uninit_buffer_syntax_cache (struct buffer *UNUSED_IF_NEW_GC (buf)) |
| 3252 | 550 { |
| 4141 | 551 #ifndef NEW_GC |
| 3252 | 552 xfree (buf->syntax_cache, struct syntax_cache *); |
| 553 buf->syntax_cache = 0; | |
| 4141 | 554 #endif /* not NEW_GC */ |
| 3252 | 555 } |
| 556 | |
| 557 /* extent-specific APIs used in extents.c and insdel.c */ | |
| 558 | |
| 559 /* The syntax-table property on the range covered by EXTENT may be changing, | |
| 560 either because EXTENT has a syntax-table property and is being attached | |
| 561 or detached (this includes having its endpoints changed), or because | |
| 562 the value of EXTENT's syntax-table property is changing. */ | |
| 563 | |
| 564 void | |
| 565 signal_syntax_cache_extent_changed (EXTENT extent) | |
| 566 { | |
| 567 Lisp_Object buffer = Fextent_object (wrap_extent (extent)); | |
| 568 if (BUFFERP (buffer)) | |
| 569 { | |
| 570 /* This was getting called with the buffer's start and end null, eg in | |
| 571 cperl mode, which triggers an assert in byte_marker_position. Cf | |
| 572 thread rooted at <yxz7j7xzk97.fsf@gimli.holgi.priv> on xemacs-beta. | |
| 573 <yxzfymklb6p.fsf@gimli.holgi.priv> has a recipe, but you also need | |
| 574 to delete or type SPC to get the crash. | |
| 575 #### Delete this comment when setup_syntax_cache is made sane. */ | |
| 576 struct syntax_cache *cache = XBUFFER (buffer)->syntax_cache; | |
| 577 /* #### would this be slower or less accurate in character terms? */ | |
| 578 Bytexpos start = extent_endpoint_byte (extent, 0); | |
| 579 Bytexpos end = extent_endpoint_byte (extent, 1); | |
| 580 Bytexpos start2 = byte_marker_position (cache->start); | |
| 581 Bytexpos end2 = byte_marker_position (cache->end); | |
| 582 /* If the extent is entirely before or entirely after the cache | |
| 583 range, it doesn't overlap. Otherwise, invalidate the range. */ | |
| 584 if (!(end < start2 || start > end2)) | |
| 585 reset_buffer_syntax_cache_range (cache, buffer, 0); | |
| 586 } | |
| 587 } | |
| 588 | |
| 589 /* Extents have been adjusted for insertion or deletion, so we need to | |
| 590 refetch the start and end position of the extent */ | |
| 591 void | |
| 592 signal_syntax_cache_extent_adjust (struct buffer *buf) | |
| 593 { | |
| 594 struct syntax_cache *cache = buf->syntax_cache; | |
| 595 /* If the cache was invalid before, leave it that way. We only want | |
| 596 to update the limits of validity when they were actually valid. */ | |
| 597 if (cache->prev_change < 0) | |
| 598 return; | |
| 599 cache->prev_change = marker_position (cache->start); | |
| 600 cache->next_change = marker_position (cache->end); | |
| 601 } | |
| 602 | |
| 603 | |
| 460 | 604 |
| 428 | 605 /* Convert a letter which signifies a syntax code |
| 606 into the code it signifies. | |
| 607 This is used by modify-syntax-entry, and other things. */ | |
| 608 | |
| 442 | 609 const unsigned char syntax_spec_code[0400] = |
| 428 | 610 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, |
| 611 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, | |
| 612 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, | |
| 613 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, | |
| 614 (char) Swhitespace, 0377, (char) Sstring, 0377, | |
| 615 (char) Smath, 0377, 0377, (char) Squote, | |
| 616 (char) Sopen, (char) Sclose, 0377, 0377, | |
| 617 0377, (char) Swhitespace, (char) Spunct, (char) Scharquote, | |
| 618 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, | |
| 619 0377, 0377, 0377, 0377, | |
| 620 (char) Scomment, 0377, (char) Sendcomment, 0377, | |
| 621 (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */ | |
| 622 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, | |
| 623 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword, | |
| 624 0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol, | |
| 625 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */ | |
| 626 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, | |
| 627 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword, | |
| 460 | 628 0377, 0377, 0377, 0377, (char) Sstring_fence, 0377, 0377, 0377 |
| 428 | 629 }; |
| 630 | |
| 460 | 631 const unsigned char syntax_code_spec[] = " .w_()'\"$\\/<>@!|"; |
| 428 | 632 |
| 633 DEFUN ("syntax-designator-chars", Fsyntax_designator_chars, 0, 0, 0, /* | |
| 634 Return a string of the recognized syntax designator chars. | |
| 635 The chars are ordered by their internal syntax codes, which are | |
| 636 numbered starting at 0. | |
| 637 */ | |
| 638 ()) | |
| 639 { | |
| 640 return Vsyntax_designator_chars_string; | |
| 641 } | |
| 642 | |
| 643 DEFUN ("char-syntax", Fchar_syntax, 1, 2, 0, /* | |
| 444 | 644 Return the syntax code of CHARACTER, described by a character. |
| 645 For example, if CHARACTER is a word constituent, | |
| 646 the character `?w' is returned. | |
| 428 | 647 The characters that correspond to various syntax codes |
| 648 are listed in the documentation of `modify-syntax-entry'. | |
| 444 | 649 Optional second argument SYNTAX-TABLE defaults to the current buffer's |
| 428 | 650 syntax table. |
| 651 */ | |
| 444 | 652 (character, syntax_table)) |
| 428 | 653 { |
| 826 | 654 Lisp_Object mirrortab; |
| 428 | 655 |
| 444 | 656 if (NILP (character)) |
| 428 | 657 { |
| 444 | 658 character = make_char ('\000'); |
| 428 | 659 } |
| 444 | 660 CHECK_CHAR_COERCE_INT (character); |
| 826 | 661 syntax_table = check_syntax_table (syntax_table, |
| 662 current_buffer->syntax_table); | |
| 663 mirrortab = XCHAR_TABLE (syntax_table)->mirror_table; | |
| 664 return make_char (syntax_code_spec[(int) SYNTAX (mirrortab, | |
| 665 XCHAR (character))]); | |
| 428 | 666 } |
| 667 | |
| 668 #ifdef MULE | |
| 669 | |
| 670 enum syntaxcode | |
| 2286 | 671 charset_syntax (struct buffer *UNUSED (buf), Lisp_Object UNUSED (charset), |
| 672 int *multi_p_out) | |
| 428 | 673 { |
| 674 *multi_p_out = 1; | |
| 826 | 675 /* !!#### get this right */ |
| 3152 | 676 return Sword; |
| 428 | 677 } |
| 678 | |
| 679 #endif | |
| 680 | |
| 681 Lisp_Object | |
| 867 | 682 syntax_match (Lisp_Object syntax_table, Ichar ch) |
| 428 | 683 { |
| 826 | 684 Lisp_Object code = get_char_table (ch, syntax_table); |
| 428 | 685 Lisp_Object code2 = code; |
| 686 | |
| 687 if (CONSP (code)) | |
| 688 code2 = XCAR (code); | |
| 689 if (SYNTAX_FROM_CODE (XINT (code2)) == Sinherit) | |
| 826 | 690 code = get_char_table (ch, Vstandard_syntax_table); |
| 428 | 691 |
| 692 return CONSP (code) ? XCDR (code) : Qnil; | |
| 693 } | |
| 694 | |
| 695 DEFUN ("matching-paren", Fmatching_paren, 1, 2, 0, /* | |
| 444 | 696 Return the matching parenthesis of CHARACTER, or nil if none. |
| 697 Optional second argument SYNTAX-TABLE defaults to the current buffer's | |
| 428 | 698 syntax table. |
| 699 */ | |
| 444 | 700 (character, syntax_table)) |
| 428 | 701 { |
| 826 | 702 Lisp_Object mirrortab; |
| 1315 | 703 enum syntaxcode code; |
| 428 | 704 |
| 444 | 705 CHECK_CHAR_COERCE_INT (character); |
| 826 | 706 syntax_table = check_syntax_table (syntax_table, |
| 707 current_buffer->syntax_table); | |
| 708 mirrortab = XCHAR_TABLE (syntax_table)->mirror_table; | |
| 444 | 709 code = SYNTAX (mirrortab, XCHAR (character)); |
| 428 | 710 if (code == Sopen || code == Sclose || code == Sstring) |
| 444 | 711 return syntax_match (syntax_table, XCHAR (character)); |
| 428 | 712 return Qnil; |
| 713 } | |
| 714 | |
| 715 | |
| 716 | |
| 717 #ifdef MULE | |
| 718 /* Return 1 if there is a word boundary between two word-constituent | |
| 719 characters C1 and C2 if they appear in this order, else return 0. | |
| 720 There is no word boundary between two word-constituent ASCII | |
| 721 characters. */ | |
| 722 #define WORD_BOUNDARY_P(c1, c2) \ | |
| 867 | 723 (!(ichar_ascii_p (c1) && ichar_ascii_p (c2)) \ |
| 428 | 724 && word_boundary_p (c1, c2)) |
| 725 #endif | |
| 726 | |
| 727 /* Return the position across COUNT words from FROM. | |
| 728 If that many words cannot be found before the end of the buffer, return 0. | |
| 729 COUNT negative means scan backward and stop at word beginning. */ | |
| 730 | |
| 665 | 731 Charbpos |
| 732 scan_words (struct buffer *buf, Charbpos from, int count) | |
| 428 | 733 { |
| 665 | 734 Charbpos limit = count > 0 ? BUF_ZV (buf) : BUF_BEGV (buf); |
| 867 | 735 Ichar ch0, ch1; |
| 428 | 736 enum syntaxcode code; |
| 826 | 737 struct syntax_cache *scache = setup_buffer_syntax_cache (buf, from, count); |
| 460 | 738 |
| 428 | 739 /* #### is it really worth it to hand expand both cases? JV */ |
| 740 while (count > 0) | |
| 741 { | |
| 742 QUIT; | |
| 743 | |
| 744 while (1) | |
| 745 { | |
| 746 if (from == limit) | |
| 747 return 0; | |
| 748 | |
| 826 | 749 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 750 ch0 = BUF_FETCH_CHAR (buf, from); |
| 826 | 751 code = SYNTAX_FROM_CACHE (scache, ch0); |
| 428 | 752 |
| 442 | 753 from++; |
| 428 | 754 if (words_include_escapes |
| 755 && (code == Sescape || code == Scharquote)) | |
| 756 break; | |
| 757 if (code == Sword) | |
| 758 break; | |
| 759 } | |
| 760 | |
| 761 QUIT; | |
| 762 | |
| 763 while (from != limit) | |
| 764 { | |
| 826 | 765 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 766 ch1 = BUF_FETCH_CHAR (buf, from); |
| 826 | 767 code = SYNTAX_FROM_CACHE (scache, ch1); |
| 428 | 768 if (!(words_include_escapes |
| 769 && (code == Sescape || code == Scharquote))) | |
| 770 if (code != Sword | |
| 771 #ifdef MULE | |
| 772 || WORD_BOUNDARY_P (ch0, ch1) | |
| 434 | 773 #endif |
| 428 | 774 ) |
| 775 break; | |
| 776 #ifdef MULE | |
| 777 ch0 = ch1; | |
| 434 | 778 #endif |
| 428 | 779 from++; |
| 780 } | |
| 781 count--; | |
| 782 } | |
| 783 | |
| 784 while (count < 0) | |
| 785 { | |
| 786 QUIT; | |
| 787 | |
| 788 while (1) | |
| 789 { | |
| 790 if (from == limit) | |
| 791 return 0; | |
| 792 | |
| 826 | 793 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 428 | 794 ch1 = BUF_FETCH_CHAR (buf, from - 1); |
| 826 | 795 code = SYNTAX_FROM_CACHE (scache, ch1); |
| 460 | 796 from--; |
| 442 | 797 |
| 428 | 798 if (words_include_escapes |
| 799 && (code == Sescape || code == Scharquote)) | |
| 800 break; | |
| 801 if (code == Sword) | |
| 802 break; | |
| 803 } | |
| 804 | |
| 805 QUIT; | |
| 806 | |
| 807 while (from != limit) | |
| 808 { | |
| 826 | 809 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 428 | 810 ch0 = BUF_FETCH_CHAR (buf, from - 1); |
| 826 | 811 code = SYNTAX_FROM_CACHE (scache, ch0); |
| 460 | 812 |
| 428 | 813 if (!(words_include_escapes |
| 814 && (code == Sescape || code == Scharquote))) | |
| 815 if (code != Sword | |
| 816 #ifdef MULE | |
| 817 || WORD_BOUNDARY_P (ch0, ch1) | |
| 818 #endif | |
| 819 ) | |
| 820 break; | |
| 821 #ifdef MULE | |
| 822 ch1 = ch0; | |
| 823 #endif | |
| 824 from--; | |
| 825 } | |
| 826 count++; | |
| 827 } | |
| 828 | |
| 829 return from; | |
| 830 } | |
| 831 | |
| 446 | 832 DEFUN ("forward-word", Fforward_word, 0, 2, "_p", /* |
| 428 | 833 Move point forward COUNT words (backward if COUNT is negative). |
| 446 | 834 Normally t is returned, but if an edge of the buffer is reached, |
| 835 point is left there and nil is returned. | |
| 428 | 836 |
| 462 | 837 The characters that are moved over may be added to the current selection |
| 838 \(i.e. active region) if the Shift key is held down, a motion key is used | |
| 839 to invoke this command, and `shifted-motion-keys-select-region' is t; see | |
| 840 the documentation for this variable for more details. | |
| 841 | |
| 446 | 842 COUNT defaults to 1, and BUFFER defaults to the current buffer. |
| 428 | 843 */ |
| 844 (count, buffer)) | |
| 845 { | |
| 665 | 846 Charbpos val; |
| 428 | 847 struct buffer *buf = decode_buffer (buffer, 0); |
| 446 | 848 EMACS_INT n; |
| 849 | |
| 850 if (NILP (count)) | |
| 851 n = 1; | |
| 852 else | |
| 853 { | |
| 854 CHECK_INT (count); | |
| 855 n = XINT (count); | |
| 856 } | |
| 428 | 857 |
| 446 | 858 val = scan_words (buf, BUF_PT (buf), n); |
| 859 if (val) | |
| 428 | 860 { |
| 446 | 861 BUF_SET_PT (buf, val); |
| 862 return Qt; | |
| 863 } | |
| 864 else | |
| 865 { | |
| 866 BUF_SET_PT (buf, n > 0 ? BUF_ZV (buf) : BUF_BEGV (buf)); | |
| 428 | 867 return Qnil; |
| 868 } | |
| 869 } | |
| 870 | |
| 871 static void scan_sexps_forward (struct buffer *buf, | |
| 872 struct lisp_parse_state *, | |
| 665 | 873 Charbpos from, Charbpos end, |
| 428 | 874 int targetdepth, int stopbefore, |
| 875 Lisp_Object oldstate, | |
| 876 int commentstop); | |
| 877 | |
| 878 static int | |
| 665 | 879 find_start_of_comment (struct buffer *buf, Charbpos from, Charbpos stop, |
| 460 | 880 int comstyle) |
| 428 | 881 { |
| 867 | 882 Ichar c; |
| 428 | 883 enum syntaxcode code; |
| 884 | |
| 885 /* Look back, counting the parity of string-quotes, | |
| 886 and recording the comment-starters seen. | |
| 887 When we reach a safe place, assume that's not in a string; | |
| 888 then step the main scan to the earliest comment-starter seen | |
| 889 an even number of string quotes away from the safe place. | |
| 890 | |
| 891 OFROM[I] is position of the earliest comment-starter seen | |
| 892 which is I+2X quotes from the comment-end. | |
| 893 PARITY is current parity of quotes from the comment end. */ | |
| 894 int parity = 0; | |
| 867 | 895 Ichar my_stringend = 0; |
| 428 | 896 int string_lossage = 0; |
| 665 | 897 Charbpos comment_end = from; |
| 898 Charbpos comstart_pos = 0; | |
| 428 | 899 int comstart_parity = 0; |
| 900 int styles_match_p = 0; | |
| 460 | 901 /* mask to match comment styles against; for ST_COMMENT_STYLE, this |
| 902 will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */ | |
| 903 int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A; | |
| 826 | 904 struct syntax_cache *scache = buf->syntax_cache; |
| 428 | 905 |
| 906 /* At beginning of range to scan, we're outside of strings; | |
| 907 that determines quote parity to the comment-end. */ | |
| 908 while (from != stop) | |
| 909 { | |
| 460 | 910 int syncode; |
| 911 | |
| 428 | 912 /* Move back and examine a character. */ |
| 913 from--; | |
| 826 | 914 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 428 | 915 |
| 916 c = BUF_FETCH_CHAR (buf, from); | |
| 826 | 917 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 918 code = SYNTAX_FROM_CODE (syncode); | |
| 428 | 919 |
| 920 /* is this a 1-char comment end sequence? if so, try | |
| 921 to see if style matches previously extracted mask */ | |
| 922 if (code == Sendcomment) | |
| 923 { | |
| 924 styles_match_p = | |
| 460 | 925 SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask; |
| 428 | 926 } |
| 927 | |
| 928 /* or are we looking at a 1-char comment start sequence | |
| 929 of the style matching mask? */ | |
| 460 | 930 else if (code == Scomment) |
| 428 | 931 { |
| 460 | 932 styles_match_p = |
| 933 SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask; | |
| 428 | 934 } |
| 935 | |
| 460 | 936 /* otherwise, is this a 2-char comment end or start sequence? */ |
| 937 else if (from > stop) | |
| 938 do | |
| 939 { | |
| 940 /* 2-char comment end sequence? */ | |
| 941 if (SYNTAX_CODE_END_SECOND_P (syncode)) | |
| 942 { | |
| 943 int prev_syncode; | |
| 826 | 944 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 460 | 945 prev_syncode = |
| 1315 | 946 SYNTAX_CODE_FROM_CACHE (scache, |
| 947 BUF_FETCH_CHAR (buf, from - 1)); | |
| 460 | 948 |
| 949 if (SYNTAX_CODES_END_P (prev_syncode, syncode)) | |
| 950 { | |
| 951 code = Sendcomment; | |
| 952 styles_match_p = | |
| 826 | 953 SYNTAX_CODES_COMMENT_MASK_END (prev_syncode, |
| 954 syncode) & mask; | |
| 460 | 955 from--; |
| 826 | 956 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 460 | 957 c = BUF_FETCH_CHAR (buf, from); |
| 958 | |
| 959 /* Found a comment-end sequence, so skip past the | |
| 960 check for a comment-start */ | |
| 961 break; | |
| 962 } | |
| 963 } | |
| 964 | |
| 965 /* 2-char comment start sequence? */ | |
| 966 if (SYNTAX_CODE_START_SECOND_P (syncode)) | |
| 967 { | |
| 968 int prev_syncode; | |
| 826 | 969 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 460 | 970 prev_syncode = |
| 1315 | 971 SYNTAX_CODE_FROM_CACHE (scache, |
| 972 BUF_FETCH_CHAR (buf, from - 1)); | |
| 460 | 973 |
| 974 if (SYNTAX_CODES_START_P (prev_syncode, syncode)) | |
| 975 { | |
| 976 code = Scomment; | |
| 977 styles_match_p = | |
| 826 | 978 SYNTAX_CODES_COMMENT_MASK_START (prev_syncode, |
| 979 syncode) & mask; | |
| 460 | 980 from--; |
| 826 | 981 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 460 | 982 c = BUF_FETCH_CHAR (buf, from); |
| 983 } | |
| 984 } | |
| 985 } while (0); | |
| 428 | 986 |
| 987 /* Ignore escaped characters. */ | |
| 988 if (char_quoted (buf, from)) | |
| 989 continue; | |
| 990 | |
| 991 /* Track parity of quotes. */ | |
| 992 if (code == Sstring) | |
| 993 { | |
| 994 parity ^= 1; | |
| 995 if (my_stringend == 0) | |
| 996 my_stringend = c; | |
| 997 /* If we have two kinds of string delimiters. | |
| 998 There's no way to grok this scanning backwards. */ | |
| 999 else if (my_stringend != c) | |
| 1000 string_lossage = 1; | |
| 1001 } | |
| 1002 | |
| 460 | 1003 if (code == Sstring_fence || code == Scomment_fence) |
| 1004 { | |
| 1005 parity ^= 1; | |
| 1006 if (my_stringend == 0) | |
| 1007 my_stringend = | |
| 1008 code == Sstring_fence ? ST_STRING_STYLE : ST_COMMENT_STYLE; | |
| 1009 /* If we have two kinds of string delimiters. | |
| 1010 There's no way to grok this scanning backwards. */ | |
| 1011 else if (my_stringend != (code == Sstring_fence | |
| 1012 ? ST_STRING_STYLE : ST_COMMENT_STYLE)) | |
| 1013 string_lossage = 1; | |
| 1014 } | |
| 1015 | |
| 428 | 1016 /* Record comment-starters according to that |
| 1017 quote-parity to the comment-end. */ | |
| 1018 if (code == Scomment && styles_match_p) | |
| 1019 { | |
| 1020 comstart_parity = parity; | |
| 1021 comstart_pos = from; | |
| 1022 } | |
| 1023 | |
| 1024 /* If we find another earlier comment-ender, | |
| 1025 any comment-starts earlier than that don't count | |
| 1026 (because they go with the earlier comment-ender). */ | |
| 1027 if (code == Sendcomment && styles_match_p) | |
| 1028 break; | |
| 1029 | |
| 1030 /* Assume a defun-start point is outside of strings. */ | |
| 1031 if (code == Sopen | |
| 1032 && (from == stop || BUF_FETCH_CHAR (buf, from - 1) == '\n')) | |
| 1033 break; | |
| 1034 } | |
| 1035 | |
| 1036 if (comstart_pos == 0) | |
| 1037 from = comment_end; | |
| 1038 /* If the earliest comment starter | |
| 1039 is followed by uniform paired string quotes or none, | |
| 1040 we know it can't be inside a string | |
| 1041 since if it were then the comment ender would be inside one. | |
| 1042 So it does start a comment. Skip back to it. */ | |
| 1043 else if (comstart_parity == 0 && !string_lossage) | |
| 1044 from = comstart_pos; | |
| 1045 else | |
| 1046 { | |
| 1047 /* We had two kinds of string delimiters mixed up | |
| 1048 together. Decode this going forwards. | |
| 1049 Scan fwd from the previous comment ender | |
| 1050 to the one in question; this records where we | |
| 1051 last passed a comment starter. */ | |
| 1052 | |
| 1053 struct lisp_parse_state state; | |
| 1054 scan_sexps_forward (buf, &state, find_defun_start (buf, comment_end), | |
| 1055 comment_end - 1, -10000, 0, Qnil, 0); | |
| 1056 if (state.incomment) | |
| 460 | 1057 from = state.comstr_start; |
| 428 | 1058 else |
| 1059 /* We can't grok this as a comment; scan it normally. */ | |
| 1060 from = comment_end; | |
| 826 | 1061 UPDATE_SYNTAX_CACHE_FORWARD (scache, from - 1); |
| 428 | 1062 } |
| 1063 return from; | |
| 1064 } | |
| 1065 | |
| 665 | 1066 static Charbpos |
| 826 | 1067 find_end_of_comment (struct buffer *buf, Charbpos from, Charbpos stop, |
| 1068 int comstyle) | |
| 428 | 1069 { |
| 1070 int c; | |
| 460 | 1071 int prev_code; |
| 1072 /* mask to match comment styles against; for ST_COMMENT_STYLE, this | |
| 1073 will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */ | |
| 1074 int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A; | |
| 826 | 1075 struct syntax_cache *scache = buf->syntax_cache; |
| 428 | 1076 |
| 460 | 1077 /* This is only called by functions which have already set up the |
| 1078 syntax_cache and are keeping it up-to-date */ | |
| 428 | 1079 while (1) |
| 1080 { | |
| 1081 if (from == stop) | |
| 1082 { | |
| 1083 return -1; | |
| 1084 } | |
| 460 | 1085 |
| 826 | 1086 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1087 c = BUF_FETCH_CHAR (buf, from); |
| 460 | 1088 |
| 1089 /* Test for generic comments */ | |
| 1090 if (comstyle == ST_COMMENT_STYLE) | |
| 1091 { | |
| 826 | 1092 if (SYNTAX_FROM_CACHE (scache, c) == Scomment_fence) |
| 460 | 1093 { |
| 1094 from++; | |
| 826 | 1095 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1096 break; |
| 1097 } | |
| 1098 from++; | |
| 1099 continue; /* No need to test other comment styles in a | |
| 1100 generic comment */ | |
| 1101 } | |
| 1102 else | |
| 1103 | |
| 826 | 1104 if (SYNTAX_FROM_CACHE (scache, c) == Sendcomment |
| 460 | 1105 && SYNTAX_CODE_MATCHES_1CHAR_P |
| 826 | 1106 (SYNTAX_CODE_FROM_CACHE (scache, c), mask)) |
| 428 | 1107 /* we have encountered a comment end of the same style |
| 1108 as the comment sequence which began this comment | |
| 1109 section */ | |
| 460 | 1110 { |
| 1111 from++; | |
| 826 | 1112 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1113 break; |
| 1114 } | |
| 428 | 1115 |
| 826 | 1116 prev_code = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 428 | 1117 from++; |
| 826 | 1118 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1119 if (from < stop |
| 460 | 1120 && SYNTAX_CODES_MATCH_END_P |
| 1121 (prev_code, | |
| 826 | 1122 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)), |
| 460 | 1123 mask) |
| 1124 | |
| 1125 ) | |
| 428 | 1126 /* we have encountered a comment end of the same style |
| 1127 as the comment sequence which began this comment | |
| 1128 section */ | |
| 460 | 1129 { |
| 1130 from++; | |
| 826 | 1131 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1132 break; |
| 1133 } | |
| 428 | 1134 } |
| 1135 return from; | |
| 1136 } | |
| 1137 | |
| 1138 | |
| 1139 /* #### between FSF 19.23 and 19.28 there are some changes to the logic | |
| 1140 in this function (and minor changes to find_start_of_comment(), | |
| 1141 above, which is part of Fforward_comment() in FSF). Attempts to port | |
| 1142 that logic made this function break, so I'm leaving it out. If anyone | |
| 1143 ever complains about this function not working properly, take a look | |
| 1144 at those changes. --ben */ | |
| 1145 | |
| 446 | 1146 DEFUN ("forward-comment", Fforward_comment, 0, 2, 0, /* |
| 444 | 1147 Move forward across up to COUNT comments, or backwards if COUNT is negative. |
| 428 | 1148 Stop scanning if we find something other than a comment or whitespace. |
| 1149 Set point to where scanning stops. | |
| 444 | 1150 If COUNT comments are found as expected, with nothing except whitespace |
| 428 | 1151 between them, return t; otherwise return nil. |
| 1152 Point is set in either case. | |
| 446 | 1153 COUNT defaults to 1, and BUFFER defaults to the current buffer. |
| 428 | 1154 */ |
| 444 | 1155 (count, buffer)) |
| 428 | 1156 { |
| 665 | 1157 Charbpos from; |
| 1158 Charbpos stop; | |
| 867 | 1159 Ichar c; |
| 428 | 1160 enum syntaxcode code; |
| 460 | 1161 int syncode; |
| 444 | 1162 EMACS_INT n; |
| 428 | 1163 struct buffer *buf = decode_buffer (buffer, 0); |
| 826 | 1164 struct syntax_cache *scache; |
| 1165 | |
| 446 | 1166 if (NILP (count)) |
| 1167 n = 1; | |
| 1168 else | |
| 1169 { | |
| 1170 CHECK_INT (count); | |
| 1171 n = XINT (count); | |
| 1172 } | |
| 428 | 1173 |
| 1174 from = BUF_PT (buf); | |
| 1175 | |
| 826 | 1176 scache = setup_buffer_syntax_cache (buf, from, n); |
| 444 | 1177 while (n > 0) |
| 428 | 1178 { |
| 1179 QUIT; | |
| 1180 | |
| 1181 stop = BUF_ZV (buf); | |
| 1182 while (from < stop) | |
| 1183 { | |
| 460 | 1184 int comstyle = 0; /* mask for finding matching comment style */ |
| 428 | 1185 |
| 1186 if (char_quoted (buf, from)) | |
| 1187 { | |
| 1188 from++; | |
| 1189 continue; | |
| 1190 } | |
| 1191 | |
| 826 | 1192 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1193 c = BUF_FETCH_CHAR (buf, from); |
| 826 | 1194 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 1195 code = SYNTAX_FROM_CODE (syncode); | |
| 428 | 1196 |
| 1197 if (code == Scomment) | |
| 1198 { | |
| 1199 /* we have encountered a single character comment start | |
| 1200 sequence, and we are ignoring all text inside comments. | |
| 1201 we must record the comment style this character begins | |
| 1202 so that later, only a comment end of the same style actually | |
| 1203 ends the comment section */ | |
| 460 | 1204 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) |
| 1205 == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 428 | 1206 } |
| 1207 | |
| 460 | 1208 else if (code == Scomment_fence) |
| 1209 { | |
| 1210 from++; | |
| 1211 code = Scomment; | |
| 1212 comstyle = ST_COMMENT_STYLE; | |
| 1213 } | |
| 1214 | |
| 428 | 1215 else if (from < stop |
| 460 | 1216 && SYNTAX_CODE_START_FIRST_P (syncode)) |
| 428 | 1217 { |
| 460 | 1218 int next_syncode; |
| 826 | 1219 UPDATE_SYNTAX_CACHE_FORWARD (scache, from + 1); |
| 460 | 1220 next_syncode = |
| 826 | 1221 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from + 1)); |
| 460 | 1222 |
| 1223 if (SYNTAX_CODES_START_P (syncode, next_syncode)) | |
| 1224 { | |
| 1225 /* we have encountered a 2char comment start sequence and we | |
| 1226 are ignoring all text inside comments. we must record | |
| 1227 the comment style this sequence begins so that later, | |
| 1228 only a comment end of the same style actually ends | |
| 1229 the comment section */ | |
| 1230 code = Scomment; | |
| 1231 comstyle = | |
| 1232 SYNTAX_CODES_COMMENT_MASK_START (syncode, next_syncode) | |
| 1233 == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 1234 from++; | |
| 1235 } | |
| 428 | 1236 } |
| 1237 | |
| 1238 if (code == Scomment) | |
| 1239 { | |
| 826 | 1240 Charbpos newfrom = find_end_of_comment (buf, from, stop, |
| 1241 comstyle); | |
| 428 | 1242 if (newfrom < 0) |
| 1243 { | |
| 1244 /* we stopped because from==stop */ | |
| 1245 BUF_SET_PT (buf, stop); | |
| 1246 return Qnil; | |
| 1247 } | |
| 1248 from = newfrom; | |
| 1249 | |
| 1250 /* We have skipped one comment. */ | |
| 1251 break; | |
| 1252 } | |
| 1253 else if (code != Swhitespace | |
| 1254 && code != Sendcomment | |
| 1255 && code != Scomment ) | |
| 1256 { | |
| 1257 BUF_SET_PT (buf, from); | |
| 1258 return Qnil; | |
| 1259 } | |
| 1260 from++; | |
| 1261 } | |
| 1262 | |
| 1263 /* End of comment reached */ | |
| 444 | 1264 n--; |
| 428 | 1265 } |
| 1266 | |
| 444 | 1267 while (n < 0) |
| 428 | 1268 { |
| 1269 QUIT; | |
| 1270 | |
| 1271 stop = BUF_BEGV (buf); | |
| 1272 while (from > stop) | |
| 1273 { | |
| 460 | 1274 int comstyle = 0; /* mask for finding matching comment style */ |
| 428 | 1275 |
| 1276 from--; | |
| 1277 if (char_quoted (buf, from)) | |
| 1278 { | |
| 1279 from--; | |
| 1280 continue; | |
| 1281 } | |
| 1282 | |
| 1283 c = BUF_FETCH_CHAR (buf, from); | |
| 826 | 1284 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 1285 code = SYNTAX_FROM_CODE (syncode); | |
| 428 | 1286 |
| 1287 if (code == Sendcomment) | |
| 1288 { | |
| 1289 /* we have found a single char end comment. we must record | |
| 1290 the comment style encountered so that later, we can match | |
| 1291 only the proper comment begin sequence of the same style */ | |
| 460 | 1292 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) |
| 1293 == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 1294 } | |
| 1295 | |
| 1296 else if (code == Scomment_fence) | |
| 1297 { | |
| 1298 code = Sendcomment; | |
| 1299 comstyle = ST_COMMENT_STYLE; | |
| 428 | 1300 } |
| 1301 | |
| 1302 else if (from > stop | |
| 460 | 1303 && SYNTAX_CODE_END_SECOND_P (syncode)) |
| 428 | 1304 { |
| 460 | 1305 int prev_syncode; |
| 826 | 1306 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 460 | 1307 prev_syncode = |
| 826 | 1308 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1)); |
| 460 | 1309 if (SYNTAX_CODES_END_P (prev_syncode, syncode)) |
| 1310 { | |
| 1311 /* We must record the comment style encountered so that | |
| 1312 later, we can match only the proper comment begin | |
| 1313 sequence of the same style. */ | |
| 1314 code = Sendcomment; | |
| 1315 comstyle = SYNTAX_CODES_COMMENT_MASK_END | |
| 1316 (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 1317 from--; | |
| 1318 } | |
| 428 | 1319 } |
| 1320 | |
| 1321 if (code == Sendcomment) | |
| 1322 { | |
| 460 | 1323 from = find_start_of_comment (buf, from, stop, comstyle); |
| 428 | 1324 break; |
| 1325 } | |
| 1326 | |
| 1327 else if (code != Swhitespace | |
| 460 | 1328 && code != Scomment |
| 1329 && code != Sendcomment) | |
| 428 | 1330 { |
| 1331 BUF_SET_PT (buf, from + 1); | |
| 1332 return Qnil; | |
| 1333 } | |
| 1334 } | |
| 1335 | |
| 444 | 1336 n++; |
| 428 | 1337 } |
| 1338 | |
| 1339 BUF_SET_PT (buf, from); | |
| 1340 return Qt; | |
| 1341 } | |
| 1342 | |
| 1343 | |
| 1344 Lisp_Object | |
| 665 | 1345 scan_lists (struct buffer *buf, Charbpos from, int count, int depth, |
| 444 | 1346 int sexpflag, int noerror) |
| 428 | 1347 { |
| 665 | 1348 Charbpos stop; |
| 867 | 1349 Ichar c; |
| 428 | 1350 int quoted; |
| 1351 int mathexit = 0; | |
| 1352 enum syntaxcode code; | |
| 460 | 1353 int syncode; |
| 428 | 1354 int min_depth = depth; /* Err out if depth gets less than this. */ |
| 826 | 1355 struct syntax_cache *scache; |
| 1356 | |
| 428 | 1357 if (depth > 0) min_depth = 0; |
| 1358 | |
| 826 | 1359 scache = setup_buffer_syntax_cache (buf, from, count); |
| 428 | 1360 while (count > 0) |
| 1361 { | |
| 1362 QUIT; | |
| 1363 | |
| 1364 stop = BUF_ZV (buf); | |
| 1365 while (from < stop) | |
| 1366 { | |
| 460 | 1367 int comstyle = 0; /* mask for finding matching comment style */ |
| 428 | 1368 |
| 826 | 1369 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1370 c = BUF_FETCH_CHAR (buf, from); |
| 826 | 1371 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 1372 code = SYNTAX_FROM_CODE (syncode); | |
| 428 | 1373 from++; |
| 1374 | |
| 1375 /* a 1-char comment start sequence */ | |
| 1376 if (code == Scomment && parse_sexp_ignore_comments) | |
| 1377 { | |
| 460 | 1378 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) == |
| 1379 SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 428 | 1380 } |
| 1381 | |
| 1382 /* else, a 2-char comment start sequence? */ | |
| 1383 else if (from < stop | |
| 460 | 1384 && SYNTAX_CODE_START_FIRST_P (syncode) |
| 428 | 1385 && parse_sexp_ignore_comments) |
| 1386 { | |
| 460 | 1387 int next_syncode; |
| 826 | 1388 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1389 next_syncode = |
| 826 | 1390 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)); |
| 460 | 1391 |
| 1392 if (SYNTAX_CODES_START_P (syncode, next_syncode)) | |
| 1393 { | |
| 826 | 1394 /* we have encountered a comment start sequence and we |
| 1395 are ignoring all text inside comments. we must record | |
| 1396 the comment style this sequence begins so that later, | |
| 1397 only a comment end of the same style actually ends | |
| 1398 the comment section */ | |
| 1399 code = Scomment; | |
| 460 | 1400 comstyle = SYNTAX_CODES_COMMENT_MASK_START |
| 1401 (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 826 | 1402 from++; |
| 1403 } | |
| 428 | 1404 } |
| 826 | 1405 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1406 |
| 460 | 1407 if (SYNTAX_CODE_PREFIX (syncode)) |
| 428 | 1408 continue; |
| 1409 | |
| 1410 switch (code) | |
| 1411 { | |
| 1412 case Sescape: | |
| 1413 case Scharquote: | |
| 1414 if (from == stop) goto lose; | |
| 1415 from++; | |
| 1416 /* treat following character as a word constituent */ | |
| 1417 case Sword: | |
| 1418 case Ssymbol: | |
| 1419 if (depth || !sexpflag) break; | |
| 1420 /* This word counts as a sexp; return at end of it. */ | |
| 1421 while (from < stop) | |
| 1422 { | |
| 826 | 1423 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 1424 switch (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from))) | |
| 428 | 1425 { |
| 1426 case Scharquote: | |
| 1427 case Sescape: | |
| 1428 from++; | |
| 1429 if (from == stop) goto lose; | |
| 1430 break; | |
| 1431 case Sword: | |
| 1432 case Ssymbol: | |
| 1433 case Squote: | |
| 1434 break; | |
| 1435 default: | |
| 1436 goto done; | |
| 1437 } | |
| 1438 from++; | |
| 1439 } | |
| 1440 goto done; | |
| 1441 | |
| 460 | 1442 case Scomment_fence: |
| 1443 comstyle = ST_COMMENT_STYLE; | |
| 428 | 1444 case Scomment: |
| 1445 if (!parse_sexp_ignore_comments) | |
| 1446 break; | |
| 826 | 1447 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1448 { |
| 665 | 1449 Charbpos newfrom = |
| 460 | 1450 find_end_of_comment (buf, from, stop, comstyle); |
| 428 | 1451 if (newfrom < 0) |
| 1452 { | |
| 1453 /* we stopped because from == stop in search forward */ | |
| 1454 from = stop; | |
| 1455 if (depth == 0) | |
| 1456 goto done; | |
| 1457 goto lose; | |
| 1458 } | |
| 1459 from = newfrom; | |
| 1460 } | |
| 1461 break; | |
| 1462 | |
| 1463 case Smath: | |
| 1464 if (!sexpflag) | |
| 1465 break; | |
| 1466 if (from != stop && c == BUF_FETCH_CHAR (buf, from)) | |
| 1467 from++; | |
| 1468 if (mathexit) | |
| 1469 { | |
| 1470 mathexit = 0; | |
| 1471 goto close1; | |
| 1472 } | |
| 1473 mathexit = 1; | |
| 1474 | |
| 1475 case Sopen: | |
| 1476 if (!++depth) goto done; | |
| 1477 break; | |
| 1478 | |
| 1479 case Sclose: | |
| 1480 close1: | |
| 1481 if (!--depth) goto done; | |
| 1482 if (depth < min_depth) | |
| 1483 { | |
| 444 | 1484 if (noerror) |
| 428 | 1485 return Qnil; |
| 826 | 1486 syntax_error ("Containing expression ends prematurely", |
| 1487 Qunbound); | |
| 428 | 1488 } |
| 1489 break; | |
| 1490 | |
| 460 | 1491 case Sstring_fence: |
| 428 | 1492 case Sstring: |
| 1493 { | |
| 867 | 1494 Ichar stringterm; |
| 460 | 1495 |
| 1496 if (code != Sstring_fence) | |
| 1497 { | |
| 826 | 1498 /* XEmacs change: call syntax_match on character */ |
| 867 | 1499 Ichar ch = BUF_FETCH_CHAR (buf, from - 1); |
| 460 | 1500 Lisp_Object stermobj = |
| 1296 | 1501 syntax_match (scache->syntax_table, ch); |
| 428 | 1502 |
| 1503 if (CHARP (stermobj)) | |
| 1504 stringterm = XCHAR (stermobj); | |
| 1505 else | |
| 1506 stringterm = ch; | |
| 460 | 1507 } |
| 1508 else | |
| 1509 stringterm = '\0'; /* avoid compiler warnings */ | |
| 428 | 1510 |
| 1511 while (1) | |
| 1512 { | |
| 1513 if (from >= stop) | |
| 1514 goto lose; | |
| 826 | 1515 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1516 c = BUF_FETCH_CHAR (buf, from); |
| 1517 if (code == Sstring | |
| 1518 ? c == stringterm | |
| 826 | 1519 : SYNTAX_FROM_CACHE (scache, c) == Sstring_fence) |
| 428 | 1520 break; |
| 460 | 1521 |
| 826 | 1522 switch (SYNTAX_FROM_CACHE (scache, c)) |
| 428 | 1523 { |
| 1524 case Scharquote: | |
| 1525 case Sescape: | |
| 1526 from++; | |
| 1527 break; | |
| 1528 default: | |
| 1529 break; | |
| 1530 } | |
| 1531 from++; | |
| 1532 } | |
| 1533 from++; | |
| 1534 if (!depth && sexpflag) goto done; | |
| 1535 break; | |
| 1536 } | |
| 1537 | |
| 1538 default: | |
| 1539 break; | |
| 1540 } | |
| 1541 } | |
| 1542 | |
| 1543 /* Reached end of buffer. Error if within object, | |
| 1544 return nil if between */ | |
| 1545 if (depth) goto lose; | |
| 1546 | |
| 1547 return Qnil; | |
| 1548 | |
| 1549 /* End of object reached */ | |
| 1550 done: | |
| 1551 count--; | |
| 1552 } | |
| 1553 | |
| 1554 while (count < 0) | |
| 1555 { | |
| 1556 QUIT; | |
| 1557 | |
| 1558 stop = BUF_BEGV (buf); | |
| 1559 while (from > stop) | |
| 1560 { | |
| 460 | 1561 int comstyle = 0; /* mask for finding matching comment style */ |
| 428 | 1562 |
| 1563 from--; | |
| 826 | 1564 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 428 | 1565 quoted = char_quoted (buf, from); |
| 1566 if (quoted) | |
| 460 | 1567 { |
| 428 | 1568 from--; |
| 826 | 1569 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 460 | 1570 } |
| 428 | 1571 |
| 1572 c = BUF_FETCH_CHAR (buf, from); | |
| 826 | 1573 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 1574 code = SYNTAX_FROM_CODE (syncode); | |
| 428 | 1575 |
| 1576 if (code == Sendcomment && parse_sexp_ignore_comments) | |
| 1577 { | |
| 1578 /* we have found a single char end comment. we must record | |
| 1579 the comment style encountered so that later, we can match | |
| 1580 only the proper comment begin sequence of the same style */ | |
| 460 | 1581 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) |
| 1582 == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 428 | 1583 } |
| 1584 | |
| 1585 else if (from > stop | |
| 460 | 1586 && SYNTAX_CODE_END_SECOND_P (syncode) |
| 428 | 1587 && !char_quoted (buf, from - 1) |
| 1588 && parse_sexp_ignore_comments) | |
| 1589 { | |
| 460 | 1590 int prev_syncode; |
| 826 | 1591 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 1592 prev_syncode = | |
| 1593 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1)); | |
| 460 | 1594 |
| 1595 if (SYNTAX_CODES_END_P (prev_syncode, syncode)) | |
| 1596 { | |
| 428 | 1597 /* we must record the comment style encountered so that |
| 1598 later, we can match only the proper comment begin | |
| 1599 sequence of the same style */ | |
| 1600 code = Sendcomment; | |
| 460 | 1601 comstyle = SYNTAX_CODES_COMMENT_MASK_END |
| 1602 (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 428 | 1603 from--; |
| 1604 } | |
| 460 | 1605 } |
| 428 | 1606 |
| 460 | 1607 if (SYNTAX_CODE_PREFIX (syncode)) |
| 428 | 1608 continue; |
| 1609 | |
| 434 | 1610 switch (quoted ? Sword : code) |
| 428 | 1611 { |
| 1612 case Sword: | |
| 1613 case Ssymbol: | |
| 1614 if (depth || !sexpflag) break; | |
| 1615 /* This word counts as a sexp; count object finished after | |
| 1616 passing it. */ | |
| 1617 while (from > stop) | |
| 1618 { | |
| 826 | 1619 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 428 | 1620 quoted = char_quoted (buf, from - 1); |
| 1621 | |
| 1622 if (quoted) | |
| 1623 from--; | |
| 1624 if (! (quoted | |
| 1625 || (syncode = | |
| 826 | 1626 SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, |
| 1627 from - 1))) | |
| 428 | 1628 == Sword |
| 1629 || syncode == Ssymbol | |
| 1630 || syncode == Squote)) | |
| 1631 goto done2; | |
| 1632 from--; | |
| 1633 } | |
| 1634 goto done2; | |
| 1635 | |
| 1636 case Smath: | |
| 1637 if (!sexpflag) | |
| 1638 break; | |
| 1639 if (from != stop && c == BUF_FETCH_CHAR (buf, from - 1)) | |
| 1640 from--; | |
| 1641 if (mathexit) | |
| 1642 { | |
| 1643 mathexit = 0; | |
| 1644 goto open2; | |
| 1645 } | |
| 1646 mathexit = 1; | |
| 1647 | |
| 1648 case Sclose: | |
| 1649 if (!++depth) goto done2; | |
| 1650 break; | |
| 1651 | |
| 1652 case Sopen: | |
| 1653 open2: | |
| 1654 if (!--depth) goto done2; | |
| 1655 if (depth < min_depth) | |
| 1656 { | |
| 444 | 1657 if (noerror) |
| 428 | 1658 return Qnil; |
| 826 | 1659 syntax_error ("Containing expression ends prematurely", |
| 1660 Qunbound); | |
| 428 | 1661 } |
| 1662 break; | |
| 1663 | |
| 460 | 1664 case Scomment_fence: |
| 1665 comstyle = ST_COMMENT_STYLE; | |
| 428 | 1666 case Sendcomment: |
| 1667 if (parse_sexp_ignore_comments) | |
| 460 | 1668 from = find_start_of_comment (buf, from, stop, comstyle); |
| 428 | 1669 break; |
| 1670 | |
| 460 | 1671 case Sstring_fence: |
| 428 | 1672 case Sstring: |
| 1673 { | |
| 867 | 1674 Ichar stringterm; |
| 460 | 1675 |
| 1676 if (code != Sstring_fence) | |
| 1677 { | |
| 428 | 1678 /* XEmacs change: call syntax_match() on character */ |
| 867 | 1679 Ichar ch = BUF_FETCH_CHAR (buf, from); |
| 460 | 1680 Lisp_Object stermobj = |
| 1296 | 1681 syntax_match (scache->syntax_table, ch); |
| 428 | 1682 |
| 1683 if (CHARP (stermobj)) | |
| 1684 stringterm = XCHAR (stermobj); | |
| 1685 else | |
| 1686 stringterm = ch; | |
| 460 | 1687 } |
| 1688 else | |
| 1689 stringterm = '\0'; /* avoid compiler warnings */ | |
| 428 | 1690 |
| 1691 while (1) | |
| 1692 { | |
| 1693 if (from == stop) goto lose; | |
| 460 | 1694 |
| 826 | 1695 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 460 | 1696 c = BUF_FETCH_CHAR (buf, from - 1); |
| 1697 | |
| 1698 if ((code == Sstring | |
| 1699 ? c == stringterm | |
| 826 | 1700 : SYNTAX_FROM_CACHE (scache, c) == Sstring_fence) |
| 460 | 1701 && !char_quoted (buf, from - 1)) |
| 1702 { | |
| 428 | 1703 break; |
| 460 | 1704 } |
| 1705 | |
| 428 | 1706 from--; |
| 1707 } | |
| 1708 from--; | |
| 1709 if (!depth && sexpflag) goto done2; | |
| 1710 break; | |
| 1711 } | |
| 1712 } | |
| 1713 } | |
| 1714 | |
| 1715 /* Reached start of buffer. Error if within object, | |
| 1716 return nil if between */ | |
| 1717 if (depth) goto lose; | |
| 1718 | |
| 1719 return Qnil; | |
| 1720 | |
| 1721 done2: | |
| 1722 count++; | |
| 1723 } | |
| 1724 | |
| 1725 | |
| 1726 return (make_int (from)); | |
| 1727 | |
| 1728 lose: | |
| 444 | 1729 if (!noerror) |
| 826 | 1730 syntax_error ("Unbalanced parentheses", Qunbound); |
| 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 { |
| 826 | 2293 Lisp_Object mirrortab = VOID_TO_LISP (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 { | |
| 1296 | 2307 Lisp_Object mirrortab = VOID_TO_LISP (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 |
| 826 | 2352 map_char_table (table, &range, copy_to_mirrortab, LISP_TO_VOID (mirrortab)); |
| 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, |
| 2357 copy_if_not_already_present, LISP_TO_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 |
| 2394 INIT_LRECORD_IMPLEMENTATION (syntax_cache); | |
| 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); | |
| 2421 } | |
| 2422 | |
| 2423 void | |
| 2424 vars_of_syntax (void) | |
| 2425 { | |
| 2426 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments /* | |
| 2427 Non-nil means `forward-sexp', etc., should treat comments as whitespace. | |
| 2428 */ ); | |
| 434 | 2429 parse_sexp_ignore_comments = 0; |
| 428 | 2430 |
| 460 | 2431 DEFVAR_BOOL ("lookup-syntax-properties", &lookup_syntax_properties /* |
| 826 | 2432 Non-nil means `forward-sexp', etc., respect the `syntax-table' property. |
| 2433 This property can be placed on buffers or strings and can be used to explicitly | |
| 2434 specify the syntax table to be used for looking up the syntax of the chars | |
| 2435 having this property, or to directly specify the syntax of the chars. | |
| 2436 | |
| 460 | 2437 The value of this property should be either a syntax table, or a cons |
| 2438 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric | |
| 2439 syntax code, MATCHCHAR being nil or the character to match (which is | |
| 826 | 2440 relevant only when the syntax code is open/close-type). |
| 460 | 2441 */ ); |
| 2442 lookup_syntax_properties = 1; | |
| 2443 | |
| 428 | 2444 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes /* |
| 2445 Non-nil means `forward-word', etc., should treat escape chars part of words. | |
| 2446 */ ); | |
| 434 | 2447 words_include_escapes = 0; |
| 428 | 2448 |
| 2449 no_quit_in_re_search = 0; | |
| 1296 | 2450 |
| 2451 Vbogus_syntax_table_value = make_float (0.0); | |
| 2452 staticpro (&Vbogus_syntax_table_value); | |
| 428 | 2453 } |
| 2454 | |
| 2455 static void | |
| 3540 | 2456 define_standard_syntax (const UExtbyte *p, enum syntaxcode syn) |
| 428 | 2457 { |
| 2458 for (; *p; p++) | |
| 2459 Fput_char_table (make_char (*p), make_int (syn), Vstandard_syntax_table); | |
| 2460 } | |
| 2461 | |
| 2462 void | |
| 2463 complex_vars_of_syntax (void) | |
| 2464 { | |
| 867 | 2465 Ichar i; |
| 3540 | 2466 const UExtbyte *p; /* Latin-1, not internal format. */ |
| 2467 | |
| 2468 #define SET_RANGE_SYNTAX(start, end, syntax) \ | |
| 2469 do { \ | |
| 2470 for (i = start; i <= end; i++) \ | |
| 2471 Fput_char_table(make_char(i), make_int(syntax), \ | |
| 2472 Vstandard_syntax_table); \ | |
| 2473 } while (0) | |
| 2474 | |
| 2475 /* Set this now, so first buffer creation can refer to it. | |
| 2476 | |
| 2477 Make it nil before calling copy-syntax-table so that copy-syntax-table | |
| 2478 will know not to try to copy from garbage */ | |
| 428 | 2479 Vstandard_syntax_table = Qnil; |
| 2480 Vstandard_syntax_table = Fcopy_syntax_table (Qnil); | |
| 2481 staticpro (&Vstandard_syntax_table); | |
| 2482 | |
| 826 | 2483 Vtemp_table_for_use_updating_syntax_tables = Fmake_char_table (Qgeneric); |
| 2484 staticpro (&Vtemp_table_for_use_updating_syntax_tables); | |
| 2485 | |
| 428 | 2486 Vsyntax_designator_chars_string = make_string_nocopy (syntax_code_spec, |
| 2487 Smax); | |
| 2488 staticpro (&Vsyntax_designator_chars_string); | |
| 2489 | |
| 3540 | 2490 /* Default character syntax is word. */ |
| 3152 | 2491 set_char_table_default (Vstandard_syntax_table, make_int (Sword)); |
| 428 | 2492 |
| 3540 | 2493 /* Control 0; treat as punctuation */ |
| 2494 SET_RANGE_SYNTAX(0, 32, Spunct); | |
| 428 | 2495 |
| 3544 | 2496 /* The whitespace--overwriting some of the above changes. |
| 2497 | |
| 2498 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
|
2499 define_standard_syntax((const UExtbyte *)" \t\015\014\012", Swhitespace); |
| 3540 | 2500 |
| 2501 /* DEL plus Control 1 */ | |
| 2502 SET_RANGE_SYNTAX(127, 159, Spunct); | |
| 2503 | |
| 3544 | 2504 define_standard_syntax ((const UExtbyte *)"\"", Sstring); |
| 2505 define_standard_syntax ((const UExtbyte *)"\\", Sescape); | |
| 2506 define_standard_syntax ((const UExtbyte *)"_-+*/&|<>=", Ssymbol); | |
| 2507 define_standard_syntax ((const UExtbyte *)".,;:?!#@~^'`", Spunct); | |
| 428 | 2508 |
| 3544 | 2509 for (p = (const UExtbyte *)"()[]{}"; *p; p+=2) |
| 428 | 2510 { |
| 2511 Fput_char_table (make_char (p[0]), | |
| 2512 Fcons (make_int (Sopen), make_char (p[1])), | |
| 2513 Vstandard_syntax_table); | |
| 2514 Fput_char_table (make_char (p[1]), | |
| 2515 Fcons (make_int (Sclose), make_char (p[0])), | |
| 2516 Vstandard_syntax_table); | |
| 2517 } | |
| 3540 | 2518 |
| 2519 /* Latin 1 "symbols." This contrasts with the FSF, where they're word | |
| 2520 constituents. */ | |
| 2521 SET_RANGE_SYNTAX(0240, 0277, Ssymbol); | |
| 2522 | |
| 2523 /* The guillemets. These are not parentheses, in contrast to what the old | |
| 2524 code did. */ | |
| 3569 | 2525 define_standard_syntax((const UExtbyte *)"\253\273", Spunct); |
| 3540 | 2526 |
| 2527 /* The inverted exclamation mark, and the multiplication and division | |
| 2528 signs. */ | |
| 3544 | 2529 define_standard_syntax((const UExtbyte *)"\241\327\367", Spunct); |
| 3540 | 2530 |
| 2531 #undef SET_RANGE_SYNTAX | |
| 428 | 2532 } |