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