comparison src/font-lock.c @ 0:376386a54a3c r19-14

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