git.chise.org Git - chise/xemacs-chise.git-/blob - src/syntax.c

   1 /* XEmacs routines to deal with syntax tables; also word and list parsing.
   2    Copyright (C) 1985-1994 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Sun Microsystems, Inc.
   4    Copyright (C) 2001 MORIOKA Tomohiko
   5
   6 This file is part of XEmacs.
   7
   8 XEmacs is free software; you can redistribute it and/or modify it
   9 under the terms of the GNU General Public License as published by the
  10 Free Software Foundation; either version 2, or (at your option) any
  11 later version.
  12
  13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with XEmacs; see the file COPYING.  If not, write to
  20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 Boston, MA 02111-1307, USA.  */
  22
  23 /* Synched up with: FSF 19.28. */
  24
  25 /* This file has been Mule-ized. */
  26
  27 #include <config.h>
  28 #include "lisp.h"
  29
  30 #include "buffer.h"
  31 #include "syntax.h"
  32 #include "extents.h"
  33
  34 /* Here is a comment from Ken'ichi HANDA <handa@etl.go.jp>
  35    explaining the purpose of the Sextword syntax category:
  36
  37 Japanese words are not separated by spaces, which makes finding word
  38 boundaries very difficult.  Theoretically it's impossible without
  39 using natural language processing techniques.  But, by defining
  40 pseudo-words as below (much simplified for letting you understand it
  41 easily) for Japanese, we can have a convenient forward-word function
  42 for Japanese.
  43
  44         A Japanese word is a sequence of characters that consists of
  45         zero or more Kanji characters followed by zero or more
  46         Hiragana characters.
  47
  48 Then, the problem is that now we can't say that a sequence of
  49 word-constituents makes up a WORD.  For instance, both Hiragana "A"
  50 and Kanji "KAN" are word-constituents but the sequence of these two
  51 letters can't be a single word.
  52
  53 So, we introduced Sextword for Japanese letters.  A character of
  54 Sextword is a word-constituent but a word boundary may exist between
  55 two such characters.  */
  56
  57 /* Mule 2.4 doesn't seem to have Sextword - I'm removing it -- mrb */
  58 /* Recovered by tomo */
  59
  60 #define ST_COMMENT_STYLE 0x101
  61 #define ST_STRING_STYLE  0x102
  62
  63 Lisp_Object Qsyntax_table;
  64 int lookup_syntax_properties;
  65
  66 Lisp_Object Qsyntax_table_p;
  67
  68 int words_include_escapes;
  69
  70 int parse_sexp_ignore_comments;
  71
  72 /* The following two variables are provided to tell additional information
  73    to the regex routines.  We do it this way rather than change the
  74    arguments to re_search_2() in an attempt to maintain some call
  75    compatibility with other versions of the regex code. */
  76
  77 /* Tell the regex routines not to QUIT.  Normally there is a QUIT
  78    each iteration in re_search_2(). */
  79 int no_quit_in_re_search;
  80
  81 /* Tell the regex routines which buffer to access for SYNTAX() lookups
  82    and the like. */
  83 struct buffer *regex_emacs_buffer;
  84
  85 /* In Emacs, this is the string or buffer in which we
  86    are matching.  It is used for looking up syntax properties.  */
  87 Lisp_Object regex_match_object;
  88
  89 Lisp_Object Vstandard_syntax_table;
  90
  91 Lisp_Object Vsyntax_designator_chars_string;
  92
  93 /* This is the internal form of the parse state used in parse-partial-sexp.  */
  94
  95 struct lisp_parse_state
  96 {
  97   int depth;            /* Depth at end of parsing */
  98   Emchar instring;      /* -1 if not within string, else desired terminator */
  99   int incomment;        /* Nonzero if within a comment at end of parsing */
 100   int comstyle;         /* comment style a=0, or b=1, or ST_COMMENT_STYLE */
 101   int quoted;           /* Nonzero if just after an escape char at end of
 102                            parsing */
 103   Bufpos thislevelstart;/* Char number of most recent start-of-expression
 104                            at current level */
 105   Bufpos prevlevelstart;/* Char number of start of containing expression */
 106   Bufpos location;      /* Char number at which parsing stopped */
 107   int mindepth;         /* Minimum depth seen while scanning  */
 108   Bufpos comstr_start;  /* Position just after last comment/string starter  */
 109   Lisp_Object levelstarts;      /* Char numbers of starts-of-expression
 110                                    of levels (starting from outermost).  */
 111 };
 112 \f
 113 /* These variables are a cache for finding the start of a defun.
 114    find_start_pos    is the place for which the defun start was found.
 115    find_start_value  is the defun start position found for it.
 116    find_start_buffer is the buffer it was found in.
 117    find_start_begv   is the BEGV value when it was found.
 118    find_start_modiff is the value of MODIFF when it was found.  */
 119
 120 static Bufpos find_start_pos;
 121 static Bufpos find_start_value;
 122 static struct buffer *find_start_buffer;
 123 static Bufpos find_start_begv;
 124 static int find_start_modiff;
 125
 126 /* Find a defun-start that is the last one before POS (or nearly the last).
 127    We record what we find, so that another call in the same area
 128    can return the same value right away.  */
 129
 130 static Bufpos
 131 find_defun_start (struct buffer *buf, Bufpos pos)
 132 {
 133   Bufpos tem;
 134
 135   /* Use previous finding, if it's valid and applies to this inquiry.  */
 136   if (buf == find_start_buffer
 137       /* Reuse the defun-start even if POS is a little farther on.
 138          POS might be in the next defun, but that's ok.
 139          Our value may not be the best possible, but will still be usable.  */
 140       && pos <= find_start_pos + 1000
 141       && pos >= find_start_value
 142       && BUF_BEGV (buf) == find_start_begv
 143       && BUF_MODIFF (buf) == find_start_modiff)
 144     return find_start_value;
 145
 146   /* Back up to start of line.  */
 147   tem = find_next_newline (buf, pos, -1);
 148
 149   SETUP_SYNTAX_CACHE (tem, 1);
 150   while (tem > BUF_BEGV (buf))
 151     {
 152       UPDATE_SYNTAX_CACHE_BACKWARD(tem);
 153
 154       /* Open-paren at start of line means we found our defun-start.  */
 155       if (SYNTAX_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, tem)) == Sopen)
 156         break;
 157       /* Move to beg of previous line.  */
 158       tem = find_next_newline (buf, tem, -2);
 159     }
 160
 161   /* Record what we found, for the next try.  */
 162   find_start_value  = tem;
 163   find_start_buffer = buf;
 164   find_start_modiff = BUF_MODIFF (buf);
 165   find_start_begv   = BUF_BEGV (buf);
 166   find_start_pos    = pos;
 167
 168   return find_start_value;
 169 }
 170 \f
 171 DEFUN ("syntax-table-p", Fsyntax_table_p, 1, 1, 0, /*
 172 Return t if OBJECT is a syntax table.
 173 Any vector of 256 elements will do.
 174 */
 175        (object))
 176 {
 177   return (CHAR_TABLEP (object)
 178           && XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_SYNTAX)
 179     ? Qt : Qnil;
 180 }
 181
 182 static Lisp_Object
 183 check_syntax_table (Lisp_Object obj, Lisp_Object default_)
 184 {
 185   if (NILP (obj))
 186     obj = default_;
 187   while (NILP (Fsyntax_table_p (obj)))
 188     obj = wrong_type_argument (Qsyntax_table_p, obj);
 189   return obj;
 190 }
 191
 192 DEFUN ("syntax-table", Fsyntax_table, 0, 1, 0, /*
 193 Return the current syntax table.
 194 This is the one specified by the current buffer, or by BUFFER if it
 195 is non-nil.
 196 */
 197        (buffer))
 198 {
 199   return decode_buffer (buffer, 0)->syntax_table;
 200 }
 201
 202 DEFUN ("standard-syntax-table", Fstandard_syntax_table, 0, 0, 0, /*
 203 Return the standard syntax table.
 204 This is the one used for new buffers.
 205 */
 206        ())
 207 {
 208   return Vstandard_syntax_table;
 209 }
 210
 211 DEFUN ("copy-syntax-table", Fcopy_syntax_table, 0, 1, 0, /*
 212 Return a new syntax table which is a copy of SYNTAX-TABLE.
 213 SYNTAX-TABLE defaults to the standard syntax table.
 214 */
 215        (syntax_table))
 216 {
 217   if (NILP (Vstandard_syntax_table))
 218     return Fmake_char_table (Qsyntax);
 219
 220   syntax_table = check_syntax_table (syntax_table, Vstandard_syntax_table);
 221   return Fcopy_char_table (syntax_table);
 222 }
 223
 224 DEFUN ("set-syntax-table", Fset_syntax_table, 1, 2, 0, /*
 225 Select SYNTAX-TABLE as the new syntax table for BUFFER.
 226 BUFFER defaults to the current buffer if omitted.
 227 */
 228        (syntax_table, buffer))
 229 {
 230   struct buffer *buf = decode_buffer (buffer, 0);
 231   syntax_table = check_syntax_table (syntax_table, Qnil);
 232   buf->syntax_table = syntax_table;
 233 #ifndef UTF2000
 234   buf->mirror_syntax_table = XCHAR_TABLE (syntax_table)->mirror_table;
 235 #endif
 236   /* Indicate that this buffer now has a specified syntax table.  */
 237   buf->local_var_flags |= XINT (buffer_local_flags.syntax_table);
 238   return syntax_table;
 239 }
 240 \f
 241 /* The current syntax state */
 242 struct syntax_cache syntax_cache;
 243
 244
 245 /*
 246    Update syntax_cache to an appropriate setting for position POS
 247
 248    The sign of COUNT gives the relative position of POS wrt the
 249    previously valid interval.  (not currently used)
 250
 251    `syntax_cache.*_change' are the next and previous positions at
 252    which syntax_code and c_s_t will need to be recalculated.
 253
 254    #### Currently this code uses 'get-char-property', which will
 255    return the "last smallest" extent at a given position. In cases
 256    where overlapping extents are defined, this code will simply use
 257    whatever is returned by get-char-property.
 258
 259    It might be worth it at some point to merge provided syntax tables
 260    outward to the current buffer. */
 261
 262 void
 263 update_syntax_cache (int pos, int count, int init)
 264 {
 265   Lisp_Object tmp_table;
 266
 267   if (init)
 268     {
 269       syntax_cache.prev_change = -1;
 270       syntax_cache.next_change = -1;
 271     }
 272
 273   if (pos > syntax_cache.prev_change &&
 274       pos < syntax_cache.next_change)
 275     {
 276       /* do nothing */
 277     }
 278   else
 279     {
 280       if (NILP (syntax_cache.object) || EQ (syntax_cache.object, Qt))
 281         {
 282           int get_change_before = pos + 1;
 283
 284           tmp_table = Fget_char_property (make_int(pos), Qsyntax_table,
 285                                           make_buffer (syntax_cache.buffer), Qnil);
 286           syntax_cache.next_change =
 287             XINT (Fnext_extent_change (make_int (pos > 0 ? pos : 1),
 288                                        make_buffer (syntax_cache.buffer)));
 289
 290           if (get_change_before < 1)
 291             get_change_before = 1;
 292           else if (get_change_before > BUF_ZV (syntax_cache.buffer))
 293             get_change_before = BUF_ZV (syntax_cache.buffer);
 294
 295           syntax_cache.prev_change =
 296             XINT (Fprevious_extent_change (make_int (get_change_before),
 297                                            make_buffer (syntax_cache.buffer)));
 298         }
 299       else
 300         {
 301           int get_change_before = pos + 1;
 302
 303           tmp_table = Fget_char_property (make_int(pos), Qsyntax_table,
 304                                           syntax_cache.object, Qnil);
 305           syntax_cache.next_change =
 306             XINT (Fnext_extent_change (make_int (pos >= 0 ? pos : 0),
 307                                        syntax_cache.object));
 308
 309           if (get_change_before < 0)
 310             get_change_before = 0;
 311           else if (get_change_before > XSTRING_LENGTH(syntax_cache.object))
 312             get_change_before = XSTRING_LENGTH(syntax_cache.object);
 313
 314           syntax_cache.prev_change =
 315             XINT (Fprevious_extent_change (make_int (pos >= 0 ? pos : 0),
 316                                            syntax_cache.object));
 317         }
 318
 319       if (EQ (Fsyntax_table_p (tmp_table), Qt))
 320         {
 321           syntax_cache.use_code = 0;
 322 #ifdef UTF2000
 323           syntax_cache.current_syntax_table = tmp_table;
 324 #else
 325           syntax_cache.current_syntax_table =
 326             XCHAR_TABLE (tmp_table)->mirror_table;
 327 #endif
 328         }
 329       else if (CONSP (tmp_table) && INTP (XCAR (tmp_table)))
 330         {
 331           syntax_cache.use_code = 1;
 332           syntax_cache.syntax_code = XINT (XCAR(tmp_table));
 333         }
 334       else
 335         {
 336           syntax_cache.use_code = 0;
 337 #ifdef UTF2000
 338           syntax_cache.current_syntax_table =
 339             syntax_cache.buffer->syntax_table;
 340 #else
 341           syntax_cache.current_syntax_table =
 342             syntax_cache.buffer->mirror_syntax_table;
 343 #endif
 344         }
 345     }
 346 }
 347 \f
 348 /* Convert a letter which signifies a syntax code
 349    into the code it signifies.
 350    This is used by modify-syntax-entry, and other things. */
 351
 352 const unsigned char syntax_spec_code[0400] =
 353 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 354   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 355   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 356   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 357   (char) Swhitespace, 0377, (char) Sstring, 0377,
 358       (char) Smath, 0377, 0377, (char) Squote,
 359   (char) Sopen, (char) Sclose, 0377, 0377,
 360         0377, (char) Swhitespace, (char) Spunct, (char) Scharquote,
 361   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 362   0377, 0377, 0377, 0377,
 363         (char) Scomment, 0377, (char) Sendcomment, 0377,
 364   (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377,   /* @, A ... */
 365   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 366   0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
 367   0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol,
 368   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,   /* `, a, ... */
 369   0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
 370   0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
 371   0377, 0377, 0377, 0377, (char) Sstring_fence, 0377, 0377, 0377
 372 };
 373
 374 const unsigned char syntax_code_spec[] =  " .w_()'\"$\\/<>@!|";
 375
 376 DEFUN ("syntax-designator-chars", Fsyntax_designator_chars, 0, 0, 0, /*
 377 Return a string of the recognized syntax designator chars.
 378 The chars are ordered by their internal syntax codes, which are
 379 numbered starting at 0.
 380 */
 381        ())
 382 {
 383   return Vsyntax_designator_chars_string;
 384 }
 385
 386 DEFUN ("char-syntax", Fchar_syntax, 1, 2, 0, /*
 387 Return the syntax code of CHARACTER, described by a character.
 388 For example, if CHARACTER is a word constituent,
 389 the character `?w' is returned.
 390 The characters that correspond to various syntax codes
 391 are listed in the documentation of `modify-syntax-entry'.
 392 Optional second argument SYNTAX-TABLE defaults to the current buffer's
 393 syntax table.
 394 */
 395        (character, syntax_table))
 396 {
 397 #ifndef UTF2000
 398   Lisp_Char_Table *mirrortab;
 399 #endif
 400
 401   if (NILP (character))
 402     {
 403       character = make_char ('\000');
 404     }
 405   CHECK_CHAR_COERCE_INT (character);
 406   syntax_table = check_syntax_table (syntax_table, current_buffer->syntax_table);
 407 #ifdef UTF2000
 408   return make_char (syntax_code_spec[(int) SYNTAX (XCHAR_TABLE(syntax_table),
 409                                                    XCHAR (character))]);
 410 #else
 411   mirrortab = XCHAR_TABLE (XCHAR_TABLE (syntax_table)->mirror_table);
 412   return make_char (syntax_code_spec[(int) SYNTAX (mirrortab, XCHAR (character))]);
 413 #endif
 414 }
 415
 416 #ifdef MULE
 417
 418 enum syntaxcode
 419 charset_syntax (struct buffer *buf, Lisp_Object charset, int *multi_p_out)
 420 {
 421   *multi_p_out = 1;
 422   /* #### get this right */
 423   return Spunct;
 424 }
 425
 426 #endif
 427
 428 Lisp_Object
 429 syntax_match (Lisp_Object syntax_table, Emchar ch)
 430 {
 431   Lisp_Object code = XCHAR_TABLE_VALUE_UNSAFE (syntax_table, ch);
 432   Lisp_Object code2 = code;
 433
 434   if (CONSP (code))
 435     code2 = XCAR (code);
 436   if (SYNTAX_FROM_CODE (XINT (code2)) == Sinherit)
 437     code = XCHAR_TABLE_VALUE_UNSAFE (Vstandard_syntax_table, ch);
 438
 439   return CONSP (code) ? XCDR (code) : Qnil;
 440 }
 441
 442 DEFUN ("matching-paren", Fmatching_paren, 1, 2, 0, /*
 443 Return the matching parenthesis of CHARACTER, or nil if none.
 444 Optional second argument SYNTAX-TABLE defaults to the current buffer's
 445 syntax table.
 446 */
 447        (character, syntax_table))
 448 {
 449 #ifndef UTF2000
 450   Lisp_Char_Table *mirrortab;
 451 #endif
 452   int code;
 453
 454   CHECK_CHAR_COERCE_INT (character);
 455   syntax_table = check_syntax_table (syntax_table, current_buffer->syntax_table);
 456 #ifdef UTF2000
 457   code = SYNTAX (XCHAR_TABLE (syntax_table), XCHAR (character));
 458 #else
 459   mirrortab = XCHAR_TABLE (XCHAR_TABLE (syntax_table)->mirror_table);
 460   code = SYNTAX (mirrortab, XCHAR (character));
 461 #endif
 462   if (code == Sopen || code == Sclose || code == Sstring)
 463     return syntax_match (syntax_table, XCHAR (character));
 464   return Qnil;
 465 }
 466
 467 \f
 468
 469 #ifdef MULE
 470 /* Return 1 if there is a word boundary between two word-constituent
 471    characters C1 and C2 if they appear in this order, else return 0.
 472    There is no word boundary between two word-constituent ASCII
 473    characters.  */
 474 #define WORD_BOUNDARY_P(c1, c2)                 \
 475   (!(CHAR_ASCII_P (c1) && CHAR_ASCII_P (c2))    \
 476    && word_boundary_p (c1, c2))
 477
 478 extern int word_boundary_p (Emchar c1, Emchar c2);
 479 #endif
 480
 481 /* Return the position across COUNT words from FROM.
 482    If that many words cannot be found before the end of the buffer, return 0.
 483    COUNT negative means scan backward and stop at word beginning.  */
 484
 485 Bufpos
 486 scan_words (struct buffer *buf, Bufpos from, int count)
 487 {
 488   Bufpos limit = count > 0 ? BUF_ZV (buf) : BUF_BEGV (buf);
 489   Emchar ch0, ch1;
 490   enum syntaxcode code;
 491
 492   SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, from, count);
 493
 494   /* #### is it really worth it to hand expand both cases? JV */
 495   while (count > 0)
 496     {
 497       QUIT;
 498
 499       while (1)
 500         {
 501           if (from == limit)
 502             return 0;
 503
 504           UPDATE_SYNTAX_CACHE_FORWARD (from);
 505           ch0 = BUF_FETCH_CHAR (buf, from);
 506           code = SYNTAX_FROM_CACHE (mirrortab, ch0);
 507
 508           from++;
 509           if (words_include_escapes
 510               && (code == Sescape || code == Scharquote))
 511             break;
 512           if (code == Sword)
 513             break;
 514         }
 515
 516       QUIT;
 517
 518       while (from != limit)
 519         {
 520           UPDATE_SYNTAX_CACHE_FORWARD (from);
 521           ch1 = BUF_FETCH_CHAR (buf, from);
 522           code = SYNTAX_FROM_CACHE (mirrortab, ch1);
 523           if (!(words_include_escapes
 524                 && (code == Sescape || code == Scharquote)))
 525             if (code != Sword
 526 #ifdef MULE
 527                 || WORD_BOUNDARY_P (ch0, ch1)
 528 #endif
 529                 )
 530               break;
 531 #ifdef MULE
 532           ch0 = ch1;
 533 #endif
 534           from++;
 535         }
 536       count--;
 537     }
 538
 539   while (count < 0)
 540     {
 541       QUIT;
 542
 543       while (1)
 544         {
 545           if (from == limit)
 546             return 0;
 547
 548           UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
 549           ch1 = BUF_FETCH_CHAR (buf, from - 1);
 550           code = SYNTAX_FROM_CACHE (mirrortab, ch1);
 551           from--;
 552
 553           if (words_include_escapes
 554               && (code == Sescape || code == Scharquote))
 555             break;
 556           if (code == Sword)
 557             break;
 558         }
 559
 560       QUIT;
 561
 562       while (from != limit)
 563         {
 564           UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
 565           ch0 = BUF_FETCH_CHAR (buf, from - 1);
 566           code = SYNTAX_FROM_CACHE (mirrortab, ch0);
 567
 568           if (!(words_include_escapes
 569                 && (code == Sescape || code == Scharquote)))
 570             if (code != Sword
 571 #ifdef MULE
 572                 || WORD_BOUNDARY_P (ch0, ch1)
 573 #endif
 574                 )
 575               break;
 576 #ifdef MULE
 577           ch1 = ch0;
 578 #endif
 579           from--;
 580         }
 581       count++;
 582     }
 583
 584   return from;
 585 }
 586
 587 DEFUN ("forward-word", Fforward_word, 0, 2, "_p", /*
 588 Move point forward COUNT words (backward if COUNT is negative).
 589 Normally t is returned, but if an edge of the buffer is reached,
 590 point is left there and nil is returned.
 591
 592 The characters that are moved over may be added to the current selection
 593 \(i.e. active region) if the Shift key is held down, a motion key is used
 594 to invoke this command, and `shifted-motion-keys-select-region' is t; see
 595 the documentation for this variable for more details.
 596
 597 COUNT defaults to 1, and BUFFER defaults to the current buffer.
 598 */
 599        (count, buffer))
 600 {
 601   Bufpos val;
 602   struct buffer *buf = decode_buffer (buffer, 0);
 603   EMACS_INT n;
 604
 605   if (NILP (count))
 606     n = 1;
 607   else
 608     {
 609       CHECK_INT (count);
 610       n = XINT (count);
 611     }
 612
 613   val = scan_words (buf, BUF_PT (buf), n);
 614   if (val)
 615     {
 616       BUF_SET_PT (buf, val);
 617       return Qt;
 618     }
 619   else
 620     {
 621       BUF_SET_PT (buf, n > 0 ? BUF_ZV (buf) : BUF_BEGV (buf));
 622       return Qnil;
 623     }
 624 }
 625 \f
 626 static void scan_sexps_forward (struct buffer *buf,
 627                                 struct lisp_parse_state *,
 628                                 Bufpos from, Bufpos end,
 629                                 int targetdepth, int stopbefore,
 630                                 Lisp_Object oldstate,
 631                                 int commentstop);
 632
 633 static int
 634 find_start_of_comment (struct buffer *buf, Bufpos from, Bufpos stop,
 635                        int comstyle)
 636 {
 637   Emchar c;
 638   enum syntaxcode code;
 639
 640   /* Look back, counting the parity of string-quotes,
 641      and recording the comment-starters seen.
 642      When we reach a safe place, assume that's not in a string;
 643      then step the main scan to the earliest comment-starter seen
 644      an even number of string quotes away from the safe place.
 645
 646      OFROM[I] is position of the earliest comment-starter seen
 647      which is I+2X quotes from the comment-end.
 648      PARITY is current parity of quotes from the comment end.  */
 649   int parity = 0;
 650   Emchar my_stringend = 0;
 651   int string_lossage = 0;
 652   Bufpos comment_end = from;
 653   Bufpos comstart_pos = 0;
 654   int comstart_parity = 0;
 655   int styles_match_p = 0;
 656   /* mask to match comment styles against; for ST_COMMENT_STYLE, this
 657      will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */
 658   int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A;
 659
 660   /* At beginning of range to scan, we're outside of strings;
 661      that determines quote parity to the comment-end.  */
 662   while (from != stop)
 663     {
 664       int syncode;
 665
 666       /* Move back and examine a character.  */
 667       from--;
 668       UPDATE_SYNTAX_CACHE_BACKWARD (from);
 669
 670       c = BUF_FETCH_CHAR (buf, from);
 671       code = SYNTAX_FROM_CACHE (mirrortab, c);
 672       syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
 673
 674       /* is this a 1-char comment end sequence? if so, try
 675          to see if style matches previously extracted mask */
 676       if (code == Sendcomment)
 677         {
 678           styles_match_p =
 679             SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask;
 680         }
 681
 682       /* or are we looking at a 1-char comment start sequence
 683          of the style matching mask? */
 684       else if (code == Scomment)
 685         {
 686           styles_match_p =
 687             SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask;
 688         }
 689
 690       /* otherwise, is this a 2-char comment end or start sequence? */
 691       else if (from > stop)
 692         do
 693           {
 694             /* 2-char comment end sequence? */
 695             if (SYNTAX_CODE_END_SECOND_P (syncode))
 696               {
 697                 int prev_syncode;
 698                 UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
 699                 prev_syncode =
 700                   SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from - 1));
 701
 702                 if (SYNTAX_CODES_END_P (prev_syncode, syncode))
 703                   {
 704                     code = Sendcomment;
 705                     styles_match_p =
 706                       SYNTAX_CODES_COMMENT_MASK_END (prev_syncode, syncode);
 707                     from--;
 708                     UPDATE_SYNTAX_CACHE_BACKWARD (from);
 709                     c = BUF_FETCH_CHAR (buf, from);
 710
 711                     /* Found a comment-end sequence, so skip past the
 712                        check for a comment-start */
 713                     break;
 714                   }
 715               }
 716
 717             /* 2-char comment start sequence? */
 718             if (SYNTAX_CODE_START_SECOND_P (syncode))
 719               {
 720                 int prev_syncode;
 721                 UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
 722                 prev_syncode =
 723                   SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from - 1));
 724
 725                 if (SYNTAX_CODES_START_P (prev_syncode, syncode))
 726                   {
 727                     code = Scomment;
 728                     styles_match_p =
 729                       SYNTAX_CODES_COMMENT_MASK_START (prev_syncode, syncode);
 730                     from--;
 731                     UPDATE_SYNTAX_CACHE_BACKWARD (from);
 732                     c = BUF_FETCH_CHAR (buf, from);
 733                   }
 734               }
 735           } while (0);
 736
 737       /* Ignore escaped characters.  */
 738       if (char_quoted (buf, from))
 739         continue;
 740
 741       /* Track parity of quotes.  */
 742       if (code == Sstring)
 743         {
 744           parity ^= 1;
 745           if (my_stringend == 0)
 746             my_stringend = c;
 747           /* If we have two kinds of string delimiters.
 748              There's no way to grok this scanning backwards.  */
 749           else if (my_stringend != c)
 750             string_lossage = 1;
 751         }
 752
 753       if (code == Sstring_fence || code == Scomment_fence)
 754         {
 755           parity ^= 1;
 756           if (my_stringend == 0)
 757             my_stringend =
 758               code == Sstring_fence ? ST_STRING_STYLE : ST_COMMENT_STYLE;
 759           /* If we have two kinds of string delimiters.
 760              There's no way to grok this scanning backwards.  */
 761           else if (my_stringend != (code == Sstring_fence
 762                                     ? ST_STRING_STYLE : ST_COMMENT_STYLE))
 763             string_lossage = 1;
 764         }
 765
 766       /* Record comment-starters according to that
 767          quote-parity to the comment-end.  */
 768       if (code == Scomment && styles_match_p)
 769         {
 770           comstart_parity = parity;
 771           comstart_pos = from;
 772         }
 773
 774       /* If we find another earlier comment-ender,
 775          any comment-starts earlier than that don't count
 776          (because they go with the earlier comment-ender).  */
 777       if (code == Sendcomment && styles_match_p)
 778         break;
 779
 780       /* Assume a defun-start point is outside of strings.  */
 781       if (code == Sopen
 782           && (from == stop || BUF_FETCH_CHAR (buf, from - 1) == '\n'))
 783         break;
 784     }
 785
 786   if (comstart_pos == 0)
 787     from = comment_end;
 788   /* If the earliest comment starter
 789      is followed by uniform paired string quotes or none,
 790      we know it can't be inside a string
 791      since if it were then the comment ender would be inside one.
 792      So it does start a comment.  Skip back to it.  */
 793   else if (comstart_parity == 0 && !string_lossage)
 794     from = comstart_pos;
 795   else
 796     {
 797       /* We had two kinds of string delimiters mixed up
 798          together.  Decode this going forwards.
 799          Scan fwd from the previous comment ender
 800          to the one in question; this records where we
 801          last passed a comment starter.  */
 802
 803       struct lisp_parse_state state;
 804       scan_sexps_forward (buf, &state, find_defun_start (buf, comment_end),
 805                           comment_end - 1, -10000, 0, Qnil, 0);
 806       if (state.incomment)
 807         from = state.comstr_start;
 808       else
 809         /* We can't grok this as a comment; scan it normally.  */
 810         from = comment_end;
 811       UPDATE_SYNTAX_CACHE_FORWARD (from - 1);
 812     }
 813   return from;
 814 }
 815
 816 static Bufpos
 817 find_end_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int comstyle)
 818 {
 819   int c;
 820   int prev_code;
 821   /* mask to match comment styles against; for ST_COMMENT_STYLE, this
 822      will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */
 823   int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A;
 824
 825   /* This is only called by functions which have already set up the
 826      syntax_cache and are keeping it up-to-date */
 827   while (1)
 828     {
 829       if (from == stop)
 830         {
 831           return -1;
 832         }
 833
 834       UPDATE_SYNTAX_CACHE_FORWARD (from);
 835       c = BUF_FETCH_CHAR (buf, from);
 836
 837       /* Test for generic comments */
 838       if (comstyle == ST_COMMENT_STYLE)
 839         {
 840           if (SYNTAX_FROM_CACHE (mirrortab, c) == Scomment_fence)
 841             {
 842               from++;
 843               UPDATE_SYNTAX_CACHE_FORWARD (from);
 844               break;
 845             }
 846           from++;
 847           continue; /* No need to test other comment styles in a
 848                        generic comment */
 849         }
 850       else
 851
 852         if (SYNTAX_FROM_CACHE (mirrortab, c) == Sendcomment
 853             && SYNTAX_CODE_MATCHES_1CHAR_P
 854             (SYNTAX_CODE_FROM_CACHE (mirrortab, c), mask))
 855         /* we have encountered a comment end of the same style
 856            as the comment sequence which began this comment
 857            section */
 858           {
 859             from++;
 860             UPDATE_SYNTAX_CACHE_FORWARD (from);
 861             break;
 862           }
 863
 864       prev_code = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
 865       from++;
 866       UPDATE_SYNTAX_CACHE_FORWARD (from);
 867       if (from < stop
 868           && SYNTAX_CODES_MATCH_END_P
 869           (prev_code,
 870            SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from)),
 871            mask)
 872
 873           )
 874         /* we have encountered a comment end of the same style
 875            as the comment sequence which began this comment
 876            section */
 877         {
 878           from++;
 879           UPDATE_SYNTAX_CACHE_FORWARD (from);
 880           break;
 881         }
 882     }
 883   return from;
 884 }
 885
 886 \f
 887 /* #### between FSF 19.23 and 19.28 there are some changes to the logic
 888    in this function (and minor changes to find_start_of_comment(),
 889    above, which is part of Fforward_comment() in FSF).  Attempts to port
 890    that logic made this function break, so I'm leaving it out.  If anyone
 891    ever complains about this function not working properly, take a look
 892    at those changes.  --ben */
 893
 894 DEFUN ("forward-comment", Fforward_comment, 0, 2, 0, /*
 895 Move forward across up to COUNT comments, or backwards if COUNT is negative.
 896 Stop scanning if we find something other than a comment or whitespace.
 897 Set point to where scanning stops.
 898 If COUNT comments are found as expected, with nothing except whitespace
 899 between them, return t; otherwise return nil.
 900 Point is set in either case.
 901 COUNT defaults to 1, and BUFFER defaults to the current buffer.
 902 */
 903        (count, buffer))
 904 {
 905   Bufpos from;
 906   Bufpos stop;
 907   Emchar c;
 908   enum syntaxcode code;
 909   int syncode;
 910   EMACS_INT n;
 911   struct buffer *buf = decode_buffer (buffer, 0);
 912
 913   if (NILP (count))
 914     n = 1;
 915   else
 916     {
 917       CHECK_INT (count);
 918       n = XINT (count);
 919     }
 920
 921   from = BUF_PT (buf);
 922
 923   SETUP_SYNTAX_CACHE (from, n);
 924   while (n > 0)
 925     {
 926       QUIT;
 927
 928       stop = BUF_ZV (buf);
 929       while (from < stop)
 930         {
 931           int comstyle = 0;     /* mask for finding matching comment style */
 932
 933           if (char_quoted (buf, from))
 934             {
 935               from++;
 936               continue;
 937             }
 938
 939           UPDATE_SYNTAX_CACHE_FORWARD (from);
 940           c = BUF_FETCH_CHAR (buf, from);
 941           code = SYNTAX_FROM_CACHE (mirrortab, c);
 942           syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
 943
 944           if (code == Scomment)
 945             {
 946               /* we have encountered a single character comment start
 947                  sequence, and we are ignoring all text inside comments.
 948                  we must record the comment style this character begins
 949                  so that later, only a comment end of the same style actually
 950                  ends the comment section */
 951               comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
 952                 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
 953             }
 954
 955           else if (code == Scomment_fence)
 956             {
 957               from++;
 958               code = Scomment;
 959               comstyle = ST_COMMENT_STYLE;
 960             }
 961
 962           else if (from < stop
 963                    && SYNTAX_CODE_START_FIRST_P (syncode))
 964             {
 965               int next_syncode;
 966               UPDATE_SYNTAX_CACHE_FORWARD (from + 1);
 967               next_syncode =
 968                 SYNTAX_CODE_FROM_CACHE (mirrortab,
 969                                         BUF_FETCH_CHAR (buf, from + 1));
 970
 971               if (SYNTAX_CODES_START_P (syncode, next_syncode))
 972                 {
 973                   /* we have encountered a 2char comment start sequence and we
 974                      are ignoring all text inside comments. we must record
 975                      the comment style this sequence begins so that later,
 976                      only a comment end of the same style actually ends
 977                      the comment section */
 978                   code = Scomment;
 979                   comstyle =
 980                     SYNTAX_CODES_COMMENT_MASK_START (syncode, next_syncode)
 981                     == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
 982                   from++;
 983                 }
 984             }
 985
 986           if (code == Scomment)
 987             {
 988               Bufpos newfrom = find_end_of_comment (buf, from, stop, comstyle);
 989               if (newfrom < 0)
 990                 {
 991                   /* we stopped because from==stop */
 992                   BUF_SET_PT (buf, stop);
 993                   return Qnil;
 994                 }
 995               from = newfrom;
 996
 997               /* We have skipped one comment.  */
 998               break;
 999             }
1000           else if (code != Swhitespace
1001                    && code != Sendcomment
1002                    && code != Scomment )
1003             {
1004               BUF_SET_PT (buf, from);
1005               return Qnil;
1006             }
1007           from++;
1008         }
1009
1010       /* End of comment reached */
1011       n--;
1012     }
1013
1014   while (n < 0)
1015     {
1016       QUIT;
1017
1018       stop = BUF_BEGV (buf);
1019       while (from > stop)
1020         {
1021           int comstyle = 0;     /* mask for finding matching comment style */
1022
1023           from--;
1024           if (char_quoted (buf, from))
1025             {
1026               from--;
1027               continue;
1028             }
1029
1030           c = BUF_FETCH_CHAR (buf, from);
1031           code = SYNTAX_FROM_CACHE (mirrortab, c);
1032           syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
1033
1034           if (code == Sendcomment)
1035             {
1036               /* we have found a single char end comment. we must record
1037                  the comment style encountered so that later, we can match
1038                  only the proper comment begin sequence of the same style */
1039               comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
1040                 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1041             }
1042
1043           else if (code == Scomment_fence)
1044             {
1045               code = Sendcomment;
1046               comstyle = ST_COMMENT_STYLE;
1047             }
1048
1049           else if (from > stop
1050                    && SYNTAX_CODE_END_SECOND_P (syncode))
1051             {
1052               int prev_syncode;
1053               UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
1054               prev_syncode =
1055                 SYNTAX_CODE_FROM_CACHE (mirrortab,
1056                                         BUF_FETCH_CHAR (buf, from - 1));
1057               if (SYNTAX_CODES_END_P (prev_syncode, syncode))
1058                 {
1059                   /* We must record the comment style encountered so that
1060                      later, we can match only the proper comment begin
1061                      sequence of the same style.  */
1062                   code = Sendcomment;
1063                   comstyle = SYNTAX_CODES_COMMENT_MASK_END
1064                     (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1065                   from--;
1066                 }
1067             }
1068
1069           if (code == Sendcomment)
1070             {
1071               from = find_start_of_comment (buf, from, stop, comstyle);
1072               break;
1073             }
1074
1075           else if (code != Swhitespace
1076                    && code != Scomment
1077                    && code != Sendcomment)
1078             {
1079               BUF_SET_PT (buf, from + 1);
1080               return Qnil;
1081             }
1082         }
1083
1084       n++;
1085     }
1086
1087   BUF_SET_PT (buf, from);
1088   return Qt;
1089 }
1090
1091 \f
1092 Lisp_Object
1093 scan_lists (struct buffer *buf, Bufpos from, int count, int depth,
1094             int sexpflag, int noerror)
1095 {
1096   Bufpos stop;
1097   Emchar c;
1098   int quoted;
1099   int mathexit = 0;
1100   enum syntaxcode code;
1101   int syncode;
1102   int min_depth = depth;    /* Err out if depth gets less than this. */
1103
1104   if (depth > 0) min_depth = 0;
1105
1106   SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, from, count);
1107   while (count > 0)
1108     {
1109       QUIT;
1110
1111       stop = BUF_ZV (buf);
1112       while (from < stop)
1113         {
1114           int comstyle = 0;     /* mask for finding matching comment style */
1115
1116           UPDATE_SYNTAX_CACHE_FORWARD (from);
1117           c = BUF_FETCH_CHAR (buf, from);
1118           code = SYNTAX_FROM_CACHE (mirrortab, c);
1119           syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
1120           from++;
1121
1122           /* a 1-char comment start sequence */
1123           if (code == Scomment && parse_sexp_ignore_comments)
1124             {
1125               comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) ==
1126                 SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1127             }
1128
1129           /* else, a 2-char comment start sequence? */
1130           else if (from < stop
1131                    && SYNTAX_CODE_START_FIRST_P (syncode)
1132                    && parse_sexp_ignore_comments)
1133             {
1134               int next_syncode;
1135               UPDATE_SYNTAX_CACHE_FORWARD (from);
1136               next_syncode =
1137                 SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from));
1138
1139               if (SYNTAX_CODES_START_P (syncode, next_syncode))
1140                 {
1141               /* we have encountered a comment start sequence and we
1142                  are ignoring all text inside comments. we must record
1143                  the comment style this sequence begins so that later,
1144                  only a comment end of the same style actually ends
1145                  the comment section */
1146               code = Scomment;
1147                   comstyle = SYNTAX_CODES_COMMENT_MASK_START
1148                     (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1149               from++;
1150             }
1151             }
1152           UPDATE_SYNTAX_CACHE_FORWARD (from);
1153
1154           if (SYNTAX_CODE_PREFIX (syncode))
1155             continue;
1156
1157           switch (code)
1158             {
1159             case Sescape:
1160             case Scharquote:
1161               if (from == stop) goto lose;
1162               from++;
1163               /* treat following character as a word constituent */
1164             case Sword:
1165             case Ssymbol:
1166               if (depth || !sexpflag) break;
1167               /* This word counts as a sexp; return at end of it. */
1168               while (from < stop)
1169                 {
1170                   UPDATE_SYNTAX_CACHE_FORWARD (from);
1171                   switch (SYNTAX_FROM_CACHE (mirrortab,
1172                                              BUF_FETCH_CHAR (buf, from)))
1173                     {
1174                     case Scharquote:
1175                     case Sescape:
1176                       from++;
1177                       if (from == stop) goto lose;
1178                       break;
1179                     case Sword:
1180                     case Ssymbol:
1181                     case Squote:
1182                       break;
1183                     default:
1184                       goto done;
1185                     }
1186                   from++;
1187                 }
1188               goto done;
1189
1190             case Scomment_fence:
1191               comstyle = ST_COMMENT_STYLE;
1192             case Scomment:
1193               if (!parse_sexp_ignore_comments)
1194                 break;
1195               UPDATE_SYNTAX_CACHE_FORWARD (from);
1196               {
1197                 Bufpos newfrom =
1198                   find_end_of_comment (buf, from, stop, comstyle);
1199                 if (newfrom < 0)
1200                   {
1201                     /* we stopped because from == stop in search forward */
1202                     from = stop;
1203                     if (depth == 0)
1204                       goto done;
1205                     goto lose;
1206                   }
1207                 from = newfrom;
1208               }
1209               break;
1210
1211             case Smath:
1212               if (!sexpflag)
1213                 break;
1214               if (from != stop && c == BUF_FETCH_CHAR (buf, from))
1215                 from++;
1216               if (mathexit)
1217                 {
1218                   mathexit = 0;
1219                   goto close1;
1220                 }
1221               mathexit = 1;
1222
1223             case Sopen:
1224               if (!++depth) goto done;
1225               break;
1226
1227             case Sclose:
1228             close1:
1229             if (!--depth) goto done;
1230             if (depth < min_depth)
1231               {
1232                 if (noerror)
1233                   return Qnil;
1234                 error ("Containing expression ends prematurely");
1235               }
1236             break;
1237
1238             case Sstring_fence:
1239             case Sstring:
1240               {
1241                 Emchar stringterm;
1242
1243                 if (code != Sstring_fence)
1244                   {
1245                 /* XEmacs change: call syntax_match on character */
1246                 Emchar ch = BUF_FETCH_CHAR (buf, from - 1);
1247                     Lisp_Object stermobj =
1248                       syntax_match (syntax_cache.current_syntax_table, ch);
1249
1250                 if (CHARP (stermobj))
1251                   stringterm = XCHAR (stermobj);
1252                 else
1253                   stringterm = ch;
1254                   }
1255                 else
1256                   stringterm = '\0'; /* avoid compiler warnings */
1257
1258                 while (1)
1259                   {
1260                     if (from >= stop)
1261                       goto lose;
1262                     UPDATE_SYNTAX_CACHE_FORWARD (from);
1263                     c = BUF_FETCH_CHAR (buf, from);
1264                     if (code == Sstring
1265                         ? c == stringterm
1266                         : SYNTAX_FROM_CACHE (mirrortab, c) == Sstring_fence)
1267                       break;
1268
1269                     switch (SYNTAX_FROM_CACHE (mirrortab, c))
1270                       {
1271                       case Scharquote:
1272                       case Sescape:
1273                         from++;
1274                         break;
1275                       default:
1276                         break;
1277                       }
1278                     from++;
1279                   }
1280                 from++;
1281                 if (!depth && sexpflag) goto done;
1282                 break;
1283               }
1284
1285             default:
1286               break;
1287             }
1288         }
1289
1290       /* Reached end of buffer.  Error if within object,
1291          return nil if between */
1292       if (depth) goto lose;
1293
1294       return Qnil;
1295
1296       /* End of object reached */
1297     done:
1298       count--;
1299     }
1300
1301   while (count < 0)
1302     {
1303       QUIT;
1304
1305       stop = BUF_BEGV (buf);
1306       while (from > stop)
1307         {
1308           int comstyle = 0;     /* mask for finding matching comment style */
1309
1310           from--;
1311           UPDATE_SYNTAX_CACHE_BACKWARD (from);
1312           quoted = char_quoted (buf, from);
1313           if (quoted)
1314             {
1315             from--;
1316               UPDATE_SYNTAX_CACHE_BACKWARD (from);
1317             }
1318
1319           c = BUF_FETCH_CHAR (buf, from);
1320           code = SYNTAX_FROM_CACHE (mirrortab, c);
1321           syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
1322
1323           if (code == Sendcomment && parse_sexp_ignore_comments)
1324             {
1325               /* we have found a single char end comment. we must record
1326                  the comment style encountered so that later, we can match
1327                  only the proper comment begin sequence of the same style */
1328               comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
1329                 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1330             }
1331
1332           else if (from > stop
1333                    && SYNTAX_CODE_END_SECOND_P (syncode)
1334                    && !char_quoted (buf, from - 1)
1335                    && parse_sexp_ignore_comments)
1336             {
1337               int prev_syncode;
1338               UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
1339               prev_syncode = SYNTAX_CODE_FROM_CACHE
1340                 (mirrortab, BUF_FETCH_CHAR (buf, from - 1));
1341
1342               if (SYNTAX_CODES_END_P (prev_syncode, syncode))
1343                 {
1344               /* we must record the comment style encountered so that
1345                  later, we can match only the proper comment begin
1346                  sequence of the same style */
1347               code = Sendcomment;
1348                   comstyle = SYNTAX_CODES_COMMENT_MASK_END
1349                     (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1350               from--;
1351             }
1352             }
1353
1354           if (SYNTAX_CODE_PREFIX (syncode))
1355             continue;
1356
1357           switch (quoted ? Sword : code)
1358             {
1359             case Sword:
1360             case Ssymbol:
1361               if (depth || !sexpflag) break;
1362               /* This word counts as a sexp; count object finished after
1363                  passing it. */
1364               while (from > stop)
1365                 {
1366                   UPDATE_SYNTAX_CACHE_BACKWARD (from);
1367                   quoted = char_quoted (buf, from - 1);
1368
1369                   if (quoted)
1370                     from--;
1371                   if (! (quoted
1372                          || (syncode =
1373                              SYNTAX_FROM_CACHE (mirrortab,
1374                                                 BUF_FETCH_CHAR (buf, from - 1)))
1375                          == Sword
1376                          || syncode == Ssymbol
1377                          || syncode == Squote))
1378                     goto done2;
1379                   from--;
1380                 }
1381               goto done2;
1382
1383             case Smath:
1384               if (!sexpflag)
1385                 break;
1386               if (from != stop && c == BUF_FETCH_CHAR (buf, from - 1))
1387                 from--;
1388               if (mathexit)
1389                 {
1390                   mathexit = 0;
1391                   goto open2;
1392                 }
1393               mathexit = 1;
1394
1395             case Sclose:
1396               if (!++depth) goto done2;
1397               break;
1398
1399             case Sopen:
1400             open2:
1401             if (!--depth) goto done2;
1402             if (depth < min_depth)
1403               {
1404                 if (noerror)
1405                   return Qnil;
1406                 error ("Containing expression ends prematurely");
1407               }
1408             break;
1409
1410             case Scomment_fence:
1411               comstyle = ST_COMMENT_STYLE;
1412             case Sendcomment:
1413               if (parse_sexp_ignore_comments)
1414                 from = find_start_of_comment (buf, from, stop, comstyle);
1415               break;
1416
1417             case Sstring_fence:
1418             case Sstring:
1419               {
1420                 Emchar stringterm;
1421
1422                 if (code != Sstring_fence)
1423                   {
1424                 /* XEmacs change: call syntax_match() on character */
1425                 Emchar ch = BUF_FETCH_CHAR (buf, from);
1426                     Lisp_Object stermobj =
1427                       syntax_match (syntax_cache.current_syntax_table, ch);
1428
1429                 if (CHARP (stermobj))
1430                   stringterm = XCHAR (stermobj);
1431                 else
1432                   stringterm = ch;
1433                   }
1434                 else
1435                   stringterm = '\0'; /* avoid compiler warnings */
1436
1437                 while (1)
1438                   {
1439                     if (from == stop) goto lose;
1440
1441                     UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
1442                     c = BUF_FETCH_CHAR (buf, from - 1);
1443
1444                     if ((code == Sstring
1445                         ? c == stringterm
1446                          : SYNTAX_FROM_CACHE (mirrortab, c) == Sstring_fence)
1447                         && !char_quoted (buf, from - 1))
1448                       {
1449                       break;
1450                       }
1451
1452                     from--;
1453                   }
1454                 from--;
1455                 if (!depth && sexpflag) goto done2;
1456                 break;
1457               }
1458             }
1459         }
1460
1461       /* Reached start of buffer.  Error if within object,
1462          return nil if between */
1463       if (depth) goto lose;
1464
1465       return Qnil;
1466
1467     done2:
1468       count++;
1469     }
1470
1471
1472   return (make_int (from));
1473
1474 lose:
1475   if (!noerror)
1476     error ("Unbalanced parentheses");
1477   return Qnil;
1478 }
1479
1480 int
1481 char_quoted (struct buffer *buf, Bufpos pos)
1482 {
1483   enum syntaxcode code;
1484   Bufpos beg = BUF_BEGV (buf);
1485   int quoted = 0;
1486   Bufpos startpos = pos;
1487
1488   while (pos > beg)
1489     {
1490       UPDATE_SYNTAX_CACHE_BACKWARD (pos - 1);
1491       code = SYNTAX_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, pos - 1));
1492
1493       if (code != Scharquote && code != Sescape)
1494         break;
1495       pos--;
1496       quoted = !quoted;
1497     }
1498
1499   UPDATE_SYNTAX_CACHE (startpos);
1500   return quoted;
1501 }
1502
1503 DEFUN ("scan-lists", Fscan_lists, 3, 5, 0, /*
1504 Scan from character number FROM by COUNT lists.
1505 Returns the character number of the position thus found.
1506
1507 If DEPTH is nonzero, paren depth begins counting from that value,
1508 only places where the depth in parentheses becomes zero
1509 are candidates for stopping; COUNT such places are counted.
1510 Thus, a positive value for DEPTH means go out levels.
1511
1512 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
1513
1514 If the beginning or end of (the accessible part of) the buffer is reached
1515 and the depth is wrong, an error is signaled.
1516 If the depth is right but the count is not used up, nil is returned.
1517
1518 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead
1519 of in the current buffer.
1520
1521 If optional arg NOERROR is non-nil, scan-lists will return nil instead of
1522 signalling an error.
1523 */
1524        (from, count, depth, buffer, noerror))
1525 {
1526   struct buffer *buf;
1527
1528   CHECK_INT (from);
1529   CHECK_INT (count);
1530   CHECK_INT (depth);
1531   buf = decode_buffer (buffer, 0);
1532
1533   return scan_lists (buf, XINT (from), XINT (count), XINT (depth), 0,
1534                      !NILP (noerror));
1535 }
1536
1537 DEFUN ("scan-sexps", Fscan_sexps, 2, 4, 0, /*
1538 Scan from character number FROM by COUNT balanced expressions.
1539 If COUNT is negative, scan backwards.
1540 Returns the character number of the position thus found.
1541
1542 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
1543
1544 If the beginning or end of (the accessible part of) the buffer is reached
1545 in the middle of a parenthetical grouping, an error is signaled.
1546 If the beginning or end is reached between groupings
1547 but before count is used up, nil is returned.
1548
1549 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead
1550 of in the current buffer.
1551
1552 If optional arg NOERROR is non-nil, scan-sexps will return nil instead of
1553 signalling an error.
1554 */
1555        (from, count, buffer, noerror))
1556 {
1557   struct buffer *buf = decode_buffer (buffer, 0);
1558   CHECK_INT (from);
1559   CHECK_INT (count);
1560
1561   return scan_lists (buf, XINT (from), XINT (count), 0, 1, !NILP (noerror));
1562 }
1563
1564 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, 0, 1, 0, /*
1565 Move point backward over any number of chars with prefix syntax.
1566 This includes chars with "quote" or "prefix" syntax (' or p).
1567
1568 Optional arg BUFFER defaults to the current buffer.
1569 */
1570        (buffer))
1571 {
1572   struct buffer *buf = decode_buffer (buffer, 0);
1573   Bufpos beg = BUF_BEGV (buf);
1574   Bufpos pos = BUF_PT (buf);
1575 #ifndef emacs
1576 #ifdef UTF2000
1577   Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->syntax_table);
1578 #else
1579   Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
1580 #endif
1581 #endif
1582   Emchar c = '\0'; /* initialize to avoid compiler warnings */
1583
1584
1585   SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, pos, -1);
1586
1587   while (pos > beg && !char_quoted (buf, pos - 1)
1588          /* Previous statement updates syntax table.  */
1589          && (SYNTAX_FROM_CACHE (mirrortab, c = BUF_FETCH_CHAR (buf, pos - 1)) == Squote
1590              || SYNTAX_CODE_PREFIX (SYNTAX_CODE_FROM_CACHE (mirrortab, c))))
1591     pos--;
1592
1593   BUF_SET_PT (buf, pos);
1594
1595   return Qnil;
1596 }
1597 \f
1598 /* Parse forward from FROM to END,
1599    assuming that FROM has state OLDSTATE (nil means FROM is start of function),
1600    and return a description of the state of the parse at END.
1601    If STOPBEFORE is nonzero, stop at the start of an atom.
1602    If COMMENTSTOP is nonzero, stop at the start of a comment.  */
1603
1604 static void
1605 scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr,
1606                     Bufpos from, Bufpos end,
1607                     int targetdepth, int stopbefore,
1608                     Lisp_Object oldstate,
1609                     int commentstop)
1610 {
1611   struct lisp_parse_state state;
1612
1613   enum syntaxcode code;
1614   struct level { int last, prev; };
1615   struct level levelstart[100];
1616   struct level *curlevel = levelstart;
1617   struct level *endlevel = levelstart + 100;
1618   int depth;    /* Paren depth of current scanning location.
1619                            level - levelstart equals this except
1620                            when the depth becomes negative.  */
1621   int mindepth;         /* Lowest DEPTH value seen.  */
1622   int start_quoted = 0;         /* Nonzero means starting after a char quote */
1623   int boundary_stop = commentstop == -1;
1624   Lisp_Object tem;
1625
1626   SETUP_SYNTAX_CACHE (from, 1);
1627   if (NILP (oldstate))
1628     {
1629       depth = 0;
1630       state.instring = -1;
1631       state.incomment = 0;
1632       state.comstyle = 0;       /* comment style a by default */
1633       state.comstr_start = -1;  /* no comment/string seen.  */
1634     }
1635   else
1636     {
1637       tem = Fcar (oldstate);    /* elt 0, depth */
1638       if (!NILP (tem))
1639         depth = XINT (tem);
1640       else
1641         depth = 0;
1642
1643       oldstate = Fcdr (oldstate);
1644       oldstate = Fcdr (oldstate);
1645       oldstate = Fcdr (oldstate);
1646       tem = Fcar (oldstate);    /* elt 3, instring */
1647       state.instring = ( !NILP (tem)
1648                          ? ( INTP (tem) ? XINT (tem) : ST_STRING_STYLE)
1649                          : -1);
1650
1651       oldstate = Fcdr (oldstate);
1652       tem = Fcar (oldstate);    /* elt 4, incomment */
1653       state.incomment = !NILP (tem);
1654
1655       oldstate = Fcdr (oldstate);
1656       tem = Fcar (oldstate);    /* elt 5, follows-quote */
1657       start_quoted = !NILP (tem);
1658
1659       /* if the eighth element of the list is nil, we are in comment style
1660          a; if it is t, we are in comment style b; if it is 'syntax-table,
1661          we are in a generic comment */
1662       oldstate = Fcdr (oldstate);
1663       oldstate = Fcdr (oldstate);
1664       tem = Fcar (oldstate);    /* elt 7, comment style a/b/fence */
1665       state.comstyle = NILP (tem) ? 0 : ( EQ (tem, Qsyntax_table)
1666                                           ? ST_COMMENT_STYLE : 1 );
1667
1668       oldstate = Fcdr (oldstate); /* elt 8, start of last comment/string */
1669       tem = Fcar (oldstate);
1670       state.comstr_start = NILP (tem) ? -1 : XINT (tem);
1671
1672       /* elt 9, char numbers of starts-of-expression of levels
1673          (starting from outermost). */
1674       oldstate = Fcdr (oldstate);
1675       tem = Fcar (oldstate);    /* elt 9, intermediate data for
1676                                    continuation of parsing (subject
1677                                    to change). */
1678       while (!NILP (tem))       /* >= second enclosing sexps.  */
1679         {
1680           curlevel->last = XINT (Fcar (tem));
1681           if (++curlevel == endlevel)
1682             error ("Nesting too deep for parser");
1683           curlevel->prev = -1;
1684           curlevel->last = -1;
1685           tem = Fcdr (tem);
1686         }
1687     }
1688   state.quoted = 0;
1689   mindepth = depth;
1690
1691   curlevel->prev = -1;
1692   curlevel->last = -1;
1693
1694   /* Enter the loop at a place appropriate for initial state. */
1695
1696   if (state.incomment) goto startincomment;
1697   if (state.instring >= 0)
1698     {
1699       if (start_quoted) goto startquotedinstring;
1700       goto startinstring;
1701     }
1702   if (start_quoted) goto startquoted;
1703
1704   while (from < end)
1705     {
1706       Emchar c;
1707       int syncode;
1708
1709       QUIT;
1710
1711       UPDATE_SYNTAX_CACHE_FORWARD (from);
1712       c = BUF_FETCH_CHAR (buf, from);
1713       code = SYNTAX_FROM_CACHE (mirrortab, c);
1714       syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
1715       from++;
1716
1717           /* record the comment style we have entered so that only the
1718              comment-ender sequence (or single char) of the same style
1719              actually terminates the comment section. */
1720       if (code == Scomment)
1721         {
1722           state.comstyle =
1723             SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
1724             == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1725           state.comstr_start = from - 1;
1726         }
1727
1728       /* a generic comment delimiter? */
1729       else if (code == Scomment_fence)
1730         {
1731           state.comstyle = ST_COMMENT_STYLE;
1732           state.comstr_start = from - 1;
1733           code = Scomment;
1734         }
1735
1736       else if (from < end &&
1737                SYNTAX_CODE_START_FIRST_P (syncode))
1738         {
1739           int next_syncode;
1740           UPDATE_SYNTAX_CACHE_FORWARD (from);
1741           next_syncode =
1742             SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from));
1743
1744           if (SYNTAX_CODES_START_P (syncode, next_syncode))
1745         {
1746           code = Scomment;
1747               state.comstyle = SYNTAX_CODES_COMMENT_MASK_START
1748                 (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1749               state.comstr_start = from - 1;
1750           from++;
1751               UPDATE_SYNTAX_CACHE_FORWARD (from);
1752             }
1753         }
1754
1755       if (SYNTAX_CODE_PREFIX (syncode))
1756         continue;
1757       switch (code)
1758         {
1759         case Sescape:
1760         case Scharquote:
1761           if (stopbefore) goto stop;  /* this arg means stop at sexp start */
1762           curlevel->last = from - 1;
1763         startquoted:
1764           if (from == end) goto endquoted;
1765           from++;
1766           goto symstarted;
1767           /* treat following character as a word constituent */
1768         case Sword:
1769         case Ssymbol:
1770           if (stopbefore) goto stop;  /* this arg means stop at sexp start */
1771           curlevel->last = from - 1;
1772         symstarted:
1773           while (from < end)
1774             {
1775               UPDATE_SYNTAX_CACHE_FORWARD (from);
1776               switch (SYNTAX_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from)))
1777                 {
1778                 case Scharquote:
1779                 case Sescape:
1780                   from++;
1781                   if (from == end) goto endquoted;
1782                   break;
1783                 case Sword:
1784                 case Ssymbol:
1785                 case Squote:
1786                   break;
1787                 default:
1788                   goto symdone;
1789                 }
1790               from++;
1791             }
1792         symdone:
1793           curlevel->prev = curlevel->last;
1794           break;
1795
1796         case Scomment:
1797           state.incomment = 1;
1798           if (commentstop || boundary_stop) goto done;
1799         startincomment:
1800           if (commentstop == 1)
1801             goto done;
1802           UPDATE_SYNTAX_CACHE_FORWARD (from);
1803           {
1804             Bufpos newfrom = find_end_of_comment (buf, from, end, state.comstyle);
1805             if (newfrom < 0)
1806               {
1807                 /* we terminated search because from == end */
1808                 from = end;
1809                 goto done;
1810               }
1811             from = newfrom;
1812           }
1813           state.incomment = 0;
1814           state.comstyle = 0;                /* reset the comment style */
1815           if (boundary_stop) goto done;
1816           break;
1817
1818         case Sopen:
1819           if (stopbefore) goto stop;  /* this arg means stop at sexp start */
1820           depth++;
1821           /* curlevel++->last ran into compiler bug on Apollo */
1822           curlevel->last = from - 1;
1823           if (++curlevel == endlevel)
1824             error ("Nesting too deep for parser");
1825           curlevel->prev = -1;
1826           curlevel->last = -1;
1827           if (targetdepth == depth) goto done;
1828           break;
1829
1830         case Sclose:
1831           depth--;
1832           if (depth < mindepth)
1833             mindepth = depth;
1834           if (curlevel != levelstart)
1835             curlevel--;
1836           curlevel->prev = curlevel->last;
1837           if (targetdepth == depth) goto done;
1838           break;
1839
1840         case Sstring:
1841         case Sstring_fence:
1842           state.comstr_start = from - 1;
1843             if (stopbefore) goto stop; /* this arg means stop at sexp start */
1844             curlevel->last = from - 1;
1845           if (code == Sstring_fence)
1846             {
1847               state.instring = ST_STRING_STYLE;
1848             }
1849           else
1850             {
1851               /* XEmacs change: call syntax_match() on character */
1852               Emchar ch = BUF_FETCH_CHAR (buf, from - 1);
1853               Lisp_Object stermobj =
1854                 syntax_match (syntax_cache.current_syntax_table, ch);
1855
1856               if (CHARP (stermobj))
1857                 state.instring = XCHAR (stermobj);
1858               else
1859                 state.instring = ch;
1860           }
1861           if (boundary_stop) goto done;
1862         startinstring:
1863           while (1)
1864             {
1865               enum syntaxcode temp_code;
1866
1867               if (from >= end) goto done;
1868
1869               UPDATE_SYNTAX_CACHE_FORWARD (from);
1870               c = BUF_FETCH_CHAR (buf, from);
1871               temp_code = SYNTAX_FROM_CACHE (mirrortab, c);
1872
1873               if (
1874                   state.instring != ST_STRING_STYLE &&
1875                   temp_code == Sstring &&
1876                   c == state.instring) break;
1877
1878               switch (temp_code)
1879                 {
1880                 case Sstring_fence:
1881                   if (state.instring == ST_STRING_STYLE)
1882                     goto string_end;
1883                   break;
1884                 case Scharquote:
1885                 case Sescape:
1886                   {
1887                     from++;
1888                   startquotedinstring:
1889                     if (from >= end) goto endquoted;
1890                     break;
1891                   }
1892                 default:
1893                   break;
1894                 }
1895               from++;
1896             }
1897         string_end:
1898           state.instring = -1;
1899           curlevel->prev = curlevel->last;
1900           from++;
1901           if (boundary_stop) goto done;
1902           break;
1903
1904         case Smath:
1905           break;
1906
1907         case Swhitespace:
1908         case Spunct:
1909         case Squote:
1910         case Sendcomment:
1911         case Scomment_fence:
1912         case Sinherit:
1913         case Smax:
1914           break;
1915         }
1916     }
1917   goto done;
1918
1919  stop:   /* Here if stopping before start of sexp. */
1920   from--;    /* We have just fetched the char that starts it; */
1921   goto done; /* but return the position before it. */
1922
1923  endquoted:
1924   state.quoted = 1;
1925  done:
1926   state.depth = depth;
1927   state.mindepth = mindepth;
1928   state.thislevelstart = curlevel->prev;
1929   state.prevlevelstart
1930     = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
1931   state.location = from;
1932   state.levelstarts = Qnil;
1933   while (--curlevel >= levelstart)
1934     state.levelstarts = Fcons (make_int (curlevel->last),
1935                                state.levelstarts);
1936
1937   *stateptr = state;
1938 }
1939
1940 DEFUN ("parse-partial-sexp", Fparse_partial_sexp, 2, 7, 0, /*
1941 Parse Lisp syntax starting at FROM until TO; return status of parse at TO.
1942 Parsing stops at TO or when certain criteria are met;
1943  point is set to where parsing stops.
1944 If fifth arg OLDSTATE is omitted or nil,
1945  parsing assumes that FROM is the beginning of a function.
1946 Value is a list of nine elements describing final state of parsing:
1947  0. depth in parens.
1948  1. character address of start of innermost containing list; nil if none.
1949  2. character address of start of last complete sexp terminated.
1950  3. non-nil if inside a string.
1951     (It is the character that will terminate the string,
1952      or t if the string should be terminated by an explicit
1953      `syntax-table' property.)
1954  4. t if inside a comment.
1955  5. t if following a quote character.
1956  6. the minimum paren-depth encountered during this scan.
1957  7. nil if in comment style a, or not in a comment; t if in comment style b;
1958     `syntax-table' if given by an explicit `syntax-table' property.
1959  8. character address of start of last comment or string; nil if none.
1960  9. Intermediate data for continuation of parsing (subject to change).
1961 If third arg TARGETDEPTH is non-nil, parsing stops if the depth
1962 in parentheses becomes equal to TARGETDEPTH.
1963 Fourth arg STOPBEFORE non-nil means stop when come to
1964  any character that starts a sexp.
1965 Fifth arg OLDSTATE is a nine-element list like what this function returns.
1966 It is used to initialize the state of the parse.  Its second and third
1967 elements are ignored.
1968 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. If it
1969 is `syntax-table', stop after the start of a comment or a string, or after
1970 the end of a comment or string.
1971 */
1972        (from, to, targetdepth, stopbefore, oldstate, commentstop, buffer))
1973 {
1974   struct lisp_parse_state state;
1975   int target;
1976   Bufpos start, end;
1977   struct buffer *buf = decode_buffer (buffer, 0);
1978   Lisp_Object val;
1979
1980   if (!NILP (targetdepth))
1981     {
1982       CHECK_INT (targetdepth);
1983       target = XINT (targetdepth);
1984     }
1985   else
1986     target = -100000;           /* We won't reach this depth */
1987
1988   get_buffer_range_char (buf, from, to, &start, &end, 0);
1989   scan_sexps_forward (buf, &state, start, end,
1990                       target, !NILP (stopbefore), oldstate,
1991                       (NILP (commentstop)
1992                        ? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1)));
1993   BUF_SET_PT (buf, state.location);
1994
1995   /* reverse order */
1996   val = Qnil;
1997   val = Fcons (state.levelstarts, val);
1998   val = Fcons ((state.incomment || (state.instring >= 0))
1999                ? make_int (state.comstr_start) : Qnil, val);
2000   val = Fcons (state.comstyle  ? (state.comstyle == ST_COMMENT_STYLE
2001                                   ? Qsyntax_table : Qt) : Qnil, val);
2002   val = Fcons (make_int (state.mindepth),   val);
2003   val = Fcons (state.quoted    ? Qt : Qnil, val);
2004   val = Fcons (state.incomment ? Qt : Qnil, val);
2005   val = Fcons (state.instring < 0
2006                ? Qnil
2007                : (state.instring == ST_STRING_STYLE
2008                   ? Qt : make_int (state.instring)), val);
2009   val = Fcons (state.thislevelstart < 0 ? Qnil : make_int (state.thislevelstart), val);
2010   val = Fcons (state.prevlevelstart < 0 ? Qnil : make_int (state.prevlevelstart), val);
2011   val = Fcons (make_int (state.depth), val);
2012
2013   return val;
2014 }
2015
2016
2017 /* Updating of the mirror syntax table.
2018
2019    Each syntax table has a corresponding mirror table in it.
2020    Whenever we make a change to a syntax table, we call
2021    update_syntax_table() on it.
2022
2023    #### We really only need to map over the changed range.
2024
2025    If we change the standard syntax table, we need to map over
2026    all tables because any of them could be inheriting from the
2027    standard syntax table.
2028
2029    When `set-syntax-table' is called, we set the buffer's mirror
2030    syntax table as well.
2031    */
2032
2033 struct cmst_arg
2034 {
2035   Lisp_Object mirrortab;
2036   int check_inherit;
2037 };
2038
2039 static int
2040 cmst_mapfun (struct chartab_range *range, Lisp_Object val, void *arg)
2041 {
2042   struct cmst_arg *closure = (struct cmst_arg *) arg;
2043
2044   if (CONSP (val))
2045     val = XCAR (val);
2046   if (SYNTAX_FROM_CODE (XINT (val)) == Sinherit
2047       && closure->check_inherit)
2048     {
2049       struct cmst_arg recursive;
2050
2051       recursive.mirrortab = closure->mirrortab;
2052       recursive.check_inherit = 0;
2053       map_char_table (XCHAR_TABLE (Vstandard_syntax_table), range,
2054                                    cmst_mapfun, &recursive);
2055     }
2056   else
2057     put_char_table (XCHAR_TABLE (closure->mirrortab), range, val);
2058   return 0;
2059 }
2060
2061 #ifndef UTF2000
2062 static void
2063 update_just_this_syntax_table (Lisp_Char_Table *ct)
2064 {
2065   struct chartab_range range;
2066   struct cmst_arg arg;
2067
2068   arg.mirrortab = ct->mirror_table;
2069   arg.check_inherit = (CHAR_TABLEP (Vstandard_syntax_table)
2070                        && ct != XCHAR_TABLE (Vstandard_syntax_table));
2071   range.type = CHARTAB_RANGE_ALL;
2072   map_char_table (ct, &range, cmst_mapfun, &arg);
2073 }
2074
2075 /* Called from chartab.c when a change is made to a syntax table.
2076    If this is the standard syntax table, we need to recompute
2077    *all* syntax tables (yuck).  Otherwise we just recompute this
2078    one. */
2079
2080 void
2081 update_syntax_table (Lisp_Char_Table *ct)
2082 {
2083   /* Don't be stymied at startup. */
2084   if (CHAR_TABLEP (Vstandard_syntax_table)
2085       && ct == XCHAR_TABLE (Vstandard_syntax_table))
2086     {
2087       Lisp_Object syntab;
2088
2089       for (syntab = Vall_syntax_tables; !NILP (syntab);
2090            syntab = XCHAR_TABLE (syntab)->next_table)
2091         update_just_this_syntax_table (XCHAR_TABLE (syntab));
2092     }
2093   else
2094     update_just_this_syntax_table (ct);
2095 }
2096 #endif
2097
2098 \f
2099 /************************************************************************/
2100 /*                            initialization                            */
2101 /************************************************************************/
2102
2103 void
2104 syms_of_syntax (void)
2105 {
2106   defsymbol (&Qsyntax_table_p, "syntax-table-p");
2107   defsymbol (&Qsyntax_table, "syntax-table");
2108
2109   DEFSUBR (Fsyntax_table_p);
2110   DEFSUBR (Fsyntax_table);
2111   DEFSUBR (Fstandard_syntax_table);
2112   DEFSUBR (Fcopy_syntax_table);
2113   DEFSUBR (Fset_syntax_table);
2114   DEFSUBR (Fsyntax_designator_chars);
2115   DEFSUBR (Fchar_syntax);
2116   DEFSUBR (Fmatching_paren);
2117   /* DEFSUBR (Fmodify_syntax_entry); now in Lisp. */
2118   /* DEFSUBR (Fdescribe_syntax); now in Lisp. */
2119
2120   DEFSUBR (Fforward_word);
2121
2122   DEFSUBR (Fforward_comment);
2123   DEFSUBR (Fscan_lists);
2124   DEFSUBR (Fscan_sexps);
2125   DEFSUBR (Fbackward_prefix_chars);
2126   DEFSUBR (Fparse_partial_sexp);
2127 }
2128
2129 void
2130 vars_of_syntax (void)
2131 {
2132   DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments /*
2133 Non-nil means `forward-sexp', etc., should treat comments as whitespace.
2134 */ );
2135   parse_sexp_ignore_comments = 0;
2136
2137   DEFVAR_BOOL ("lookup-syntax-properties", &lookup_syntax_properties /*
2138 Non-nil means `forward-sexp', etc., grant `syntax-table' property.
2139 The value of this property should be either a syntax table, or a cons
2140 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric
2141 syntax code, MATCHCHAR being nil or the character to match (which is
2142 relevant only for open/close type.
2143 */ );
2144   lookup_syntax_properties = 1;
2145
2146   DEFVAR_BOOL ("words-include-escapes", &words_include_escapes /*
2147 Non-nil means `forward-word', etc., should treat escape chars part of words.
2148 */ );
2149   words_include_escapes = 0;
2150
2151   no_quit_in_re_search = 0;
2152 }
2153
2154 static void
2155 define_standard_syntax (const char *p, enum syntaxcode syn)
2156 {
2157   for (; *p; p++)
2158     Fput_char_table (make_char (*p), make_int (syn), Vstandard_syntax_table);
2159 }
2160
2161 void
2162 complex_vars_of_syntax (void)
2163 {
2164   Emchar i;
2165   const char *p;
2166   /* Set this now, so first buffer creation can refer to it. */
2167   /* Make it nil before calling copy-syntax-table
2168      so that copy-syntax-table will know not to try to copy from garbage */
2169   Vstandard_syntax_table = Qnil;
2170   Vstandard_syntax_table = Fcopy_syntax_table (Qnil);
2171   staticpro (&Vstandard_syntax_table);
2172
2173   Vsyntax_designator_chars_string = make_string_nocopy (syntax_code_spec,
2174                                                         Smax);
2175   staticpro (&Vsyntax_designator_chars_string);
2176
2177   fill_char_table (XCHAR_TABLE (Vstandard_syntax_table), make_int (Spunct));
2178
2179   for (i = 0; i <= 32; i++)     /* Control 0 plus SPACE */
2180     Fput_char_table (make_char (i), make_int (Swhitespace),
2181                      Vstandard_syntax_table);
2182   for (i = 127; i <= 159; i++)  /* DEL plus Control 1 */
2183     Fput_char_table (make_char (i), make_int (Swhitespace),
2184                      Vstandard_syntax_table);
2185
2186   define_standard_syntax ("abcdefghijklmnopqrstuvwxyz"
2187                           "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
2188                           "0123456789"
2189                           "$%", Sword);
2190   define_standard_syntax ("\"", Sstring);
2191   define_standard_syntax ("\\", Sescape);
2192   define_standard_syntax ("_-+*/&|<>=", Ssymbol);
2193   define_standard_syntax (".,;:?!#@~^'`", Spunct);
2194
2195   for (p = "()[]{}"; *p; p+=2)
2196     {
2197       Fput_char_table (make_char (p[0]),
2198                        Fcons (make_int (Sopen), make_char (p[1])),
2199                        Vstandard_syntax_table);
2200       Fput_char_table (make_char (p[1]),
2201                        Fcons (make_int (Sclose), make_char (p[0])),
2202                        Vstandard_syntax_table);
2203     }
2204 }