src/syntax.c

   1 /* GNU Emacs routines to deal with syntax tables; also word and list parsing.
   2    Copyright (C) 1985, 87, 93, 94, 95, 97, 1998, 1999 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, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21
  22 #include <config.h>
  23 #include <ctype.h>
  24 #include "lisp.h"
  25 #include "commands.h"
  26 #include "buffer.h"
  27 #include "charset.h"
  28 #include "keymap.h"
  29
  30 /* Make syntax table lookup grant data in gl_state.  */
  31 #define SYNTAX_ENTRY_VIA_PROPERTY
  32
  33 #include "syntax.h"
  34 #include "intervals.h"
  35
  36 /* We use these constants in place for comment-style and
  37    string-ender-char to distinguish  comments/strings started by
  38    comment_fence and string_fence codes.  */
  39
  40 #define ST_COMMENT_STYLE (256 + 1)
  41 #define ST_STRING_STYLE (256 + 2)
  42 #include "category.h"
  43
  44 Lisp_Object Qsyntax_table_p, Qsyntax_table, Qscan_error;
  45
  46 int words_include_escapes;
  47 int parse_sexp_lookup_properties;
  48
  49 /* Nonzero means `scan-sexps' treat all multibyte characters as symbol.  */
  50 int multibyte_syntax_as_symbol;
  51
  52 /* Used as a temporary in SYNTAX_ENTRY and other macros in syntax.h,
  53    if not compiled with GCC.  No need to mark it, since it is used
  54    only very temporarily.  */
  55 Lisp_Object syntax_temp;
  56
  57 /* Non-zero means an open parenthesis in column 0 is always considered
  58    to be the start of a defun.  Zero means an open parenthesis in
  59    column 0 has no special meaning.  */
  60
  61 int open_paren_in_column_0_is_defun_start;
  62
  63 /* This is the internal form of the parse state used in parse-partial-sexp.  */
  64
  65 struct lisp_parse_state
  66   {
  67     int depth;          /* Depth at end of parsing.  */
  68     int instring;       /* -1 if not within string, else desired terminator.  */
  69     int incomment;      /* -1 if in unnestable comment else comment nesting */
  70     int comstyle;       /* comment style a=0, or b=1, or ST_COMMENT_STYLE.  */
  71     int quoted;         /* Nonzero if just after an escape char at end of parsing */
  72     int thislevelstart; /* Char number of most recent start-of-expression at current level */
  73     int prevlevelstart; /* Char number of start of containing expression */
  74     int location;       /* Char number at which parsing stopped.  */
  75     int mindepth;       /* Minimum depth seen while scanning.  */
  76     int comstr_start;   /* Position just after last comment/string starter.  */
  77     Lisp_Object levelstarts;    /* Char numbers of starts-of-expression
  78                                    of levels (starting from outermost).  */
  79   };
  80 \f
  81 /* These variables are a cache for finding the start of a defun.
  82    find_start_pos is the place for which the defun start was found.
  83    find_start_value is the defun start position found for it.
  84    find_start_value_byte is the corresponding byte position.
  85    find_start_buffer is the buffer it was found in.
  86    find_start_begv is the BEGV value when it was found.
  87    find_start_modiff is the value of MODIFF when it was found.  */
  88
  89 static int find_start_pos;
  90 static int find_start_value;
  91 static int find_start_value_byte;
  92 static struct buffer *find_start_buffer;
  93 static int find_start_begv;
  94 static int find_start_modiff;
  95
  96
  97 static int find_defun_start P_ ((int, int));
  98 static int back_comment P_ ((int, int, int, int, int, int *, int *));
  99 static int char_quoted P_ ((int, int));
 100 static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object));
 101 static Lisp_Object scan_lists P_ ((int, int, int, int));
 102 static void scan_sexps_forward P_ ((struct lisp_parse_state *,
 103                                     int, int, int, int,
 104                                     int, Lisp_Object, int));
 105 \f
 106
 107 struct gl_state_s gl_state;             /* Global state of syntax parser.  */
 108
 109 INTERVAL interval_of ();
 110 #define INTERVALS_AT_ONCE 10            /* 1 + max-number of intervals
 111                                            to scan to property-change.  */
 112
 113 /* Update gl_state to an appropriate interval which contains CHARPOS.  The
 114    sign of COUNT give the relative position of CHARPOS wrt the previously
 115    valid interval.  If INIT, only [be]_property fields of gl_state are
 116    valid at start, the rest is filled basing on OBJECT.
 117
 118    `gl_state.*_i' are the intervals, and CHARPOS is further in the search
 119    direction than the intervals - or in an interval.  We update the
 120    current syntax-table basing on the property of this interval, and
 121    update the interval to start further than CHARPOS - or be
 122    NULL_INTERVAL.  We also update lim_property to be the next value of
 123    charpos to call this subroutine again - or be before/after the
 124    start/end of OBJECT.  */
 125
 126 void
 127 update_syntax_table (charpos, count, init, object)
 128      int charpos, count, init;
 129      Lisp_Object object;
 130 {
 131   Lisp_Object tmp_table;
 132   int cnt = 0, invalidate = 1;
 133   INTERVAL i, oldi;
 134
 135   if (init)
 136     {
 137       gl_state.old_prop = Qnil;
 138       gl_state.start = gl_state.b_property;
 139       gl_state.stop = gl_state.e_property;
 140       i = interval_of (charpos, object);
 141       gl_state.backward_i = gl_state.forward_i = i;
 142       invalidate = 0;
 143       if (NULL_INTERVAL_P (i))
 144         return;
 145       /* interval_of updates only ->position of the return value, so
 146          update the parents manually to speed up update_interval.  */
 147       while (!NULL_PARENT (i))
 148         {
 149           if (AM_RIGHT_CHILD (i))
 150             INTERVAL_PARENT (i)->position = i->position
 151               - LEFT_TOTAL_LENGTH (i) + TOTAL_LENGTH (i) /* right end */
 152               - TOTAL_LENGTH (INTERVAL_PARENT (i))
 153               + LEFT_TOTAL_LENGTH (INTERVAL_PARENT (i));
 154           else
 155             INTERVAL_PARENT (i)->position = i->position - LEFT_TOTAL_LENGTH (i)
 156               + TOTAL_LENGTH (i);
 157           i = INTERVAL_PARENT (i);
 158         }
 159       i = gl_state.forward_i;
 160       gl_state.b_property = i->position - gl_state.offset;
 161       gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset;
 162       goto update;
 163     }
 164   oldi = i = count > 0 ? gl_state.forward_i : gl_state.backward_i;
 165
 166   /* We are guaranteed to be called with CHARPOS either in i,
 167      or further off.  */
 168   if (NULL_INTERVAL_P (i))
 169     error ("Error in syntax_table logic for to-the-end intervals");
 170   else if (charpos < i->position)               /* Move left.  */
 171     {
 172       if (count > 0)
 173         error ("Error in syntax_table logic for intervals <-");
 174       /* Update the interval.  */
 175       i = update_interval (i, charpos);
 176       if (INTERVAL_LAST_POS (i) != gl_state.b_property)
 177         {
 178           invalidate = 0;
 179           gl_state.forward_i = i;
 180           gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset;
 181         }
 182     }
 183   else if (charpos >= INTERVAL_LAST_POS (i)) /* Move right.  */
 184     {
 185       if (count < 0)
 186         error ("Error in syntax_table logic for intervals ->");
 187       /* Update the interval.  */
 188       i = update_interval (i, charpos);
 189       if (i->position != gl_state.e_property)
 190         {
 191           invalidate = 0;
 192           gl_state.backward_i = i;
 193           gl_state.b_property = i->position - gl_state.offset;
 194         }
 195     }
 196
 197   update:
 198   tmp_table = textget (i->plist, Qsyntax_table);
 199
 200   if (invalidate)
 201     invalidate = !EQ (tmp_table, gl_state.old_prop); /* Need to invalidate? */
 202
 203   if (invalidate)               /* Did not get to adjacent interval.  */
 204     {                           /* with the same table => */
 205                                 /* invalidate the old range.  */
 206       if (count > 0)
 207         {
 208           gl_state.backward_i = i;
 209           gl_state.b_property = i->position - gl_state.offset;
 210         }
 211       else
 212         {
 213           gl_state.forward_i = i;
 214           gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset;
 215         }
 216     }
 217
 218   if (!EQ (tmp_table, gl_state.old_prop))
 219     {
 220       gl_state.current_syntax_table = tmp_table;
 221       gl_state.old_prop = tmp_table;
 222       if (EQ (Fsyntax_table_p (tmp_table), Qt))
 223         {
 224           gl_state.use_global = 0;
 225         }
 226       else if (CONSP (tmp_table))
 227         {
 228           gl_state.use_global = 1;
 229           gl_state.global_code = tmp_table;
 230         }
 231       else
 232         {
 233           gl_state.use_global = 0;
 234           gl_state.current_syntax_table = current_buffer->syntax_table;
 235         }
 236     }
 237
 238   while (!NULL_INTERVAL_P (i))
 239     {
 240       if (cnt && !EQ (tmp_table, textget (i->plist, Qsyntax_table)))
 241         {
 242           if (count > 0)
 243             {
 244               gl_state.e_property = i->position - gl_state.offset;
 245               gl_state.forward_i = i;
 246             }
 247           else
 248             {
 249               gl_state.b_property = i->position + LENGTH (i) - gl_state.offset;
 250               gl_state.backward_i = i;
 251             }
 252           return;
 253         }
 254       else if (cnt == INTERVALS_AT_ONCE)
 255         {
 256           if (count > 0)
 257             {
 258               gl_state.e_property = i->position + LENGTH (i) - gl_state.offset;
 259               gl_state.forward_i = i;
 260             }
 261           else
 262             {
 263               gl_state.b_property = i->position - gl_state.offset;
 264               gl_state.backward_i = i;
 265             }
 266           return;
 267         }
 268       cnt++;
 269       i = count > 0 ? next_interval (i) : previous_interval (i);
 270     }
 271   eassert (NULL_INTERVAL_P (i)); /* This property goes to the end.  */
 272   if (count > 0)
 273     gl_state.e_property = gl_state.stop;
 274   else
 275     gl_state.b_property = gl_state.start;
 276 }
 277 \f
 278 /* Returns TRUE if char at CHARPOS is quoted.
 279    Global syntax-table data should be set up already to be good at CHARPOS
 280    or after.  On return global syntax data is good for lookup at CHARPOS. */
 281
 282 static int
 283 char_quoted (charpos, bytepos)
 284      register int charpos, bytepos;
 285 {
 286   register enum syntaxcode code;
 287   register int beg = BEGV;
 288   register int quoted = 0;
 289   int orig = charpos;
 290
 291   DEC_BOTH (charpos, bytepos);
 292
 293   while (bytepos >= beg)
 294     {
 295       UPDATE_SYNTAX_TABLE_BACKWARD (charpos);
 296       code = SYNTAX (FETCH_CHAR (bytepos));
 297       if (! (code == Scharquote || code == Sescape))
 298         break;
 299
 300       DEC_BOTH (charpos, bytepos);
 301       quoted = !quoted;
 302     }
 303
 304   UPDATE_SYNTAX_TABLE (orig);
 305   return quoted;
 306 }
 307
 308 /* Return the bytepos one character after BYTEPOS.
 309    We assume that BYTEPOS is not at the end of the buffer.  */
 310
 311 INLINE int
 312 inc_bytepos (bytepos)
 313      int bytepos;
 314 {
 315   if (NILP (current_buffer->enable_multibyte_characters))
 316     return bytepos + 1;
 317
 318   INC_POS (bytepos);
 319   return bytepos;
 320 }
 321
 322 /* Return the bytepos one character before BYTEPOS.
 323    We assume that BYTEPOS is not at the start of the buffer.  */
 324
 325 INLINE int
 326 dec_bytepos (bytepos)
 327      int bytepos;
 328 {
 329   if (NILP (current_buffer->enable_multibyte_characters))
 330     return bytepos - 1;
 331
 332   DEC_POS (bytepos);
 333   return bytepos;
 334 }
 335 \f
 336 /* Return a defun-start position before before POS and not too far before.
 337    It should be the last one before POS, or nearly the last.
 338
 339    When open_paren_in_column_0_is_defun_start is nonzero,
 340    the beginning of every line is treated as a defun-start.
 341
 342    We record the information about where the scan started
 343    and what its result was, so that another call in the same area
 344    can return the same value very quickly.
 345
 346    There is no promise at which position the global syntax data is
 347    valid on return from the subroutine, so the caller should explicitly
 348    update the global data.  */
 349
 350 static int
 351 find_defun_start (pos, pos_byte)
 352      int pos, pos_byte;
 353 {
 354   int opoint = PT, opoint_byte = PT_BYTE;
 355
 356   /* Use previous finding, if it's valid and applies to this inquiry.  */
 357   if (current_buffer == find_start_buffer
 358       /* Reuse the defun-start even if POS is a little farther on.
 359          POS might be in the next defun, but that's ok.
 360          Our value may not be the best possible, but will still be usable.  */
 361       && pos <= find_start_pos + 1000
 362       && pos >= find_start_value
 363       && BEGV == find_start_begv
 364       && MODIFF == find_start_modiff)
 365     return find_start_value;
 366
 367   /* Back up to start of line.  */
 368   scan_newline (pos, pos_byte, BEGV, BEGV_BYTE, -1, 1);
 369
 370   /* We optimize syntax-table lookup for rare updates.  Thus we accept
 371      only those `^\s(' which are good in global _and_ text-property
 372      syntax-tables.  */
 373   gl_state.current_syntax_table = current_buffer->syntax_table;
 374   gl_state.use_global = 0;
 375   if (open_paren_in_column_0_is_defun_start)
 376     {
 377       while (PT > BEGV)
 378         {
 379           /* Open-paren at start of line means we may have found our
 380              defun-start.  */
 381           if (SYNTAX (FETCH_CHAR (PT_BYTE)) == Sopen)
 382             {
 383               SETUP_SYNTAX_TABLE (PT + 1, -1);  /* Try again... */
 384               if (SYNTAX (FETCH_CHAR (PT_BYTE)) == Sopen)
 385                 break;
 386               /* Now fallback to the default value.  */
 387               gl_state.current_syntax_table = current_buffer->syntax_table;
 388               gl_state.use_global = 0;
 389             }
 390           /* Move to beg of previous line.  */
 391           scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1);
 392         }
 393     }
 394
 395   /* Record what we found, for the next try.  */
 396   find_start_value = PT;
 397   find_start_value_byte = PT_BYTE;
 398   find_start_buffer = current_buffer;
 399   find_start_modiff = MODIFF;
 400   find_start_begv = BEGV;
 401   find_start_pos = pos;
 402
 403   TEMP_SET_PT_BOTH (opoint, opoint_byte);
 404
 405   return find_start_value;
 406 }
 407 \f
 408 /* Return the SYNTAX_COMEND_FIRST of the character before POS, POS_BYTE.  */
 409
 410 static int
 411 prev_char_comend_first (pos, pos_byte)
 412      int pos, pos_byte;
 413 {
 414   int c, val;
 415
 416   DEC_BOTH (pos, pos_byte);
 417   UPDATE_SYNTAX_TABLE_BACKWARD (pos);
 418   c = FETCH_CHAR (pos_byte);
 419   val = SYNTAX_COMEND_FIRST (c);
 420   UPDATE_SYNTAX_TABLE_FORWARD (pos + 1);
 421   return val;
 422 }
 423
 424 /* Return the SYNTAX_COMSTART_FIRST of the character before POS, POS_BYTE.  */
 425
 426 /* static int
 427  * prev_char_comstart_first (pos, pos_byte)
 428  *      int pos, pos_byte;
 429  * {
 430  *   int c, val;
 431  *
 432  *   DEC_BOTH (pos, pos_byte);
 433  *   UPDATE_SYNTAX_TABLE_BACKWARD (pos);
 434  *   c = FETCH_CHAR (pos_byte);
 435  *   val = SYNTAX_COMSTART_FIRST (c);
 436  *   UPDATE_SYNTAX_TABLE_FORWARD (pos + 1);
 437  *   return val;
 438  * } */
 439
 440 /* Checks whether charpos FROM is at the end of a comment.
 441    FROM_BYTE is the bytepos corresponding to FROM.
 442    Do not move back before STOP.
 443
 444    Return a positive value if we find a comment ending at FROM/FROM_BYTE;
 445    return -1 otherwise.
 446
 447    If successful, store the charpos of the comment's beginning
 448    into *CHARPOS_PTR, and the bytepos into *BYTEPOS_PTR.
 449
 450    Global syntax data remains valid for backward search starting at
 451    the returned value (or at FROM, if the search was not successful).  */
 452
 453 static int
 454 back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_ptr)
 455      int from, from_byte, stop;
 456      int comnested, comstyle;
 457      int *charpos_ptr, *bytepos_ptr;
 458 {
 459   /* Look back, counting the parity of string-quotes,
 460      and recording the comment-starters seen.
 461      When we reach a safe place, assume that's not in a string;
 462      then step the main scan to the earliest comment-starter seen
 463      an even number of string quotes away from the safe place.
 464
 465      OFROM[I] is position of the earliest comment-starter seen
 466      which is I+2X quotes from the comment-end.
 467      PARITY is current parity of quotes from the comment end.  */
 468   int string_style = -1;        /* Presumed outside of any string. */
 469   int string_lossage = 0;
 470   /* Not a real lossage: indicates that we have passed a matching comment
 471      starter plus an non-matching comment-ender, meaning that any matching
 472      comment-starter we might see later could be a false positive (hidden
 473      inside another comment).
 474      Test case:  { a (* b } c (* d *) */
 475   int comment_lossage = 0;
 476   int comment_end = from;
 477   int comment_end_byte = from_byte;
 478   int comstart_pos = 0;
 479   int comstart_byte;
 480   /* Place where the containing defun starts,
 481      or 0 if we didn't come across it yet.  */
 482   int defun_start = 0;
 483   int defun_start_byte = 0;
 484   register enum syntaxcode code;
 485   int nesting = 1;              /* current comment nesting */
 486   int c;
 487   int syntax = 0;
 488
 489   /* FIXME: A }} comment-ender style leads to incorrect behavior
 490      in the case of {{ c }}} because we ignore the last two chars which are
 491      assumed to be comment-enders although they aren't.  */
 492
 493   /* At beginning of range to scan, we're outside of strings;
 494      that determines quote parity to the comment-end.  */
 495   while (from != stop)
 496     {
 497       int temp_byte, prev_syntax;
 498       int com2start, com2end;
 499
 500       /* Move back and examine a character.  */
 501       DEC_BOTH (from, from_byte);
 502       UPDATE_SYNTAX_TABLE_BACKWARD (from);
 503
 504       prev_syntax = syntax;
 505       c = FETCH_CHAR (from_byte);
 506       syntax = SYNTAX_WITH_FLAGS (c);
 507       code = SYNTAX (c);
 508
 509       /* Check for 2-char comment markers.  */
 510       com2start = (SYNTAX_FLAGS_COMSTART_FIRST (syntax)
 511                    && SYNTAX_FLAGS_COMSTART_SECOND (prev_syntax)
 512                    && comstyle == SYNTAX_FLAGS_COMMENT_STYLE (prev_syntax)
 513                    && (SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax)
 514                        || SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested);
 515       com2end = (SYNTAX_FLAGS_COMEND_FIRST (syntax)
 516                  && SYNTAX_FLAGS_COMEND_SECOND (prev_syntax));
 517
 518       /* Nasty cases with overlapping 2-char comment markers:
 519          - snmp-mode: -- c -- foo -- c --
 520                       --- c --
 521                       ------ c --
 522          - c-mode:    *||*
 523                       |* *|* *|
 524                       |*| |* |*|
 525                       ///   */
 526
 527       /* If a 2-char comment sequence partly overlaps with another,
 528          we don't try to be clever.  */
 529       if (from > stop && (com2end || com2start))
 530         {
 531           int next = from, next_byte = from_byte, next_c, next_syntax;
 532           DEC_BOTH (next, next_byte);
 533           UPDATE_SYNTAX_TABLE_BACKWARD (next);
 534           next_c = FETCH_CHAR (next_byte);
 535           next_syntax = SYNTAX_WITH_FLAGS (next_c);
 536           if (((com2start || comnested)
 537                && SYNTAX_FLAGS_COMEND_SECOND (syntax)
 538                && SYNTAX_FLAGS_COMEND_FIRST (next_syntax))
 539               || ((com2end || comnested)
 540                   && SYNTAX_FLAGS_COMSTART_SECOND (syntax)
 541                   && comstyle == SYNTAX_FLAGS_COMMENT_STYLE (syntax)
 542                   && SYNTAX_FLAGS_COMSTART_FIRST (next_syntax)))
 543             goto lossage;
 544           /* UPDATE_SYNTAX_TABLE_FORWARD (next + 1); */
 545         }
 546
 547       if (com2start && comstart_pos == 0)
 548         /* We're looking at a comment starter.  But it might be a comment
 549            ender as well (see snmp-mode).  The first time we see one, we
 550            need to consider it as a comment starter,
 551            and the subsequent times as a comment ender.  */
 552         com2end = 0;
 553
 554       /* Turn a 2-char comment sequences into the appropriate syntax.  */
 555       if (com2end)
 556         code = Sendcomment;
 557       else if (com2start)
 558         code = Scomment;
 559       /* Ignore comment starters of a different style.  */
 560       else if (code == Scomment
 561                && (comstyle != SYNTAX_FLAGS_COMMENT_STYLE (syntax)
 562                    || SYNTAX_FLAGS_COMMENT_NESTED (syntax) != comnested))
 563         continue;
 564
 565       /* Ignore escaped characters, except comment-enders.  */
 566       if (code != Sendcomment && char_quoted (from, from_byte))
 567         continue;
 568
 569       switch (code)
 570         {
 571         case Sstring_fence:
 572         case Scomment_fence:
 573           c = (code == Sstring_fence ? ST_STRING_STYLE : ST_COMMENT_STYLE);
 574         case Sstring:
 575           /* Track parity of quotes.  */
 576           if (string_style == -1)
 577             /* Entering a string.  */
 578             string_style = c;
 579           else if (string_style == c)
 580             /* Leaving the string.  */
 581             string_style = -1;
 582           else
 583             /* If we have two kinds of string delimiters.
 584                There's no way to grok this scanning backwards.  */
 585             string_lossage = 1;
 586           break;
 587
 588         case Scomment:
 589           /* We've already checked that it is the relevant comstyle.  */
 590           if (string_style != -1 || comment_lossage || string_lossage)
 591             /* There are odd string quotes involved, so let's be careful.
 592                Test case in Pascal: " { " a { " } */
 593             goto lossage;
 594
 595           if (!comnested)
 596             {
 597               /* Record best comment-starter so far.  */
 598               comstart_pos = from;
 599               comstart_byte = from_byte;
 600             }
 601           else if (--nesting <= 0)
 602             /* nested comments have to be balanced, so we don't need to
 603                keep looking for earlier ones.  We use here the same (slightly
 604                incorrect) reasoning as below:  since it is followed by uniform
 605                paired string quotes, this comment-start has to be outside of
 606                strings, else the comment-end itself would be inside a string. */
 607             goto done;
 608           break;
 609
 610         case Sendcomment:
 611           if (SYNTAX_FLAGS_COMMENT_STYLE (syntax) == comstyle
 612               && (SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax)
 613                   || SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested)
 614             /* This is the same style of comment ender as ours. */
 615             {
 616               if (comnested)
 617                 nesting++;
 618               else
 619                 /* Anything before that can't count because it would match
 620                    this comment-ender rather than ours.  */
 621                 from = stop;    /* Break out of the loop.  */
 622             }
 623           else if (comstart_pos != 0 || c != '\n')
 624             /* We're mixing comment styles here, so we'd better be careful.
 625                The (comstart_pos != 0 || c != '\n') check is not quite correct
 626                (we should just always set comment_lossage), but removing it
 627                would imply that any multiline comment in C would go through
 628                lossage, which seems overkill.
 629                The failure should only happen in the rare cases such as
 630                  { (* } *)   */
 631             comment_lossage = 1;
 632           break;
 633
 634         case Sopen:
 635           /* Assume a defun-start point is outside of strings.  */
 636           if (open_paren_in_column_0_is_defun_start
 637               && (from == stop
 638                   || (temp_byte = dec_bytepos (from_byte),
 639                       FETCH_CHAR (temp_byte) == '\n')))
 640             {
 641               defun_start = from;
 642               defun_start_byte = from_byte;
 643               from = stop;      /* Break out of the loop.  */
 644             }
 645           break;
 646
 647         default:
 648           break;
 649         }
 650     }
 651
 652   if (comstart_pos == 0)
 653     {
 654       from = comment_end;
 655       from_byte = comment_end_byte;
 656       UPDATE_SYNTAX_TABLE_FORWARD (comment_end - 1);
 657     }
 658   /* If comstart_pos is set and we get here (ie. didn't jump to `lossage'
 659      or `done'), then we've found the beginning of the non-nested comment.  */
 660   else if (1)   /* !comnested */
 661     {
 662       from = comstart_pos;
 663       from_byte = comstart_byte;
 664       /* Globals are correct now.  */
 665     }
 666   else
 667     {
 668       struct lisp_parse_state state;
 669     lossage:
 670       /* We had two kinds of string delimiters mixed up
 671          together.  Decode this going forwards.
 672          Scan fwd from a known safe place (beginning-of-defun)
 673          to the one in question; this records where we
 674          last passed a comment starter.  */
 675       /* If we did not already find the defun start, find it now.  */
 676       if (defun_start == 0)
 677         {
 678           defun_start = find_defun_start (comment_end, comment_end_byte);
 679           defun_start_byte = find_start_value_byte;
 680         }
 681       do
 682         {
 683           scan_sexps_forward (&state,
 684                               defun_start, defun_start_byte,
 685                               comment_end, -10000, 0, Qnil, 0);
 686           defun_start = comment_end;
 687           if (state.incomment == (comnested ? 1 : -1)
 688               && state.comstyle == comstyle)
 689             from = state.comstr_start;
 690           else
 691             {
 692               from = comment_end;
 693               if (state.incomment)
 694                 /* If comment_end is inside some other comment, maybe ours
 695                    is nested, so we need to try again from within the
 696                    surrounding comment.  Example: { a (* " *)  */
 697                 {
 698                   /* FIXME: We should advance by one or two chars. */
 699                   defun_start = state.comstr_start + 2;
 700                   defun_start_byte = CHAR_TO_BYTE (defun_start);
 701                 }
 702             }
 703         } while (defun_start < comment_end);
 704
 705       from_byte = CHAR_TO_BYTE (from);
 706       UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
 707     }
 708
 709  done:
 710   *charpos_ptr = from;
 711   *bytepos_ptr = from_byte;
 712
 713   return (from == comment_end) ? -1 : from;
 714 }
 715 \f
 716 DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0,
 717        doc: /* Return t if OBJECT is a syntax table.
 718 Currently, any char-table counts as a syntax table.  */)
 719      (object)
 720      Lisp_Object object;
 721 {
 722   if (CHAR_TABLE_P (object)
 723       && EQ (XCHAR_TABLE (object)->purpose, Qsyntax_table))
 724     return Qt;
 725   return Qnil;
 726 }
 727
 728 static void
 729 check_syntax_table (obj)
 730      Lisp_Object obj;
 731 {
 732   if (!(CHAR_TABLE_P (obj)
 733         && EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table)))
 734     wrong_type_argument (Qsyntax_table_p, obj);
 735 }
 736
 737 DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0,
 738        doc: /* Return the current syntax table.
 739 This is the one specified by the current buffer.  */)
 740      ()
 741 {
 742   return current_buffer->syntax_table;
 743 }
 744
 745 DEFUN ("standard-syntax-table", Fstandard_syntax_table,
 746    Sstandard_syntax_table, 0, 0, 0,
 747        doc: /* Return the standard syntax table.
 748 This is the one used for new buffers.  */)
 749      ()
 750 {
 751   return Vstandard_syntax_table;
 752 }
 753
 754 DEFUN ("copy-syntax-table", Fcopy_syntax_table, Scopy_syntax_table, 0, 1, 0,
 755        doc: /* Construct a new syntax table and return it.
 756 It is a copy of the TABLE, which defaults to the standard syntax table.  */)
 757      (table)
 758      Lisp_Object table;
 759 {
 760   Lisp_Object copy;
 761
 762   if (!NILP (table))
 763     check_syntax_table (table);
 764   else
 765     table = Vstandard_syntax_table;
 766
 767   copy = Fcopy_sequence (table);
 768
 769   /* Only the standard syntax table should have a default element.
 770      Other syntax tables should inherit from parents instead.  */
 771   XCHAR_TABLE (copy)->defalt = Qnil;
 772
 773   /* Copied syntax tables should all have parents.
 774      If we copied one with no parent, such as the standard syntax table,
 775      use the standard syntax table as the copy's parent.  */
 776   if (NILP (XCHAR_TABLE (copy)->parent))
 777     Fset_char_table_parent (copy, Vstandard_syntax_table);
 778   return copy;
 779 }
 780
 781 DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 1, 0,
 782        doc: /* Select a new syntax table for the current buffer.
 783 One argument, a syntax table.  */)
 784      (table)
 785      Lisp_Object table;
 786 {
 787   int idx;
 788   check_syntax_table (table);
 789   current_buffer->syntax_table = table;
 790   /* Indicate that this buffer now has a specified syntax table.  */
 791   idx = PER_BUFFER_VAR_IDX (syntax_table);
 792   SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);
 793   return table;
 794 }
 795 \f
 796 /* Convert a letter which signifies a syntax code
 797  into the code it signifies.
 798  This is used by modify-syntax-entry, and other things.  */
 799
 800 unsigned char syntax_spec_code[0400] =
 801   { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 802     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 803     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 804     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 805     (char) Swhitespace, (char) Scomment_fence, (char) Sstring, 0377,
 806         (char) Smath, 0377, 0377, (char) Squote,
 807     (char) Sopen, (char) Sclose, 0377, 0377,
 808         0377, (char) Swhitespace, (char) Spunct, (char) Scharquote,
 809     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 810     0377, 0377, 0377, 0377,
 811         (char) Scomment, 0377, (char) Sendcomment, 0377,
 812     (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377,   /* @, A ... */
 813     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 814     0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
 815     0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol,
 816     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,   /* `, a, ... */
 817     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 818     0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
 819     0377, 0377, 0377, 0377, (char) Sstring_fence, 0377, 0377, 0377
 820   };
 821
 822 /* Indexed by syntax code, give the letter that describes it.  */
 823
 824 char syntax_code_spec[16] =
 825   {
 826     ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@',
 827     '!', '|'
 828   };
 829
 830 /* Indexed by syntax code, give the object (cons of syntax code and
 831    nil) to be stored in syntax table.  Since these objects can be
 832    shared among syntax tables, we generate them in advance.  By
 833    sharing objects, the function `describe-syntax' can give a more
 834    compact listing.  */
 835 static Lisp_Object Vsyntax_code_object;
 836
 837 \f
 838 /* Look up the value for CHARACTER in syntax table TABLE's parent
 839    and its parents.  SYNTAX_ENTRY calls this, when TABLE itself has nil
 840    for CHARACTER.  It's actually used only when not compiled with GCC.  */
 841
 842 Lisp_Object
 843 syntax_parent_lookup (table, character)
 844      Lisp_Object table;
 845      int character;
 846 {
 847   Lisp_Object value;
 848
 849   while (1)
 850     {
 851       table = XCHAR_TABLE (table)->parent;
 852       if (NILP (table))
 853         return Qnil;
 854
 855       value = XCHAR_TABLE (table)->contents[character];
 856       if (!NILP (value))
 857         return value;
 858     }
 859 }
 860
 861 DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0,
 862        doc: /* Return the syntax code of CHARACTER, described by a character.
 863 For example, if CHARACTER is a word constituent,
 864 the character `w' is returned.
 865 The characters that correspond to various syntax codes
 866 are listed in the documentation of `modify-syntax-entry'.  */)
 867      (character)
 868      Lisp_Object character;
 869 {
 870   int char_int;
 871   gl_state.current_syntax_table = current_buffer->syntax_table;
 872
 873   gl_state.use_global = 0;
 874   CHECK_NUMBER (character);
 875   char_int = XINT (character);
 876   return make_number (syntax_code_spec[(int) SYNTAX (char_int)]);
 877 }
 878
 879 DEFUN ("matching-paren", Fmatching_paren, Smatching_paren, 1, 1, 0,
 880        doc: /* Return the matching parenthesis of CHARACTER, or nil if none.  */)
 881      (character)
 882      Lisp_Object character;
 883 {
 884   int char_int, code;
 885   gl_state.current_syntax_table = current_buffer->syntax_table;
 886   gl_state.use_global = 0;
 887   CHECK_NUMBER (character);
 888   char_int = XINT (character);
 889   code = SYNTAX (char_int);
 890   if (code == Sopen || code == Sclose)
 891     return SYNTAX_MATCH (char_int);
 892   return Qnil;
 893 }
 894
 895 DEFUN ("string-to-syntax", Fstring_to_syntax, Sstring_to_syntax, 1, 1, 0,
 896        doc: /* Convert a syntax specification STRING into syntax cell form.
 897 STRING should be a string as it is allowed as argument of
 898 `modify-syntax-entry'.  Value is the equivalent cons cell
 899 (CODE . MATCHING-CHAR) that can be used as value of a `syntax-table'
 900 text property.  */)
 901      (string)
 902      Lisp_Object string;
 903 {
 904   register const unsigned char *p;
 905   register enum syntaxcode code;
 906   int val;
 907   Lisp_Object match;
 908
 909   CHECK_STRING (string);
 910
 911   p = SDATA (string);
 912   code = (enum syntaxcode) syntax_spec_code[*p++];
 913   if (((int) code & 0377) == 0377)
 914     error ("invalid syntax description letter: %c", p[-1]);
 915
 916   if (code == Sinherit)
 917     return Qnil;
 918
 919   if (*p)
 920     {
 921       int len;
 922       int character = (STRING_CHAR_AND_LENGTH
 923                        (p, SBYTES (string) - 1, len));
 924       XSETINT (match, character);
 925       if (XFASTINT (match) == ' ')
 926         match = Qnil;
 927       p += len;
 928     }
 929   else
 930     match = Qnil;
 931
 932   val = (int) code;
 933   while (*p)
 934     switch (*p++)
 935       {
 936       case '1':
 937         val |= 1 << 16;
 938         break;
 939
 940       case '2':
 941         val |= 1 << 17;
 942         break;
 943
 944       case '3':
 945         val |= 1 << 18;
 946         break;
 947
 948       case '4':
 949         val |= 1 << 19;
 950         break;
 951
 952       case 'p':
 953         val |= 1 << 20;
 954         break;
 955
 956       case 'b':
 957         val |= 1 << 21;
 958         break;
 959
 960       case 'n':
 961         val |= 1 << 22;
 962         break;
 963       }
 964
 965   if (val < XVECTOR (Vsyntax_code_object)->size && NILP (match))
 966     return XVECTOR (Vsyntax_code_object)->contents[val];
 967   else
 968     /* Since we can't use a shared object, let's make a new one.  */
 969     return Fcons (make_number (val), match);
 970 }
 971
 972 /* I really don't know why this is interactive
 973    help-form should at least be made useful whilst reading the second arg.  */
 974 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3,
 975   "cSet syntax for character: \nsSet syntax for %s to: ",
 976        doc: /* Set syntax for character CHAR according to string NEWENTRY.
 977 The syntax is changed only for table SYNTAX_TABLE, which defaults to
 978  the current buffer's syntax table.
 979 The first character of NEWENTRY should be one of the following:
 980   Space or -  whitespace syntax.    w   word constituent.
 981   _           symbol constituent.   .   punctuation.
 982   (           open-parenthesis.     )   close-parenthesis.
 983   "           string quote.         \\   escape.
 984   $           paired delimiter.     '   expression quote or prefix operator.
 985   <           comment starter.      >   comment ender.
 986   /           character-quote.      @   inherit from `standard-syntax-table'.
 987   |           generic string fence. !   generic comment fence.
 988
 989 Only single-character comment start and end sequences are represented thus.
 990 Two-character sequences are represented as described below.
 991 The second character of NEWENTRY is the matching parenthesis,
 992  used only if the first character is `(' or `)'.
 993 Any additional characters are flags.
 994 Defined flags are the characters 1, 2, 3, 4, b, p, and n.
 995  1 means CHAR is the start of a two-char comment start sequence.
 996  2 means CHAR is the second character of such a sequence.
 997  3 means CHAR is the start of a two-char comment end sequence.
 998  4 means CHAR is the second character of such a sequence.
 999
1000 There can be up to two orthogonal comment sequences.  This is to support
1001 language modes such as C++.  By default, all comment sequences are of style
1002 a, but you can set the comment sequence style to b (on the second character
1003 of a comment-start, or the first character of a comment-end sequence) using
1004 this flag:
1005  b means CHAR is part of comment sequence b.
1006  n means CHAR is part of a nestable comment sequence.
1007
1008  p means CHAR is a prefix character for `backward-prefix-chars';
1009    such characters are treated as whitespace when they occur
1010    between expressions.
1011 usage: (modify-syntax-entry CHAR NEWENTRY &optional SYNTAX-TABLE) */)
1012      (c, newentry, syntax_table)
1013      Lisp_Object c, newentry, syntax_table;
1014 {
1015   CHECK_NUMBER (c);
1016
1017   if (NILP (syntax_table))
1018     syntax_table = current_buffer->syntax_table;
1019   else
1020     check_syntax_table (syntax_table);
1021
1022   SET_RAW_SYNTAX_ENTRY (syntax_table, XINT (c), Fstring_to_syntax (newentry));
1023   return Qnil;
1024 }
1025 \f
1026 /* Dump syntax table to buffer in human-readable format */
1027
1028 DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
1029        Sinternal_describe_syntax_value, 1, 1, 0,
1030        doc: /* Insert a description of the internal syntax description SYNTAX at point.  */)
1031      (syntax)
1032      Lisp_Object syntax;
1033 {
1034   register enum syntaxcode code;
1035   char desc, start1, start2, end1, end2, prefix, comstyle, comnested;
1036   char str[2];
1037   Lisp_Object first, match_lisp, value = syntax;
1038
1039   if (NILP (value))
1040     {
1041       insert_string ("default");
1042       return syntax;
1043     }
1044
1045   if (CHAR_TABLE_P (value))
1046     {
1047       insert_string ("deeper char-table ...");
1048       return syntax;
1049     }
1050
1051   if (!CONSP (value))
1052     {
1053       insert_string ("invalid");
1054       return syntax;
1055     }
1056
1057   first = XCAR (value);
1058   match_lisp = XCDR (value);
1059
1060   if (!INTEGERP (first) || !(NILP (match_lisp) || INTEGERP (match_lisp)))
1061     {
1062       insert_string ("invalid");
1063       return syntax;
1064     }
1065
1066   code = (enum syntaxcode) (XINT (first) & 0377);
1067   start1 = (XINT (first) >> 16) & 1;
1068   start2 = (XINT (first) >> 17) & 1;
1069   end1 = (XINT (first) >> 18) & 1;
1070   end2 = (XINT (first) >> 19) & 1;
1071   prefix = (XINT (first) >> 20) & 1;
1072   comstyle = (XINT (first) >> 21) & 1;
1073   comnested = (XINT (first) >> 22) & 1;
1074
1075   if ((int) code < 0 || (int) code >= (int) Smax)
1076     {
1077       insert_string ("invalid");
1078       return syntax;
1079     }
1080   desc = syntax_code_spec[(int) code];
1081
1082   str[0] = desc, str[1] = 0;
1083   insert (str, 1);
1084
1085   if (NILP (match_lisp))
1086     insert (" ", 1);
1087   else
1088     insert_char (XINT (match_lisp));
1089
1090   if (start1)
1091     insert ("1", 1);
1092   if (start2)
1093     insert ("2", 1);
1094
1095   if (end1)
1096     insert ("3", 1);
1097   if (end2)
1098     insert ("4", 1);
1099
1100   if (prefix)
1101     insert ("p", 1);
1102   if (comstyle)
1103     insert ("b", 1);
1104   if (comnested)
1105     insert ("n", 1);
1106
1107   insert_string ("\twhich means: ");
1108
1109   switch (SWITCH_ENUM_CAST (code))
1110     {
1111     case Swhitespace:
1112       insert_string ("whitespace"); break;
1113     case Spunct:
1114       insert_string ("punctuation"); break;
1115     case Sword:
1116       insert_string ("word"); break;
1117     case Ssymbol:
1118       insert_string ("symbol"); break;
1119     case Sopen:
1120       insert_string ("open"); break;
1121     case Sclose:
1122       insert_string ("close"); break;
1123     case Squote:
1124       insert_string ("prefix"); break;
1125     case Sstring:
1126       insert_string ("string"); break;
1127     case Smath:
1128       insert_string ("math"); break;
1129     case Sescape:
1130       insert_string ("escape"); break;
1131     case Scharquote:
1132       insert_string ("charquote"); break;
1133     case Scomment:
1134       insert_string ("comment"); break;
1135     case Sendcomment:
1136       insert_string ("endcomment"); break;
1137     case Sinherit:
1138       insert_string ("inherit"); break;
1139     case Scomment_fence:
1140       insert_string ("comment fence"); break;
1141     case Sstring_fence:
1142       insert_string ("string fence"); break;
1143     default:
1144       insert_string ("invalid");
1145       return syntax;
1146     }
1147
1148   if (!NILP (match_lisp))
1149     {
1150       insert_string (", matches ");
1151       insert_char (XINT (match_lisp));
1152     }
1153
1154   if (start1)
1155     insert_string (",\n\t  is the first character of a comment-start sequence");
1156   if (start2)
1157     insert_string (",\n\t  is the second character of a comment-start sequence");
1158
1159   if (end1)
1160     insert_string (",\n\t  is the first character of a comment-end sequence");
1161   if (end2)
1162     insert_string (",\n\t  is the second character of a comment-end sequence");
1163   if (comstyle)
1164     insert_string (" (comment style b)");
1165   if (comnested)
1166     insert_string (" (nestable)");
1167
1168   if (prefix)
1169     insert_string (",\n\t  is a prefix character for `backward-prefix-chars'");
1170
1171   return syntax;
1172 }
1173 \f
1174 int parse_sexp_ignore_comments;
1175
1176 /* Return the position across COUNT words from FROM.
1177    If that many words cannot be found before the end of the buffer, return 0.
1178    COUNT negative means scan backward and stop at word beginning.  */
1179
1180 int
1181 scan_words (from, count)
1182      register int from, count;
1183 {
1184   register int beg = BEGV;
1185   register int end = ZV;
1186   register int from_byte = CHAR_TO_BYTE (from);
1187   register enum syntaxcode code;
1188   int ch0, ch1;
1189
1190   immediate_quit = 1;
1191   QUIT;
1192
1193   SETUP_SYNTAX_TABLE (from, count);
1194
1195   while (count > 0)
1196     {
1197       while (1)
1198         {
1199           if (from == end)
1200             {
1201               immediate_quit = 0;
1202               return 0;
1203             }
1204           UPDATE_SYNTAX_TABLE_FORWARD (from);
1205           ch0 = FETCH_CHAR (from_byte);
1206           code = SYNTAX (ch0);
1207           INC_BOTH (from, from_byte);
1208           if (words_include_escapes
1209               && (code == Sescape || code == Scharquote))
1210             break;
1211           if (code == Sword)
1212             break;
1213         }
1214       /* Now CH0 is a character which begins a word and FROM is the
1215          position of the next character.  */
1216       while (1)
1217         {
1218           if (from == end) break;
1219           UPDATE_SYNTAX_TABLE_FORWARD (from);
1220           ch1 = FETCH_CHAR (from_byte);
1221           code = SYNTAX (ch1);
1222           if (!(words_include_escapes
1223                 && (code == Sescape || code == Scharquote)))
1224             if (code != Sword || WORD_BOUNDARY_P (ch0, ch1))
1225               break;
1226           INC_BOTH (from, from_byte);
1227           ch0 = ch1;
1228         }
1229       count--;
1230     }
1231   while (count < 0)
1232     {
1233       while (1)
1234         {
1235           if (from == beg)
1236             {
1237               immediate_quit = 0;
1238               return 0;
1239             }
1240           DEC_BOTH (from, from_byte);
1241           UPDATE_SYNTAX_TABLE_BACKWARD (from);
1242           ch1 = FETCH_CHAR (from_byte);
1243           code = SYNTAX (ch1);
1244           if (words_include_escapes
1245               && (code == Sescape || code == Scharquote))
1246             break;
1247           if (code == Sword)
1248             break;
1249         }
1250       /* Now CH1 is a character which ends a word and FROM is the
1251          position of it.  */
1252       while (1)
1253         {
1254           int temp_byte;
1255
1256           if (from == beg)
1257             break;
1258           temp_byte = dec_bytepos (from_byte);
1259           UPDATE_SYNTAX_TABLE_BACKWARD (from);
1260           ch0 = FETCH_CHAR (temp_byte);
1261           code = SYNTAX (ch0);
1262           if (!(words_include_escapes
1263                 && (code == Sescape || code == Scharquote)))
1264             if (code != Sword || WORD_BOUNDARY_P (ch0, ch1))
1265               break;
1266           DEC_BOTH (from, from_byte);
1267           ch1 = ch0;
1268         }
1269       count++;
1270     }
1271
1272   immediate_quit = 0;
1273
1274   return from;
1275 }
1276
1277 DEFUN ("forward-word", Fforward_word, Sforward_word, 1, 1, "p",
1278        doc: /* Move point forward ARG words (backward if ARG is negative).
1279 Normally returns t.
1280 If an edge of the buffer or a field boundary is reached, point is left there
1281 and the function returns nil.  Field boundaries are not noticed if
1282 `inhibit-field-text-motion' is non-nil.  */)
1283      (count)
1284      Lisp_Object count;
1285 {
1286   int orig_val, val;
1287   CHECK_NUMBER (count);
1288
1289   val = orig_val = scan_words (PT, XINT (count));
1290   if (! orig_val)
1291     val = XINT (count) > 0 ? ZV : BEGV;
1292
1293   /* Avoid jumping out of an input field.  */
1294   val = XFASTINT (Fconstrain_to_field (make_number (val), make_number (PT),
1295                                        Qt, Qnil, Qnil));
1296
1297   SET_PT (val);
1298   return val == orig_val ? Qt : Qnil;
1299 }
1300 \f
1301 Lisp_Object skip_chars ();
1302
1303 DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0,
1304        doc: /* Move point forward, stopping before a char not in STRING, or at pos LIM.
1305 STRING is like the inside of a `[...]' in a regular expression
1306 except that `]' is never special and `\\' quotes `^', `-' or `\\'
1307  (but not as the end of a range; quoting is never needed there).
1308 Thus, with arg "a-zA-Z", this skips letters stopping before first nonletter.
1309 With arg "^a-zA-Z", skips nonletters stopping before first letter.
1310 Returns the distance traveled, either zero or positive.  */)
1311      (string, lim)
1312      Lisp_Object string, lim;
1313 {
1314   return skip_chars (1, 0, string, lim);
1315 }
1316
1317 DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
1318        doc: /* Move point backward, stopping after a char not in STRING, or at pos LIM.
1319 See `skip-chars-forward' for details.
1320 Returns the distance traveled, either zero or negative.  */)
1321      (string, lim)
1322      Lisp_Object string, lim;
1323 {
1324   return skip_chars (0, 0, string, lim);
1325 }
1326
1327 DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0,
1328        doc: /* Move point forward across chars in specified syntax classes.
1329 SYNTAX is a string of syntax code characters.
1330 Stop before a char whose syntax is not in SYNTAX, or at position LIM.
1331 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
1332 This function returns the distance traveled, either zero or positive.  */)
1333      (syntax, lim)
1334      Lisp_Object syntax, lim;
1335 {
1336   return skip_chars (1, 1, syntax, lim);
1337 }
1338
1339 DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0,
1340        doc: /* Move point backward across chars in specified syntax classes.
1341 SYNTAX is a string of syntax code characters.
1342 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.
1343 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
1344 This function returns the distance traveled, either zero or negative.  */)
1345      (syntax, lim)
1346      Lisp_Object syntax, lim;
1347 {
1348   return skip_chars (0, 1, syntax, lim);
1349 }
1350
1351 static Lisp_Object
1352 skip_chars (forwardp, syntaxp, string, lim)
1353      int forwardp, syntaxp;
1354      Lisp_Object string, lim;
1355 {
1356   register unsigned int c;
1357   unsigned char fastmap[0400];
1358   /* If SYNTAXP is 0, STRING may contain multi-byte form of characters
1359      of which codes don't fit in FASTMAP.  In that case, set the
1360      ranges of characters in CHAR_RANGES.  */
1361   int *char_ranges;
1362   int n_char_ranges = 0;
1363   int negate = 0;
1364   register int i, i_byte;
1365   int multibyte = !NILP (current_buffer->enable_multibyte_characters);
1366   int string_multibyte;
1367   int size_byte;
1368   const unsigned char *str;
1369   int len;
1370
1371   CHECK_STRING (string);
1372   char_ranges = (int *) alloca (SCHARS (string) * (sizeof (int)) * 2);
1373   string_multibyte = STRING_MULTIBYTE (string);
1374   str = SDATA (string);
1375   size_byte = SBYTES (string);
1376
1377   /* Adjust the multibyteness of the string to that of the buffer.  */
1378   if (multibyte != string_multibyte)
1379     {
1380       int nbytes;
1381
1382       if (multibyte)
1383         nbytes = count_size_as_multibyte (SDATA (string),
1384                                           SCHARS (string));
1385       else
1386         nbytes = SCHARS (string);
1387       if (nbytes != size_byte)
1388         {
1389           unsigned char *tmp = (unsigned char *) alloca (nbytes);
1390           copy_text (SDATA (string), tmp, size_byte,
1391                      string_multibyte, multibyte);
1392           size_byte = nbytes;
1393           str = tmp;
1394         }
1395     }
1396
1397   if (NILP (lim))
1398     XSETINT (lim, forwardp ? ZV : BEGV);
1399   else
1400     CHECK_NUMBER_COERCE_MARKER (lim);
1401
1402   /* In any case, don't allow scan outside bounds of buffer.  */
1403   if (XINT (lim) > ZV)
1404     XSETFASTINT (lim, ZV);
1405   if (XINT (lim) < BEGV)
1406     XSETFASTINT (lim, BEGV);
1407
1408   bzero (fastmap, sizeof fastmap);
1409
1410   i_byte = 0;
1411
1412   if (i_byte < size_byte
1413       && SREF (string, 0) == '^')
1414     {
1415       negate = 1; i_byte++;
1416     }
1417
1418   /* Find the characters specified and set their elements of fastmap.
1419      If syntaxp, each character counts as itself.
1420      Otherwise, handle backslashes and ranges specially.  */
1421
1422   while (i_byte < size_byte)
1423     {
1424       c = STRING_CHAR_AND_LENGTH (str + i_byte, size_byte - i_byte, len);
1425       i_byte += len;
1426
1427       if (syntaxp)
1428         fastmap[syntax_spec_code[c & 0377]] = 1;
1429       else
1430         {
1431           if (c == '\\')
1432             {
1433               if (i_byte == size_byte)
1434                 break;
1435
1436               c = STRING_CHAR_AND_LENGTH (str+i_byte, size_byte-i_byte, len);
1437               i_byte += len;
1438             }
1439           if (i_byte < size_byte
1440               && str[i_byte] == '-')
1441             {
1442               unsigned int c2;
1443
1444               /* Skip over the dash.  */
1445               i_byte++;
1446
1447               if (i_byte == size_byte)
1448                 break;
1449
1450               /* Get the end of the range.  */
1451               c2 =STRING_CHAR_AND_LENGTH (str+i_byte, size_byte-i_byte, len);
1452               i_byte += len;
1453
1454               if (SINGLE_BYTE_CHAR_P (c))
1455                 {
1456                   if (! SINGLE_BYTE_CHAR_P (c2))
1457                     {
1458                       /* Handle a range starting with a character of
1459                          less than 256, and ending with a character of
1460                          not less than 256.  Split that into two
1461                          ranges, the low one ending at 0377, and the
1462                          high one starting at the smallest character
1463                          in the charset of C2 and ending at C2.  */
1464                       int charset = CHAR_CHARSET (c2);
1465                       int c1 = MAKE_CHAR (charset, 0, 0);
1466
1467                       char_ranges[n_char_ranges++] = c1;
1468                       char_ranges[n_char_ranges++] = c2;
1469                       c2 = 0377;
1470                     }
1471                   while (c <= c2)
1472                     {
1473                       fastmap[c] = 1;
1474                       c++;
1475                     }
1476                 }
1477               else if (c <= c2) /* Both C and C2 are multibyte char.  */
1478                 {
1479                   char_ranges[n_char_ranges++] = c;
1480                   char_ranges[n_char_ranges++] = c2;
1481                 }
1482             }
1483           else
1484             {
1485               if (SINGLE_BYTE_CHAR_P (c))
1486                 fastmap[c] = 1;
1487               else
1488                 {
1489                   char_ranges[n_char_ranges++] = c;
1490                   char_ranges[n_char_ranges++] = c;
1491                 }
1492             }
1493         }
1494     }
1495
1496   /* If ^ was the first character, complement the fastmap.  */
1497   if (negate)
1498     for (i = 0; i < sizeof fastmap; i++)
1499       fastmap[i] ^= 1;
1500
1501   {
1502     int start_point = PT;
1503     int pos = PT;
1504     int pos_byte = PT_BYTE;
1505
1506     immediate_quit = 1;
1507     if (syntaxp)
1508       {
1509         SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
1510         if (forwardp)
1511           {
1512             if (multibyte)
1513               {
1514                 if (pos < XINT (lim))
1515                   while (fastmap[(int) SYNTAX (FETCH_CHAR (pos_byte))])
1516                     {
1517                       /* Since we already checked for multibyteness,
1518                          avoid using INC_BOTH which checks again.  */
1519                       INC_POS (pos_byte);
1520                       pos++;
1521                       if (pos >= XINT (lim))
1522                         break;
1523                       UPDATE_SYNTAX_TABLE_FORWARD (pos);
1524                     }
1525               }
1526             else
1527               {
1528                 while (pos < XINT (lim)
1529                        && fastmap[(int) SYNTAX (FETCH_BYTE (pos))])
1530                   {
1531                     pos++;
1532                     UPDATE_SYNTAX_TABLE_FORWARD (pos);
1533                   }
1534               }
1535           }
1536         else
1537           {
1538             if (multibyte)
1539               {
1540                 while (pos > XINT (lim))
1541                   {
1542                     int savepos = pos_byte;
1543                     /* Since we already checked for multibyteness,
1544                        avoid using DEC_BOTH which checks again.  */
1545                     pos--;
1546                     DEC_POS (pos_byte);
1547                     UPDATE_SYNTAX_TABLE_BACKWARD (pos);
1548                     if (!fastmap[(int) SYNTAX (FETCH_CHAR (pos_byte))])
1549                       {
1550                         pos++;
1551                         pos_byte = savepos;
1552                         break;
1553                       }
1554                   }
1555               }
1556             else
1557               {
1558                 if (pos > XINT (lim))
1559                   while (fastmap[(int) SYNTAX (FETCH_BYTE (pos - 1))])
1560                     {
1561                       pos--;
1562                       if (pos <= XINT (lim))
1563                         break;
1564                       UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
1565                     }
1566               }
1567           }
1568       }
1569     else
1570       {
1571         if (forwardp)
1572           {
1573             if (multibyte)
1574               while (pos < XINT (lim))
1575                 {
1576                   c = FETCH_MULTIBYTE_CHAR (pos_byte);
1577                   if (SINGLE_BYTE_CHAR_P (c))
1578                     {
1579                       if (!fastmap[c])
1580                         break;
1581                     }
1582                   else
1583                     {
1584                       /* If we are looking at a multibyte character,
1585                          we must look up the character in the table
1586                          CHAR_RANGES.  If there's no data in the
1587                          table, that character is not what we want to
1588                          skip.  */
1589
1590                       /* The following code do the right thing even if
1591                          n_char_ranges is zero (i.e. no data in
1592                          CHAR_RANGES).  */
1593                       for (i = 0; i < n_char_ranges; i += 2)
1594                         if (c >= char_ranges[i] && c <= char_ranges[i + 1])
1595                           break;
1596                       if (!(negate ^ (i < n_char_ranges)))
1597                         break;
1598                     }
1599                   INC_BOTH (pos, pos_byte);
1600                 }
1601             else
1602               while (pos < XINT (lim) && fastmap[FETCH_BYTE (pos)])
1603                 pos++;
1604           }
1605         else
1606           {
1607             if (multibyte)
1608               while (pos > XINT (lim))
1609                 {
1610                   int prev_pos_byte = pos_byte;
1611
1612                   DEC_POS (prev_pos_byte);
1613                   c = FETCH_MULTIBYTE_CHAR (prev_pos_byte);
1614                   if (SINGLE_BYTE_CHAR_P (c))
1615                     {
1616                       if (!fastmap[c])
1617                         break;
1618                     }
1619                   else
1620                     {
1621                       /* See the comment in the previous similar code.  */
1622                       for (i = 0; i < n_char_ranges; i += 2)
1623                         if (c >= char_ranges[i] && c <= char_ranges[i + 1])
1624                           break;
1625                       if (!(negate ^ (i < n_char_ranges)))
1626                         break;
1627                     }
1628                   pos--;
1629                   pos_byte = prev_pos_byte;
1630                 }
1631             else
1632               while (pos > XINT (lim) && fastmap[FETCH_BYTE (pos - 1)])
1633                 pos--;
1634           }
1635       }
1636
1637 #if 0 /* Not needed now that a position in mid-character
1638          cannot be specified in Lisp.  */
1639     if (multibyte
1640         /* INC_POS or DEC_POS might have moved POS over LIM.  */
1641         && (forwardp ? (pos > XINT (lim)) : (pos < XINT (lim))))
1642       pos = XINT (lim);
1643 #endif
1644
1645     if (! multibyte)
1646       pos_byte = pos;
1647
1648     SET_PT_BOTH (pos, pos_byte);
1649     immediate_quit = 0;
1650
1651     return make_number (PT - start_point);
1652   }
1653 }
1654 \f
1655 /* Jump over a comment, assuming we are at the beginning of one.
1656    FROM is the current position.
1657    FROM_BYTE is the bytepos corresponding to FROM.
1658    Do not move past STOP (a charpos).
1659    The comment over which we have to jump is of style STYLE
1660      (either SYNTAX_COMMENT_STYLE(foo) or ST_COMMENT_STYLE).
1661    NESTING should be positive to indicate the nesting at the beginning
1662      for nested comments and should be zero or negative else.
1663      ST_COMMENT_STYLE cannot be nested.
1664    PREV_SYNTAX is the SYNTAX_WITH_FLAGS of the previous character
1665      (or 0 If the search cannot start in the middle of a two-character).
1666
1667    If successful, return 1 and store the charpos of the comment's end
1668    into *CHARPOS_PTR and the corresponding bytepos into *BYTEPOS_PTR.
1669    Else, return 0 and store the charpos STOP into *CHARPOS_PTR, the
1670    corresponding bytepos into *BYTEPOS_PTR and the current nesting
1671    (as defined for state.incomment) in *INCOMMENT_PTR.
1672
1673    The comment end is the last character of the comment rather than the
1674      character just after the comment.
1675
1676    Global syntax data is assumed to initially be valid for FROM and
1677    remains valid for forward search starting at the returned position. */
1678
1679 static int
1680 forw_comment (from, from_byte, stop, nesting, style, prev_syntax,
1681               charpos_ptr, bytepos_ptr, incomment_ptr)
1682      int from, from_byte, stop;
1683      int nesting, style, prev_syntax;
1684      int *charpos_ptr, *bytepos_ptr, *incomment_ptr;
1685 {
1686   register int c, c1;
1687   register enum syntaxcode code;
1688   register int syntax;
1689
1690   if (nesting <= 0) nesting = -1;
1691
1692   /* Enter the loop in the middle so that we find
1693      a 2-char comment ender if we start in the middle of it.  */
1694   syntax = prev_syntax;
1695   if (syntax != 0) goto forw_incomment;
1696
1697   while (1)
1698     {
1699       if (from == stop)
1700         {
1701           *incomment_ptr = nesting;
1702           *charpos_ptr = from;
1703           *bytepos_ptr = from_byte;
1704           return 0;
1705         }
1706       c = FETCH_CHAR (from_byte);
1707       syntax = SYNTAX_WITH_FLAGS (c);
1708       code = syntax & 0xff;
1709       if (code == Sendcomment
1710           && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style
1711           && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ?
1712               (nesting > 0 && --nesting == 0) : nesting < 0))
1713         /* we have encountered a comment end of the same style
1714            as the comment sequence which began this comment
1715            section */
1716         break;
1717       if (code == Scomment_fence
1718           && style == ST_COMMENT_STYLE)
1719         /* we have encountered a comment end of the same style
1720            as the comment sequence which began this comment
1721            section.  */
1722         break;
1723       if (nesting > 0
1724           && code == Scomment
1725           && SYNTAX_FLAGS_COMMENT_NESTED (syntax)
1726           && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style)
1727         /* we have encountered a nested comment of the same style
1728            as the comment sequence which began this comment section */
1729         nesting++;
1730       INC_BOTH (from, from_byte);
1731       UPDATE_SYNTAX_TABLE_FORWARD (from);
1732
1733     forw_incomment:
1734       if (from < stop && SYNTAX_FLAGS_COMEND_FIRST (syntax)
1735           && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style
1736           && (c1 = FETCH_CHAR (from_byte),
1737               SYNTAX_COMEND_SECOND (c1))
1738           && ((SYNTAX_FLAGS_COMMENT_NESTED (syntax) ||
1739                SYNTAX_COMMENT_NESTED (c1)) ? nesting > 0 : nesting < 0))
1740         {
1741           if (--nesting <= 0)
1742             /* we have encountered a comment end of the same style
1743                as the comment sequence which began this comment
1744                section */
1745             break;
1746           else
1747             {
1748               INC_BOTH (from, from_byte);
1749               UPDATE_SYNTAX_TABLE_FORWARD (from);
1750             }
1751         }
1752       if (nesting > 0
1753           && from < stop
1754           && SYNTAX_FLAGS_COMSTART_FIRST (syntax)
1755           && (c1 = FETCH_CHAR (from_byte),
1756               SYNTAX_COMMENT_STYLE (c1) == style
1757               && SYNTAX_COMSTART_SECOND (c1))
1758           && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ||
1759               SYNTAX_COMMENT_NESTED (c1)))
1760         /* we have encountered a nested comment of the same style
1761            as the comment sequence which began this comment
1762            section */
1763         {
1764           INC_BOTH (from, from_byte);
1765           UPDATE_SYNTAX_TABLE_FORWARD (from);
1766           nesting++;
1767         }
1768     }
1769   *charpos_ptr = from;
1770   *bytepos_ptr = from_byte;
1771   return 1;
1772 }
1773
1774 DEFUN ("forward-comment", Fforward_comment, Sforward_comment, 1, 1, 0,
1775        doc: /* Move forward across up to N comments.  If N is negative, move backward.
1776 Stop scanning if we find something other than a comment or whitespace.
1777 Set point to where scanning stops.
1778 If N comments are found as expected, with nothing except whitespace
1779 between them, return t; otherwise return nil.  */)
1780      (count)
1781      Lisp_Object count;
1782 {
1783   register int from;
1784   int from_byte;
1785   register int stop;
1786   register int c, c1;
1787   register enum syntaxcode code;
1788   int comstyle = 0;         /* style of comment encountered */
1789   int comnested = 0;        /* whether the comment is nestable or not */
1790   int found;
1791   int count1;
1792   int out_charpos, out_bytepos;
1793   int dummy;
1794
1795   CHECK_NUMBER (count);
1796   count1 = XINT (count);
1797   stop = count1 > 0 ? ZV : BEGV;
1798
1799   immediate_quit = 1;
1800   QUIT;
1801
1802   from = PT;
1803   from_byte = PT_BYTE;
1804
1805   SETUP_SYNTAX_TABLE (from, count1);
1806   while (count1 > 0)
1807     {
1808       do
1809         {
1810           int comstart_first;
1811
1812           if (from == stop)
1813             {
1814               SET_PT_BOTH (from, from_byte);
1815               immediate_quit = 0;
1816               return Qnil;
1817             }
1818           c = FETCH_CHAR (from_byte);
1819           code = SYNTAX (c);
1820           comstart_first = SYNTAX_COMSTART_FIRST (c);
1821           comnested = SYNTAX_COMMENT_NESTED (c);
1822           comstyle = SYNTAX_COMMENT_STYLE (c);
1823           INC_BOTH (from, from_byte);
1824           UPDATE_SYNTAX_TABLE_FORWARD (from);
1825           if (from < stop && comstart_first
1826               && (c1 = FETCH_CHAR (from_byte),
1827                   SYNTAX_COMSTART_SECOND (c1)))
1828             {
1829               /* We have encountered a comment start sequence and we
1830                  are ignoring all text inside comments.  We must record
1831                  the comment style this sequence begins so that later,
1832                  only a comment end of the same style actually ends
1833                  the comment section.  */
1834               code = Scomment;
1835               comstyle = SYNTAX_COMMENT_STYLE (c1);
1836               comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
1837               INC_BOTH (from, from_byte);
1838               UPDATE_SYNTAX_TABLE_FORWARD (from);
1839             }
1840         }
1841       while (code == Swhitespace || (code == Sendcomment && c == '\n'));
1842
1843       if (code == Scomment_fence)
1844         comstyle = ST_COMMENT_STYLE;
1845       else if (code != Scomment)
1846         {
1847           immediate_quit = 0;
1848           DEC_BOTH (from, from_byte);
1849           SET_PT_BOTH (from, from_byte);
1850           return Qnil;
1851         }
1852       /* We're at the start of a comment.  */
1853       found = forw_comment (from, from_byte, stop, comnested, comstyle, 0,
1854                             &out_charpos, &out_bytepos, &dummy);
1855       from = out_charpos; from_byte = out_bytepos;
1856       if (!found)
1857         {
1858           immediate_quit = 0;
1859           SET_PT_BOTH (from, from_byte);
1860           return Qnil;
1861         }
1862       INC_BOTH (from, from_byte);
1863       UPDATE_SYNTAX_TABLE_FORWARD (from);
1864       /* We have skipped one comment.  */
1865       count1--;
1866     }
1867
1868   while (count1 < 0)
1869     {
1870       while (1)
1871         {
1872           int quoted;
1873
1874           if (from <= stop)
1875             {
1876               SET_PT_BOTH (BEGV, BEGV_BYTE);
1877               immediate_quit = 0;
1878               return Qnil;
1879             }
1880
1881           DEC_BOTH (from, from_byte);
1882           /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from).  */
1883           quoted = char_quoted (from, from_byte);
1884           c = FETCH_CHAR (from_byte);
1885           code = SYNTAX (c);
1886           comstyle = 0;
1887           comnested = SYNTAX_COMMENT_NESTED (c);
1888           if (code == Sendcomment)
1889             comstyle = SYNTAX_COMMENT_STYLE (c);
1890           if (from > stop && SYNTAX_COMEND_SECOND (c)
1891               && prev_char_comend_first (from, from_byte)
1892               && !char_quoted (from - 1, dec_bytepos (from_byte)))
1893             {
1894               /* We must record the comment style encountered so that
1895                  later, we can match only the proper comment begin
1896                  sequence of the same style.  */
1897               DEC_BOTH (from, from_byte);
1898               code = Sendcomment;
1899               /* Calling char_quoted, above, set up global syntax position
1900                  at the new value of FROM.  */
1901               c1 = FETCH_CHAR (from_byte);
1902               comstyle = SYNTAX_COMMENT_STYLE (c1);
1903               comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
1904             }
1905
1906           if (code == Scomment_fence)
1907             {
1908               /* Skip until first preceding unquoted comment_fence.  */
1909               int found = 0, ini = from, ini_byte = from_byte;
1910
1911               while (1)
1912                 {
1913                   DEC_BOTH (from, from_byte);
1914                   if (from == stop)
1915                     break;
1916                   UPDATE_SYNTAX_TABLE_BACKWARD (from);
1917                   c = FETCH_CHAR (from_byte);
1918                   if (SYNTAX (c) == Scomment_fence
1919                       && !char_quoted (from, from_byte))
1920                     {
1921                       found = 1;
1922                       break;
1923                     }
1924                 }
1925               if (found == 0)
1926                 {
1927                   from = ini;           /* Set point to ini + 1.  */
1928                   from_byte = ini_byte;
1929                   goto leave;
1930                 }
1931             }
1932           else if (code == Sendcomment)
1933             {
1934               found = back_comment (from, from_byte, stop, comnested, comstyle,
1935                                     &out_charpos, &out_bytepos);
1936               if (found == -1)
1937                 {
1938                   if (c == '\n')
1939                     /* This end-of-line is not an end-of-comment.
1940                        Treat it like a whitespace.
1941                        CC-mode (and maybe others) relies on this behavior.  */
1942                     ;
1943                   else
1944                     {
1945                       /* Failure: we should go back to the end of this
1946                          not-quite-endcomment.  */
1947                       if (SYNTAX(c) != code)
1948                         /* It was a two-char Sendcomment.  */
1949                         INC_BOTH (from, from_byte);
1950                       goto leave;
1951                     }
1952                 }
1953               else
1954                 {
1955                   /* We have skipped one comment.  */
1956                   from = out_charpos, from_byte = out_bytepos;
1957                   break;
1958                 }
1959             }
1960           else if (code != Swhitespace || quoted)
1961             {
1962             leave:
1963               immediate_quit = 0;
1964               INC_BOTH (from, from_byte);
1965               SET_PT_BOTH (from, from_byte);
1966               return Qnil;
1967             }
1968         }
1969
1970       count1++;
1971     }
1972
1973   SET_PT_BOTH (from, from_byte);
1974   immediate_quit = 0;
1975   return Qt;
1976 }
1977 \f
1978 /* Return syntax code of character C if C is a single byte character
1979    or `multibyte_symbol_p' is zero.  Otherwise, return Ssymbol.  */
1980
1981 #define SYNTAX_WITH_MULTIBYTE_CHECK(c)                  \
1982   ((SINGLE_BYTE_CHAR_P (c) || !multibyte_symbol_p)      \
1983    ? SYNTAX (c) : Ssymbol)
1984
1985 static Lisp_Object
1986 scan_lists (from, count, depth, sexpflag)
1987      register int from;
1988      int count, depth, sexpflag;
1989 {
1990   Lisp_Object val;
1991   register int stop = count > 0 ? ZV : BEGV;
1992   register int c, c1;
1993   int stringterm;
1994   int quoted;
1995   int mathexit = 0;
1996   register enum syntaxcode code, temp_code;
1997   int min_depth = depth;    /* Err out if depth gets less than this.  */
1998   int comstyle = 0;         /* style of comment encountered */
1999   int comnested = 0;        /* whether the comment is nestable or not */
2000   int temp_pos;
2001   int last_good = from;
2002   int found;
2003   int from_byte;
2004   int out_bytepos, out_charpos;
2005   int temp, dummy;
2006   int multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
2007
2008   if (depth > 0) min_depth = 0;
2009
2010   if (from > ZV) from = ZV;
2011   if (from < BEGV) from = BEGV;
2012
2013   from_byte = CHAR_TO_BYTE (from);
2014
2015   immediate_quit = 1;
2016   QUIT;
2017
2018   SETUP_SYNTAX_TABLE (from, count);
2019   while (count > 0)
2020     {
2021       while (from < stop)
2022         {
2023           int comstart_first, prefix;
2024           UPDATE_SYNTAX_TABLE_FORWARD (from);
2025           c = FETCH_CHAR (from_byte);
2026           code = SYNTAX_WITH_MULTIBYTE_CHECK (c);
2027           comstart_first = SYNTAX_COMSTART_FIRST (c);
2028           comnested = SYNTAX_COMMENT_NESTED (c);
2029           comstyle = SYNTAX_COMMENT_STYLE (c);
2030           prefix = SYNTAX_PREFIX (c);
2031           if (depth == min_depth)
2032             last_good = from;
2033           INC_BOTH (from, from_byte);
2034           UPDATE_SYNTAX_TABLE_FORWARD (from);
2035           if (from < stop && comstart_first
2036               && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte))
2037               && parse_sexp_ignore_comments)
2038             {
2039               /* we have encountered a comment start sequence and we
2040                  are ignoring all text inside comments.  We must record
2041                  the comment style this sequence begins so that later,
2042                  only a comment end of the same style actually ends
2043                  the comment section */
2044               code = Scomment;
2045               c1 = FETCH_CHAR (from_byte);
2046               comstyle = SYNTAX_COMMENT_STYLE (c1);
2047               comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
2048               INC_BOTH (from, from_byte);
2049               UPDATE_SYNTAX_TABLE_FORWARD (from);
2050             }
2051
2052           if (prefix)
2053             continue;
2054
2055           switch (SWITCH_ENUM_CAST (code))
2056             {
2057             case Sescape:
2058             case Scharquote:
2059               if (from == stop) goto lose;
2060               INC_BOTH (from, from_byte);
2061               /* treat following character as a word constituent */
2062             case Sword:
2063             case Ssymbol:
2064               if (depth || !sexpflag) break;
2065               /* This word counts as a sexp; return at end of it.  */
2066               while (from < stop)
2067                 {
2068                   UPDATE_SYNTAX_TABLE_FORWARD (from);
2069
2070                   /* Some compilers can't handle this inside the switch.  */
2071                   c = FETCH_CHAR (from_byte);
2072                   temp = SYNTAX_WITH_MULTIBYTE_CHECK (c);
2073                   switch (temp)
2074                     {
2075                     case Scharquote:
2076                     case Sescape:
2077                       INC_BOTH (from, from_byte);
2078                       if (from == stop) goto lose;
2079                       break;
2080                     case Sword:
2081                     case Ssymbol:
2082                     case Squote:
2083                       break;
2084                     default:
2085                       goto done;
2086                     }
2087                   INC_BOTH (from, from_byte);
2088                 }
2089               goto done;
2090
2091             case Scomment_fence:
2092               comstyle = ST_COMMENT_STYLE;
2093               /* FALLTHROUGH */
2094             case Scomment:
2095               if (!parse_sexp_ignore_comments) break;
2096               UPDATE_SYNTAX_TABLE_FORWARD (from);
2097               found = forw_comment (from, from_byte, stop,
2098                                     comnested, comstyle, 0,
2099                                     &out_charpos, &out_bytepos, &dummy);
2100               from = out_charpos, from_byte = out_bytepos;
2101               if (!found)
2102                 {
2103                   if (depth == 0)
2104                     goto done;
2105                   goto lose;
2106                 }
2107               INC_BOTH (from, from_byte);
2108               UPDATE_SYNTAX_TABLE_FORWARD (from);
2109               break;
2110
2111             case Smath:
2112               if (!sexpflag)
2113                 break;
2114               if (from != stop && c == FETCH_CHAR (from_byte))
2115                 {
2116                   INC_BOTH (from, from_byte);
2117                 }
2118               if (mathexit)
2119                 {
2120                   mathexit = 0;
2121                   goto close1;
2122                 }
2123               mathexit = 1;
2124
2125             case Sopen:
2126               if (!++depth) goto done;
2127               break;
2128
2129             case Sclose:
2130             close1:
2131               if (!--depth) goto done;
2132               if (depth < min_depth)
2133                 Fsignal (Qscan_error,
2134                          Fcons (build_string ("Containing expression ends prematurely"),
2135                                 Fcons (make_number (last_good),
2136                                        Fcons (make_number (from), Qnil))));
2137               break;
2138
2139             case Sstring:
2140             case Sstring_fence:
2141               temp_pos = dec_bytepos (from_byte);
2142               stringterm = FETCH_CHAR (temp_pos);
2143               while (1)
2144                 {
2145                   if (from >= stop) goto lose;
2146                   UPDATE_SYNTAX_TABLE_FORWARD (from);
2147                   c = FETCH_CHAR (from_byte);
2148                   if (code == Sstring
2149                       ? (c == stringterm
2150                          && SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring)
2151                       : SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring_fence)
2152                     break;
2153
2154                   /* Some compilers can't handle this inside the switch.  */
2155                   temp = SYNTAX_WITH_MULTIBYTE_CHECK (c);
2156                   switch (temp)
2157                     {
2158                     case Scharquote:
2159                     case Sescape:
2160                       INC_BOTH (from, from_byte);
2161                     }
2162                   INC_BOTH (from, from_byte);
2163                 }
2164               INC_BOTH (from, from_byte);
2165               if (!depth && sexpflag) goto done;
2166               break;
2167             }
2168         }
2169
2170       /* Reached end of buffer.  Error if within object, return nil if between */
2171       if (depth) goto lose;
2172
2173       immediate_quit = 0;
2174       return Qnil;
2175
2176       /* End of object reached */
2177     done:
2178       count--;
2179     }
2180
2181   while (count < 0)
2182     {
2183       while (from > stop)
2184         {
2185           DEC_BOTH (from, from_byte);
2186           UPDATE_SYNTAX_TABLE_BACKWARD (from);
2187           c = FETCH_CHAR (from_byte);
2188           code = SYNTAX_WITH_MULTIBYTE_CHECK (c);
2189           if (depth == min_depth)
2190             last_good = from;
2191           comstyle = 0;
2192           comnested = SYNTAX_COMMENT_NESTED (c);
2193           if (code == Sendcomment)
2194             comstyle = SYNTAX_COMMENT_STYLE (c);
2195           if (from > stop && SYNTAX_COMEND_SECOND (c)
2196               && prev_char_comend_first (from, from_byte)
2197               && parse_sexp_ignore_comments)
2198             {
2199               /* We must record the comment style encountered so that
2200                  later, we can match only the proper comment begin
2201                  sequence of the same style.  */
2202               DEC_BOTH (from, from_byte);
2203               UPDATE_SYNTAX_TABLE_BACKWARD (from);
2204               code = Sendcomment;
2205               c1 = FETCH_CHAR (from_byte);
2206               comstyle = SYNTAX_COMMENT_STYLE (c1);
2207               comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
2208             }
2209
2210           /* Quoting turns anything except a comment-ender
2211              into a word character.  Note that this cannot be true
2212              if we decremented FROM in the if-statement above.  */
2213           if (code != Sendcomment && char_quoted (from, from_byte))
2214             code = Sword;
2215           else if (SYNTAX_PREFIX (c))
2216             continue;
2217
2218           switch (SWITCH_ENUM_CAST (code))
2219             {
2220             case Sword:
2221             case Ssymbol:
2222             case Sescape:
2223             case Scharquote:
2224               if (depth || !sexpflag) break;
2225               /* This word counts as a sexp; count object finished
2226                  after passing it.  */
2227               while (from > stop)
2228                 {
2229                   temp_pos = from_byte;
2230                   if (! NILP (current_buffer->enable_multibyte_characters))
2231                     DEC_POS (temp_pos);
2232                   else
2233                     temp_pos--;
2234                   UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
2235                   c1 = FETCH_CHAR (temp_pos);
2236                   temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1);
2237                   /* Don't allow comment-end to be quoted.  */
2238                   if (temp_code == Sendcomment)
2239                     goto done2;
2240                   quoted = char_quoted (from - 1, temp_pos);
2241                   if (quoted)
2242                     {
2243                       DEC_BOTH (from, from_byte);
2244                       temp_pos = dec_bytepos (temp_pos);
2245                       UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
2246                     }
2247                   c1 = FETCH_CHAR (temp_pos);
2248                   temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1);
2249                   if (! (quoted || temp_code == Sword
2250                          || temp_code == Ssymbol
2251                          || temp_code == Squote))
2252                     goto done2;
2253                   DEC_BOTH (from, from_byte);
2254                 }
2255               goto done2;
2256
2257             case Smath:
2258               if (!sexpflag)
2259                 break;
2260               temp_pos = dec_bytepos (from_byte);
2261               UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
2262               if (from != stop && c == FETCH_CHAR (temp_pos))
2263                 DEC_BOTH (from, from_byte);
2264               if (mathexit)
2265                 {
2266                   mathexit = 0;
2267                   goto open2;
2268                 }
2269               mathexit = 1;
2270
2271             case Sclose:
2272               if (!++depth) goto done2;
2273               break;
2274
2275             case Sopen:
2276             open2:
2277               if (!--depth) goto done2;
2278               if (depth < min_depth)
2279                 Fsignal (Qscan_error,
2280                          Fcons (build_string ("Containing expression ends prematurely"),
2281                                 Fcons (make_number (last_good),
2282                                        Fcons (make_number (from), Qnil))));
2283               break;
2284
2285             case Sendcomment:
2286               if (!parse_sexp_ignore_comments)
2287                 break;
2288               found = back_comment (from, from_byte, stop, comnested, comstyle,
2289                                     &out_charpos, &out_bytepos);
2290               /* FIXME:  if found == -1, then it really wasn't a comment-end.
2291                  For single-char Sendcomment, we can't do much about it apart
2292                  from skipping the char.
2293                  For 2-char endcomments, we could try again, taking both
2294                  chars as separate entities, but it's a lot of trouble
2295                  for very little gain, so we don't bother either.  -sm */
2296               if (found != -1)
2297                 from = out_charpos, from_byte = out_bytepos;
2298               break;
2299
2300             case Scomment_fence:
2301             case Sstring_fence:
2302               while (1)
2303                 {
2304                   DEC_BOTH (from, from_byte);
2305                   if (from == stop) goto lose;
2306                   UPDATE_SYNTAX_TABLE_BACKWARD (from);
2307                   if (!char_quoted (from, from_byte)
2308                       && (c = FETCH_CHAR (from_byte),
2309                           SYNTAX_WITH_MULTIBYTE_CHECK (c) == code))
2310                     break;
2311                 }
2312               if (code == Sstring_fence && !depth && sexpflag) goto done2;
2313               break;
2314
2315             case Sstring:
2316               stringterm = FETCH_CHAR (from_byte);
2317               while (1)
2318                 {
2319                   if (from == stop) goto lose;
2320                   temp_pos = from_byte;
2321                   if (! NILP (current_buffer->enable_multibyte_characters))
2322                     DEC_POS (temp_pos);
2323                   else
2324                     temp_pos--;
2325                   UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
2326                   if (!char_quoted (from - 1, temp_pos)
2327                       && stringterm == (c = FETCH_CHAR (temp_pos))
2328                       && SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring)
2329                     break;
2330                   DEC_BOTH (from, from_byte);
2331                 }
2332               DEC_BOTH (from, from_byte);
2333               if (!depth && sexpflag) goto done2;
2334               break;
2335             }
2336         }
2337
2338       /* Reached start of buffer.  Error if within object, return nil if between */
2339       if (depth) goto lose;
2340
2341       immediate_quit = 0;
2342       return Qnil;
2343
2344     done2:
2345       count++;
2346     }
2347
2348
2349   immediate_quit = 0;
2350   XSETFASTINT (val, from);
2351   return val;
2352
2353  lose:
2354   Fsignal (Qscan_error,
2355            Fcons (build_string ("Unbalanced parentheses"),
2356                   Fcons (make_number (last_good),
2357                          Fcons (make_number (from), Qnil))));
2358
2359   /* NOTREACHED */
2360 }
2361
2362 DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0,
2363        doc: /* Scan from character number FROM by COUNT lists.
2364 Returns the character number of the position thus found.
2365
2366 If DEPTH is nonzero, paren depth begins counting from that value,
2367 only places where the depth in parentheses becomes zero
2368 are candidates for stopping; COUNT such places are counted.
2369 Thus, a positive value for DEPTH means go out levels.
2370
2371 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
2372
2373 If the beginning or end of (the accessible part of) the buffer is reached
2374 and the depth is wrong, an error is signaled.
2375 If the depth is right but the count is not used up, nil is returned.  */)
2376      (from, count, depth)
2377      Lisp_Object from, count, depth;
2378 {
2379   CHECK_NUMBER (from);
2380   CHECK_NUMBER (count);
2381   CHECK_NUMBER (depth);
2382
2383   return scan_lists (XINT (from), XINT (count), XINT (depth), 0);
2384 }
2385
2386 DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0,
2387        doc: /* Scan from character number FROM by COUNT balanced expressions.
2388 If COUNT is negative, scan backwards.
2389 Returns the character number of the position thus found.
2390
2391 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
2392
2393 If the beginning or end of (the accessible part of) the buffer is reached
2394 in the middle of a parenthetical grouping, an error is signaled.
2395 If the beginning or end is reached between groupings
2396 but before count is used up, nil is returned.  */)
2397      (from, count)
2398      Lisp_Object from, count;
2399 {
2400   CHECK_NUMBER (from);
2401   CHECK_NUMBER (count);
2402
2403   return scan_lists (XINT (from), XINT (count), 0, 1);
2404 }
2405
2406 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars,
2407        0, 0, 0,
2408        doc: /* Move point backward over any number of chars with prefix syntax.
2409 This includes chars with "quote" or "prefix" syntax (' or p).  */)
2410      ()
2411 {
2412   int beg = BEGV;
2413   int opoint = PT;
2414   int opoint_byte = PT_BYTE;
2415   int pos = PT;
2416   int pos_byte = PT_BYTE;
2417   int c;
2418
2419   if (pos <= beg)
2420     {
2421       SET_PT_BOTH (opoint, opoint_byte);
2422
2423       return Qnil;
2424     }
2425
2426   SETUP_SYNTAX_TABLE (pos, -1);
2427
2428   DEC_BOTH (pos, pos_byte);
2429
2430   while (!char_quoted (pos, pos_byte)
2431          /* Previous statement updates syntax table.  */
2432          && ((c = FETCH_CHAR (pos_byte), SYNTAX (c) == Squote)
2433              || SYNTAX_PREFIX (c)))
2434     {
2435       opoint = pos;
2436       opoint_byte = pos_byte;
2437
2438       if (pos + 1 > beg)
2439         DEC_BOTH (pos, pos_byte);
2440     }
2441
2442   SET_PT_BOTH (opoint, opoint_byte);
2443
2444   return Qnil;
2445 }
2446 \f
2447 /* Parse forward from FROM / FROM_BYTE to END,
2448    assuming that FROM has state OLDSTATE (nil means FROM is start of function),
2449    and return a description of the state of the parse at END.
2450    If STOPBEFORE is nonzero, stop at the start of an atom.
2451    If COMMENTSTOP is 1, stop at the start of a comment.
2452    If COMMENTSTOP is -1, stop at the start or end of a comment,
2453    after the beginning of a string, or after the end of a string.  */
2454
2455 static void
2456 scan_sexps_forward (stateptr, from, from_byte, end, targetdepth,
2457                     stopbefore, oldstate, commentstop)
2458      struct lisp_parse_state *stateptr;
2459      register int from;
2460      int end, targetdepth, stopbefore;
2461      Lisp_Object oldstate;
2462      int commentstop;
2463 {
2464   struct lisp_parse_state state;
2465
2466   register enum syntaxcode code;
2467   int c1;
2468   int comnested;
2469   struct level { int last, prev; };
2470   struct level levelstart[100];
2471   register struct level *curlevel = levelstart;
2472   struct level *endlevel = levelstart + 100;
2473   register int depth;   /* Paren depth of current scanning location.
2474                            level - levelstart equals this except
2475                            when the depth becomes negative.  */
2476   int mindepth;         /* Lowest DEPTH value seen.  */
2477   int start_quoted = 0;         /* Nonzero means starting after a char quote */
2478   Lisp_Object tem;
2479   int prev_from;                /* Keep one character before FROM.  */
2480   int prev_from_byte;
2481   int prev_from_syntax;
2482   int boundary_stop = commentstop == -1;
2483   int nofence;
2484   int found;
2485   int out_bytepos, out_charpos;
2486   int temp;
2487
2488   prev_from = from;
2489   prev_from_byte = from_byte;
2490   if (from != BEGV)
2491     DEC_BOTH (prev_from, prev_from_byte);
2492
2493   /* Use this macro instead of `from++'.  */
2494 #define INC_FROM                                \
2495 do { prev_from = from;                          \
2496      prev_from_byte = from_byte;                \
2497      prev_from_syntax                           \
2498        = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); \
2499      INC_BOTH (from, from_byte);                \
2500      UPDATE_SYNTAX_TABLE_FORWARD (from);        \
2501   } while (0)
2502
2503   immediate_quit = 1;
2504   QUIT;
2505
2506   if (NILP (oldstate))
2507     {
2508       depth = 0;
2509       state.instring = -1;
2510       state.incomment = 0;
2511       state.comstyle = 0;       /* comment style a by default.  */
2512       state.comstr_start = -1;  /* no comment/string seen.  */
2513     }
2514   else
2515     {
2516       tem = Fcar (oldstate);
2517       if (!NILP (tem))
2518         depth = XINT (tem);
2519       else
2520         depth = 0;
2521
2522       oldstate = Fcdr (oldstate);
2523       oldstate = Fcdr (oldstate);
2524       oldstate = Fcdr (oldstate);
2525       tem = Fcar (oldstate);
2526       /* Check whether we are inside string_fence-style string: */
2527       state.instring = (!NILP (tem)
2528                         ? (INTEGERP (tem) ? XINT (tem) : ST_STRING_STYLE)
2529                         : -1);
2530
2531       oldstate = Fcdr (oldstate);
2532       tem = Fcar (oldstate);
2533       state.incomment = (!NILP (tem)
2534                          ? (INTEGERP (tem) ? XINT (tem) : -1)
2535                          : 0);
2536
2537       oldstate = Fcdr (oldstate);
2538       tem = Fcar (oldstate);
2539       start_quoted = !NILP (tem);
2540
2541       /* if the eighth element of the list is nil, we are in comment
2542          style a.  If it is non-nil, we are in comment style b */
2543       oldstate = Fcdr (oldstate);
2544       oldstate = Fcdr (oldstate);
2545       tem = Fcar (oldstate);
2546       state.comstyle = NILP (tem) ? 0 : (EQ (tem, Qsyntax_table)
2547                                          ? ST_COMMENT_STYLE : 1);
2548
2549       oldstate = Fcdr (oldstate);
2550       tem = Fcar (oldstate);
2551       state.comstr_start = NILP (tem) ? -1 : XINT (tem) ;
2552       oldstate = Fcdr (oldstate);
2553       tem = Fcar (oldstate);
2554       while (!NILP (tem))               /* >= second enclosing sexps.  */
2555         {
2556           /* curlevel++->last ran into compiler bug on Apollo */
2557           curlevel->last = XINT (Fcar (tem));
2558           if (++curlevel == endlevel)
2559             curlevel--; /* error ("Nesting too deep for parser"); */
2560           curlevel->prev = -1;
2561           curlevel->last = -1;
2562           tem = Fcdr (tem);
2563         }
2564     }
2565   state.quoted = 0;
2566   mindepth = depth;
2567
2568   curlevel->prev = -1;
2569   curlevel->last = -1;
2570
2571   SETUP_SYNTAX_TABLE (prev_from, 1);
2572   prev_from_syntax = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte));
2573   UPDATE_SYNTAX_TABLE_FORWARD (from);
2574
2575   /* Enter the loop at a place appropriate for initial state.  */
2576
2577   if (state.incomment)
2578     goto startincomment;
2579   if (state.instring >= 0)
2580     {
2581       nofence = state.instring != ST_STRING_STYLE;
2582       if (start_quoted)
2583         goto startquotedinstring;
2584       goto startinstring;
2585     }
2586   else if (start_quoted)
2587     goto startquoted;
2588
2589 #if 0 /* This seems to be redundant with the identical code above.  */
2590   SETUP_SYNTAX_TABLE (prev_from, 1);
2591   prev_from_syntax = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte));
2592   UPDATE_SYNTAX_TABLE_FORWARD (from);
2593 #endif
2594
2595   while (from < end)
2596     {
2597       INC_FROM;
2598       code = prev_from_syntax & 0xff;
2599
2600       if (code == Scomment)
2601         {
2602           state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax);
2603           state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
2604                              1 : -1);
2605           state.comstr_start = prev_from;
2606         }
2607       else if (code == Scomment_fence)
2608         {
2609           /* Record the comment style we have entered so that only
2610              the comment-end sequence of the same style actually
2611              terminates the comment section.  */
2612           state.comstyle = ST_COMMENT_STYLE;
2613           state.incomment = -1;
2614           state.comstr_start = prev_from;
2615           code = Scomment;
2616         }
2617      else if (from < end)
2618         if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax))
2619           if (c1 = FETCH_CHAR (from_byte),
2620               SYNTAX_COMSTART_SECOND (c1))
2621             /* Duplicate code to avoid a complex if-expression
2622                which causes trouble for the SGI compiler.  */
2623             {
2624               /* Record the comment style we have entered so that only
2625                  the comment-end sequence of the same style actually
2626                  terminates the comment section.  */
2627               state.comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte));
2628               comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax);
2629               comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
2630               state.incomment = comnested ? 1 : -1;
2631               state.comstr_start = prev_from;
2632               INC_FROM;
2633               code = Scomment;
2634             }
2635
2636       if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
2637         continue;
2638       switch (SWITCH_ENUM_CAST (code))
2639         {
2640         case Sescape:
2641         case Scharquote:
2642           if (stopbefore) goto stop;  /* this arg means stop at sexp start */
2643           curlevel->last = prev_from;
2644         startquoted:
2645           if (from == end) goto endquoted;
2646           INC_FROM;
2647           goto symstarted;
2648           /* treat following character as a word constituent */
2649         case Sword:
2650         case Ssymbol:
2651           if (stopbefore) goto stop;  /* this arg means stop at sexp start */
2652           curlevel->last = prev_from;
2653         symstarted:
2654           while (from < end)
2655             {
2656               /* Some compilers can't handle this inside the switch.  */
2657               temp = SYNTAX (FETCH_CHAR (from_byte));
2658               switch (temp)
2659                 {
2660                 case Scharquote:
2661                 case Sescape:
2662                   INC_FROM;
2663                   if (from == end) goto endquoted;
2664                   break;
2665                 case Sword:
2666                 case Ssymbol:
2667                 case Squote:
2668                   break;
2669                 default:
2670                   goto symdone;
2671                 }
2672               INC_FROM;
2673             }
2674         symdone:
2675           curlevel->prev = curlevel->last;
2676           break;
2677
2678         case Scomment:
2679           if (commentstop || boundary_stop) goto done;
2680         startincomment:
2681           /* The (from == BEGV) test was to enter the loop in the middle so
2682              that we find a 2-char comment ender even if we start in the
2683              middle of it.  We don't want to do that if we're just at the
2684              beginning of the comment (think of (*) ... (*)).  */
2685           found = forw_comment (from, from_byte, end,
2686                                 state.incomment, state.comstyle,
2687                                 (from == BEGV || from < state.comstr_start + 3)
2688                                 ? 0 : prev_from_syntax,
2689                                 &out_charpos, &out_bytepos, &state.incomment);
2690           from = out_charpos; from_byte = out_bytepos;
2691           /* Beware!  prev_from and friends are invalid now.
2692              Luckily, the `done' doesn't use them and the INC_FROM
2693              sets them to a sane value without looking at them. */
2694           if (!found) goto done;
2695           INC_FROM;
2696           state.incomment = 0;
2697           state.comstyle = 0;   /* reset the comment style */
2698           if (boundary_stop) goto done;
2699           break;
2700
2701         case Sopen:
2702           if (stopbefore) goto stop;  /* this arg means stop at sexp start */
2703           depth++;
2704           /* curlevel++->last ran into compiler bug on Apollo */
2705           curlevel->last = prev_from;
2706           if (++curlevel == endlevel)
2707             curlevel--; /* error ("Nesting too deep for parser"); */
2708           curlevel->prev = -1;
2709           curlevel->last = -1;
2710           if (targetdepth == depth) goto done;
2711           break;
2712
2713         case Sclose:
2714           depth--;
2715           if (depth < mindepth)
2716             mindepth = depth;
2717           if (curlevel != levelstart)
2718             curlevel--;
2719           curlevel->prev = curlevel->last;
2720           if (targetdepth == depth) goto done;
2721           break;
2722
2723         case Sstring:
2724         case Sstring_fence:
2725           state.comstr_start = from - 1;
2726           if (stopbefore) goto stop;  /* this arg means stop at sexp start */
2727           curlevel->last = prev_from;
2728           state.instring = (code == Sstring
2729                             ? (FETCH_CHAR (prev_from_byte))
2730                             : ST_STRING_STYLE);
2731           if (boundary_stop) goto done;
2732         startinstring:
2733           {
2734             nofence = state.instring != ST_STRING_STYLE;
2735
2736             while (1)
2737               {
2738                 int c;
2739
2740                 if (from >= end) goto done;
2741                 c = FETCH_CHAR (from_byte);
2742                 /* Some compilers can't handle this inside the switch.  */
2743                 temp = SYNTAX (c);
2744
2745                 /* Check TEMP here so that if the char has
2746                    a syntax-table property which says it is NOT
2747                    a string character, it does not end the string.  */
2748                 if (nofence && c == state.instring && temp == Sstring)
2749                   break;
2750
2751                 switch (temp)
2752                   {
2753                   case Sstring_fence:
2754                     if (!nofence) goto string_end;
2755                     break;
2756                   case Scharquote:
2757                   case Sescape:
2758                     INC_FROM;
2759                   startquotedinstring:
2760                     if (from >= end) goto endquoted;
2761                   }
2762                 INC_FROM;
2763               }
2764           }
2765         string_end:
2766           state.instring = -1;
2767           curlevel->prev = curlevel->last;
2768           INC_FROM;
2769           if (boundary_stop) goto done;
2770           break;
2771
2772         case Smath:
2773           break;
2774         }
2775     }
2776   goto done;
2777
2778  stop:   /* Here if stopping before start of sexp. */
2779   from = prev_from;    /* We have just fetched the char that starts it; */
2780   goto done; /* but return the position before it. */
2781
2782  endquoted:
2783   state.quoted = 1;
2784  done:
2785   state.depth = depth;
2786   state.mindepth = mindepth;
2787   state.thislevelstart = curlevel->prev;
2788   state.prevlevelstart
2789     = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
2790   state.location = from;
2791   state.levelstarts = Qnil;
2792   while (--curlevel >= levelstart)
2793       state.levelstarts = Fcons (make_number (curlevel->last),
2794                                  state.levelstarts);
2795   immediate_quit = 0;
2796
2797   *stateptr = state;
2798 }
2799
2800 DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0,
2801        doc: /* Parse Lisp syntax starting at FROM until TO; return status of parse at TO.
2802 Parsing stops at TO or when certain criteria are met;
2803  point is set to where parsing stops.
2804 If fifth arg OLDSTATE is omitted or nil,
2805  parsing assumes that FROM is the beginning of a function.
2806 Value is a list of ten elements describing final state of parsing:
2807  0. depth in parens.
2808  1. character address of start of innermost containing list; nil if none.
2809  2. character address of start of last complete sexp terminated.
2810  3. non-nil if inside a string.
2811     (it is the character that will terminate the string,
2812      or t if the string should be terminated by a generic string delimiter.)
2813  4. nil if outside a comment, t if inside a non-nestable comment,
2814     else an integer (the current comment nesting).
2815  5. t if following a quote character.
2816  6. the minimum paren-depth encountered during this scan.
2817  7. t if in a comment of style b; symbol `syntax-table' if the comment
2818     should be terminated by a generic comment delimiter.
2819  8. character address of start of comment or string; nil if not in one.
2820  9. Intermediate data for continuation of parsing (subject to change).
2821 If third arg TARGETDEPTH is non-nil, parsing stops if the depth
2822 in parentheses becomes equal to TARGETDEPTH.
2823 Fourth arg STOPBEFORE non-nil means stop when come to
2824  any character that starts a sexp.
2825 Fifth arg OLDSTATE is a nine-element list like what this function returns.
2826  It is used to initialize the state of the parse.  Elements number 1, 2, 6
2827  and 8 are ignored; you can leave off element 8 (the last) entirely.
2828 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
2829  If it is symbol `syntax-table', stop after the start of a comment or a
2830  string, or after end of a comment or a string.  */)
2831      (from, to, targetdepth, stopbefore, oldstate, commentstop)
2832      Lisp_Object from, to, targetdepth, stopbefore, oldstate, commentstop;
2833 {
2834   struct lisp_parse_state state;
2835   int target;
2836
2837   if (!NILP (targetdepth))
2838     {
2839       CHECK_NUMBER (targetdepth);
2840       target = XINT (targetdepth);
2841     }
2842   else
2843     target = -100000;           /* We won't reach this depth */
2844
2845   validate_region (&from, &to);
2846   scan_sexps_forward (&state, XINT (from), CHAR_TO_BYTE (XINT (from)),
2847                       XINT (to),
2848                       target, !NILP (stopbefore), oldstate,
2849                       (NILP (commentstop)
2850                        ? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1)));
2851
2852   SET_PT (state.location);
2853
2854   return Fcons (make_number (state.depth),
2855            Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart),
2856              Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart),
2857                Fcons (state.instring >= 0
2858                       ? (state.instring == ST_STRING_STYLE
2859                          ? Qt : make_number (state.instring)) : Qnil,
2860                  Fcons (state.incomment < 0 ? Qt :
2861                         (state.incomment == 0 ? Qnil :
2862                          make_number (state.incomment)),
2863                    Fcons (state.quoted ? Qt : Qnil,
2864                      Fcons (make_number (state.mindepth),
2865                        Fcons ((state.comstyle
2866                                ? (state.comstyle == ST_COMMENT_STYLE
2867                                   ? Qsyntax_table : Qt) :
2868                                Qnil),
2869                               Fcons (((state.incomment
2870                                        || (state.instring >= 0))
2871                                       ? make_number (state.comstr_start)
2872                                       : Qnil),
2873                                      Fcons (state.levelstarts, Qnil))))))))));
2874 }
2875 \f
2876 void
2877 init_syntax_once ()
2878 {
2879   register int i, c;
2880   Lisp_Object temp;
2881
2882   /* This has to be done here, before we call Fmake_char_table.  */
2883   Qsyntax_table = intern ("syntax-table");
2884   staticpro (&Qsyntax_table);
2885
2886   /* Intern this now in case it isn't already done.
2887      Setting this variable twice is harmless.
2888      But don't staticpro it here--that is done in alloc.c.  */
2889   Qchar_table_extra_slots = intern ("char-table-extra-slots");
2890
2891   /* Create objects which can be shared among syntax tables.  */
2892   Vsyntax_code_object = Fmake_vector (make_number (Smax), Qnil);
2893   for (i = 0; i < XVECTOR (Vsyntax_code_object)->size; i++)
2894     XVECTOR (Vsyntax_code_object)->contents[i]
2895       = Fcons (make_number (i), Qnil);
2896
2897   /* Now we are ready to set up this property, so we can
2898      create syntax tables.  */
2899   Fput (Qsyntax_table, Qchar_table_extra_slots, make_number (0));
2900
2901   temp = XVECTOR (Vsyntax_code_object)->contents[(int) Swhitespace];
2902
2903   Vstandard_syntax_table = Fmake_char_table (Qsyntax_table, temp);
2904
2905   temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword];
2906   for (i = 'a'; i <= 'z'; i++)
2907     SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
2908   for (i = 'A'; i <= 'Z'; i++)
2909     SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
2910   for (i = '0'; i <= '9'; i++)
2911     SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
2912
2913   SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '$', temp);
2914   SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '%', temp);
2915
2916   SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '(',
2917                         Fcons (make_number (Sopen), make_number (')')));
2918   SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ')',
2919                         Fcons (make_number (Sclose), make_number ('(')));
2920   SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '[',
2921                         Fcons (make_number (Sopen), make_number (']')));
2922   SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ']',
2923                         Fcons (make_number (Sclose), make_number ('[')));
2924   SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '{',
2925                         Fcons (make_number (Sopen), make_number ('}')));
2926   SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '}',
2927                         Fcons (make_number (Sclose), make_number ('{')));
2928   SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '"',
2929                         Fcons (make_number ((int) Sstring), Qnil));
2930   SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\\',
2931                         Fcons (make_number ((int) Sescape), Qnil));
2932
2933   temp = XVECTOR (Vsyntax_code_object)->contents[(int) Ssymbol];
2934   for (i = 0; i < 10; i++)
2935     {
2936       c = "_-+*/&|<>="[i];
2937       SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp);
2938     }
2939
2940   temp = XVECTOR (Vsyntax_code_object)->contents[(int) Spunct];
2941   for (i = 0; i < 12; i++)
2942     {
2943       c = ".,;:?!#@~^'`"[i];
2944       SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp);
2945     }
2946
2947   /* All multibyte characters have syntax `word' by default.  */
2948   temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword];
2949   for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
2950     XCHAR_TABLE (Vstandard_syntax_table)->contents[i] = temp;
2951 }
2952
2953 void
2954 syms_of_syntax ()
2955 {
2956   Qsyntax_table_p = intern ("syntax-table-p");
2957   staticpro (&Qsyntax_table_p);
2958
2959   staticpro (&Vsyntax_code_object);
2960
2961   Qscan_error = intern ("scan-error");
2962   staticpro (&Qscan_error);
2963   Fput (Qscan_error, Qerror_conditions,
2964         Fcons (Qscan_error, Fcons (Qerror, Qnil)));
2965   Fput (Qscan_error, Qerror_message,
2966         build_string ("Scan error"));
2967
2968   DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments,
2969                doc: /* Non-nil means `forward-sexp', etc., should treat comments as whitespace.  */);
2970
2971   DEFVAR_BOOL ("parse-sexp-lookup-properties", &parse_sexp_lookup_properties,
2972                doc: /* Non-nil means `forward-sexp', etc., obey `syntax-table' property.
2973 Otherwise, that text property is simply ignored.
2974 See the info node `(elisp)Syntax Properties' for a description of the
2975 `syntax-table' property.  */);
2976
2977   words_include_escapes = 0;
2978   DEFVAR_BOOL ("words-include-escapes", &words_include_escapes,
2979                doc: /* Non-nil means `forward-word', etc., should treat escape chars part of words.  */);
2980
2981   DEFVAR_BOOL ("multibyte-syntax-as-symbol", &multibyte_syntax_as_symbol,
2982                doc: /* Non-nil means `scan-sexps' treats all multibyte characters as symbol.  */);
2983   multibyte_syntax_as_symbol = 0;
2984
2985   DEFVAR_BOOL ("open-paren-in-column-0-is-defun-start",
2986                &open_paren_in_column_0_is_defun_start,
2987                doc: /* Non-nil means an open paren in column 0 denotes the start of a defun.  */);
2988   open_paren_in_column_0_is_defun_start = 1;
2989
2990   defsubr (&Ssyntax_table_p);
2991   defsubr (&Ssyntax_table);
2992   defsubr (&Sstandard_syntax_table);
2993   defsubr (&Scopy_syntax_table);
2994   defsubr (&Sset_syntax_table);
2995   defsubr (&Schar_syntax);
2996   defsubr (&Smatching_paren);
2997   defsubr (&Sstring_to_syntax);
2998   defsubr (&Smodify_syntax_entry);
2999   defsubr (&Sinternal_describe_syntax_value);
3000
3001   defsubr (&Sforward_word);
3002
3003   defsubr (&Sskip_chars_forward);
3004   defsubr (&Sskip_chars_backward);
3005   defsubr (&Sskip_syntax_forward);
3006   defsubr (&Sskip_syntax_backward);
3007
3008   defsubr (&Sforward_comment);
3009   defsubr (&Sscan_lists);
3010   defsubr (&Sscan_sexps);
3011   defsubr (&Sbackward_prefix_chars);
3012   defsubr (&Sparse_partial_sexp);
3013 }