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 COUNT defaults to 1, and BUFFER defaults to the current buffer.
 593 */
 594        (count, buffer))
 595 {
 596   Bufpos val;
 597   struct buffer *buf = decode_buffer (buffer, 0);
 598   EMACS_INT n;
 599
 600   if (NILP (count))
 601     n = 1;
 602   else
 603     {
 604       CHECK_INT (count);
 605       n = XINT (count);
 606     }
 607
 608   val = scan_words (buf, BUF_PT (buf), n);
 609   if (val)
 610     {
 611       BUF_SET_PT (buf, val);
 612       return Qt;
 613     }
 614   else
 615     {
 616       BUF_SET_PT (buf, n > 0 ? BUF_ZV (buf) : BUF_BEGV (buf));
 617       return Qnil;
 618     }
 619 }
 620 \f
 621 static void scan_sexps_forward (struct buffer *buf,
 622                                 struct lisp_parse_state *,
 623                                 Bufpos from, Bufpos end,
 624                                 int targetdepth, int stopbefore,
 625                                 Lisp_Object oldstate,
 626                                 int commentstop);
 627
 628 static int
 629 find_start_of_comment (struct buffer *buf, Bufpos from, Bufpos stop,
 630                        int comstyle)
 631 {
 632   Emchar c;
 633   enum syntaxcode code;
 634
 635   /* Look back, counting the parity of string-quotes,
 636      and recording the comment-starters seen.
 637      When we reach a safe place, assume that's not in a string;
 638      then step the main scan to the earliest comment-starter seen
 639      an even number of string quotes away from the safe place.
 640
 641      OFROM[I] is position of the earliest comment-starter seen
 642      which is I+2X quotes from the comment-end.
 643      PARITY is current parity of quotes from the comment end.  */
 644   int parity = 0;
 645   Emchar my_stringend = 0;
 646   int string_lossage = 0;
 647   Bufpos comment_end = from;
 648   Bufpos comstart_pos = 0;
 649   int comstart_parity = 0;
 650   int styles_match_p = 0;
 651   /* mask to match comment styles against; for ST_COMMENT_STYLE, this
 652      will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */
 653   int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A;
 654
 655   /* At beginning of range to scan, we're outside of strings;
 656      that determines quote parity to the comment-end.  */
 657   while (from != stop)
 658     {
 659       int syncode;
 660
 661       /* Move back and examine a character.  */
 662       from--;
 663       UPDATE_SYNTAX_CACHE_BACKWARD (from);
 664
 665       c = BUF_FETCH_CHAR (buf, from);
 666       code = SYNTAX_FROM_CACHE (mirrortab, c);
 667       syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
 668
 669       /* is this a 1-char comment end sequence? if so, try
 670          to see if style matches previously extracted mask */
 671       if (code == Sendcomment)
 672         {
 673           styles_match_p =
 674             SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask;
 675         }
 676
 677       /* or are we looking at a 1-char comment start sequence
 678          of the style matching mask? */
 679       else if (code == Scomment)
 680         {
 681           styles_match_p =
 682             SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask;
 683         }
 684
 685       /* otherwise, is this a 2-char comment end or start sequence? */
 686       else if (from > stop)
 687         do
 688           {
 689             /* 2-char comment end sequence? */
 690             if (SYNTAX_CODE_END_SECOND_P (syncode))
 691               {
 692                 int prev_syncode;
 693                 UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
 694                 prev_syncode =
 695                   SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from - 1));
 696
 697                 if (SYNTAX_CODES_END_P (prev_syncode, syncode))
 698                   {
 699                     code = Sendcomment;
 700                     styles_match_p =
 701                       SYNTAX_CODES_COMMENT_MASK_END (prev_syncode, syncode);
 702                     from--;
 703                     UPDATE_SYNTAX_CACHE_BACKWARD (from);
 704                     c = BUF_FETCH_CHAR (buf, from);
 705
 706                     /* Found a comment-end sequence, so skip past the
 707                        check for a comment-start */
 708                     break;
 709                   }
 710               }
 711
 712             /* 2-char comment start sequence? */
 713             if (SYNTAX_CODE_START_SECOND_P (syncode))
 714               {
 715                 int prev_syncode;
 716                 UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
 717                 prev_syncode =
 718                   SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from - 1));
 719
 720                 if (SYNTAX_CODES_START_P (prev_syncode, syncode))
 721                   {
 722                     code = Scomment;
 723                     styles_match_p =
 724                       SYNTAX_CODES_COMMENT_MASK_START (prev_syncode, syncode);
 725                     from--;
 726                     UPDATE_SYNTAX_CACHE_BACKWARD (from);
 727                     c = BUF_FETCH_CHAR (buf, from);
 728                   }
 729               }
 730           } while (0);
 731
 732       /* Ignore escaped characters.  */
 733       if (char_quoted (buf, from))
 734         continue;
 735
 736       /* Track parity of quotes.  */
 737       if (code == Sstring)
 738         {
 739           parity ^= 1;
 740           if (my_stringend == 0)
 741             my_stringend = c;
 742           /* If we have two kinds of string delimiters.
 743              There's no way to grok this scanning backwards.  */
 744           else if (my_stringend != c)
 745             string_lossage = 1;
 746         }
 747
 748       if (code == Sstring_fence || code == Scomment_fence)
 749         {
 750           parity ^= 1;
 751           if (my_stringend == 0)
 752             my_stringend =
 753               code == Sstring_fence ? ST_STRING_STYLE : ST_COMMENT_STYLE;
 754           /* If we have two kinds of string delimiters.
 755              There's no way to grok this scanning backwards.  */
 756           else if (my_stringend != (code == Sstring_fence
 757                                     ? ST_STRING_STYLE : ST_COMMENT_STYLE))
 758             string_lossage = 1;
 759         }
 760
 761       /* Record comment-starters according to that
 762          quote-parity to the comment-end.  */
 763       if (code == Scomment && styles_match_p)
 764         {
 765           comstart_parity = parity;
 766           comstart_pos = from;
 767         }
 768
 769       /* If we find another earlier comment-ender,
 770          any comment-starts earlier than that don't count
 771          (because they go with the earlier comment-ender).  */
 772       if (code == Sendcomment && styles_match_p)
 773         break;
 774
 775       /* Assume a defun-start point is outside of strings.  */
 776       if (code == Sopen
 777           && (from == stop || BUF_FETCH_CHAR (buf, from - 1) == '\n'))
 778         break;
 779     }
 780
 781   if (comstart_pos == 0)
 782     from = comment_end;
 783   /* If the earliest comment starter
 784      is followed by uniform paired string quotes or none,
 785      we know it can't be inside a string
 786      since if it were then the comment ender would be inside one.
 787      So it does start a comment.  Skip back to it.  */
 788   else if (comstart_parity == 0 && !string_lossage)
 789     from = comstart_pos;
 790   else
 791     {
 792       /* We had two kinds of string delimiters mixed up
 793          together.  Decode this going forwards.
 794          Scan fwd from the previous comment ender
 795          to the one in question; this records where we
 796          last passed a comment starter.  */
 797
 798       struct lisp_parse_state state;
 799       scan_sexps_forward (buf, &state, find_defun_start (buf, comment_end),
 800                           comment_end - 1, -10000, 0, Qnil, 0);
 801       if (state.incomment)
 802         from = state.comstr_start;
 803       else
 804         /* We can't grok this as a comment; scan it normally.  */
 805         from = comment_end;
 806       UPDATE_SYNTAX_CACHE_FORWARD (from - 1);
 807     }
 808   return from;
 809 }
 810
 811 static Bufpos
 812 find_end_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int comstyle)
 813 {
 814   int c;
 815   int prev_code;
 816   /* mask to match comment styles against; for ST_COMMENT_STYLE, this
 817      will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */
 818   int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A;
 819
 820   /* This is only called by functions which have already set up the
 821      syntax_cache and are keeping it up-to-date */
 822   while (1)
 823     {
 824       if (from == stop)
 825         {
 826           return -1;
 827         }
 828
 829       UPDATE_SYNTAX_CACHE_FORWARD (from);
 830       c = BUF_FETCH_CHAR (buf, from);
 831
 832       /* Test for generic comments */
 833       if (comstyle == ST_COMMENT_STYLE)
 834         {
 835           if (SYNTAX_FROM_CACHE (mirrortab, c) == Scomment_fence)
 836             {
 837               from++;
 838               UPDATE_SYNTAX_CACHE_FORWARD (from);
 839               break;
 840             }
 841           from++;
 842           continue; /* No need to test other comment styles in a
 843                        generic comment */
 844         }
 845       else
 846
 847         if (SYNTAX_FROM_CACHE (mirrortab, c) == Sendcomment
 848             && SYNTAX_CODE_MATCHES_1CHAR_P
 849             (SYNTAX_CODE_FROM_CACHE (mirrortab, c), mask))
 850         /* we have encountered a comment end of the same style
 851            as the comment sequence which began this comment
 852            section */
 853           {
 854             from++;
 855             UPDATE_SYNTAX_CACHE_FORWARD (from);
 856             break;
 857           }
 858
 859       prev_code = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
 860       from++;
 861       UPDATE_SYNTAX_CACHE_FORWARD (from);
 862       if (from < stop
 863           && SYNTAX_CODES_MATCH_END_P
 864           (prev_code,
 865            SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from)),
 866            mask)
 867
 868           )
 869         /* we have encountered a comment end of the same style
 870            as the comment sequence which began this comment
 871            section */
 872         {
 873           from++;
 874           UPDATE_SYNTAX_CACHE_FORWARD (from);
 875           break;
 876         }
 877     }
 878   return from;
 879 }
 880
 881 \f
 882 /* #### between FSF 19.23 and 19.28 there are some changes to the logic
 883    in this function (and minor changes to find_start_of_comment(),
 884    above, which is part of Fforward_comment() in FSF).  Attempts to port
 885    that logic made this function break, so I'm leaving it out.  If anyone
 886    ever complains about this function not working properly, take a look
 887    at those changes.  --ben */
 888
 889 DEFUN ("forward-comment", Fforward_comment, 0, 2, 0, /*
 890 Move forward across up to COUNT comments, or backwards if COUNT is negative.
 891 Stop scanning if we find something other than a comment or whitespace.
 892 Set point to where scanning stops.
 893 If COUNT comments are found as expected, with nothing except whitespace
 894 between them, return t; otherwise return nil.
 895 Point is set in either case.
 896 COUNT defaults to 1, and BUFFER defaults to the current buffer.
 897 */
 898        (count, buffer))
 899 {
 900   Bufpos from;
 901   Bufpos stop;
 902   Emchar c;
 903   enum syntaxcode code;
 904   int syncode;
 905   EMACS_INT n;
 906   struct buffer *buf = decode_buffer (buffer, 0);
 907
 908   if (NILP (count))
 909     n = 1;
 910   else
 911     {
 912       CHECK_INT (count);
 913       n = XINT (count);
 914     }
 915
 916   from = BUF_PT (buf);
 917
 918   SETUP_SYNTAX_CACHE (from, n);
 919   while (n > 0)
 920     {
 921       QUIT;
 922
 923       stop = BUF_ZV (buf);
 924       while (from < stop)
 925         {
 926           int comstyle = 0;     /* mask for finding matching comment style */
 927
 928           if (char_quoted (buf, from))
 929             {
 930               from++;
 931               continue;
 932             }
 933
 934           UPDATE_SYNTAX_CACHE_FORWARD (from);
 935           c = BUF_FETCH_CHAR (buf, from);
 936           code = SYNTAX_FROM_CACHE (mirrortab, c);
 937           syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
 938
 939           if (code == Scomment)
 940             {
 941               /* we have encountered a single character comment start
 942                  sequence, and we are ignoring all text inside comments.
 943                  we must record the comment style this character begins
 944                  so that later, only a comment end of the same style actually
 945                  ends the comment section */
 946               comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
 947                 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
 948             }
 949
 950           else if (code == Scomment_fence)
 951             {
 952               from++;
 953               code = Scomment;
 954               comstyle = ST_COMMENT_STYLE;
 955             }
 956
 957           else if (from < stop
 958                    && SYNTAX_CODE_START_FIRST_P (syncode))
 959             {
 960               int next_syncode;
 961               UPDATE_SYNTAX_CACHE_FORWARD (from + 1);
 962               next_syncode =
 963                 SYNTAX_CODE_FROM_CACHE (mirrortab,
 964                                         BUF_FETCH_CHAR (buf, from + 1));
 965
 966               if (SYNTAX_CODES_START_P (syncode, next_syncode))
 967                 {
 968                   /* we have encountered a 2char comment start sequence and we
 969                      are ignoring all text inside comments. we must record
 970                      the comment style this sequence begins so that later,
 971                      only a comment end of the same style actually ends
 972                      the comment section */
 973                   code = Scomment;
 974                   comstyle =
 975                     SYNTAX_CODES_COMMENT_MASK_START (syncode, next_syncode)
 976                     == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
 977                   from++;
 978                 }
 979             }
 980
 981           if (code == Scomment)
 982             {
 983               Bufpos newfrom = find_end_of_comment (buf, from, stop, comstyle);
 984               if (newfrom < 0)
 985                 {
 986                   /* we stopped because from==stop */
 987                   BUF_SET_PT (buf, stop);
 988                   return Qnil;
 989                 }
 990               from = newfrom;
 991
 992               /* We have skipped one comment.  */
 993               break;
 994             }
 995           else if (code != Swhitespace
 996                    && code != Sendcomment
 997                    && code != Scomment )
 998             {
 999               BUF_SET_PT (buf, from);
1000               return Qnil;
1001             }
1002           from++;
1003         }
1004
1005       /* End of comment reached */
1006       n--;
1007     }
1008
1009   while (n < 0)
1010     {
1011       QUIT;
1012
1013       stop = BUF_BEGV (buf);
1014       while (from > stop)
1015         {
1016           int comstyle = 0;     /* mask for finding matching comment style */
1017
1018           from--;
1019           if (char_quoted (buf, from))
1020             {
1021               from--;
1022               continue;
1023             }
1024
1025           c = BUF_FETCH_CHAR (buf, from);
1026           code = SYNTAX_FROM_CACHE (mirrortab, c);
1027           syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
1028
1029           if (code == Sendcomment)
1030             {
1031               /* we have found a single char end comment. we must record
1032                  the comment style encountered so that later, we can match
1033                  only the proper comment begin sequence of the same style */
1034               comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
1035                 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1036             }
1037
1038           else if (code == Scomment_fence)
1039             {
1040               code = Sendcomment;
1041               comstyle = ST_COMMENT_STYLE;
1042             }
1043
1044           else if (from > stop
1045                    && SYNTAX_CODE_END_SECOND_P (syncode))
1046             {
1047               int prev_syncode;
1048               UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
1049               prev_syncode =
1050                 SYNTAX_CODE_FROM_CACHE (mirrortab,
1051                                         BUF_FETCH_CHAR (buf, from - 1));
1052               if (SYNTAX_CODES_END_P (prev_syncode, syncode))
1053                 {
1054                   /* We must record the comment style encountered so that
1055                      later, we can match only the proper comment begin
1056                      sequence of the same style.  */
1057                   code = Sendcomment;
1058                   comstyle = SYNTAX_CODES_COMMENT_MASK_END
1059                     (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1060                   from--;
1061                 }
1062             }
1063
1064           if (code == Sendcomment)
1065             {
1066               from = find_start_of_comment (buf, from, stop, comstyle);
1067               break;
1068             }
1069
1070           else if (code != Swhitespace
1071                    && code != Scomment
1072                    && code != Sendcomment)
1073             {
1074               BUF_SET_PT (buf, from + 1);
1075               return Qnil;
1076             }
1077         }
1078
1079       n++;
1080     }
1081
1082   BUF_SET_PT (buf, from);
1083   return Qt;
1084 }
1085
1086 \f
1087 Lisp_Object
1088 scan_lists (struct buffer *buf, Bufpos from, int count, int depth,
1089             int sexpflag, int noerror)
1090 {
1091   Bufpos stop;
1092   Emchar c;
1093   int quoted;
1094   int mathexit = 0;
1095   enum syntaxcode code;
1096   int syncode;
1097   int min_depth = depth;    /* Err out if depth gets less than this. */
1098
1099   if (depth > 0) min_depth = 0;
1100
1101   SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, from, count);
1102   while (count > 0)
1103     {
1104       QUIT;
1105
1106       stop = BUF_ZV (buf);
1107       while (from < stop)
1108         {
1109           int comstyle = 0;     /* mask for finding matching comment style */
1110
1111           UPDATE_SYNTAX_CACHE_FORWARD (from);
1112           c = BUF_FETCH_CHAR (buf, from);
1113           code = SYNTAX_FROM_CACHE (mirrortab, c);
1114           syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
1115           from++;
1116
1117           /* a 1-char comment start sequence */
1118           if (code == Scomment && parse_sexp_ignore_comments)
1119             {
1120               comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) ==
1121                 SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1122             }
1123
1124           /* else, a 2-char comment start sequence? */
1125           else if (from < stop
1126                    && SYNTAX_CODE_START_FIRST_P (syncode)
1127                    && parse_sexp_ignore_comments)
1128             {
1129               int next_syncode;
1130               UPDATE_SYNTAX_CACHE_FORWARD (from);
1131               next_syncode =
1132                 SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from));
1133
1134               if (SYNTAX_CODES_START_P (syncode, next_syncode))
1135                 {
1136               /* we have encountered a comment start sequence and we
1137                  are ignoring all text inside comments. we must record
1138                  the comment style this sequence begins so that later,
1139                  only a comment end of the same style actually ends
1140                  the comment section */
1141               code = Scomment;
1142                   comstyle = SYNTAX_CODES_COMMENT_MASK_START
1143                     (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1144               from++;
1145             }
1146             }
1147           UPDATE_SYNTAX_CACHE_FORWARD (from);
1148
1149           if (SYNTAX_CODE_PREFIX (syncode))
1150             continue;
1151
1152           switch (code)
1153             {
1154             case Sescape:
1155             case Scharquote:
1156               if (from == stop) goto lose;
1157               from++;
1158               /* treat following character as a word constituent */
1159             case Sword:
1160             case Ssymbol:
1161               if (depth || !sexpflag) break;
1162               /* This word counts as a sexp; return at end of it. */
1163               while (from < stop)
1164                 {
1165                   UPDATE_SYNTAX_CACHE_FORWARD (from);
1166                   switch (SYNTAX_FROM_CACHE (mirrortab,
1167                                              BUF_FETCH_CHAR (buf, from)))
1168                     {
1169                     case Scharquote:
1170                     case Sescape:
1171                       from++;
1172                       if (from == stop) goto lose;
1173                       break;
1174                     case Sword:
1175                     case Ssymbol:
1176                     case Squote:
1177                       break;
1178                     default:
1179                       goto done;
1180                     }
1181                   from++;
1182                 }
1183               goto done;
1184
1185             case Scomment_fence:
1186               comstyle = ST_COMMENT_STYLE;
1187             case Scomment:
1188               if (!parse_sexp_ignore_comments)
1189                 break;
1190               UPDATE_SYNTAX_CACHE_FORWARD (from);
1191               {
1192                 Bufpos newfrom =
1193                   find_end_of_comment (buf, from, stop, comstyle);
1194                 if (newfrom < 0)
1195                   {
1196                     /* we stopped because from == stop in search forward */
1197                     from = stop;
1198                     if (depth == 0)
1199                       goto done;
1200                     goto lose;
1201                   }
1202                 from = newfrom;
1203               }
1204               break;
1205
1206             case Smath:
1207               if (!sexpflag)
1208                 break;
1209               if (from != stop && c == BUF_FETCH_CHAR (buf, from))
1210                 from++;
1211               if (mathexit)
1212                 {
1213                   mathexit = 0;
1214                   goto close1;
1215                 }
1216               mathexit = 1;
1217
1218             case Sopen:
1219               if (!++depth) goto done;
1220               break;
1221
1222             case Sclose:
1223             close1:
1224             if (!--depth) goto done;
1225             if (depth < min_depth)
1226               {
1227                 if (noerror)
1228                   return Qnil;
1229                 error ("Containing expression ends prematurely");
1230               }
1231             break;
1232
1233             case Sstring_fence:
1234             case Sstring:
1235               {
1236                 Emchar stringterm;
1237
1238                 if (code != Sstring_fence)
1239                   {
1240                 /* XEmacs change: call syntax_match on character */
1241                 Emchar ch = BUF_FETCH_CHAR (buf, from - 1);
1242                     Lisp_Object stermobj =
1243                       syntax_match (syntax_cache.current_syntax_table, ch);
1244
1245                 if (CHARP (stermobj))
1246                   stringterm = XCHAR (stermobj);
1247                 else
1248                   stringterm = ch;
1249                   }
1250                 else
1251                   stringterm = '\0'; /* avoid compiler warnings */
1252
1253                 while (1)
1254                   {
1255                     if (from >= stop)
1256                       goto lose;
1257                     UPDATE_SYNTAX_CACHE_FORWARD (from);
1258                     c = BUF_FETCH_CHAR (buf, from);
1259                     if (code == Sstring
1260                         ? c == stringterm
1261                         : SYNTAX_FROM_CACHE (mirrortab, c) == Sstring_fence)
1262                       break;
1263
1264                     switch (SYNTAX_FROM_CACHE (mirrortab, c))
1265                       {
1266                       case Scharquote:
1267                       case Sescape:
1268                         from++;
1269                         break;
1270                       default:
1271                         break;
1272                       }
1273                     from++;
1274                   }
1275                 from++;
1276                 if (!depth && sexpflag) goto done;
1277                 break;
1278               }
1279
1280             default:
1281               break;
1282             }
1283         }
1284
1285       /* Reached end of buffer.  Error if within object,
1286          return nil if between */
1287       if (depth) goto lose;
1288
1289       return Qnil;
1290
1291       /* End of object reached */
1292     done:
1293       count--;
1294     }
1295
1296   while (count < 0)
1297     {
1298       QUIT;
1299
1300       stop = BUF_BEGV (buf);
1301       while (from > stop)
1302         {
1303           int comstyle = 0;     /* mask for finding matching comment style */
1304
1305           from--;
1306           UPDATE_SYNTAX_CACHE_BACKWARD (from);
1307           quoted = char_quoted (buf, from);
1308           if (quoted)
1309             {
1310             from--;
1311               UPDATE_SYNTAX_CACHE_BACKWARD (from);
1312             }
1313
1314           c = BUF_FETCH_CHAR (buf, from);
1315           code = SYNTAX_FROM_CACHE (mirrortab, c);
1316           syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
1317
1318           if (code == Sendcomment && parse_sexp_ignore_comments)
1319             {
1320               /* we have found a single char end comment. we must record
1321                  the comment style encountered so that later, we can match
1322                  only the proper comment begin sequence of the same style */
1323               comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
1324                 == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1325             }
1326
1327           else if (from > stop
1328                    && SYNTAX_CODE_END_SECOND_P (syncode)
1329                    && !char_quoted (buf, from - 1)
1330                    && parse_sexp_ignore_comments)
1331             {
1332               int prev_syncode;
1333               UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
1334               prev_syncode = SYNTAX_CODE_FROM_CACHE
1335                 (mirrortab, BUF_FETCH_CHAR (buf, from - 1));
1336
1337               if (SYNTAX_CODES_END_P (prev_syncode, syncode))
1338                 {
1339               /* we must record the comment style encountered so that
1340                  later, we can match only the proper comment begin
1341                  sequence of the same style */
1342               code = Sendcomment;
1343                   comstyle = SYNTAX_CODES_COMMENT_MASK_END
1344                     (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1345               from--;
1346             }
1347             }
1348
1349           if (SYNTAX_CODE_PREFIX (syncode))
1350             continue;
1351
1352           switch (quoted ? Sword : code)
1353             {
1354             case Sword:
1355             case Ssymbol:
1356               if (depth || !sexpflag) break;
1357               /* This word counts as a sexp; count object finished after
1358                  passing it. */
1359               while (from > stop)
1360                 {
1361                   UPDATE_SYNTAX_CACHE_BACKWARD (from);
1362                   quoted = char_quoted (buf, from - 1);
1363
1364                   if (quoted)
1365                     from--;
1366                   if (! (quoted
1367                          || (syncode =
1368                              SYNTAX_FROM_CACHE (mirrortab,
1369                                                 BUF_FETCH_CHAR (buf, from - 1)))
1370                          == Sword
1371                          || syncode == Ssymbol
1372                          || syncode == Squote))
1373                     goto done2;
1374                   from--;
1375                 }
1376               goto done2;
1377
1378             case Smath:
1379               if (!sexpflag)
1380                 break;
1381               if (from != stop && c == BUF_FETCH_CHAR (buf, from - 1))
1382                 from--;
1383               if (mathexit)
1384                 {
1385                   mathexit = 0;
1386                   goto open2;
1387                 }
1388               mathexit = 1;
1389
1390             case Sclose:
1391               if (!++depth) goto done2;
1392               break;
1393
1394             case Sopen:
1395             open2:
1396             if (!--depth) goto done2;
1397             if (depth < min_depth)
1398               {
1399                 if (noerror)
1400                   return Qnil;
1401                 error ("Containing expression ends prematurely");
1402               }
1403             break;
1404
1405             case Scomment_fence:
1406               comstyle = ST_COMMENT_STYLE;
1407             case Sendcomment:
1408               if (parse_sexp_ignore_comments)
1409                 from = find_start_of_comment (buf, from, stop, comstyle);
1410               break;
1411
1412             case Sstring_fence:
1413             case Sstring:
1414               {
1415                 Emchar stringterm;
1416
1417                 if (code != Sstring_fence)
1418                   {
1419                 /* XEmacs change: call syntax_match() on character */
1420                 Emchar ch = BUF_FETCH_CHAR (buf, from);
1421                     Lisp_Object stermobj =
1422                       syntax_match (syntax_cache.current_syntax_table, ch);
1423
1424                 if (CHARP (stermobj))
1425                   stringterm = XCHAR (stermobj);
1426                 else
1427                   stringterm = ch;
1428                   }
1429                 else
1430                   stringterm = '\0'; /* avoid compiler warnings */
1431
1432                 while (1)
1433                   {
1434                     if (from == stop) goto lose;
1435
1436                     UPDATE_SYNTAX_CACHE_BACKWARD (from - 1);
1437                     c = BUF_FETCH_CHAR (buf, from - 1);
1438
1439                     if ((code == Sstring
1440                         ? c == stringterm
1441                          : SYNTAX_FROM_CACHE (mirrortab, c) == Sstring_fence)
1442                         && !char_quoted (buf, from - 1))
1443                       {
1444                       break;
1445                       }
1446
1447                     from--;
1448                   }
1449                 from--;
1450                 if (!depth && sexpflag) goto done2;
1451                 break;
1452               }
1453             }
1454         }
1455
1456       /* Reached start of buffer.  Error if within object,
1457          return nil if between */
1458       if (depth) goto lose;
1459
1460       return Qnil;
1461
1462     done2:
1463       count++;
1464     }
1465
1466
1467   return (make_int (from));
1468
1469 lose:
1470   if (!noerror)
1471     error ("Unbalanced parentheses");
1472   return Qnil;
1473 }
1474
1475 int
1476 char_quoted (struct buffer *buf, Bufpos pos)
1477 {
1478   enum syntaxcode code;
1479   Bufpos beg = BUF_BEGV (buf);
1480   int quoted = 0;
1481   Bufpos startpos = pos;
1482
1483   while (pos > beg)
1484     {
1485       UPDATE_SYNTAX_CACHE_BACKWARD (pos - 1);
1486       code = SYNTAX_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, pos - 1));
1487
1488       if (code != Scharquote && code != Sescape)
1489         break;
1490       pos--;
1491       quoted = !quoted;
1492     }
1493
1494   UPDATE_SYNTAX_CACHE (startpos);
1495   return quoted;
1496 }
1497
1498 DEFUN ("scan-lists", Fscan_lists, 3, 5, 0, /*
1499 Scan from character number FROM by COUNT lists.
1500 Returns the character number of the position thus found.
1501
1502 If DEPTH is nonzero, paren depth begins counting from that value,
1503 only places where the depth in parentheses becomes zero
1504 are candidates for stopping; COUNT such places are counted.
1505 Thus, a positive value for DEPTH means go out levels.
1506
1507 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
1508
1509 If the beginning or end of (the accessible part of) the buffer is reached
1510 and the depth is wrong, an error is signaled.
1511 If the depth is right but the count is not used up, nil is returned.
1512
1513 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead
1514 of in the current buffer.
1515
1516 If optional arg NOERROR is non-nil, scan-lists will return nil instead of
1517 signalling an error.
1518 */
1519        (from, count, depth, buffer, noerror))
1520 {
1521   struct buffer *buf;
1522
1523   CHECK_INT (from);
1524   CHECK_INT (count);
1525   CHECK_INT (depth);
1526   buf = decode_buffer (buffer, 0);
1527
1528   return scan_lists (buf, XINT (from), XINT (count), XINT (depth), 0,
1529                      !NILP (noerror));
1530 }
1531
1532 DEFUN ("scan-sexps", Fscan_sexps, 2, 4, 0, /*
1533 Scan from character number FROM by COUNT balanced expressions.
1534 If COUNT is negative, scan backwards.
1535 Returns the character number of the position thus found.
1536
1537 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
1538
1539 If the beginning or end of (the accessible part of) the buffer is reached
1540 in the middle of a parenthetical grouping, an error is signaled.
1541 If the beginning or end is reached between groupings
1542 but before count is used up, nil is returned.
1543
1544 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead
1545 of in the current buffer.
1546
1547 If optional arg NOERROR is non-nil, scan-sexps will return nil instead of
1548 signalling an error.
1549 */
1550        (from, count, buffer, noerror))
1551 {
1552   struct buffer *buf = decode_buffer (buffer, 0);
1553   CHECK_INT (from);
1554   CHECK_INT (count);
1555
1556   return scan_lists (buf, XINT (from), XINT (count), 0, 1, !NILP (noerror));
1557 }
1558
1559 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, 0, 1, 0, /*
1560 Move point backward over any number of chars with prefix syntax.
1561 This includes chars with "quote" or "prefix" syntax (' or p).
1562
1563 Optional arg BUFFER defaults to the current buffer.
1564 */
1565        (buffer))
1566 {
1567   struct buffer *buf = decode_buffer (buffer, 0);
1568   Bufpos beg = BUF_BEGV (buf);
1569   Bufpos pos = BUF_PT (buf);
1570 #ifndef emacs
1571 #ifdef UTF2000
1572   Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->syntax_table);
1573 #else
1574   Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
1575 #endif
1576 #endif
1577   Emchar c = '\0'; /* initialize to avoid compiler warnings */
1578
1579
1580   SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, pos, -1);
1581
1582   while (pos > beg && !char_quoted (buf, pos - 1)
1583          /* Previous statement updates syntax table.  */
1584          && (SYNTAX_FROM_CACHE (mirrortab, c = BUF_FETCH_CHAR (buf, pos - 1)) == Squote
1585              || SYNTAX_CODE_PREFIX (SYNTAX_CODE_FROM_CACHE (mirrortab, c))))
1586     pos--;
1587
1588   BUF_SET_PT (buf, pos);
1589
1590   return Qnil;
1591 }
1592 \f
1593 /* Parse forward from FROM to END,
1594    assuming that FROM has state OLDSTATE (nil means FROM is start of function),
1595    and return a description of the state of the parse at END.
1596    If STOPBEFORE is nonzero, stop at the start of an atom.
1597    If COMMENTSTOP is nonzero, stop at the start of a comment.  */
1598
1599 static void
1600 scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr,
1601                     Bufpos from, Bufpos end,
1602                     int targetdepth, int stopbefore,
1603                     Lisp_Object oldstate,
1604                     int commentstop)
1605 {
1606   struct lisp_parse_state state;
1607
1608   enum syntaxcode code;
1609   struct level { int last, prev; };
1610   struct level levelstart[100];
1611   struct level *curlevel = levelstart;
1612   struct level *endlevel = levelstart + 100;
1613   int depth;    /* Paren depth of current scanning location.
1614                            level - levelstart equals this except
1615                            when the depth becomes negative.  */
1616   int mindepth;         /* Lowest DEPTH value seen.  */
1617   int start_quoted = 0;         /* Nonzero means starting after a char quote */
1618   int boundary_stop = commentstop == -1;
1619   Lisp_Object tem;
1620
1621   SETUP_SYNTAX_CACHE (from, 1);
1622   if (NILP (oldstate))
1623     {
1624       depth = 0;
1625       state.instring = -1;
1626       state.incomment = 0;
1627       state.comstyle = 0;       /* comment style a by default */
1628       state.comstr_start = -1;  /* no comment/string seen.  */
1629     }
1630   else
1631     {
1632       tem = Fcar (oldstate);    /* elt 0, depth */
1633       if (!NILP (tem))
1634         depth = XINT (tem);
1635       else
1636         depth = 0;
1637
1638       oldstate = Fcdr (oldstate);
1639       oldstate = Fcdr (oldstate);
1640       oldstate = Fcdr (oldstate);
1641       tem = Fcar (oldstate);    /* elt 3, instring */
1642       state.instring = ( !NILP (tem)
1643                          ? ( INTP (tem) ? XINT (tem) : ST_STRING_STYLE)
1644                          : -1);
1645
1646       oldstate = Fcdr (oldstate);
1647       tem = Fcar (oldstate);    /* elt 4, incomment */
1648       state.incomment = !NILP (tem);
1649
1650       oldstate = Fcdr (oldstate);
1651       tem = Fcar (oldstate);    /* elt 5, follows-quote */
1652       start_quoted = !NILP (tem);
1653
1654       /* if the eighth element of the list is nil, we are in comment style
1655          a; if it is t, we are in comment style b; if it is 'syntax-table,
1656          we are in a generic comment */
1657       oldstate = Fcdr (oldstate);
1658       oldstate = Fcdr (oldstate);
1659       tem = Fcar (oldstate);    /* elt 7, comment style a/b/fence */
1660       state.comstyle = NILP (tem) ? 0 : ( EQ (tem, Qsyntax_table)
1661                                           ? ST_COMMENT_STYLE : 1 );
1662
1663       oldstate = Fcdr (oldstate); /* elt 8, start of last comment/string */
1664       tem = Fcar (oldstate);
1665       state.comstr_start = NILP (tem) ? -1 : XINT (tem);
1666
1667       /* elt 9, char numbers of starts-of-expression of levels
1668          (starting from outermost). */
1669       oldstate = Fcdr (oldstate);
1670       tem = Fcar (oldstate);    /* elt 9, intermediate data for
1671                                    continuation of parsing (subject
1672                                    to change). */
1673       while (!NILP (tem))       /* >= second enclosing sexps.  */
1674         {
1675           curlevel->last = XINT (Fcar (tem));
1676           if (++curlevel == endlevel)
1677             error ("Nesting too deep for parser");
1678           curlevel->prev = -1;
1679           curlevel->last = -1;
1680           tem = Fcdr (tem);
1681         }
1682     }
1683   state.quoted = 0;
1684   mindepth = depth;
1685
1686   curlevel->prev = -1;
1687   curlevel->last = -1;
1688
1689   /* Enter the loop at a place appropriate for initial state. */
1690
1691   if (state.incomment) goto startincomment;
1692   if (state.instring >= 0)
1693     {
1694       if (start_quoted) goto startquotedinstring;
1695       goto startinstring;
1696     }
1697   if (start_quoted) goto startquoted;
1698
1699   while (from < end)
1700     {
1701       Emchar c;
1702       int syncode;
1703
1704       QUIT;
1705
1706       UPDATE_SYNTAX_CACHE_FORWARD (from);
1707       c = BUF_FETCH_CHAR (buf, from);
1708       code = SYNTAX_FROM_CACHE (mirrortab, c);
1709       syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c);
1710       from++;
1711
1712           /* record the comment style we have entered so that only the
1713              comment-ender sequence (or single char) of the same style
1714              actually terminates the comment section. */
1715       if (code == Scomment)
1716         {
1717           state.comstyle =
1718             SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode)
1719             == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1720           state.comstr_start = from - 1;
1721         }
1722
1723       /* a generic comment delimiter? */
1724       else if (code == Scomment_fence)
1725         {
1726           state.comstyle = ST_COMMENT_STYLE;
1727           state.comstr_start = from - 1;
1728           code = Scomment;
1729         }
1730
1731       else if (from < end &&
1732                SYNTAX_CODE_START_FIRST_P (syncode))
1733         {
1734           int next_syncode;
1735           UPDATE_SYNTAX_CACHE_FORWARD (from);
1736           next_syncode =
1737             SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from));
1738
1739           if (SYNTAX_CODES_START_P (syncode, next_syncode))
1740         {
1741           code = Scomment;
1742               state.comstyle = SYNTAX_CODES_COMMENT_MASK_START
1743                 (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1;
1744               state.comstr_start = from - 1;
1745           from++;
1746               UPDATE_SYNTAX_CACHE_FORWARD (from);
1747             }
1748         }
1749
1750       if (SYNTAX_CODE_PREFIX (syncode))
1751         continue;
1752       switch (code)
1753         {
1754         case Sescape:
1755         case Scharquote:
1756           if (stopbefore) goto stop;  /* this arg means stop at sexp start */
1757           curlevel->last = from - 1;
1758         startquoted:
1759           if (from == end) goto endquoted;
1760           from++;
1761           goto symstarted;
1762           /* treat following character as a word constituent */
1763         case Sword:
1764         case Ssymbol:
1765           if (stopbefore) goto stop;  /* this arg means stop at sexp start */
1766           curlevel->last = from - 1;
1767         symstarted:
1768           while (from < end)
1769             {
1770               UPDATE_SYNTAX_CACHE_FORWARD (from);
1771               switch (SYNTAX_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from)))
1772                 {
1773                 case Scharquote:
1774                 case Sescape:
1775                   from++;
1776                   if (from == end) goto endquoted;
1777                   break;
1778                 case Sword:
1779                 case Ssymbol:
1780                 case Squote:
1781                   break;
1782                 default:
1783                   goto symdone;
1784                 }
1785               from++;
1786             }
1787         symdone:
1788           curlevel->prev = curlevel->last;
1789           break;
1790
1791         case Scomment:
1792           state.incomment = 1;
1793           if (commentstop || boundary_stop) goto done;
1794         startincomment:
1795           if (commentstop == 1)
1796             goto done;
1797           UPDATE_SYNTAX_CACHE_FORWARD (from);
1798           {
1799             Bufpos newfrom = find_end_of_comment (buf, from, end, state.comstyle);
1800             if (newfrom < 0)
1801               {
1802                 /* we terminated search because from == end */
1803                 from = end;
1804                 goto done;
1805               }
1806             from = newfrom;
1807           }
1808           state.incomment = 0;
1809           state.comstyle = 0;                /* reset the comment style */
1810           if (boundary_stop) goto done;
1811           break;
1812
1813         case Sopen:
1814           if (stopbefore) goto stop;  /* this arg means stop at sexp start */
1815           depth++;
1816           /* curlevel++->last ran into compiler bug on Apollo */
1817           curlevel->last = from - 1;
1818           if (++curlevel == endlevel)
1819             error ("Nesting too deep for parser");
1820           curlevel->prev = -1;
1821           curlevel->last = -1;
1822           if (targetdepth == depth) goto done;
1823           break;
1824
1825         case Sclose:
1826           depth--;
1827           if (depth < mindepth)
1828             mindepth = depth;
1829           if (curlevel != levelstart)
1830             curlevel--;
1831           curlevel->prev = curlevel->last;
1832           if (targetdepth == depth) goto done;
1833           break;
1834
1835         case Sstring:
1836         case Sstring_fence:
1837           state.comstr_start = from - 1;
1838             if (stopbefore) goto stop; /* this arg means stop at sexp start */
1839             curlevel->last = from - 1;
1840           if (code == Sstring_fence)
1841             {
1842               state.instring = ST_STRING_STYLE;
1843             }
1844           else
1845             {
1846               /* XEmacs change: call syntax_match() on character */
1847               Emchar ch = BUF_FETCH_CHAR (buf, from - 1);
1848               Lisp_Object stermobj =
1849                 syntax_match (syntax_cache.current_syntax_table, ch);
1850
1851               if (CHARP (stermobj))
1852                 state.instring = XCHAR (stermobj);
1853               else
1854                 state.instring = ch;
1855           }
1856           if (boundary_stop) goto done;
1857         startinstring:
1858           while (1)
1859             {
1860               enum syntaxcode temp_code;
1861
1862               if (from >= end) goto done;
1863
1864               UPDATE_SYNTAX_CACHE_FORWARD (from);
1865               c = BUF_FETCH_CHAR (buf, from);
1866               temp_code = SYNTAX_FROM_CACHE (mirrortab, c);
1867
1868               if (
1869                   state.instring != ST_STRING_STYLE &&
1870                   temp_code == Sstring &&
1871                   c == state.instring) break;
1872
1873               switch (temp_code)
1874                 {
1875                 case Sstring_fence:
1876                   if (state.instring == ST_STRING_STYLE)
1877                     goto string_end;
1878                   break;
1879                 case Scharquote:
1880                 case Sescape:
1881                   {
1882                     from++;
1883                   startquotedinstring:
1884                     if (from >= end) goto endquoted;
1885                     break;
1886                   }
1887                 default:
1888                   break;
1889                 }
1890               from++;
1891             }
1892         string_end:
1893           state.instring = -1;
1894           curlevel->prev = curlevel->last;
1895           from++;
1896           if (boundary_stop) goto done;
1897           break;
1898
1899         case Smath:
1900           break;
1901
1902         case Swhitespace:
1903         case Spunct:
1904         case Squote:
1905         case Sendcomment:
1906         case Scomment_fence:
1907         case Sinherit:
1908         case Smax:
1909           break;
1910         }
1911     }
1912   goto done;
1913
1914  stop:   /* Here if stopping before start of sexp. */
1915   from--;    /* We have just fetched the char that starts it; */
1916   goto done; /* but return the position before it. */
1917
1918  endquoted:
1919   state.quoted = 1;
1920  done:
1921   state.depth = depth;
1922   state.mindepth = mindepth;
1923   state.thislevelstart = curlevel->prev;
1924   state.prevlevelstart
1925     = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
1926   state.location = from;
1927   state.levelstarts = Qnil;
1928   while (--curlevel >= levelstart)
1929     state.levelstarts = Fcons (make_int (curlevel->last),
1930                                state.levelstarts);
1931
1932   *stateptr = state;
1933 }
1934
1935 DEFUN ("parse-partial-sexp", Fparse_partial_sexp, 2, 7, 0, /*
1936 Parse Lisp syntax starting at FROM until TO; return status of parse at TO.
1937 Parsing stops at TO or when certain criteria are met;
1938  point is set to where parsing stops.
1939 If fifth arg OLDSTATE is omitted or nil,
1940  parsing assumes that FROM is the beginning of a function.
1941 Value is a list of nine elements describing final state of parsing:
1942  0. depth in parens.
1943  1. character address of start of innermost containing list; nil if none.
1944  2. character address of start of last complete sexp terminated.
1945  3. non-nil if inside a string.
1946     (It is the character that will terminate the string,
1947      or t if the string should be terminated by an explicit
1948      `syntax-table' property.)
1949  4. t if inside a comment.
1950  5. t if following a quote character.
1951  6. the minimum paren-depth encountered during this scan.
1952  7. nil if in comment style a, or not in a comment; t if in comment style b;
1953     `syntax-table' if given by an explicit `syntax-table' property.
1954  8. character address of start of last comment or string; nil if none.
1955  9. Intermediate data for continuation of parsing (subject to change).
1956 If third arg TARGETDEPTH is non-nil, parsing stops if the depth
1957 in parentheses becomes equal to TARGETDEPTH.
1958 Fourth arg STOPBEFORE non-nil means stop when come to
1959  any character that starts a sexp.
1960 Fifth arg OLDSTATE is a nine-element list like what this function returns.
1961 It is used to initialize the state of the parse.  Its second and third
1962 elements are ignored.
1963 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. If it
1964 is `syntax-table', stop after the start of a comment or a string, or after
1965 the end of a comment or string.
1966 */
1967        (from, to, targetdepth, stopbefore, oldstate, commentstop, buffer))
1968 {
1969   struct lisp_parse_state state;
1970   int target;
1971   Bufpos start, end;
1972   struct buffer *buf = decode_buffer (buffer, 0);
1973   Lisp_Object val;
1974
1975   if (!NILP (targetdepth))
1976     {
1977       CHECK_INT (targetdepth);
1978       target = XINT (targetdepth);
1979     }
1980   else
1981     target = -100000;           /* We won't reach this depth */
1982
1983   get_buffer_range_char (buf, from, to, &start, &end, 0);
1984   scan_sexps_forward (buf, &state, start, end,
1985                       target, !NILP (stopbefore), oldstate,
1986                       (NILP (commentstop)
1987                        ? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1)));
1988   BUF_SET_PT (buf, state.location);
1989
1990   /* reverse order */
1991   val = Qnil;
1992   val = Fcons (state.levelstarts, val);
1993   val = Fcons ((state.incomment || (state.instring >= 0))
1994                ? make_int (state.comstr_start) : Qnil, val);
1995   val = Fcons (state.comstyle  ? (state.comstyle == ST_COMMENT_STYLE
1996                                   ? Qsyntax_table : Qt) : Qnil, val);
1997   val = Fcons (make_int (state.mindepth),   val);
1998   val = Fcons (state.quoted    ? Qt : Qnil, val);
1999   val = Fcons (state.incomment ? Qt : Qnil, val);
2000   val = Fcons (state.instring < 0
2001                ? Qnil
2002                : (state.instring == ST_STRING_STYLE
2003                   ? Qt : make_int (state.instring)), val);
2004   val = Fcons (state.thislevelstart < 0 ? Qnil : make_int (state.thislevelstart), val);
2005   val = Fcons (state.prevlevelstart < 0 ? Qnil : make_int (state.prevlevelstart), val);
2006   val = Fcons (make_int (state.depth), val);
2007
2008   return val;
2009 }
2010
2011
2012 /* Updating of the mirror syntax table.
2013
2014    Each syntax table has a corresponding mirror table in it.
2015    Whenever we make a change to a syntax table, we call
2016    update_syntax_table() on it.
2017
2018    #### We really only need to map over the changed range.
2019
2020    If we change the standard syntax table, we need to map over
2021    all tables because any of them could be inheriting from the
2022    standard syntax table.
2023
2024    When `set-syntax-table' is called, we set the buffer's mirror
2025    syntax table as well.
2026    */
2027
2028 struct cmst_arg
2029 {
2030   Lisp_Object mirrortab;
2031   int check_inherit;
2032 };
2033
2034 static int
2035 cmst_mapfun (struct chartab_range *range, Lisp_Object val, void *arg)
2036 {
2037   struct cmst_arg *closure = (struct cmst_arg *) arg;
2038
2039   if (CONSP (val))
2040     val = XCAR (val);
2041   if (SYNTAX_FROM_CODE (XINT (val)) == Sinherit
2042       && closure->check_inherit)
2043     {
2044       struct cmst_arg recursive;
2045
2046       recursive.mirrortab = closure->mirrortab;
2047       recursive.check_inherit = 0;
2048       map_char_table (XCHAR_TABLE (Vstandard_syntax_table), range,
2049                                    cmst_mapfun, &recursive);
2050     }
2051   else
2052     put_char_table (XCHAR_TABLE (closure->mirrortab), range, val);
2053   return 0;
2054 }
2055
2056 #ifndef UTF2000
2057 static void
2058 update_just_this_syntax_table (Lisp_Char_Table *ct)
2059 {
2060   struct chartab_range range;
2061   struct cmst_arg arg;
2062
2063   arg.mirrortab = ct->mirror_table;
2064   arg.check_inherit = (CHAR_TABLEP (Vstandard_syntax_table)
2065                        && ct != XCHAR_TABLE (Vstandard_syntax_table));
2066   range.type = CHARTAB_RANGE_ALL;
2067   map_char_table (ct, &range, cmst_mapfun, &arg);
2068 }
2069
2070 /* Called from chartab.c when a change is made to a syntax table.
2071    If this is the standard syntax table, we need to recompute
2072    *all* syntax tables (yuck).  Otherwise we just recompute this
2073    one. */
2074
2075 void
2076 update_syntax_table (Lisp_Char_Table *ct)
2077 {
2078   /* Don't be stymied at startup. */
2079   if (CHAR_TABLEP (Vstandard_syntax_table)
2080       && ct == XCHAR_TABLE (Vstandard_syntax_table))
2081     {
2082       Lisp_Object syntab;
2083
2084       for (syntab = Vall_syntax_tables; !NILP (syntab);
2085            syntab = XCHAR_TABLE (syntab)->next_table)
2086         update_just_this_syntax_table (XCHAR_TABLE (syntab));
2087     }
2088   else
2089     update_just_this_syntax_table (ct);
2090 }
2091 #endif
2092
2093 \f
2094 /************************************************************************/
2095 /*                            initialization                            */
2096 /************************************************************************/
2097
2098 void
2099 syms_of_syntax (void)
2100 {
2101   defsymbol (&Qsyntax_table_p, "syntax-table-p");
2102   defsymbol (&Qsyntax_table, "syntax-table");
2103
2104   DEFSUBR (Fsyntax_table_p);
2105   DEFSUBR (Fsyntax_table);
2106   DEFSUBR (Fstandard_syntax_table);
2107   DEFSUBR (Fcopy_syntax_table);
2108   DEFSUBR (Fset_syntax_table);
2109   DEFSUBR (Fsyntax_designator_chars);
2110   DEFSUBR (Fchar_syntax);
2111   DEFSUBR (Fmatching_paren);
2112   /* DEFSUBR (Fmodify_syntax_entry); now in Lisp. */
2113   /* DEFSUBR (Fdescribe_syntax); now in Lisp. */
2114
2115   DEFSUBR (Fforward_word);
2116
2117   DEFSUBR (Fforward_comment);
2118   DEFSUBR (Fscan_lists);
2119   DEFSUBR (Fscan_sexps);
2120   DEFSUBR (Fbackward_prefix_chars);
2121   DEFSUBR (Fparse_partial_sexp);
2122 }
2123
2124 void
2125 vars_of_syntax (void)
2126 {
2127   DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments /*
2128 Non-nil means `forward-sexp', etc., should treat comments as whitespace.
2129 */ );
2130   parse_sexp_ignore_comments = 0;
2131
2132   DEFVAR_BOOL ("lookup-syntax-properties", &lookup_syntax_properties /*
2133 Non-nil means `forward-sexp', etc., grant `syntax-table' property.
2134 The value of this property should be either a syntax table, or a cons
2135 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric
2136 syntax code, MATCHCHAR being nil or the character to match (which is
2137 relevant only for open/close type.
2138 */ );
2139   lookup_syntax_properties = 1;
2140
2141   DEFVAR_BOOL ("words-include-escapes", &words_include_escapes /*
2142 Non-nil means `forward-word', etc., should treat escape chars part of words.
2143 */ );
2144   words_include_escapes = 0;
2145
2146   no_quit_in_re_search = 0;
2147 }
2148
2149 static void
2150 define_standard_syntax (const char *p, enum syntaxcode syn)
2151 {
2152   for (; *p; p++)
2153     Fput_char_table (make_char (*p), make_int (syn), Vstandard_syntax_table);
2154 }
2155
2156 void
2157 complex_vars_of_syntax (void)
2158 {
2159   Emchar i;
2160   const char *p;
2161   /* Set this now, so first buffer creation can refer to it. */
2162   /* Make it nil before calling copy-syntax-table
2163      so that copy-syntax-table will know not to try to copy from garbage */
2164   Vstandard_syntax_table = Qnil;
2165   Vstandard_syntax_table = Fcopy_syntax_table (Qnil);
2166   staticpro (&Vstandard_syntax_table);
2167
2168   Vsyntax_designator_chars_string = make_string_nocopy (syntax_code_spec,
2169                                                         Smax);
2170   staticpro (&Vsyntax_designator_chars_string);
2171
2172   fill_char_table (XCHAR_TABLE (Vstandard_syntax_table), make_int (Spunct));
2173
2174   for (i = 0; i <= 32; i++)     /* Control 0 plus SPACE */
2175     Fput_char_table (make_char (i), make_int (Swhitespace),
2176                      Vstandard_syntax_table);
2177   for (i = 127; i <= 159; i++)  /* DEL plus Control 1 */
2178     Fput_char_table (make_char (i), make_int (Swhitespace),
2179                      Vstandard_syntax_table);
2180
2181   define_standard_syntax ("abcdefghijklmnopqrstuvwxyz"
2182                           "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
2183                           "0123456789"
2184                           "$%", Sword);
2185   define_standard_syntax ("\"", Sstring);
2186   define_standard_syntax ("\\", Sescape);
2187   define_standard_syntax ("_-+*/&|<>=", Ssymbol);
2188   define_standard_syntax (".,;:?!#@~^'`", Spunct);
2189
2190   for (p = "()[]{}"; *p; p+=2)
2191     {
2192       Fput_char_table (make_char (p[0]),
2193                        Fcons (make_int (Sopen), make_char (p[1])),
2194                        Vstandard_syntax_table);
2195       Fput_char_table (make_char (p[1]),
2196                        Fcons (make_int (Sclose), make_char (p[0])),
2197                        Vstandard_syntax_table);
2198     }
2199 }