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 /* GCC 2.95.4 seems to need the casts */
 395 #define SYNTAX_START_STYLE(c1, c2)                                      \
 396   ((enum comment_style)                                                 \
 397    (SYNTAX_CODES_MATCH_START_P (c1, c2, SYNTAX_COMMENT_STYLE_A) ?       \
 398    comment_style_a :                                                    \
 399    SYNTAX_CODES_MATCH_START_P (c1, c2, SYNTAX_COMMENT_STYLE_B) ?        \
 400    comment_style_b :                                                    \
 401    comment_style_none))
 402
 403 #define SYNTAX_END_STYLE(c1, c2)                                \
 404   ((enum comment_style)                                         \
 405    (SYNTAX_CODES_MATCH_END_P (c1, c2, SYNTAX_COMMENT_STYLE_A) ? \
 406    comment_style_a :                                            \
 407    SYNTAX_CODES_MATCH_END_P (c1, c2, SYNTAX_COMMENT_STYLE_B) ?  \
 408    comment_style_b :                                            \
 409    comment_style_none))
 410
 411 #define SINGLE_SYNTAX_STYLE(c)                                  \
 412   ((enum comment_style)                                         \
 413    (SYNTAX_CODE_MATCHES_1CHAR_P (c, SYNTAX_COMMENT_STYLE_A) ?   \
 414    comment_style_a :                                            \
 415    SYNTAX_CODE_MATCHES_1CHAR_P (c, SYNTAX_COMMENT_STYLE_B) ?    \
 416    comment_style_b :                                            \
 417    comment_style_none))
 418
 419 /* Set up context_cache for position PT in BUF. */
 420
 421 static void
 422 find_context (struct buffer *buf, Bufpos pt)
 423 {
 424   /* This function can GC */
 425 #ifndef emacs
 426   Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
 427   Lisp_Object syntaxtab = buf->syntax_table;
 428 #endif
 429   Emchar prev_c, c;
 430   int prev_syncode, syncode;
 431   Bufpos target = pt;
 432   setup_context_cache (buf, pt);
 433   pt = context_cache.cur_point;
 434
 435   SCS_STATISTICS_SET_FUNCTION (scs_find_context);
 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 #if 0
 639                /* #### pre-Matt code had: */
 640                (context_cache.style ==
 641                 SYNTAX_END_STYLE (c, BUF_FETCH_CHAR (buf, pt+1))) &&
 642                /* why do these differ here?! */
 643 #endif
 644                context_cache.style == SINGLE_SYNTAX_STYLE (syncode) &&
 645                (context_cache.ccontext == ccontext_start2 ||
 646                 context_cache.ccontext == ccontext_end1))
 647         /* check end1, to detect a repetition of the first char of a
 648            comment-end sequence. ie, '/xxx foo xxx/' or '/xxx foo x/',
 649            where 'x' = '*' -- mct */
 650         {
 651           if (context_cache.style == comment_style_none) ABORT ();
 652           context_cache.ccontext = ccontext_end1;
 653         }
 654
 655       else if (context_cache.ccontext == ccontext_start1)
 656         {
 657           if (context_cache.context != context_none) ABORT ();
 658           context_cache.ccontext = ccontext_none;
 659         }
 660       else if (context_cache.ccontext == ccontext_end1)
 661         {
 662           if (context_cache.context != context_block_comment) ABORT ();
 663           context_cache.context = context_none;
 664           context_cache.ccontext = ccontext_start2;
 665         }
 666
 667       if (context_cache.ccontext == ccontext_start2 &&
 668           context_cache.context == context_none)
 669         {
 670           context_cache.context = context_block_comment;
 671           if (context_cache.style == comment_style_none) ABORT ();
 672         }
 673       else if (context_cache.ccontext == ccontext_none &&
 674                context_cache.context == context_block_comment)
 675         {
 676           context_cache.context = context_none;
 677         }
 678     }
 679
 680   context_cache.needs_its_head_reexamined = 0;
 681 }
 682
 683 static Lisp_Object
 684 context_to_symbol (enum syntactic_context context)
 685 {
 686   switch (context)
 687     {
 688     case context_none:                  return Qnil;
 689     case context_string:                return Qstring;
 690     case context_comment:               return Qcomment;
 691     case context_block_comment:         return Qblock_comment;
 692     case context_generic_comment:       return Qblock_comment;
 693     case context_generic_string:        return Qstring;
 694     default: ABORT (); return Qnil; /* suppress compiler warning */
 695     }
 696 }
 697
 698 DEFUN ("buffer-syntactic-context", Fbuffer_syntactic_context, 0, 1, 0, /*
 699 Return the syntactic context of BUFFER at point.
 700 If BUFFER is nil or omitted, the current buffer is assumed.
 701 The returned value is one of the following symbols:
 702
 703         nil             ; meaning no special interpretation
 704         string          ; meaning point is within a string
 705         comment         ; meaning point is within a line comment
 706         block-comment   ; meaning point is within a block comment
 707
 708 See also the function `buffer-syntactic-context-depth', which returns
 709 the current nesting-depth within all parenthesis-syntax delimiters
 710 and the function `syntactically-sectionize', which will map a function
 711 over each syntactic context in a region.
 712
 713 WARNING: this may alter match-data.
 714 */
 715        (buffer))
 716 {
 717   /* This function can GC */
 718   struct buffer *buf = decode_buffer (buffer, 0);
 719   find_context (buf, BUF_PT (buf));
 720   return context_to_symbol (context_cache.context);
 721 }
 722
 723 DEFUN ("buffer-syntactic-context-depth", Fbuffer_syntactic_context_depth,
 724        0, 1, 0, /*
 725 Return the depth within all parenthesis-syntax delimiters at point.
 726 If BUFFER is nil or omitted, the current buffer is assumed.
 727 WARNING: this may alter match-data.
 728 */
 729        (buffer))
 730 {
 731   /* This function can GC */
 732   struct buffer *buf = decode_buffer (buffer, 0);
 733   find_context (buf, BUF_PT (buf));
 734   return make_int (context_cache.depth);
 735 }
 736
 737
 738 DEFUN ("syntactically-sectionize", Fsyntactically_sectionize, 3, 4, 0, /*
 739 Call FUNCTION for each contiguous syntactic context in the region.
 740 Call the given function with four arguments: the start and end of the
 741 region, a symbol representing the syntactic context, and the current
 742 depth (as returned by the functions `buffer-syntactic-context' and
 743 `buffer-syntactic-context-depth').  When this function is called, the
 744 current buffer will be set to BUFFER.
 745
 746 WARNING: this may alter match-data.
 747 */
 748        (function, start, end, buffer))
 749 {
 750   /* This function can GC */
 751   Bufpos s, pt, e;
 752   int edepth;
 753   enum syntactic_context this_context;
 754   Lisp_Object extent = Qnil;
 755   struct gcpro gcpro1;
 756   struct buffer *buf = decode_buffer (buffer, 0);
 757
 758   get_buffer_range_char (buf, start, end, &s, &e, 0);
 759
 760   pt = s;
 761   find_context (buf, pt);
 762
 763   GCPRO1 (extent);
 764   while (pt < e)
 765     {
 766       Bufpos estart, eend;
 767       /* skip over "blank" areas, and bug out at end-of-buffer. */
 768       while (context_cache.context == context_none)
 769         {
 770           pt++;
 771           if (pt >= e) goto DONE_LABEL;
 772           find_context (buf, pt);
 773         }
 774       /* We've found a non-blank area; keep going until we reach its end */
 775       this_context = context_cache.context;
 776       estart = pt;
 777
 778       /* Minor kludge: consider the comment-start character(s) a part of
 779          the comment.
 780        */
 781       if (this_context == context_block_comment &&
 782           context_cache.ccontext == ccontext_start2)
 783         estart -= 2;
 784       else if (this_context == context_comment
 785                || this_context == context_generic_comment
 786                )
 787         estart -= 1;
 788
 789       edepth = context_cache.depth;
 790       while (context_cache.context == this_context && pt < e)
 791         {
 792           pt++;
 793           find_context (buf, pt);
 794         }
 795
 796       eend = pt;
 797
 798       /* Minor kludge: consider the character which terminated the comment
 799          a part of the comment.
 800        */
 801       if ((this_context == context_block_comment ||
 802            this_context == context_comment
 803            || this_context == context_generic_comment
 804            )
 805           && pt < e)
 806         eend++;
 807
 808       if (estart == eend)
 809         continue;
 810       /* Make sure not to pass in values that are outside the
 811          actual bounds of this function. */
 812       call4_in_buffer (buf, function, make_int (max (s, estart)),
 813                        make_int (eend == e ? e : eend - 1),
 814                        context_to_symbol (this_context),
 815                        make_int (edepth));
 816     }
 817  DONE_LABEL:
 818   UNGCPRO;
 819   return Qnil;
 820 }
 821
 822 void
 823 syms_of_font_lock (void)
 824 {
 825   defsymbol (&Qcomment, "comment");
 826   defsymbol (&Qblock_comment, "block-comment");
 827   defsymbol (&Qbeginning_of_defun, "beginning-of-defun");
 828
 829   DEFSUBR (Fbuffer_syntactic_context);
 830   DEFSUBR (Fbuffer_syntactic_context_depth);
 831   DEFSUBR (Fsyntactically_sectionize);
 832 }
 833
 834 void
 835 reinit_vars_of_font_lock (void)
 836 {
 837   xzero (context_cache);
 838   xzero (bol_context_cache);
 839 }
 840
 841 void
 842 vars_of_font_lock (void)
 843 {
 844   reinit_vars_of_font_lock ();
 845 }