home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / src / font_lock.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-03-13  |  16.2 KB  |  539 lines
  1. /* Routines to compute the current syntactic context, for font-lock mode.
  2.    Copyright (C) 1992-1993 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* This code computes the syntactic context of the current point, that is,
  21.    whether point is within a comment, a string, what have you.  It does
  22.    this by picking a point known to be outside of any syntactic constructs
  23.    and moving forward, examining the syntax of each character.
  24.  
  25.    Two caches are used: one caches the last point computed, and the other
  26.    caches the last point at the beginning of a line.  This makes there
  27.    be little penalty for moving left-to-right on a line a character at a 
  28.    time; makes starting over on a line be cheap; and makes random-accessing
  29.    within a line relatively cheap.  
  30.  
  31.    When we move to a different line farther down in the file (but within the
  32.    current top-level form) we simply continue computing forward.  If we move
  33.    backward more than a line, or move beyond the end of the current tlf, or
  34.    switch buffers, then we call `beginning-of-defun' and start over from 
  35.    there.
  36.  
  37.    The caller must flush the caches when deletions occur; we could probably
  38.    notice that here by using the buffer-mod-time, but we don't right now.
  39.  */
  40.  
  41. #include "config.h"
  42. #include "lisp.h"
  43. #include "buffer.h"
  44. #include "syntax.h"
  45.  
  46. enum syntactic_context {
  47.   context_none, context_string, context_comment, context_block_comment
  48. };
  49.  
  50. enum block_comment_context {
  51.   ccontext_none, ccontext_start1, ccontext_start2, ccontext_end1
  52. };
  53.  
  54. #ifdef NEW_SYNTAX
  55. enum comment_style {
  56.   comment_style_none, comment_style_a, comment_style_b
  57. };
  58. #endif
  59.  
  60. struct context_cache {
  61.   int start_point;            /* cache location */
  62.   int end_point;            /* next end-of-defun forward */
  63.   struct buffer *buffer;        /* does this need to be staticpro'd? */
  64.   enum syntactic_context context;    /* single-char-syntax state */
  65.   enum block_comment_context ccontext;    /* block-comment state */
  66. #ifdef NEW_SYNTAX
  67.   enum comment_style style;        /* which comment group */
  68. #endif
  69.   unsigned char scontext;        /* active string delimiter */
  70.   int depth;                /* depth in parens */
  71.   int backslash_p;            /* just read a backslash */
  72. };
  73.  
  74. static struct context_cache context_cache;
  75. static struct context_cache bol_context_cache;
  76.  
  77. #define reset_context_cache(cc) memset((cc),0,sizeof (struct context_cache))
  78.  
  79. static int
  80. beginning_of_defun (int pt)
  81. {
  82.   int opt = PT;
  83.   if (pt == BEGV) return pt;
  84.   SET_PT (pt);
  85.   call0 (intern ("beginning-of-defun"));
  86.   pt = PT;
  87.   SET_PT (opt);
  88.   return pt;
  89. }
  90.  
  91. extern Lisp_Object Fre_search_forward (Lisp_Object, Lisp_Object,
  92.                        Lisp_Object, Lisp_Object);
  93.  
  94. static int
  95. end_of_defun (int pt)
  96. {
  97.   int opt = PT;
  98.   SET_PT (pt);
  99.   /* ## superfluous consing */
  100.   Fre_search_forward (build_string ("\n\\s("), Qnil, Qlambda, Qnil);
  101.   pt = PT;
  102.   SET_PT (opt);
  103.   return pt;
  104. }
  105.  
  106.  
  107. static void
  108. find_context_start (int pt, int end)
  109. {
  110.   int do_bod = (pt > context_cache.end_point ||
  111.         current_buffer != context_cache.buffer);
  112.  
  113.   if (! (do_bod || pt < context_cache.start_point))
  114.     return;
  115.  
  116.   if (do_bod || pt < bol_context_cache.start_point)
  117.     {
  118.       /* We must start searching at the beginning of defun.
  119.        */
  120.       pt = beginning_of_defun (pt);
  121.       context_cache.start_point = pt;
  122.       context_cache.buffer = current_buffer;
  123.       context_cache.context = context_none;
  124.       context_cache.ccontext = ccontext_none;
  125. #ifdef NEW_SYNTAX
  126.       context_cache.style = comment_style_none;
  127. #endif
  128.       context_cache.scontext = '\000';
  129.       context_cache.depth = 0;
  130.       context_cache.backslash_p = ((pt > 1) && (CHAR_AT (pt - 1) == '\\'));
  131.       if (end)
  132.     {
  133.       if (end < pt) abort ();
  134.       context_cache.end_point = end;
  135.     }
  136.       else
  137.     context_cache.end_point = end_of_defun (pt);
  138.     }
  139.   else
  140.     {
  141.       /* We can start searching at the beginning of the current line. */
  142.       context_cache = bol_context_cache;
  143.     }
  144. }
  145.  
  146.  
  147. #ifdef NEW_SYNTAX
  148. # define FIRST_CHAR_START_OF_A_OR_B(c) \
  149.       (SYNTAX_COMMENT_BITS ((c)) & SYNTAX_FIRST_CHAR_START)
  150. # define SECOND_CHAR_START_OF_A_OR_B(c) \
  151.       (SYNTAX_COMMENT_BITS ((c)) & SYNTAX_SECOND_CHAR_START)
  152. # define FIRST_CHAR_END_OF_A_OR_B(c) \
  153.       (SYNTAX_COMMENT_BITS ((c)) & SYNTAX_FIRST_CHAR_END)
  154. # define SECOND_CHAR_END_OF_A_OR_B(c) \
  155.       (SYNTAX_COMMENT_BITS ((c)) & SYNTAX_SECOND_CHAR_END)
  156. # define START_STYLE_A_P(c1, c2) \
  157.       SYNTAX_START_SEQUENCE ((c1), (c2), SYNTAX_COMMENT_STYLE_A)
  158. # define START_STYLE_B_P(c1, c2) \
  159.       SYNTAX_START_SEQUENCE ((c1), (c2), SYNTAX_COMMENT_STYLE_B)
  160. # define END_STYLE_A_P(c1, c2) \
  161.       SYNTAX_END_SEQUENCE ((c1), (c2), SYNTAX_COMMENT_STYLE_A)
  162. # define END_STYLE_B_P(c1, c2) \
  163.       SYNTAX_END_SEQUENCE ((c1), (c2), SYNTAX_COMMENT_STYLE_B)
  164.  
  165. # define SYNTAX_START_STYLE(c1, c2) \
  166.       (START_STYLE_A_P((c1),(c2)) ? comment_style_a : \
  167.        (START_STYLE_B_P((c1),(c2)) ? comment_style_b : comment_style_none))
  168. # define SYNTAX_END_STYLE(c1, c2) \
  169.       (END_STYLE_A_P((c1),(c2)) ? comment_style_a : \
  170.        (END_STYLE_B_P((c1),(c2)) ? comment_style_b : comment_style_none))
  171. # define SINGLE_SYNTAX_STYLE(c) \
  172.       (SYNTAX_SINGLE_CHAR_STYLE_A((c)) ? comment_style_a : \
  173.        SYNTAX_SINGLE_CHAR_STYLE_B((c)) ? comment_style_b : \
  174.        comment_style_none)
  175. #endif /* NEW_SYNTAX */
  176.  
  177. static void
  178. find_context (int pt, int end)
  179. {
  180.   unsigned char prev_c, c;
  181.   int target = pt;
  182.   if (end == 0)
  183.     find_context_start (pt, end);
  184.   pt = context_cache.start_point;
  185.  
  186.   if (pt > BEGV)
  187.     c = CHAR_AT (pt - 1);
  188.   else
  189.     c = 0;
  190.  
  191.   if (pt == BEGV || c == '\n')
  192.     bol_context_cache = context_cache;
  193.  
  194.   for (; pt < target; pt++, context_cache.start_point = pt)
  195.     {
  196.       if (context_cache.backslash_p)
  197.     {
  198.       context_cache.backslash_p = 0;
  199.       continue;
  200.     }
  201.  
  202.       prev_c = c;
  203.       c = CHAR_AT (pt);
  204.  
  205.       switch (SYNTAX (c))
  206.     {
  207.     case Sescape:
  208.       context_cache.backslash_p = 1;
  209.       break;
  210.  
  211.     case Sopen:
  212.       if (context_cache.context == context_none)
  213.         context_cache.depth++;
  214.       break;
  215.  
  216.     case Sclose:
  217.       if (context_cache.context == context_none)
  218.         context_cache.depth--;
  219.       break;
  220.  
  221.     case Scomment:
  222.       if (context_cache.context == context_none)
  223.         {
  224.           context_cache.context = context_comment;
  225.           context_cache.ccontext = ccontext_none;
  226. #ifdef NEW_SYNTAX
  227.           context_cache.style = SINGLE_SYNTAX_STYLE (c);
  228.           if (context_cache.style == comment_style_none) abort ();
  229. #endif
  230.         }
  231.       break;
  232.  
  233.     case Sendcomment:
  234. #ifdef NEW_SYNTAX
  235.       if (context_cache.style != SINGLE_SYNTAX_STYLE (c))
  236.         ;
  237.       else
  238. #endif
  239.            if (context_cache.context == context_comment)
  240.         {
  241.           context_cache.context = context_none;
  242. #ifdef NEW_SYNTAX
  243.           context_cache.style = comment_style_none;
  244. #endif
  245.         }
  246.       else if (context_cache.context == context_block_comment &&
  247.            (context_cache.ccontext == ccontext_start2 ||
  248.             context_cache.ccontext == ccontext_end1))
  249.         {
  250.           context_cache.context = context_none;
  251.           context_cache.ccontext = ccontext_none;
  252. #ifdef NEW_SYNTAX
  253.           context_cache.style = comment_style_none;
  254. #endif
  255.         }
  256.       break;
  257.  
  258.     case Sstring:
  259.       if (context_cache.context == context_string &&
  260.           context_cache.scontext == c)
  261.         {
  262.           context_cache.context = context_none;
  263.           context_cache.scontext = '\000';
  264.         }
  265.       else if (context_cache.context == context_none)
  266.         {
  267.           context_cache.context = context_string;
  268.           context_cache.scontext = c;
  269.           context_cache.ccontext = ccontext_none;
  270.         }
  271.       break;
  272.     default:
  273.       ;
  274.     }
  275.  
  276.  
  277.       /* That takes care of the characters with manifest syntax.
  278.      Now we've got to hack multi-char sequences that start
  279.      and end block comments.
  280.        */
  281. #ifdef NEW_SYNTAX
  282.       if (SECOND_CHAR_START_OF_A_OR_B (c) &&
  283.       context_cache.context == context_none &&
  284.       context_cache.ccontext == ccontext_start1 &&
  285.       SYNTAX_START (prev_c, c) /* the two chars match */
  286.       )
  287.     {
  288.       context_cache.ccontext = ccontext_start2;
  289.       context_cache.style = SYNTAX_START_STYLE (prev_c, c);
  290.       if (context_cache.style == comment_style_none) abort ();
  291.     }
  292.       else if (FIRST_CHAR_START_OF_A_OR_B (c) &&
  293.            context_cache.context == context_none &&
  294.            (context_cache.ccontext == ccontext_none ||
  295.         context_cache.ccontext == ccontext_start1))
  296.     {
  297.       context_cache.ccontext = ccontext_start1;
  298.       context_cache.style = comment_style_none; /* should be this already*/
  299.     }
  300.       else if (SECOND_CHAR_END_OF_A_OR_B (c) &&
  301.            context_cache.context == context_block_comment &&
  302.            context_cache.ccontext == ccontext_end1 &&
  303.            SYNTAX_END (prev_c, c) && /* the two chars match */
  304.            context_cache.style == SYNTAX_END_STYLE (prev_c, c)
  305.            )
  306.     {
  307.       context_cache.context = context_none;
  308.       context_cache.ccontext = ccontext_none;
  309.       context_cache.style = comment_style_none;
  310.     }
  311.       else if (FIRST_CHAR_END_OF_A_OR_B (c) &&
  312.            context_cache.context == context_block_comment &&
  313.            (context_cache.style == SYNTAX_END_STYLE (c, CHAR_AT (pt+1))) &&
  314.            (context_cache.ccontext == ccontext_start2 ||
  315.         context_cache.ccontext == ccontext_end1))
  316.     /* #### is it right to check for end1 here?? */
  317.     {
  318.       if (context_cache.style == comment_style_none) abort ();
  319.       context_cache.ccontext = ccontext_end1;
  320.     }
  321. #else /* !NEW_SYNTAX */
  322.  
  323.       if (SYNTAX_COMSTART_SECOND (c) &&
  324.       context_cache.context == context_none &&
  325.       context_cache.ccontext == ccontext_start1)
  326.     {
  327.       context_cache.ccontext = ccontext_start2;
  328. /*      context_cache.style = SYNTAX_COMMENT_STYLE (c); */
  329.     }
  330.       else if (SYNTAX_COMSTART_FIRST (c) &&
  331.            context_cache.context == context_none &&
  332.            (context_cache.ccontext == ccontext_none ||
  333.         context_cache.ccontext == ccontext_start1))
  334.     {
  335.       context_cache.ccontext = ccontext_start1;
  336.     }
  337.       else if (SYNTAX_COMEND_SECOND (c) &&
  338.            context_cache.context == context_block_comment &&
  339.            context_cache.ccontext == ccontext_end1)
  340.     {
  341.       context_cache.context = context_none;
  342.       context_cache.ccontext = ccontext_none;
  343.     }
  344.       else if (SYNTAX_COMEND_FIRST (c) &&
  345. /*           context_cache.style == SYNTAX_COMMENT_STYLE (c) && */
  346.            context_cache.context == context_block_comment &&
  347.            (context_cache.ccontext == ccontext_start2 ||
  348.         context_cache.ccontext == ccontext_end1))
  349.     /* #### is it right to check for end1 here?? */
  350.     {
  351.       context_cache.ccontext = ccontext_end1;
  352.     }
  353. #endif /* NEW_SYNTAX */
  354.  
  355.       else if (context_cache.ccontext == ccontext_start1)
  356.     {
  357.       if (context_cache.context != context_none) abort ();
  358.       context_cache.ccontext = ccontext_none;
  359.     }
  360.       else if (context_cache.ccontext == ccontext_end1)
  361.     {
  362.       if (context_cache.context != context_block_comment) abort ();
  363.       context_cache.context = context_none;
  364.       context_cache.ccontext = ccontext_start2;
  365.     }
  366.  
  367.       if (context_cache.ccontext == ccontext_start2 &&
  368.       context_cache.context == context_none)
  369.     {
  370.       context_cache.context = context_block_comment;
  371. #ifdef NEW_SYNTAX
  372.       if (context_cache.style == comment_style_none) abort ();
  373. #endif
  374.     }
  375.       else if (context_cache.ccontext == ccontext_none &&
  376.            context_cache.context == context_block_comment)
  377.     {
  378.       context_cache.context = context_none;
  379.     }
  380.  
  381.       if (prev_c == '\n')
  382.     bol_context_cache = context_cache;
  383.     }
  384. }
  385.  
  386.  
  387. DEFUN ("buffer-syntactic-context-flush-cache",
  388.        Fbuffer_syntactic_context_flush_cache,
  389.        Sbuffer_syntactic_context_flush_cache, 0, 0, 0,
  390.        "Flush the cache used by `buffer-syntactic-context-flush-cache'.\n\
  391. Call this when deletions occur.  This is a kludge.")
  392.     ()
  393. {
  394.   reset_context_cache (&context_cache);
  395.   reset_context_cache (&bol_context_cache);
  396.   return Qnil;
  397. }
  398.  
  399.  
  400. static Lisp_Object
  401. context_to_symbol (enum syntactic_context context)
  402. {
  403.   switch (context)
  404.     {
  405.     case context_none:        return Qnil;
  406.     /* ## superfluous interning */
  407.     case context_string:    return intern ("string");
  408.     case context_comment:    return intern ("comment");
  409.     case context_block_comment:    return intern ("block-comment");
  410.     default: abort ();
  411.     }
  412. }
  413.  
  414. DEFUN ("buffer-syntactic-context", Fbuffer_syntactic_context,
  415.        Sbuffer_syntactic_context, 0, 0, 0,
  416.        "Returns the syntactic context of the current buffer at point.\n\
  417. The returned value is one of the following symbols:\n\
  418. \n\
  419.     nil        ; meaning no special interpretation\n\
  420.     string        ; meaning point is within a string\n\
  421.     comment        ; meaning point is within a line comment\n\
  422.     block-comment    ; meaning point is within a block comment\n\
  423. \n\
  424. See also the function `buffer-syntactic-context-depth', which returns\n\
  425. the current nesting-depth within all parenthesis-syntax delimiters\n\
  426. and the function `syntactically-sectionize', which will map a function\n\
  427. over each syntactic context in a region.\n\
  428. \n\
  429. Warning, this may alter match-data.")
  430.     ()
  431. {
  432.   find_context (PT, 0);
  433.   return context_to_symbol (context_cache.context);
  434. }
  435.  
  436. DEFUN ("buffer-syntactic-context-depth", Fbuffer_syntactic_context_depth,
  437.        Sbuffer_syntactic_context_depth, 0, 0, 0,
  438.    "Returns the depth within all parenthesis-syntax delimiters at point.\n\
  439. Warning, this may alter match-data.")
  440.      ()
  441. {
  442.   find_context (PT, 0);
  443.   return make_number (context_cache.depth);
  444. }
  445.  
  446.  
  447. DEFUN ("syntactically-sectionize", Fsyntactically_sectionize,
  448.        Ssyntactically_sectionize, 3, 4, 0,
  449.        "Creates extents for each contiguous syntactic context in the region.\n\
  450. Calls the given function when each extent is created with three arguments:\n\
  451. the extent, a symbol representing the syntactic context, and the current\n\
  452. depth (as returned by the functions `buffer-syntactic-context' and\n\
  453. `buffer-syntactic-context-depth').  If the optional arg `extent-data' is\n\
  454. provided, the extent will be created with that in its data slot.\n\
  455. \n\
  456. Warning, this may alter match-data.")
  457.     (start, end, function, extent_data)
  458.     Lisp_Object start, end, function, extent_data;
  459. {
  460.   int pt, estart, edepth;
  461.   enum syntactic_context this_context;
  462.   Lisp_Object extent = Qnil;
  463.   struct gcpro gcpro1;
  464.  
  465.   CHECK_FIXNUM_COERCE_MARKER (start, 0);
  466.   CHECK_FIXNUM_COERCE_MARKER (end, 0);
  467.   start = XINT (start);
  468.   end = XINT (end);
  469.   pt = start;
  470.  
  471.   /* Only call find_context_start() once; passing the `end' arg
  472.      to find_context() means that it won't call it each time. */
  473.   find_context_start (pt, end);
  474.   find_context (pt, end);
  475.  
  476.   GCPRO1 (extent);
  477.   while (pt < end)
  478.     {
  479.       /* skip over "blank" areas, and bug out at end-of-buffer. */
  480.       while (context_cache.context == context_none)
  481.     {
  482.       pt++;
  483.       if (pt >= end) goto DONE;
  484.       find_context (pt, end);
  485.     }
  486.       /* We've found a non-blank area; keep going until we reach its end */
  487.       this_context = context_cache.context;
  488.       estart = pt;
  489.  
  490.       /* Minor kludge: consider the comment-start character(s) a part of
  491.      the comment.
  492.        */
  493.       if (this_context == context_block_comment &&
  494.       context_cache.ccontext == ccontext_start2)
  495.     estart -= 2;
  496.       else if (this_context == context_comment)
  497.     estart -= 1;
  498.  
  499.       edepth = context_cache.depth;
  500.       while (context_cache.context == this_context && pt < end)
  501.     {
  502.       pt++;
  503.       find_context (pt, end);
  504.     }
  505.  
  506.       /* Minor kludge: consider the character which terminated the comment
  507.      a part of the comment.
  508.        */
  509.       if ((this_context == context_block_comment ||
  510.        this_context == context_comment)
  511.       && pt < end)
  512.     pt++;
  513.  
  514.       if (estart == pt)
  515.     continue;
  516.       /* Now make an extent for it. */
  517.       extent = Fmake_extent (estart, pt == end ? end : pt - 1,
  518.                  Fcurrent_buffer ());
  519.       if (!NILP (extent_data))
  520.     Fset_extent_data (extent, extent_data);
  521.       call3 (function, extent, context_to_symbol (this_context),
  522.          make_number (edepth));
  523.     }
  524.  DONE:
  525.   UNGCPRO;
  526.   return Qnil;
  527. }
  528.  
  529. void
  530. syms_of_font_lock ()
  531. {
  532.   memset (&context_cache, 0, sizeof (context_cache));
  533.   memset (&bol_context_cache, 0, sizeof (bol_context_cache));
  534.   defsubr (&Sbuffer_syntactic_context);
  535.   defsubr (&Sbuffer_syntactic_context_depth);
  536.   defsubr (&Sbuffer_syntactic_context_flush_cache);
  537.   defsubr (&Ssyntactically_sectionize);
  538. }
  539.