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 /* GCC 2.95.4 seems to need the casts */
 396 #define SYNTAX_START_STYLE(c1, c2)                                      \
 397   ((enum comment_style)                                                 \
 398    (SYNTAX_CODES_MATCH_START_P (c1, c2, SYNTAX_COMMENT_STYLE_A) ?       \
 399    comment_style_a :                                                    \
 400    SYNTAX_CODES_MATCH_START_P (c1, c2, SYNTAX_COMMENT_STYLE_B) ?        \
 401    comment_style_b :                                                    \
 402    comment_style_none))
 403
 404 #define SYNTAX_END_STYLE(c1, c2)                                \
 405   ((enum comment_style)                                         \
 406    (SYNTAX_CODES_MATCH_END_P (c1, c2, SYNTAX_COMMENT_STYLE_A) ? \
 407    comment_style_a :                                            \
 408    SYNTAX_CODES_MATCH_END_P (c1, c2, SYNTAX_COMMENT_STYLE_B) ?  \
 409    comment_style_b :                                            \
 410    comment_style_none))
 411
 412 #define SINGLE_SYNTAX_STYLE(c)                                  \
 413   ((enum comment_style)                                         \
 414    (SYNTAX_CODE_MATCHES_1CHAR_P (c, SYNTAX_COMMENT_STYLE_A) ?   \
 415    comment_style_a :                                            \
 416    SYNTAX_CODE_MATCHES_1CHAR_P (c, SYNTAX_COMMENT_STYLE_B) ?    \
 417    comment_style_b :                                            \
 418    comment_style_none))
 419
 420 /* Set up context_cache for position PT in BUF. */
 421
 422 static void
 423 find_context (struct buffer *buf, Bufpos pt)
 424 {
 425   /* This function can GC */
 426 #ifndef emacs
 427 #ifdef UTF2000
 428   Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->syntax_table);
 429 #else
 430   Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
 431 #endif
 432   Lisp_Object syntaxtab = buf->syntax_table;
 433 #endif
 434   Emchar prev_c, c;
 435   int prev_syncode, syncode;
 436   Bufpos target = pt;
 437   setup_context_cache (buf, pt);
 438   pt = context_cache.cur_point;
 439
 440   SCS_STATISTICS_SET_FUNCTION (scs_find_context);
 441   SETUP_SYNTAX_CACHE (pt - 1, 1);
 442   if (pt > BUF_BEGV (buf))
 443     {
 444       c = BUF_FETCH_CHAR (buf, pt - 1);
 445       syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
 446     }
 447   else
 448     {
 449       c = '\n'; /* to get bol_context_cache at point-min */
 450       syncode = Swhitespace;
 451     }
 452
 453   for (; pt < target; pt++, context_cache.cur_point = pt)
 454     {
 455       if (context_cache.needs_its_head_reexamined)
 456         {
 457           if (context_cache.depth == 0
 458               && context_cache.context == context_none)
 459             {
 460               /* We've found an anchor spot.
 461                  Try to put the start of defun within 6000 chars of
 462                  the target, and the end of defun as close as possible.
 463                  6000 is also arbitrary but tries to strike a balance
 464                  between two conflicting pulls when dealing with a
 465                  file that has lots of stuff sitting outside of a top-
 466                  level form:
 467
 468                  a) If you move past the start of defun, you will
 469                     have to recompute defun, which in this case
 470                     means that start of defun goes all the way back
 471                     to the beginning of the file; so you want
 472                     to set start of defun a ways back from the
 473                     current point.
 474                  b) If you move a line backwards but within start of
 475                     defun, you have to move back to start of defun;
 476                     so you don't want start of defun too far from
 477                     the current point.
 478                  */
 479               if (target - context_cache.start_point > 6000)
 480                 context_cache.start_point = pt;
 481               context_cache.end_point = pt;
 482               bol_context_cache = context_cache;
 483             }
 484         }
 485
 486       UPDATE_SYNTAX_CACHE_FORWARD (pt);
 487       prev_c = c;
 488       prev_syncode = syncode;
 489       c = BUF_FETCH_CHAR (buf, pt);
 490       syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
 491
 492       if (prev_c == '\n')
 493         bol_context_cache = context_cache;
 494
 495       if (context_cache.backslash_p)
 496         {
 497           context_cache.backslash_p = 0;
 498           continue;
 499         }
 500
 501       switch (SYNTAX_FROM_CACHE (mirrortab, c))
 502         {
 503         case Sescape:
 504           context_cache.backslash_p = 1;
 505           break;
 506
 507         case Sopen:
 508           if (context_cache.context == context_none)
 509             context_cache.depth++;
 510           break;
 511
 512         case Sclose:
 513           if (context_cache.context == context_none)
 514             context_cache.depth--;
 515           break;
 516
 517         case Scomment:
 518           if (context_cache.context == context_none)
 519             {
 520               context_cache.context = context_comment;
 521               context_cache.ccontext = ccontext_none;
 522               context_cache.style = SINGLE_SYNTAX_STYLE (syncode);
 523               if (context_cache.style == comment_style_none) ABORT ();
 524             }
 525           break;
 526
 527         case Sendcomment:
 528           if (context_cache.style != SINGLE_SYNTAX_STYLE (syncode))
 529             ;
 530           else if (context_cache.context == context_comment)
 531             {
 532               context_cache.context = context_none;
 533               context_cache.style = comment_style_none;
 534             }
 535           else if (context_cache.context == context_block_comment &&
 536                    (context_cache.ccontext == ccontext_start2 ||
 537                     context_cache.ccontext == ccontext_end1))
 538             {
 539               context_cache.context = context_none;
 540               context_cache.ccontext = ccontext_none;
 541               context_cache.style = comment_style_none;
 542             }
 543           break;
 544
 545         case Sstring:
 546           {
 547             if (context_cache.context == context_string &&
 548                 context_cache.scontext == c)
 549               {
 550                 context_cache.context = context_none;
 551                 context_cache.scontext = '\000';
 552               }
 553             else if (context_cache.context == context_none)
 554               {
 555                 Lisp_Object stringtermobj =
 556                   syntax_match (syntax_cache.current_syntax_table, c);
 557                 Emchar stringterm;
 558
 559                 if (CHARP (stringtermobj))
 560                   stringterm = XCHAR (stringtermobj);
 561                 else
 562                   stringterm = c;
 563                 context_cache.context = context_string;
 564                 context_cache.scontext = stringterm;
 565                 context_cache.ccontext = ccontext_none;
 566               }
 567             break;
 568           }
 569
 570         case Scomment_fence:
 571           {
 572             if (context_cache.context == context_generic_comment)
 573               {
 574                 context_cache.context = context_none;
 575               }
 576             else if (context_cache.context == context_none)
 577               {
 578                 context_cache.context = context_generic_comment;
 579                 context_cache.ccontext = ccontext_none;
 580               }
 581             break;
 582           }
 583
 584         case Sstring_fence:
 585           {
 586             if (context_cache.context == context_generic_string)
 587               {
 588                 context_cache.context = context_none;
 589               }
 590             else if (context_cache.context == context_none)
 591               {
 592                 context_cache.context = context_generic_string;
 593                 context_cache.ccontext = ccontext_none;
 594               }
 595             break;
 596           }
 597
 598         default:
 599           ;
 600         }
 601
 602       /* That takes care of the characters with manifest syntax.
 603          Now we've got to hack multi-char sequences that start
 604          and end block comments.
 605        */
 606       if ((SYNTAX_CODE_COMMENT_BITS (syncode) &
 607            SYNTAX_SECOND_CHAR_START) &&
 608           context_cache.context == context_none &&
 609           context_cache.ccontext == ccontext_start1 &&
 610           SYNTAX_CODES_START_P (prev_syncode, syncode) /* the two chars match */
 611           )
 612         {
 613           context_cache.ccontext = ccontext_start2;
 614           context_cache.style = SYNTAX_START_STYLE (prev_syncode, syncode);
 615           if (context_cache.style == comment_style_none) ABORT ();
 616         }
 617       else if ((SYNTAX_CODE_COMMENT_BITS (syncode) &
 618                 SYNTAX_FIRST_CHAR_START) &&
 619                context_cache.context == context_none &&
 620                (context_cache.ccontext == ccontext_none ||
 621                 context_cache.ccontext == ccontext_start1))
 622         {
 623           context_cache.ccontext = ccontext_start1;
 624           context_cache.style = comment_style_none; /* should be this already*/
 625         }
 626       else if ((SYNTAX_CODE_COMMENT_BITS (syncode) &
 627                 SYNTAX_SECOND_CHAR_END) &&
 628                context_cache.context == context_block_comment &&
 629                context_cache.ccontext == ccontext_end1 &&
 630                SYNTAX_CODES_END_P (prev_syncode, syncode) &&
 631                /* the two chars match */
 632                context_cache.style ==
 633                SYNTAX_END_STYLE (prev_syncode, syncode)
 634                )
 635         {
 636           context_cache.context = context_none;
 637           context_cache.ccontext = ccontext_none;
 638           context_cache.style = comment_style_none;
 639         }
 640       else if ((SYNTAX_CODE_COMMENT_BITS (syncode) &
 641                 SYNTAX_FIRST_CHAR_END) &&
 642                context_cache.context == context_block_comment &&
 643 #if 0
 644                /* #### pre-Matt code had: */
 645                (context_cache.style ==
 646                 SYNTAX_END_STYLE (c, BUF_FETCH_CHAR (buf, pt+1))) &&
 647                /* why do these differ here?! */
 648 #endif
 649                context_cache.style == SINGLE_SYNTAX_STYLE (syncode) &&
 650                (context_cache.ccontext == ccontext_start2 ||
 651                 context_cache.ccontext == ccontext_end1))
 652         /* check end1, to detect a repetition of the first char of a
 653            comment-end sequence. ie, '/xxx foo xxx/' or '/xxx foo x/',
 654            where 'x' = '*' -- mct */
 655         {
 656           if (context_cache.style == comment_style_none) ABORT ();
 657           context_cache.ccontext = ccontext_end1;
 658         }
 659
 660       else if (context_cache.ccontext == ccontext_start1)
 661         {
 662           if (context_cache.context != context_none) ABORT ();
 663           context_cache.ccontext = ccontext_none;
 664         }
 665       else if (context_cache.ccontext == ccontext_end1)
 666         {
 667           if (context_cache.context != context_block_comment) ABORT ();
 668           context_cache.context = context_none;
 669           context_cache.ccontext = ccontext_start2;
 670         }
 671
 672       if (context_cache.ccontext == ccontext_start2 &&
 673           context_cache.context == context_none)
 674         {
 675           context_cache.context = context_block_comment;
 676           if (context_cache.style == comment_style_none) ABORT ();
 677         }
 678       else if (context_cache.ccontext == ccontext_none &&
 679                context_cache.context == context_block_comment)
 680         {
 681           context_cache.context = context_none;
 682         }
 683     }
 684
 685   context_cache.needs_its_head_reexamined = 0;
 686 }
 687
 688 static Lisp_Object
 689 context_to_symbol (enum syntactic_context context)
 690 {
 691   switch (context)
 692     {
 693     case context_none:                  return Qnil;
 694     case context_string:                return Qstring;
 695     case context_comment:               return Qcomment;
 696     case context_block_comment:         return Qblock_comment;
 697     case context_generic_comment:       return Qblock_comment;
 698     case context_generic_string:        return Qstring;
 699     default: ABORT (); return Qnil; /* suppress compiler warning */
 700     }
 701 }
 702
 703 DEFUN ("buffer-syntactic-context", Fbuffer_syntactic_context, 0, 1, 0, /*
 704 Return the syntactic context of BUFFER at point.
 705 If BUFFER is nil or omitted, the current buffer is assumed.
 706 The returned value is one of the following symbols:
 707
 708         nil             ; meaning no special interpretation
 709         string          ; meaning point is within a string
 710         comment         ; meaning point is within a line comment
 711         block-comment   ; meaning point is within a block comment
 712
 713 See also the function `buffer-syntactic-context-depth', which returns
 714 the current nesting-depth within all parenthesis-syntax delimiters
 715 and the function `syntactically-sectionize', which will map a function
 716 over each syntactic context in a region.
 717
 718 WARNING: this may alter match-data.
 719 */
 720        (buffer))
 721 {
 722   /* This function can GC */
 723   struct buffer *buf = decode_buffer (buffer, 0);
 724   find_context (buf, BUF_PT (buf));
 725   return context_to_symbol (context_cache.context);
 726 }
 727
 728 DEFUN ("buffer-syntactic-context-depth", Fbuffer_syntactic_context_depth,
 729        0, 1, 0, /*
 730 Return the depth within all parenthesis-syntax delimiters at point.
 731 If BUFFER is nil or omitted, the current buffer is assumed.
 732 WARNING: this may alter match-data.
 733 */
 734        (buffer))
 735 {
 736   /* This function can GC */
 737   struct buffer *buf = decode_buffer (buffer, 0);
 738   find_context (buf, BUF_PT (buf));
 739   return make_int (context_cache.depth);
 740 }
 741
 742
 743 DEFUN ("syntactically-sectionize", Fsyntactically_sectionize, 3, 4, 0, /*
 744 Call FUNCTION for each contiguous syntactic context in the region.
 745 Call the given function with four arguments: the start and end of the
 746 region, a symbol representing the syntactic context, and the current
 747 depth (as returned by the functions `buffer-syntactic-context' and
 748 `buffer-syntactic-context-depth').  When this function is called, the
 749 current buffer will be set to BUFFER.
 750
 751 WARNING: this may alter match-data.
 752 */
 753        (function, start, end, buffer))
 754 {
 755   /* This function can GC */
 756   Bufpos s, pt, e;
 757   int edepth;
 758   enum syntactic_context this_context;
 759   Lisp_Object extent = Qnil;
 760   struct gcpro gcpro1;
 761   struct buffer *buf = decode_buffer (buffer, 0);
 762
 763   get_buffer_range_char (buf, start, end, &s, &e, 0);
 764
 765   pt = s;
 766   find_context (buf, pt);
 767
 768   GCPRO1 (extent);
 769   while (pt < e)
 770     {
 771       Bufpos estart, eend;
 772       /* skip over "blank" areas, and bug out at end-of-buffer. */
 773       while (context_cache.context == context_none)
 774         {
 775           pt++;
 776           if (pt >= e) goto DONE_LABEL;
 777           find_context (buf, pt);
 778         }
 779       /* We've found a non-blank area; keep going until we reach its end */
 780       this_context = context_cache.context;
 781       estart = pt;
 782
 783       /* Minor kludge: consider the comment-start character(s) a part of
 784          the comment.
 785        */
 786       if (this_context == context_block_comment &&
 787           context_cache.ccontext == ccontext_start2)
 788         estart -= 2;
 789       else if (this_context == context_comment
 790                || this_context == context_generic_comment
 791                )
 792         estart -= 1;
 793
 794       edepth = context_cache.depth;
 795       while (context_cache.context == this_context && pt < e)
 796         {
 797           pt++;
 798           find_context (buf, pt);
 799         }
 800
 801       eend = pt;
 802
 803       /* Minor kludge: consider the character which terminated the comment
 804          a part of the comment.
 805        */
 806       if ((this_context == context_block_comment ||
 807            this_context == context_comment
 808            || this_context == context_generic_comment
 809            )
 810           && pt < e)
 811         eend++;
 812
 813       if (estart == eend)
 814         continue;
 815       /* Make sure not to pass in values that are outside the
 816          actual bounds of this function. */
 817       call4_in_buffer (buf, function, make_int (max (s, estart)),
 818                        make_int (eend == e ? e : eend - 1),
 819                        context_to_symbol (this_context),
 820                        make_int (edepth));
 821     }
 822  DONE_LABEL:
 823   UNGCPRO;
 824   return Qnil;
 825 }
 826
 827 void
 828 syms_of_font_lock (void)
 829 {
 830   defsymbol (&Qcomment, "comment");
 831   defsymbol (&Qblock_comment, "block-comment");
 832   defsymbol (&Qbeginning_of_defun, "beginning-of-defun");
 833
 834   DEFSUBR (Fbuffer_syntactic_context);
 835   DEFSUBR (Fbuffer_syntactic_context_depth);
 836   DEFSUBR (Fsyntactically_sectionize);
 837 }
 838
 839 void
 840 reinit_vars_of_font_lock (void)
 841 {
 842   xzero (context_cache);
 843   xzero (bol_context_cache);
 844 }
 845
 846 void
 847 vars_of_font_lock (void)
 848 {
 849   reinit_vars_of_font_lock ();
 850 }