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