Mercurial > hg > xemacs-beta
annotate src/font-lock.c @ 5167:e374ea766cc1
clean up, rearrange allocation statistics code
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-03-21 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (assert_proper_sizing):
* alloc.c (c_readonly):
* alloc.c (malloced_storage_size):
* alloc.c (fixed_type_block_overhead):
* alloc.c (lisp_object_storage_size):
* alloc.c (inc_lrecord_stats):
* alloc.c (dec_lrecord_stats):
* alloc.c (pluralize_word):
* alloc.c (object_memory_usage_stats):
* alloc.c (Fobject_memory_usage):
* alloc.c (compute_memusage_stats_length):
* alloc.c (disksave_object_finalization_1):
* alloc.c (Fgarbage_collect):
* mc-alloc.c:
* mc-alloc.c (mc_alloced_storage_size):
* mc-alloc.h:
No functionality change here. Collect the allocations-statistics
code that was scattered throughout alloc.c into one place. Add
remaining section headings so that all sections have headings
clearly identifying the start of the section and its purpose.
Expose mc_alloced_storage_size() even when not MEMORY_USAGE_STATS;
this fixes build problems and is related to the export of
lisp_object_storage_size() and malloced_storage_size() when
non-MEMORY_USAGE_STATS in the previous change set.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sun, 21 Mar 2010 04:41:49 -0500 |
| parents | 6f2158fa75ed |
| children | 308d34e9f07d |
| rev | line source |
|---|---|
| 428 | 1 /* Routines to compute the current syntactic context, for font-lock mode. |
| 2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Sun Microsystems, Inc. | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
4 Copyright (C) 2002, 2003, 2010 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: Not in FSF. */ | |
| 24 | |
| 25 /* This code computes the syntactic context of the current point, that is, | |
| 26 whether point is within a comment, a string, what have you. It does | |
| 27 this by picking a point "known" to be outside of any syntactic constructs | |
| 28 and moving forward, examining the syntax of each character. | |
| 29 | |
| 30 Two caches are used: one caches the last point computed, and the other | |
| 31 caches the last point at the beginning of a line. This makes there | |
| 32 be little penalty for moving left-to-right on a line a character at a | |
| 33 time; makes starting over on a line be cheap; and makes random-accessing | |
| 34 within a line relatively cheap. | |
| 35 | |
| 36 When we move to a different line farther down in the file (but within the | |
| 37 current top-level form) we simply continue computing forward. If we move | |
| 38 backward more than a line, or move beyond the end of the current tlf, or | |
| 39 switch buffers, then we call `beginning-of-defun' and start over from | |
| 40 there. | |
| 41 | |
| 42 #### We should really rewrite this to keep extents over the buffer | |
| 43 that hold the current syntactic information. This would be a big win. | |
| 44 This way there would be no guessing or incorrect results. | |
| 45 */ | |
| 46 | |
| 838 | 47 #include <config.h> |
| 826 | 48 |
| 838 | 49 #ifdef USE_C_FONT_LOCK |
| 50 | |
| 428 | 51 #include "lisp.h" |
| 52 | |
| 53 #include "buffer.h" | |
| 54 #include "insdel.h" | |
| 55 #include "syntax.h" | |
| 56 | |
| 57 Lisp_Object Qcomment; | |
| 58 Lisp_Object Qblock_comment; | |
| 59 Lisp_Object Qbeginning_of_defun; | |
| 60 | |
| 61 enum syntactic_context | |
| 62 { | |
| 63 context_none, | |
| 64 context_string, | |
| 65 context_comment, | |
| 460 | 66 context_block_comment, |
| 67 context_generic_comment, | |
| 68 context_generic_string | |
| 428 | 69 }; |
| 70 | |
| 71 enum block_comment_context | |
| 72 { | |
| 73 ccontext_none, | |
| 74 ccontext_start1, | |
| 75 ccontext_start2, | |
| 76 ccontext_end1 | |
| 77 }; | |
| 78 | |
| 79 enum comment_style | |
| 80 { | |
| 81 comment_style_none, | |
| 82 comment_style_a, | |
| 83 comment_style_b | |
| 84 }; | |
| 85 | |
| 86 struct context_cache | |
| 87 { | |
| 665 | 88 Charbpos start_point; /* beginning of defun */ |
| 89 Charbpos cur_point; /* cache location */ | |
| 90 Charbpos end_point; /* end of defun */ | |
| 428 | 91 struct buffer *buffer; /* does this need to be staticpro'd? */ |
| 92 enum syntactic_context context; /* single-char-syntax state */ | |
| 93 enum block_comment_context ccontext; /* block-comment state */ | |
| 94 enum comment_style style; /* which comment group */ | |
| 867 | 95 Ichar scontext; /* active string delimiter */ |
| 428 | 96 int depth; /* depth in parens */ |
| 97 int backslash_p; /* just read a backslash */ | |
| 98 int needs_its_head_reexamined; /* we're apparently outside of | |
| 99 a top level form, and far away | |
| 100 from it. This is a bad situation | |
| 101 because it will lead to constant | |
| 102 slowness as we keep going way | |
| 103 back to that form and moving | |
| 104 forward again. In this case, | |
| 105 we try to compute a "pseudo- | |
| 106 top-level-form" where the | |
| 107 depth is 0 and the context | |
| 108 is none at both ends. */ | |
| 109 }; | |
| 110 | |
| 111 /* We have two caches; one for the current point and one for | |
| 112 the beginning of line. We used to rely on the caller to | |
| 113 tell us when to invalidate them, but now we do it ourselves; | |
| 114 it lets us be smarter. */ | |
| 115 | |
| 116 static struct context_cache context_cache; | |
| 117 | |
| 118 static struct context_cache bol_context_cache; | |
| 119 | |
| 120 int font_lock_debug; | |
| 121 | |
| 122 #define reset_context_cache(cc) memset (cc, 0, sizeof (struct context_cache)) | |
| 123 | |
| 124 /* This function is called from signal_after_change() to tell us when | |
| 125 textual changes are made so we can flush our caches when necessary. | |
| 126 | |
| 127 We make the following somewhat heuristic assumptions: | |
| 128 | |
| 129 (remember that current_point is always >= start_point, but may be | |
| 130 less than or greater than end_point (we might not be inside any | |
| 131 top-level form)). | |
| 132 | |
| 133 1) Textual changes before the beginning of the current top-level form | |
| 134 don't affect anything; all we need to do is offset the caches | |
| 135 appropriately. | |
| 136 2) Textual changes right at the beginning of the current | |
| 137 top-level form messes things up and requires that we flush | |
| 138 the caches. | |
| 139 3) Textual changes after the beginning of the current top-level form | |
| 140 and before one or both or the caches invalidates the corresponding | |
| 141 cache(s). | |
| 142 4) Textual changes after the caches and before the end of the | |
| 143 current top-level form don't affect anything; all we need to do is | |
| 144 offset the caches appropriately. | |
| 145 5) Textual changes right at the end of the current top-level form | |
| 146 necessitate recomputing that end value. | |
| 147 6) Textual changes after the end of the current top-level form | |
| 148 are ignored. */ | |
| 149 | |
| 150 | |
| 151 void | |
| 665 | 152 font_lock_maybe_update_syntactic_caches (struct buffer *buf, Charbpos start, |
| 153 Charbpos orig_end, Charbpos new_end) | |
| 428 | 154 { |
| 155 /* Note: either both context_cache and bol_context_cache are valid and | |
| 156 point to the same buffer, or both are invalid. If we have to | |
| 157 invalidate just context_cache, we recopy it from bol_context_cache. | |
| 158 */ | |
| 159 if (context_cache.buffer != buf) | |
| 160 /* caches don't apply */ | |
| 161 return; | |
| 162 /* NOTE: The order of the if statements below is important. If you | |
| 163 change them around unthinkingly, you will probably break something. */ | |
| 164 if (orig_end <= context_cache.start_point - 1) | |
| 165 { | |
| 166 /* case 1: before the beginning of the current top-level form */ | |
| 167 Charcount diff = new_end - orig_end; | |
| 168 if (font_lock_debug) | |
| 169 stderr_out ("font-lock; Case 1\n"); | |
| 170 context_cache.start_point += diff; | |
| 171 context_cache.cur_point += diff; | |
| 172 context_cache.end_point += diff; | |
| 173 bol_context_cache.start_point += diff; | |
| 174 bol_context_cache.cur_point += diff; | |
| 175 bol_context_cache.end_point += diff; | |
| 176 } | |
| 177 else if (start <= context_cache.start_point) | |
| 178 { | |
| 179 if (font_lock_debug) | |
| 180 stderr_out ("font-lock; Case 2\n"); | |
| 181 /* case 2: right at the current top-level form (paren that starts | |
| 182 top level form got deleted or moved away from the newline it | |
| 183 was touching) */ | |
| 184 reset_context_cache (&context_cache); | |
| 185 reset_context_cache (&bol_context_cache); | |
| 186 } | |
| 187 /* OK, now we know that the start is after the beginning of the | |
| 188 current top-level form. */ | |
| 189 else if (start < bol_context_cache.cur_point) | |
| 190 { | |
| 191 if (font_lock_debug) | |
| 192 stderr_out ("font-lock; Case 3 (1)\n"); | |
| 193 /* case 3: after the beginning of the current top-level form | |
| 194 and before both of the caches */ | |
| 195 reset_context_cache (&context_cache); | |
| 196 reset_context_cache (&bol_context_cache); | |
| 197 } | |
| 198 else if (start < context_cache.cur_point) | |
| 199 { | |
| 200 if (font_lock_debug) | |
| 201 stderr_out ("font-lock; Case 3 (2)\n"); | |
| 202 /* case 3: but only need to invalidate one cache */ | |
| 203 context_cache = bol_context_cache; | |
| 204 } | |
| 205 /* OK, now we know that the start is after the caches. */ | |
| 206 else if (start >= context_cache.end_point) | |
| 207 { | |
| 208 if (font_lock_debug) | |
| 209 stderr_out ("font-lock; Case 6\n"); | |
| 210 /* case 6: after the end of the current top-level form | |
| 211 and after the caches. */ | |
| 212 } | |
| 213 else if (orig_end <= context_cache.end_point - 2) | |
| 214 { | |
| 215 /* case 4: after the caches and before the end of the | |
| 216 current top-level form */ | |
| 217 Charcount diff = new_end - orig_end; | |
| 218 if (font_lock_debug) | |
| 219 stderr_out ("font-lock; Case 4\n"); | |
| 220 context_cache.end_point += diff; | |
| 221 bol_context_cache.end_point += diff; | |
| 222 } | |
| 223 else | |
| 224 { | |
| 225 if (font_lock_debug) | |
| 226 stderr_out ("font-lock; Case 5\n"); | |
| 227 /* case 5: right at the end of the current top-level form */ | |
| 228 context_cache.end_point = context_cache.start_point - 1; | |
| 229 bol_context_cache.end_point = context_cache.start_point - 1; | |
| 230 } | |
| 231 } | |
| 232 | |
| 233 /* This function is called from Fkill_buffer(). */ | |
| 234 | |
| 235 void | |
| 236 font_lock_buffer_was_killed (struct buffer *buf) | |
| 237 { | |
| 238 if (context_cache.buffer == buf) | |
| 239 { | |
| 240 reset_context_cache (&context_cache); | |
| 241 reset_context_cache (&bol_context_cache); | |
| 242 } | |
| 243 } | |
| 244 | |
| 665 | 245 static Charbpos |
| 246 beginning_of_defun (struct buffer *buf, Charbpos pt) | |
| 428 | 247 { |
| 248 /* This function can GC */ | |
| 665 | 249 Charbpos opt = BUF_PT (buf); |
| 428 | 250 if (pt == BUF_BEGV (buf)) |
| 251 return pt; | |
| 252 BUF_SET_PT (buf, pt); | |
| 253 /* There used to be some kludginess to call c++-beginning-of-defun | |
| 254 if we're in C++ mode. There's no point in this any more; | |
| 255 we're using cc-mode. If you really want to get the old c++ | |
| 256 mode working, fix it rather than the C code. */ | |
| 257 call0_in_buffer (buf, Qbeginning_of_defun); | |
| 258 pt = BUF_PT (buf); | |
| 259 BUF_SET_PT (buf, opt); | |
| 260 return pt; | |
| 261 } | |
| 262 | |
| 665 | 263 static Charbpos |
| 264 end_of_defun (struct buffer *buf, Charbpos pt) | |
| 428 | 265 { |
| 266 Lisp_Object retval = scan_lists (buf, pt, 1, 0, 0, 1); | |
| 267 if (NILP (retval)) | |
| 268 return BUF_ZV (buf); | |
| 269 else | |
| 270 return XINT (retval); | |
| 271 } | |
| 272 | |
| 273 /* Set up context_cache for attempting to determine the syntactic context | |
| 274 in buffer BUF at point PT. */ | |
| 275 | |
| 276 static void | |
| 665 | 277 setup_context_cache (struct buffer *buf, Charbpos pt) |
| 428 | 278 { |
| 279 int recomputed_start_point = 0; | |
| 280 /* This function can GC */ | |
| 281 if (context_cache.buffer != buf || pt < context_cache.start_point) | |
| 282 { | |
| 283 start_over: | |
| 284 if (font_lock_debug) | |
| 285 stderr_out ("reset context cache\n"); | |
| 286 /* OK, completely invalid. */ | |
| 287 reset_context_cache (&context_cache); | |
| 288 reset_context_cache (&bol_context_cache); | |
| 289 } | |
| 290 if (!context_cache.buffer) | |
| 291 { | |
| 292 /* Need to recompute the start point. */ | |
| 293 if (font_lock_debug) | |
| 294 stderr_out ("recompute start\n"); | |
| 295 context_cache.start_point = beginning_of_defun (buf, pt); | |
| 296 recomputed_start_point = 1; | |
| 297 bol_context_cache.start_point = context_cache.start_point; | |
| 298 bol_context_cache.buffer = context_cache.buffer = buf; | |
| 299 } | |
| 300 if (context_cache.end_point < context_cache.start_point) | |
| 301 { | |
| 302 /* Need to recompute the end point. */ | |
| 303 if (font_lock_debug) | |
| 304 stderr_out ("recompute end\n"); | |
| 305 context_cache.end_point = end_of_defun (buf, context_cache.start_point); | |
| 306 bol_context_cache.end_point = context_cache.end_point; | |
| 307 } | |
| 308 if (bol_context_cache.cur_point == 0 || | |
| 309 pt < bol_context_cache.cur_point) | |
| 310 { | |
| 311 if (font_lock_debug) | |
| 312 stderr_out ("reset to start\n"); | |
| 313 if (pt > context_cache.end_point | |
| 314 /* 3000 is some arbitrary delta but seems reasonable; | |
| 315 about the size of a reasonable function */ | |
| 316 && pt - context_cache.end_point > 3000) | |
| 317 /* If we're far past the end of the top level form, | |
| 318 don't trust it; recompute it. */ | |
| 319 { | |
| 320 /* But don't get in an infinite loop doing this. | |
| 321 If we're really far past the end of the top level | |
| 322 form, try to compute a pseudo-top-level form. */ | |
| 323 if (recomputed_start_point) | |
| 324 context_cache.needs_its_head_reexamined = 1; | |
| 325 else | |
| 326 /* force recomputation */ | |
| 327 goto start_over; | |
| 328 } | |
| 329 /* Go to the nearest end of the top-level form that's before | |
| 330 us. */ | |
| 331 if (pt > context_cache.end_point) | |
| 332 pt = context_cache.end_point; | |
| 333 else | |
| 334 pt = context_cache.start_point; | |
| 335 /* Reset current point to start of buffer. */ | |
| 336 context_cache.cur_point = pt; | |
| 337 context_cache.context = context_none; | |
| 338 context_cache.ccontext = ccontext_none; | |
| 339 context_cache.style = comment_style_none; | |
| 340 context_cache.scontext = '\000'; | |
| 341 context_cache.depth = 0; | |
| 460 | 342 /* #### shouldn't this be checking the character's syntax instead of |
| 343 explicitly testing for backslash characters? */ | |
| 428 | 344 context_cache.backslash_p = ((pt > 1) && |
| 345 (BUF_FETCH_CHAR (buf, pt - 1) == '\\')); | |
| 346 /* Note that the BOL context cache may not be at the beginning | |
| 347 of the line, but that should be OK, nobody's checking. */ | |
| 348 bol_context_cache = context_cache; | |
| 349 return; | |
| 350 } | |
| 351 else if (pt < context_cache.cur_point) | |
| 352 { | |
| 353 if (font_lock_debug) | |
| 354 stderr_out ("reset to bol\n"); | |
| 355 /* bol cache is OK but current_cache is not. */ | |
| 356 context_cache = bol_context_cache; | |
| 357 return; | |
| 358 } | |
| 359 else if (pt <= context_cache.end_point) | |
| 360 { | |
| 361 if (font_lock_debug) | |
| 362 stderr_out ("everything is OK\n"); | |
| 363 /* in same top-level form. */ | |
| 364 return; | |
| 365 } | |
| 366 { | |
| 367 /* OK, we're past the end of the top-level form. */ | |
| 665 | 368 Charbpos maxpt = max (context_cache.end_point, context_cache.cur_point); |
| 428 | 369 #if 0 |
| 370 int shortage; | |
| 371 #endif | |
| 372 | |
| 373 if (font_lock_debug) | |
| 374 stderr_out ("past end\n"); | |
| 375 if (pt <= maxpt) | |
| 376 /* OK, fine. */ | |
| 377 return; | |
| 378 #if 0 | |
| 442 | 379 /* This appears to cause huge slowdowns in files which have no |
| 380 top-level forms. | |
| 428 | 381 |
| 382 In any case, it's not really necessary that we know for | |
| 383 sure the top-level form we're in; if we're in a form | |
| 384 but the form we have recorded is the previous one, | |
| 385 it will be OK. */ | |
| 386 | |
| 387 scan_buffer (buf, '\n', maxpt, pt, 1, &shortage, 1); | |
| 388 if (!shortage) | |
| 389 /* If there was a newline in the region past the known universe, | |
| 390 we might be inside another top-level form, so start over. | |
| 391 Otherwise, we're outside of any top-level forms and we know | |
| 392 the one directly before us, so it's OK. */ | |
| 393 goto start_over; | |
| 394 #endif | |
| 395 } | |
| 396 } | |
| 397 | |
| 647 | 398 /* You'd think it wouldn't be necessary to cast something to the type |
| 399 it's already defined is, but if you're GCC, you apparently think | |
| 400 differently */ | |
| 460 | 401 #define SYNTAX_START_STYLE(c1, c2) \ |
| 647 | 402 ((enum comment_style) \ |
| 460 | 403 (SYNTAX_CODES_MATCH_START_P (c1, c2, SYNTAX_COMMENT_STYLE_A) ? \ |
| 428 | 404 comment_style_a : \ |
| 460 | 405 SYNTAX_CODES_MATCH_START_P (c1, c2, SYNTAX_COMMENT_STYLE_B) ? \ |
| 428 | 406 comment_style_b : \ |
| 647 | 407 comment_style_none)) |
| 428 | 408 |
| 460 | 409 #define SYNTAX_END_STYLE(c1, c2) \ |
| 647 | 410 ((enum comment_style) \ |
| 411 (SYNTAX_CODES_MATCH_END_P (c1, c2, SYNTAX_COMMENT_STYLE_A) ? \ | |
| 460 | 412 comment_style_a : \ |
| 413 SYNTAX_CODES_MATCH_END_P (c1, c2, SYNTAX_COMMENT_STYLE_B) ? \ | |
| 414 comment_style_b : \ | |
| 647 | 415 comment_style_none)) |
| 460 | 416 |
| 417 #define SINGLE_SYNTAX_STYLE(c) \ | |
| 647 | 418 ((enum comment_style) \ |
| 419 (SYNTAX_CODE_MATCHES_1CHAR_P (c, SYNTAX_COMMENT_STYLE_A) ? \ | |
| 428 | 420 comment_style_a : \ |
| 460 | 421 SYNTAX_CODE_MATCHES_1CHAR_P (c, SYNTAX_COMMENT_STYLE_B) ? \ |
| 428 | 422 comment_style_b : \ |
| 647 | 423 comment_style_none)) |
| 428 | 424 |
| 425 /* Set up context_cache for position PT in BUF. */ | |
| 426 | |
| 427 static void | |
| 665 | 428 find_context (struct buffer *buf, Charbpos pt) |
| 428 | 429 { |
| 430 /* This function can GC */ | |
| 867 | 431 Ichar prev_c, c; |
| 460 | 432 int prev_syncode, syncode; |
| 665 | 433 Charbpos target = pt; |
| 826 | 434 struct syntax_cache *scache; |
| 844 | 435 int spec = specpdl_depth (); |
| 436 | |
| 437 /* If we are narrowed, we will get confused. In fact, we are quite often | |
| 438 narrowed when this function is called. */ | |
| 439 if (BUF_BEGV (buf) != BUF_BEG (buf) || BUF_ZV (buf) != BUF_Z (buf)) | |
| 440 { | |
| 441 record_unwind_protect (save_restriction_restore, | |
| 442 save_restriction_save (buf)); | |
| 443 Fwiden (wrap_buffer (buf)); | |
| 444 } | |
| 826 | 445 |
| 428 | 446 setup_context_cache (buf, pt); |
| 447 pt = context_cache.cur_point; | |
| 448 | |
| 842 | 449 scache = setup_buffer_syntax_cache (buf, pt > BUF_BEGV (buf) ? pt - 1 : pt, |
| 450 1); | |
| 428 | 451 if (pt > BUF_BEGV (buf)) |
| 460 | 452 { |
| 453 c = BUF_FETCH_CHAR (buf, pt - 1); | |
| 826 | 454 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 460 | 455 } |
| 428 | 456 else |
| 460 | 457 { |
| 458 c = '\n'; /* to get bol_context_cache at point-min */ | |
| 459 syncode = Swhitespace; | |
| 460 } | |
| 428 | 461 |
| 462 for (; pt < target; pt++, context_cache.cur_point = pt) | |
| 463 { | |
| 464 if (context_cache.needs_its_head_reexamined) | |
| 465 { | |
| 466 if (context_cache.depth == 0 | |
| 467 && context_cache.context == context_none) | |
| 468 { | |
| 469 /* We've found an anchor spot. | |
| 470 Try to put the start of defun within 6000 chars of | |
| 471 the target, and the end of defun as close as possible. | |
| 472 6000 is also arbitrary but tries to strike a balance | |
| 473 between two conflicting pulls when dealing with a | |
| 474 file that has lots of stuff sitting outside of a top- | |
| 475 level form: | |
| 476 | |
| 477 a) If you move past the start of defun, you will | |
| 478 have to recompute defun, which in this case | |
| 479 means that start of defun goes all the way back | |
| 480 to the beginning of the file; so you want | |
| 481 to set start of defun a ways back from the | |
| 482 current point. | |
| 483 b) If you move a line backwards but within start of | |
| 484 defun, you have to move back to start of defun; | |
| 485 so you don't want start of defun too far from | |
| 486 the current point. | |
| 487 */ | |
| 488 if (target - context_cache.start_point > 6000) | |
| 489 context_cache.start_point = pt; | |
| 490 context_cache.end_point = pt; | |
| 491 bol_context_cache = context_cache; | |
| 492 } | |
| 493 } | |
| 494 | |
| 826 | 495 UPDATE_SYNTAX_CACHE_FORWARD (scache, pt); |
| 428 | 496 prev_c = c; |
| 460 | 497 prev_syncode = syncode; |
| 428 | 498 c = BUF_FETCH_CHAR (buf, pt); |
| 826 | 499 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 428 | 500 |
| 501 if (prev_c == '\n') | |
| 502 bol_context_cache = context_cache; | |
| 503 | |
| 504 if (context_cache.backslash_p) | |
| 505 { | |
| 506 context_cache.backslash_p = 0; | |
| 507 continue; | |
| 508 } | |
| 509 | |
| 826 | 510 switch (SYNTAX_FROM_CODE (syncode)) |
| 428 | 511 { |
| 512 case Sescape: | |
| 513 context_cache.backslash_p = 1; | |
| 514 break; | |
| 515 | |
| 516 case Sopen: | |
| 517 if (context_cache.context == context_none) | |
| 518 context_cache.depth++; | |
| 519 break; | |
| 520 | |
| 521 case Sclose: | |
| 522 if (context_cache.context == context_none) | |
| 523 context_cache.depth--; | |
| 524 break; | |
| 525 | |
| 526 case Scomment: | |
| 527 if (context_cache.context == context_none) | |
| 528 { | |
| 529 context_cache.context = context_comment; | |
| 530 context_cache.ccontext = ccontext_none; | |
| 460 | 531 context_cache.style = SINGLE_SYNTAX_STYLE (syncode); |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
532 assert (context_cache.style != comment_style_none); |
| 428 | 533 } |
| 534 break; | |
| 535 | |
| 536 case Sendcomment: | |
| 460 | 537 if (context_cache.style != SINGLE_SYNTAX_STYLE (syncode)) |
| 428 | 538 ; |
| 539 else if (context_cache.context == context_comment) | |
| 540 { | |
| 541 context_cache.context = context_none; | |
| 542 context_cache.style = comment_style_none; | |
| 543 } | |
| 544 else if (context_cache.context == context_block_comment && | |
| 545 (context_cache.ccontext == ccontext_start2 || | |
| 546 context_cache.ccontext == ccontext_end1)) | |
| 547 { | |
| 548 context_cache.context = context_none; | |
| 549 context_cache.ccontext = ccontext_none; | |
| 550 context_cache.style = comment_style_none; | |
| 551 } | |
| 552 break; | |
| 553 | |
| 554 case Sstring: | |
| 555 { | |
| 556 if (context_cache.context == context_string && | |
| 557 context_cache.scontext == c) | |
| 558 { | |
| 559 context_cache.context = context_none; | |
| 560 context_cache.scontext = '\000'; | |
| 561 } | |
| 562 else if (context_cache.context == context_none) | |
| 563 { | |
| 460 | 564 Lisp_Object stringtermobj = |
| 1296 | 565 syntax_match (scache->syntax_table, c); |
| 867 | 566 Ichar stringterm; |
| 428 | 567 |
| 568 if (CHARP (stringtermobj)) | |
| 569 stringterm = XCHAR (stringtermobj); | |
| 570 else | |
| 571 stringterm = c; | |
| 572 context_cache.context = context_string; | |
| 573 context_cache.scontext = stringterm; | |
| 574 context_cache.ccontext = ccontext_none; | |
| 575 } | |
| 576 break; | |
| 577 } | |
| 460 | 578 |
| 579 case Scomment_fence: | |
| 580 { | |
| 581 if (context_cache.context == context_generic_comment) | |
| 582 { | |
| 583 context_cache.context = context_none; | |
| 584 } | |
| 585 else if (context_cache.context == context_none) | |
| 586 { | |
| 587 context_cache.context = context_generic_comment; | |
| 588 context_cache.ccontext = ccontext_none; | |
| 589 } | |
| 590 break; | |
| 591 } | |
| 592 | |
| 593 case Sstring_fence: | |
| 594 { | |
| 595 if (context_cache.context == context_generic_string) | |
| 596 { | |
| 597 context_cache.context = context_none; | |
| 598 } | |
| 599 else if (context_cache.context == context_none) | |
| 600 { | |
| 601 context_cache.context = context_generic_string; | |
| 602 context_cache.ccontext = ccontext_none; | |
| 603 } | |
| 604 break; | |
| 605 } | |
| 606 | |
| 428 | 607 default: |
| 608 ; | |
| 609 } | |
| 610 | |
| 611 /* That takes care of the characters with manifest syntax. | |
| 612 Now we've got to hack multi-char sequences that start | |
| 613 and end block comments. | |
| 614 */ | |
| 460 | 615 if ((SYNTAX_CODE_COMMENT_BITS (syncode) & |
| 428 | 616 SYNTAX_SECOND_CHAR_START) && |
| 617 context_cache.context == context_none && | |
| 618 context_cache.ccontext == ccontext_start1 && | |
| 460 | 619 SYNTAX_CODES_START_P (prev_syncode, syncode) /* the two chars match */ |
| 428 | 620 ) |
| 621 { | |
| 622 context_cache.ccontext = ccontext_start2; | |
| 460 | 623 context_cache.style = SYNTAX_START_STYLE (prev_syncode, syncode); |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
624 assert (context_cache.style != comment_style_none); |
| 428 | 625 } |
| 460 | 626 else if ((SYNTAX_CODE_COMMENT_BITS (syncode) & |
| 428 | 627 SYNTAX_FIRST_CHAR_START) && |
| 628 context_cache.context == context_none && | |
| 629 (context_cache.ccontext == ccontext_none || | |
| 630 context_cache.ccontext == ccontext_start1)) | |
| 631 { | |
| 632 context_cache.ccontext = ccontext_start1; | |
| 633 context_cache.style = comment_style_none; /* should be this already*/ | |
| 634 } | |
| 460 | 635 else if ((SYNTAX_CODE_COMMENT_BITS (syncode) & |
| 428 | 636 SYNTAX_SECOND_CHAR_END) && |
| 647 | 637 context_cache.context == |
| 638 (enum syntactic_context) context_block_comment && | |
| 639 context_cache.ccontext == | |
| 640 (enum block_comment_context) ccontext_end1 && | |
| 460 | 641 SYNTAX_CODES_END_P (prev_syncode, syncode) && |
| 428 | 642 /* the two chars match */ |
| 643 context_cache.style == | |
| 460 | 644 SYNTAX_END_STYLE (prev_syncode, syncode) |
| 428 | 645 ) |
| 646 { | |
| 647 context_cache.context = context_none; | |
| 648 context_cache.ccontext = ccontext_none; | |
| 649 context_cache.style = comment_style_none; | |
| 650 } | |
| 460 | 651 else if ((SYNTAX_CODE_COMMENT_BITS (syncode) & |
| 428 | 652 SYNTAX_FIRST_CHAR_END) && |
| 653 context_cache.context == context_block_comment && | |
| 460 | 654 context_cache.style == SINGLE_SYNTAX_STYLE (syncode) && |
| 428 | 655 (context_cache.ccontext == ccontext_start2 || |
| 656 context_cache.ccontext == ccontext_end1)) | |
| 460 | 657 /* #### is it right to check for end1 here?? |
| 658 yes, because this might be a repetition of the first char | |
| 659 of a comment-end sequence. ie, '/xxx foo xxx/' or | |
| 660 '/xxx foo x/', where 'x' = '*' -- mct */ | |
| 428 | 661 { |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
662 assert (context_cache.style != comment_style_none); |
| 428 | 663 context_cache.ccontext = ccontext_end1; |
| 664 } | |
| 665 | |
| 666 else if (context_cache.ccontext == ccontext_start1) | |
| 667 { | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
668 assert (context_cache.context == context_none); |
| 428 | 669 context_cache.ccontext = ccontext_none; |
| 670 } | |
| 671 else if (context_cache.ccontext == ccontext_end1) | |
| 672 { | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
673 assert (context_cache.context == context_block_comment); |
| 428 | 674 context_cache.context = context_none; |
| 675 context_cache.ccontext = ccontext_start2; | |
| 676 } | |
| 677 | |
| 678 if (context_cache.ccontext == ccontext_start2 && | |
| 679 context_cache.context == context_none) | |
| 680 { | |
| 681 context_cache.context = context_block_comment; | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
682 assert (context_cache.style != comment_style_none); |
| 428 | 683 } |
| 684 else if (context_cache.ccontext == ccontext_none && | |
| 685 context_cache.context == context_block_comment) | |
| 686 { | |
| 687 context_cache.context = context_none; | |
| 688 } | |
| 689 } | |
| 690 | |
| 691 context_cache.needs_its_head_reexamined = 0; | |
| 844 | 692 unbind_to (spec); |
| 428 | 693 } |
| 694 | |
| 695 static Lisp_Object | |
| 696 context_to_symbol (enum syntactic_context context) | |
| 697 { | |
| 698 switch (context) | |
| 699 { | |
| 460 | 700 case context_none: return Qnil; |
| 701 case context_string: return Qstring; | |
| 702 case context_comment: return Qcomment; | |
| 703 case context_block_comment: return Qblock_comment; | |
| 704 case context_generic_comment: return Qblock_comment; | |
| 705 case context_generic_string: return Qstring; | |
| 2500 | 706 default: ABORT (); return Qnil; /* suppress compiler warning */ |
| 428 | 707 } |
| 708 } | |
| 709 | |
| 710 DEFUN ("buffer-syntactic-context", Fbuffer_syntactic_context, 0, 1, 0, /* | |
| 711 Return the syntactic context of BUFFER at point. | |
| 712 If BUFFER is nil or omitted, the current buffer is assumed. | |
| 713 The returned value is one of the following symbols: | |
| 714 | |
| 715 nil ; meaning no special interpretation | |
| 716 string ; meaning point is within a string | |
| 717 comment ; meaning point is within a line comment | |
| 718 block-comment ; meaning point is within a block comment | |
| 719 | |
| 720 See also the function `buffer-syntactic-context-depth', which returns | |
| 721 the current nesting-depth within all parenthesis-syntax delimiters | |
| 722 and the function `syntactically-sectionize', which will map a function | |
| 723 over each syntactic context in a region. | |
| 724 | |
| 725 WARNING: this may alter match-data. | |
| 726 */ | |
| 727 (buffer)) | |
| 728 { | |
| 729 /* This function can GC */ | |
| 730 struct buffer *buf = decode_buffer (buffer, 0); | |
| 731 find_context (buf, BUF_PT (buf)); | |
| 732 return context_to_symbol (context_cache.context); | |
| 733 } | |
| 734 | |
| 735 DEFUN ("buffer-syntactic-context-depth", Fbuffer_syntactic_context_depth, | |
| 736 0, 1, 0, /* | |
| 737 Return the depth within all parenthesis-syntax delimiters at point. | |
| 738 If BUFFER is nil or omitted, the current buffer is assumed. | |
| 739 WARNING: this may alter match-data. | |
| 740 */ | |
| 741 (buffer)) | |
| 742 { | |
| 743 /* This function can GC */ | |
| 744 struct buffer *buf = decode_buffer (buffer, 0); | |
| 745 find_context (buf, BUF_PT (buf)); | |
| 746 return make_int (context_cache.depth); | |
| 747 } | |
| 748 | |
| 749 | |
| 750 DEFUN ("syntactically-sectionize", Fsyntactically_sectionize, 3, 4, 0, /* | |
| 751 Call FUNCTION for each contiguous syntactic context in the region. | |
| 752 Call the given function with four arguments: the start and end of the | |
| 753 region, a symbol representing the syntactic context, and the current | |
| 754 depth (as returned by the functions `buffer-syntactic-context' and | |
| 755 `buffer-syntactic-context-depth'). When this function is called, the | |
| 756 current buffer will be set to BUFFER. | |
| 757 | |
| 758 WARNING: this may alter match-data. | |
| 759 */ | |
| 760 (function, start, end, buffer)) | |
| 761 { | |
| 762 /* This function can GC */ | |
| 665 | 763 Charbpos s, pt, e; |
| 428 | 764 int edepth; |
| 765 enum syntactic_context this_context; | |
| 766 Lisp_Object extent = Qnil; | |
| 767 struct gcpro gcpro1; | |
| 768 struct buffer *buf = decode_buffer (buffer, 0); | |
| 769 | |
| 770 get_buffer_range_char (buf, start, end, &s, &e, 0); | |
| 771 | |
| 772 pt = s; | |
| 773 find_context (buf, pt); | |
| 774 | |
| 775 GCPRO1 (extent); | |
| 776 while (pt < e) | |
| 777 { | |
| 665 | 778 Charbpos estart, eend; |
| 428 | 779 /* skip over "blank" areas, and bug out at end-of-buffer. */ |
| 780 while (context_cache.context == context_none) | |
| 781 { | |
| 782 pt++; | |
| 783 if (pt >= e) goto DONE_LABEL; | |
| 784 find_context (buf, pt); | |
| 785 } | |
| 786 /* We've found a non-blank area; keep going until we reach its end */ | |
| 787 this_context = context_cache.context; | |
| 788 estart = pt; | |
| 789 | |
| 790 /* Minor kludge: consider the comment-start character(s) a part of | |
| 791 the comment. | |
| 792 */ | |
| 793 if (this_context == context_block_comment && | |
| 794 context_cache.ccontext == ccontext_start2) | |
| 795 estart -= 2; | |
| 460 | 796 else if (this_context == context_comment |
| 797 || this_context == context_generic_comment | |
| 798 ) | |
| 428 | 799 estart -= 1; |
| 800 | |
| 801 edepth = context_cache.depth; | |
| 802 while (context_cache.context == this_context && pt < e) | |
| 803 { | |
| 804 pt++; | |
| 805 find_context (buf, pt); | |
| 806 } | |
| 807 | |
| 808 eend = pt; | |
| 809 | |
| 810 /* Minor kludge: consider the character which terminated the comment | |
| 811 a part of the comment. | |
| 812 */ | |
| 813 if ((this_context == context_block_comment || | |
| 460 | 814 this_context == context_comment |
| 815 || this_context == context_generic_comment | |
| 816 ) | |
| 428 | 817 && pt < e) |
| 818 eend++; | |
| 819 | |
| 820 if (estart == eend) | |
| 821 continue; | |
| 822 /* Make sure not to pass in values that are outside the | |
| 823 actual bounds of this function. */ | |
| 824 call4_in_buffer (buf, function, make_int (max (s, estart)), | |
| 825 make_int (eend == e ? e : eend - 1), | |
| 826 context_to_symbol (this_context), | |
| 827 make_int (edepth)); | |
| 828 } | |
| 829 DONE_LABEL: | |
| 830 UNGCPRO; | |
| 831 return Qnil; | |
| 832 } | |
| 833 | |
| 834 void | |
| 835 syms_of_font_lock (void) | |
| 836 { | |
| 563 | 837 DEFSYMBOL (Qcomment); |
| 838 DEFSYMBOL (Qblock_comment); | |
| 839 DEFSYMBOL (Qbeginning_of_defun); | |
| 428 | 840 |
| 841 DEFSUBR (Fbuffer_syntactic_context); | |
| 842 DEFSUBR (Fbuffer_syntactic_context_depth); | |
| 843 DEFSUBR (Fsyntactically_sectionize); | |
| 844 } | |
| 845 | |
| 846 void | |
| 847 reinit_vars_of_font_lock (void) | |
| 848 { | |
| 849 xzero (context_cache); | |
| 850 xzero (bol_context_cache); | |
| 851 } | |
| 852 | |
| 853 void | |
| 854 vars_of_font_lock (void) | |
| 855 { | |
| 856 } | |
| 838 | 857 |
| 858 #endif /* USE_C_FONT_LOCK */ |