Mercurial > hg > xemacs-beta
annotate src/font-lock.c @ 5184:039d9a7f2e6d
Call init_string_ascii_begin() in #'sort*, #'fill, don't be clever.
2010-04-02 Aidan Kehoe <kehoea@parhasard.net>
* fns.c (FsortX, Ffill):
Don't try to be clever with the ascii_begin string header slot in
these function, just call init_string_ascii_begin().
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 02 Apr 2010 12:31:23 +0100 |
| 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 */ |