git.chise.org Git - chise/xemacs-chise.git-/blob - src/font-lock.c

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