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