![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to syntax.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / src|
Return to syntax.c CVS log | Up to [Apple XNU] / GNUtools / emacs / src |
1.1 ! root 1: /* GNU Emacs routines to deal with syntax tables; also word and list parsing. ! 2: Copyright (C) 1985, 1987, 1990 Free Software Foundation, Inc. ! 3: ! 4: This file is part of GNU Emacs. ! 5: ! 6: GNU Emacs is free software; you can redistribute it and/or modify ! 7: it under the terms of the GNU General Public License as published by ! 8: the Free Software Foundation; either version 1, or (at your option) ! 9: any later version. ! 10: ! 11: GNU Emacs is distributed in the hope that it will be useful, ! 12: but WITHOUT ANY WARRANTY; without even the implied warranty of ! 13: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! 14: GNU General Public License for more details. ! 15: ! 16: You should have received a copy of the GNU General Public License ! 17: along with GNU Emacs; see the file COPYING. If not, write to ! 18: the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ ! 19: ! 20: ! 21: #include "config.h" ! 22: #include <ctype.h> ! 23: #include "lisp.h" ! 24: #include "commands.h" ! 25: #include "buffer.h" ! 26: #include "syntax.h" ! 27: ! 28: Lisp_Object Qsyntax_table_p; ! 29: ! 30: DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0, ! 31: "Return t if ARG is a syntax table.\n\ ! 32: Any vector of 256 elements will do.") ! 33: (obj) ! 34: Lisp_Object obj; ! 35: { ! 36: if (XTYPE (obj) == Lisp_Vector && XVECTOR (obj)->size == 0400) ! 37: return Qt; ! 38: return Qnil; ! 39: } ! 40: ! 41: Lisp_Object ! 42: check_syntax_table (obj) ! 43: Lisp_Object obj; ! 44: { ! 45: register Lisp_Object tem; ! 46: while (tem = Fsyntax_table_p (obj), ! 47: NULL (tem)) ! 48: obj = wrong_type_argument (Qsyntax_table_p, obj, 0); ! 49: return obj; ! 50: } ! 51: ! 52: ! 53: DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0, ! 54: "Return the current syntax table.\n\ ! 55: This is the one specified by the current buffer.") ! 56: () ! 57: { ! 58: return current_buffer->syntax_table; ! 59: } ! 60: ! 61: DEFUN ("standard-syntax-table", Fstandard_syntax_table, ! 62: Sstandard_syntax_table, 0, 0, 0, ! 63: "Return the standard syntax table.\n\ ! 64: This is the one used for new buffers.") ! 65: () ! 66: { ! 67: return Vstandard_syntax_table; ! 68: } ! 69: ! 70: DEFUN ("copy-syntax-table", Fcopy_syntax_table, Scopy_syntax_table, 0, 1, 0, ! 71: "Construct a new syntax table and return it.\n\ ! 72: It is a copy of the TABLE, which defaults to the standard syntax table.") ! 73: (table) ! 74: Lisp_Object table; ! 75: { ! 76: Lisp_Object size, val; ! 77: XFASTINT (size) = 0400; ! 78: XFASTINT (val) = 0; ! 79: val = Fmake_vector (size, val); ! 80: if (!NULL (table)) ! 81: table = check_syntax_table (table); ! 82: else if (NULL (Vstandard_syntax_table)) ! 83: /* Can only be null during initialization */ ! 84: return val; ! 85: else table = Vstandard_syntax_table; ! 86: ! 87: bcopy (XVECTOR (table)->contents, ! 88: XVECTOR (val)->contents, 0400 * sizeof (Lisp_Object)); ! 89: return val; ! 90: } ! 91: ! 92: DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 1, 0, ! 93: "Select a new syntax table for the current buffer.\n\ ! 94: One argument, a syntax table.") ! 95: (table) ! 96: Lisp_Object table; ! 97: { ! 98: table = check_syntax_table (table); ! 99: current_buffer->syntax_table = table; ! 100: /* Indicate that this buffer now has a specified syntax table. */ ! 101: current_buffer->local_var_flags |= buffer_local_flags.syntax_table; ! 102: return table; ! 103: } ! 104: ! 105: /* Convert a letter which signifies a syntax code ! 106: into the code it signifies. ! 107: This is used by modify-syntax-entry, and other things. */ ! 108: ! 109: unsigned char syntax_spec_code[0400] = ! 110: { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, ! 111: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, ! 112: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, ! 113: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, ! 114: (char) Swhitespace, 0377, (char) Sstring, 0377, ! 115: (char) Smath, 0377, 0377, (char) Squote, ! 116: (char) Sopen, (char) Sclose, 0377, 0377, ! 117: 0377, (char) Swhitespace, (char) Spunct, (char) Scharquote, ! 118: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, ! 119: 0377, 0377, 0377, 0377, ! 120: (char) Scomment, 0377, (char) Sendcomment, 0377, ! 121: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A, ... */ ! 122: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, ! 123: 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword, ! 124: 0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol, ! 125: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */ ! 126: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, ! 127: 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword, ! 128: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377 ! 129: }; ! 130: ! 131: /* Indexed by syntax code, give the letter that describes it. */ ! 132: ! 133: char syntax_code_spec[13] = ! 134: { ! 135: ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>' ! 136: }; ! 137: ! 138: DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0, ! 139: "Return the syntax code of CHAR, described by a character.\n\ ! 140: For example, if CHAR is a word constituent, ?w is returned.\n\ ! 141: The characters that correspond to various syntax codes\n\ ! 142: are listed in the documentation of modify-syntax-entry.") ! 143: (ch) ! 144: Lisp_Object ch; ! 145: { ! 146: CHECK_NUMBER (ch, 0); ! 147: return make_number (syntax_code_spec[(int) SYNTAX (0xFF & XINT (ch))]); ! 148: } ! 149: ! 150: /* This comment supplies the doc string for modify-syntax-entry, ! 151: for make-docfile to see. We cannot put this in the real DEFUN ! 152: due to limits in the Unix cpp. ! 153: ! 154: DEFUN ("modify-syntax-entry", foo, bar, 0, 0, 0, ! 155: "Set syntax for character CHAR according to string S.\n\ ! 156: The syntax is changed only for table TABLE, which defaults to\n\ ! 157: the current buffer's syntax table.\n\ ! 158: The first character of S should be one of the following:\n\ ! 159: Space or - whitespace syntax. w word constituent.\n\ ! 160: _ symbol constituent. . punctuation.\n\ ! 161: ( open-parenthesis. ) close-parenthesis.\n\ ! 162: \" string quote. \\ escape character.\n\ ! 163: $ paired delimiter. ' expression prefix operator.\n\ ! 164: < comment starter. > comment ender.\n\ ! 165: / character quote.\n\ ! 166: Only single-character comment start and end sequences are represented thus.\n\ ! 167: Two-character sequences are represented as described below.\n\ ! 168: The second character of S is the matching parenthesis,\n\ ! 169: used only if the first character is ( or ).\n\ ! 170: Any additional characters are flags.\n\ ! 171: Defined flags are the characters 1, 2, 3 and 4.\n\ ! 172: 1 means C is the start of a two-char comment start sequence.\n\ ! 173: 2 means C is the second character of such a sequence.\n\ ! 174: 3 means C is the start of a two-char comment end sequence.\n\ ! 175: 4 means C is the second character of such a sequence.") ! 176: ! 177: */ ! 178: ! 179: DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3, ! 180: /* I really don't know why this is interactive ! 181: help-form should at least be made useful whilst reading the second arg ! 182: */ ! 183: "cSet syntax for character: \nsSet syntax for %s to: ", ! 184: 0 /* See immediately above */) ! 185: (c, newentry, syntax_table) ! 186: Lisp_Object c, newentry, syntax_table; ! 187: { ! 188: register unsigned char *p, match; ! 189: register enum syntaxcode code; ! 190: Lisp_Object val; ! 191: ! 192: CHECK_NUMBER (c, 0); ! 193: CHECK_STRING (newentry, 1); ! 194: if (NULL (syntax_table)) ! 195: syntax_table = current_buffer->syntax_table; ! 196: else ! 197: syntax_table = check_syntax_table (syntax_table); ! 198: ! 199: p = XSTRING (newentry)->data; ! 200: code = (enum syntaxcode) syntax_spec_code[*p++]; ! 201: if (((int) code & 0377) == 0377) ! 202: error ("invalid syntax description letter: %c", c); ! 203: ! 204: match = *p; ! 205: if (match) p++; ! 206: if (match == ' ') match = 0; ! 207: ! 208: XFASTINT (val) = (match << 8) + (int) code; ! 209: while (*p) ! 210: switch (*p++) ! 211: { ! 212: case '1': ! 213: XFASTINT (val) |= 1 << 16; ! 214: break; ! 215: ! 216: case '2': ! 217: XFASTINT (val) |= 1 << 17; ! 218: break; ! 219: ! 220: case '3': ! 221: XFASTINT (val) |= 1 << 18; ! 222: break; ! 223: ! 224: case '4': ! 225: XFASTINT (val) |= 1 << 19; ! 226: break; ! 227: } ! 228: ! 229: XVECTOR (syntax_table)->contents[0xFF & XINT (c)] = val; ! 230: ! 231: return Qnil; ! 232: } ! 233: ! 234: /* Dump syntax table to buffer in human-readable format */ ! 235: ! 236: describe_syntax (value) ! 237: Lisp_Object value; ! 238: { ! 239: register enum syntaxcode code; ! 240: char desc, match, start1, start2, end1, end2; ! 241: char str[2]; ! 242: ! 243: Findent_to (make_number (16), make_number (1)); ! 244: ! 245: if (XTYPE (value) != Lisp_Int) ! 246: { ! 247: InsStr ("invalid"); ! 248: return; ! 249: } ! 250: ! 251: code = (enum syntaxcode) (XINT (value) & 0377); ! 252: match = (XINT (value) >> 8) & 0377; ! 253: start1 = (XINT (value) >> 16) & 1; ! 254: start2 = (XINT (value) >> 17) & 1; ! 255: end1 = (XINT (value) >> 18) & 1; ! 256: end2 = (XINT (value) >> 19) & 1; ! 257: ! 258: if ((int) code < 0 || (int) code >= (int) Smax) ! 259: { ! 260: InsStr ("invalid"); ! 261: return; ! 262: } ! 263: desc = syntax_code_spec[(int) code]; ! 264: ! 265: str[0] = desc, str[1] = 0; ! 266: insert (str, 1); ! 267: ! 268: str[0] = match ? match : ' '; ! 269: insert (str, 1); ! 270: ! 271: ! 272: if (start1) ! 273: insert ("1", 1); ! 274: if (start2) ! 275: insert ("2", 1); ! 276: ! 277: if (end1) ! 278: insert ("3", 1); ! 279: if (end2) ! 280: insert ("4", 1); ! 281: ! 282: InsStr ("\twhich means: "); ! 283: ! 284: #ifdef SWITCH_ENUM_BUG ! 285: switch ((int) code) ! 286: #else ! 287: switch (code) ! 288: #endif ! 289: { ! 290: case Swhitespace: ! 291: InsStr ("whitespace"); break; ! 292: case Spunct: ! 293: InsStr ("punctuation"); break; ! 294: case Sword: ! 295: InsStr ("word"); break; ! 296: case Ssymbol: ! 297: InsStr ("symbol"); break; ! 298: case Sopen: ! 299: InsStr ("open"); break; ! 300: case Sclose: ! 301: InsStr ("close"); break; ! 302: case Squote: ! 303: InsStr ("quote"); break; ! 304: case Sstring: ! 305: InsStr ("string"); break; ! 306: case Smath: ! 307: InsStr ("math"); break; ! 308: case Sescape: ! 309: InsStr ("escape"); break; ! 310: case Scharquote: ! 311: InsStr ("charquote"); break; ! 312: case Scomment: ! 313: InsStr ("comment"); break; ! 314: case Sendcomment: ! 315: InsStr ("endcomment"); break; ! 316: default: ! 317: InsStr ("invalid"); ! 318: return; ! 319: } ! 320: ! 321: if (match) ! 322: { ! 323: InsStr (", matches "); ! 324: ! 325: str[0] = match, str[1] = 0; ! 326: insert (str, 1); ! 327: } ! 328: ! 329: if (start1) ! 330: InsStr (",\n\t is the first character of a comment-start sequence"); ! 331: if (start2) ! 332: InsStr (",\n\t is the second character of a comment-start sequence"); ! 333: ! 334: if (end1) ! 335: InsStr (",\n\t is the first character of a comment-end sequence"); ! 336: if (end2) ! 337: InsStr (",\n\t is the second character of a comment-end sequence"); ! 338: ! 339: InsStr ("\n"); ! 340: } ! 341: ! 342: Lisp_Object ! 343: describe_syntax_1 (vector) ! 344: Lisp_Object vector; ! 345: { ! 346: struct buffer *old = current_buffer; ! 347: set_buffer_internal (XBUFFER (Vstandard_output)); ! 348: describe_vector (vector, Qnil, describe_syntax, 0, Qnil); ! 349: set_buffer_internal (old); ! 350: return Qnil; ! 351: } ! 352: ! 353: DEFUN ("describe-syntax", Fdescribe_syntax, Sdescribe_syntax, 0, 0, "", ! 354: "Describe the syntax specifications in the syntax table.\n\ ! 355: The descriptions are inserted in a buffer, which is selected so you can see it.") ! 356: () ! 357: { ! 358: internal_with_output_to_temp_buffer ! 359: ("*Help*", describe_syntax_1, current_buffer->syntax_table); ! 360: ! 361: return Qnil; ! 362: } ! 363: ! 364: /* Return the position across `count' words from `from'. ! 365: If that many words cannot be found before the end of the buffer, return 0. ! 366: `count' negative means scan backward and stop at word beginning. */ ! 367: ! 368: scan_words (from, count) ! 369: register int from, count; ! 370: { ! 371: register int beg = BEGV; ! 372: register int end = ZV; ! 373: ! 374: immediate_quit = 1; ! 375: QUIT; ! 376: ! 377: while (count > 0) ! 378: { ! 379: while (1) ! 380: { ! 381: if (from == end) ! 382: { ! 383: immediate_quit = 0; ! 384: return 0; ! 385: } ! 386: if (SYNTAX(FETCH_CHAR (from)) == Sword) ! 387: break; ! 388: from++; ! 389: } ! 390: while (1) ! 391: { ! 392: if (from == end) break; ! 393: if (SYNTAX(FETCH_CHAR (from)) != Sword) ! 394: break; ! 395: from++; ! 396: } ! 397: count--; ! 398: } ! 399: while (count < 0) ! 400: { ! 401: while (1) ! 402: { ! 403: if (from == beg) ! 404: { ! 405: immediate_quit = 0; ! 406: return 0; ! 407: } ! 408: if (SYNTAX(FETCH_CHAR (from - 1)) == Sword) ! 409: break; ! 410: from--; ! 411: } ! 412: while (1) ! 413: { ! 414: if (from == beg) break; ! 415: if (SYNTAX(FETCH_CHAR (from - 1)) != Sword) ! 416: break; ! 417: from--; ! 418: } ! 419: count++; ! 420: } ! 421: ! 422: immediate_quit = 0; ! 423: ! 424: return from; ! 425: } ! 426: ! 427: DEFUN ("forward-word", Fforward_word, Sforward_word, 1, 1, "p", ! 428: "Move point forward ARG words (backward if ARG is negative).\n\ ! 429: Normally returns t.\n\ ! 430: If an edge of the buffer is reached, point is left there\n\ ! 431: and nil is returned.") ! 432: (count) ! 433: Lisp_Object count; ! 434: { ! 435: int val; ! 436: CHECK_NUMBER (count, 0); ! 437: ! 438: if (!(val = scan_words (point, XINT (count)))) ! 439: { ! 440: SET_PT (XINT (count) > 0 ? ZV : BEGV); ! 441: return Qnil; ! 442: } ! 443: SET_PT (val); ! 444: return Qt; ! 445: } ! 446: ! 447: int parse_sexp_ignore_comments; ! 448: ! 449: Lisp_Object ! 450: scan_lists (from, count, depth, sexpflag) ! 451: register int from; ! 452: int count, depth, sexpflag; ! 453: { ! 454: Lisp_Object val; ! 455: register int stop; ! 456: register int c; ! 457: char stringterm; ! 458: int quoted; ! 459: int mathexit = 0; ! 460: register enum syntaxcode code; ! 461: int min_depth = depth; /* Err out if depth gets less than this. */ ! 462: ! 463: if (depth > 0) min_depth = 0; ! 464: ! 465: immediate_quit = 1; ! 466: QUIT; ! 467: ! 468: while (count > 0) ! 469: { ! 470: stop = ZV; ! 471: while (from < stop) ! 472: { ! 473: c = FETCH_CHAR (from); ! 474: code = SYNTAX(c); ! 475: from++; ! 476: if (from < stop && SYNTAX_COMSTART_FIRST (c) ! 477: && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from)) ! 478: && parse_sexp_ignore_comments) ! 479: code = Scomment, from++; ! 480: ! 481: #ifdef SWITCH_ENUM_BUG ! 482: switch ((int) code) ! 483: #else ! 484: switch (code) ! 485: #endif ! 486: { ! 487: case Sescape: ! 488: case Scharquote: ! 489: if (from == stop) goto lose; ! 490: from++; ! 491: /* treat following character as a word constituent */ ! 492: case Sword: ! 493: case Ssymbol: ! 494: if (depth || !sexpflag) break; ! 495: /* This word counts as a sexp; return at end of it. */ ! 496: while (from < stop) ! 497: { ! 498: #ifdef SWITCH_ENUM_BUG ! 499: switch ((int) SYNTAX(FETCH_CHAR (from))) ! 500: #else ! 501: switch (SYNTAX(FETCH_CHAR (from))) ! 502: #endif ! 503: { ! 504: case Scharquote: ! 505: case Sescape: ! 506: from++; ! 507: if (from == stop) goto lose; ! 508: break; ! 509: case Sword: ! 510: case Ssymbol: ! 511: case Squote: ! 512: break; ! 513: default: ! 514: goto done; ! 515: } ! 516: from++; ! 517: } ! 518: goto done; ! 519: ! 520: case Scomment: ! 521: if (!parse_sexp_ignore_comments) break; ! 522: while (1) ! 523: { ! 524: if (from == stop) goto done; ! 525: if (SYNTAX (c = FETCH_CHAR (from)) == Sendcomment) ! 526: break; ! 527: from++; ! 528: if (from < stop && SYNTAX_COMEND_FIRST (c) ! 529: && SYNTAX_COMEND_SECOND (FETCH_CHAR (from))) ! 530: { from++; break; } ! 531: } ! 532: break; ! 533: ! 534: case Smath: ! 535: if (!sexpflag) ! 536: break; ! 537: if (from != stop && c == FETCH_CHAR (from)) ! 538: from++; ! 539: if (mathexit) ! 540: { ! 541: mathexit = 0; ! 542: goto close1; ! 543: } ! 544: mathexit = 1; ! 545: ! 546: case Sopen: ! 547: if (!++depth) goto done; ! 548: break; ! 549: ! 550: case Sclose: ! 551: close1: ! 552: if (!--depth) goto done; ! 553: if (depth < min_depth) ! 554: error ("Containing expression ends prematurely"); ! 555: break; ! 556: ! 557: case Sstring: ! 558: stringterm = FETCH_CHAR (from - 1); ! 559: while (1) ! 560: { ! 561: if (from >= stop) goto lose; ! 562: if (FETCH_CHAR (from) == stringterm) break; ! 563: #ifdef SWITCH_ENUM_BUG ! 564: switch ((int) SYNTAX(FETCH_CHAR (from))) ! 565: #else ! 566: switch (SYNTAX(FETCH_CHAR (from))) ! 567: #endif ! 568: { ! 569: case Scharquote: ! 570: case Sescape: ! 571: from++; ! 572: } ! 573: from++; ! 574: } ! 575: from++; ! 576: if (!depth && sexpflag) goto done; ! 577: break; ! 578: } ! 579: } ! 580: ! 581: /* Reached end of buffer. Error if within object, return nil if between */ ! 582: if (depth) goto lose; ! 583: ! 584: immediate_quit = 0; ! 585: return Qnil; ! 586: ! 587: /* End of object reached */ ! 588: done: ! 589: count--; ! 590: } ! 591: ! 592: while (count < 0) ! 593: { ! 594: stop = BEGV; ! 595: while (from > stop) ! 596: { ! 597: from--; ! 598: if (quoted = char_quoted (from)) ! 599: from--; ! 600: c = FETCH_CHAR (from); ! 601: code = SYNTAX (c); ! 602: if (from > stop && SYNTAX_COMEND_SECOND (c) ! 603: && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1)) ! 604: && !char_quoted (from - 1) ! 605: && parse_sexp_ignore_comments) ! 606: code = Sendcomment, from--; ! 607: ! 608: #ifdef SWITCH_ENUM_BUG ! 609: switch ((int) (quoted ? Sword : code)) ! 610: #else ! 611: switch (quoted ? Sword : code) ! 612: #endif ! 613: { ! 614: case Sword: ! 615: case Ssymbol: ! 616: if (depth || !sexpflag) break; ! 617: /* This word counts as a sexp; count object finished after passing it. */ ! 618: while (from > stop) ! 619: { ! 620: if (quoted = char_quoted (from - 1)) ! 621: from--; ! 622: if (! (quoted || SYNTAX(FETCH_CHAR (from - 1)) == Sword || ! 623: SYNTAX(FETCH_CHAR (from - 1)) == Ssymbol || ! 624: SYNTAX(FETCH_CHAR (from - 1)) == Squote)) ! 625: goto done2; ! 626: from--; ! 627: } ! 628: goto done2; ! 629: ! 630: case Smath: ! 631: if (!sexpflag) ! 632: break; ! 633: if (from != stop && c == FETCH_CHAR (from - 1)) ! 634: from--; ! 635: if (mathexit) ! 636: { ! 637: mathexit = 0; ! 638: goto open2; ! 639: } ! 640: mathexit = 1; ! 641: ! 642: case Sclose: ! 643: if (!++depth) goto done2; ! 644: break; ! 645: ! 646: case Sopen: ! 647: open2: ! 648: if (!--depth) goto done2; ! 649: if (depth < min_depth) ! 650: error ("Containing expression ends prematurely"); ! 651: break; ! 652: ! 653: case Sendcomment: ! 654: if (!parse_sexp_ignore_comments) break; ! 655: if (from != stop) from--; ! 656: while (1) ! 657: { ! 658: if (SYNTAX (c = FETCH_CHAR (from)) == Scomment) ! 659: break; ! 660: if (from == stop) goto done; ! 661: from--; ! 662: if (SYNTAX_COMSTART_SECOND (c) ! 663: && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from)) ! 664: && !char_quoted (from)) ! 665: break; ! 666: } ! 667: break; ! 668: ! 669: case Sstring: ! 670: stringterm = FETCH_CHAR (from); ! 671: while (1) ! 672: { ! 673: if (from == stop) goto lose; ! 674: if (!char_quoted (from - 1) ! 675: && stringterm == FETCH_CHAR (from - 1)) ! 676: break; ! 677: from--; ! 678: } ! 679: from--; ! 680: if (!depth && sexpflag) goto done2; ! 681: break; ! 682: } ! 683: } ! 684: ! 685: /* Reached start of buffer. Error if within object, return nil if between */ ! 686: if (depth) goto lose; ! 687: ! 688: immediate_quit = 0; ! 689: return Qnil; ! 690: ! 691: done2: ! 692: count++; ! 693: } ! 694: ! 695: ! 696: immediate_quit = 0; ! 697: XFASTINT (val) = from; ! 698: return val; ! 699: ! 700: lose: ! 701: error ("Unbalanced parentheses"); ! 702: /* NOTREACHED */ ! 703: } ! 704: ! 705: char_quoted (pos) ! 706: register int pos; ! 707: { ! 708: register enum syntaxcode code; ! 709: register int beg = BEGV; ! 710: register int quoted = 0; ! 711: ! 712: while (pos > beg && ! 713: ((code = SYNTAX (FETCH_CHAR (pos - 1))) == Scharquote ! 714: || code == Sescape)) ! 715: pos--, quoted = !quoted; ! 716: return quoted; ! 717: } ! 718: ! 719: DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0, ! 720: "Scan from character number FROM by COUNT lists.\n\ ! 721: Returns the character number of the position thus found.\n\ ! 722: \n\ ! 723: If DEPTH is nonzero, paren depth begins counting from that value,\n\ ! 724: only places where the depth in parentheses becomes zero\n\ ! 725: are candidates for stopping; COUNT such places are counted.\n\ ! 726: Thus, a positive value for DEPTH means go out levels.\n\ ! 727: \n\ ! 728: Comments are ignored if parse-sexp-ignore-comments is non-nil.\n\ ! 729: \n\ ! 730: If the beginning or end of (the visible part of) the buffer is reached\n\ ! 731: and the depth is wrong, an error is signaled.\n\ ! 732: If the depth is right but the count is not used up, nil is returned.") ! 733: (from, count, depth) ! 734: Lisp_Object from, count, depth; ! 735: { ! 736: CHECK_NUMBER (from, 0); ! 737: CHECK_NUMBER (count, 1); ! 738: CHECK_NUMBER (depth, 2); ! 739: ! 740: return scan_lists (XINT (from), XINT (count), XINT (depth), 0); ! 741: } ! 742: ! 743: DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0, ! 744: "Scan from character number FROM by COUNT balanced expressions.\n\ ! 745: Returns the character number of the position thus found.\n\ ! 746: \n\ ! 747: Comments are ignored if parse-sexp-ignore-comments is non-nil.\n\ ! 748: \n\ ! 749: If the beginning or end of (the visible part of) the buffer is reached\n\ ! 750: in the middle of a parenthetical grouping, an error is signaled.\n\ ! 751: If the beginning or end is reached between groupings but before count is used up,\n\ ! 752: nil is returned.") ! 753: (from, count) ! 754: Lisp_Object from, count; ! 755: { ! 756: CHECK_NUMBER (from, 0); ! 757: CHECK_NUMBER (count, 1); ! 758: ! 759: return scan_lists (XINT (from), XINT (count), 0, 1); ! 760: } ! 761: ! 762: DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars, ! 763: 0, 0, 0, ! 764: "Move point backward over any number of chars with syntax \"prefix\".") ! 765: () ! 766: { ! 767: int beg = BEGV; ! 768: int pos = point; ! 769: ! 770: while (pos > beg && !char_quoted (pos - 1) && SYNTAX (FETCH_CHAR (pos - 1)) == Squote) ! 771: pos--; ! 772: ! 773: SET_PT (pos); ! 774: ! 775: return Qnil; ! 776: } ! 777: ! 778: struct lisp_parse_state ! 779: { ! 780: int depth; /* Depth at end of parsing */ ! 781: int instring; /* -1 if not within string, else desired terminator. */ ! 782: int incomment; /* Nonzero if within a comment at end of parsing */ ! 783: int quoted; /* Nonzero if just after an escape char at end of parsing */ ! 784: int thislevelstart; /* Char number of most recent start-of-expression at current level */ ! 785: int prevlevelstart; /* Char number of start of containing expression */ ! 786: int location; /* Char number at which parsing stopped. */ ! 787: int mindepth; /* Minimum depth seen while scanning. */ ! 788: }; ! 789: ! 790: /* Parse forward from FROM to END, ! 791: assuming that FROM is the start of a function, ! 792: and return a description of the state of the parse at END. */ ! 793: ! 794: struct lisp_parse_state val_scan_sexps_forward; ! 795: ! 796: struct lisp_parse_state * ! 797: scan_sexps_forward (from, end, targetdepth, stopbefore, oldstate) ! 798: register int from; ! 799: int end, targetdepth, stopbefore; ! 800: Lisp_Object oldstate; ! 801: { ! 802: struct lisp_parse_state state; ! 803: ! 804: register enum syntaxcode code; ! 805: struct level { int last, prev; }; ! 806: struct level levelstart[100]; ! 807: register struct level *curlevel = levelstart; ! 808: struct level *endlevel = levelstart + 100; ! 809: char prev; ! 810: register int depth; /* Paren depth of current scanning location. ! 811: level - levelstart equals this except ! 812: when the depth becomes negative. */ ! 813: int mindepth; /* Lowest DEPTH value seen. */ ! 814: int start_quoted = 0; /* Nonzero means starting after a char quote */ ! 815: Lisp_Object tem; ! 816: ! 817: immediate_quit = 1; ! 818: QUIT; ! 819: ! 820: if (NULL (oldstate)) ! 821: { ! 822: depth = 0; ! 823: state.instring = -1; ! 824: state.incomment = 0; ! 825: } ! 826: else ! 827: { ! 828: tem = Fcar (oldstate); ! 829: if (!NULL (tem)) ! 830: depth = XINT (tem); ! 831: else ! 832: depth = 0; ! 833: ! 834: oldstate = Fcdr (oldstate); ! 835: oldstate = Fcdr (oldstate); ! 836: oldstate = Fcdr (oldstate); ! 837: tem = Fcar (oldstate); ! 838: state.instring = !NULL (tem) ? XINT (tem) : -1; ! 839: ! 840: oldstate = Fcdr (oldstate); ! 841: tem = Fcar (oldstate); ! 842: state.incomment = !NULL (tem); ! 843: ! 844: oldstate = Fcdr (oldstate); ! 845: tem = Fcar (oldstate); ! 846: start_quoted = !NULL (tem); ! 847: } ! 848: state.quoted = 0; ! 849: mindepth = depth; ! 850: ! 851: curlevel->prev = -1; ! 852: curlevel->last = -1; ! 853: ! 854: /* Enter the loop at a place appropriate for initial state. */ ! 855: ! 856: if (state.incomment) goto startincomment; ! 857: if (state.instring >= 0) ! 858: { ! 859: if (start_quoted) goto startquotedinstring; ! 860: goto startinstring; ! 861: } ! 862: if (start_quoted) goto startquoted; ! 863: ! 864: while (from < end) ! 865: { ! 866: code = SYNTAX(FETCH_CHAR (from)); ! 867: from++; ! 868: if (from < end && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from - 1)) ! 869: && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from))) ! 870: code = Scomment, from++; ! 871: #ifdef SWITCH_ENUM_BUG ! 872: switch ((int) code) ! 873: #else ! 874: switch (code) ! 875: #endif ! 876: { ! 877: case Sescape: ! 878: case Scharquote: ! 879: if (stopbefore) goto stop; /* this arg means stop at sexp start */ ! 880: curlevel->last = from - 1; ! 881: startquoted: ! 882: if (from == end) goto endquoted; ! 883: from++; ! 884: goto symstarted; ! 885: /* treat following character as a word constituent */ ! 886: case Sword: ! 887: case Ssymbol: ! 888: if (stopbefore) goto stop; /* this arg means stop at sexp start */ ! 889: curlevel->last = from - 1; ! 890: symstarted: ! 891: while (from < end) ! 892: { ! 893: #ifdef SWITCH_ENUM_BUG ! 894: switch ((int) SYNTAX(FETCH_CHAR (from))) ! 895: #else ! 896: switch (SYNTAX(FETCH_CHAR (from))) ! 897: #endif ! 898: { ! 899: case Scharquote: ! 900: case Sescape: ! 901: from++; ! 902: if (from == end) goto endquoted; ! 903: break; ! 904: case Sword: ! 905: case Ssymbol: ! 906: case Squote: ! 907: break; ! 908: default: ! 909: goto symdone; ! 910: } ! 911: from++; ! 912: } ! 913: symdone: ! 914: curlevel->prev = curlevel->last; ! 915: break; ! 916: ! 917: case Scomment: ! 918: state.incomment = 1; ! 919: startincomment: ! 920: while (1) ! 921: { ! 922: if (from == end) goto done; ! 923: if (SYNTAX (prev = FETCH_CHAR (from)) == Sendcomment) ! 924: break; ! 925: from++; ! 926: if (from < end && SYNTAX_COMEND_FIRST (prev) ! 927: && SYNTAX_COMEND_SECOND (FETCH_CHAR (from))) ! 928: { from++; break; } ! 929: } ! 930: state.incomment = 0; ! 931: break; ! 932: ! 933: case Sopen: ! 934: if (stopbefore) goto stop; /* this arg means stop at sexp start */ ! 935: depth++; ! 936: /* curlevel++->last ran into compiler bug on Apollo */ ! 937: curlevel->last = from - 1; ! 938: if (++curlevel == endlevel) ! 939: error ("Nesting too deep for parser"); ! 940: curlevel->prev = -1; ! 941: curlevel->last = -1; ! 942: if (!--targetdepth) goto done; ! 943: break; ! 944: ! 945: case Sclose: ! 946: depth--; ! 947: if (depth < mindepth) ! 948: mindepth = depth; ! 949: if (curlevel != levelstart) ! 950: curlevel--; ! 951: curlevel->prev = curlevel->last; ! 952: if (!++targetdepth) goto done; ! 953: break; ! 954: ! 955: case Sstring: ! 956: if (stopbefore) goto stop; /* this arg means stop at sexp start */ ! 957: curlevel->last = from - 1; ! 958: state.instring = FETCH_CHAR (from - 1); ! 959: startinstring: ! 960: while (1) ! 961: { ! 962: if (from >= end) goto done; ! 963: if (FETCH_CHAR (from) == state.instring) break; ! 964: #ifdef SWITCH_ENUM_BUG ! 965: switch ((int) SYNTAX(FETCH_CHAR (from))) ! 966: #else ! 967: switch (SYNTAX(FETCH_CHAR (from))) ! 968: #endif ! 969: { ! 970: case Scharquote: ! 971: case Sescape: ! 972: from++; ! 973: startquotedinstring: ! 974: if (from >= end) goto endquoted; ! 975: } ! 976: from++; ! 977: } ! 978: state.instring = -1; ! 979: curlevel->prev = curlevel->last; ! 980: from++; ! 981: break; ! 982: ! 983: case Smath: ! 984: break; ! 985: } ! 986: } ! 987: goto done; ! 988: ! 989: stop: /* Here if stopping before start of sexp. */ ! 990: from--; /* We have just fetched the char that starts it; */ ! 991: goto done; /* but return the position before it. */ ! 992: ! 993: endquoted: ! 994: state.quoted = 1; ! 995: done: ! 996: state.depth = depth; ! 997: state.mindepth = mindepth; ! 998: state.thislevelstart = curlevel->prev; ! 999: state.prevlevelstart ! 1000: = (curlevel == levelstart) ? -1 : (curlevel - 1)->last; ! 1001: state.location = from; ! 1002: immediate_quit = 0; ! 1003: ! 1004: val_scan_sexps_forward = state; ! 1005: return &val_scan_sexps_forward; ! 1006: } ! 1007: ! 1008: /* This comment supplies the doc string for parse-partial-sexp, ! 1009: for make-docfile to see. We cannot put this in the real DEFUN ! 1010: due to limits in the Unix cpp. ! 1011: ! 1012: DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 0, 0, 0, ! 1013: "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\ ! 1014: Parsing stops at TO or when certain criteria are met;\n\ ! 1015: point is set to where parsing stops.\n\ ! 1016: If fifth arg STATE is omitted or nil,\n\ ! 1017: parsing assumes that FROM is the beginning of a function.\n\ ! 1018: Value is a list of seven elements describing final state of parsing:\n\ ! 1019: 1. depth in parens.\n\ ! 1020: 2. character address of start of innermost containing list; nil if none.\n\ ! 1021: 3. character address of start of last complete sexp terminated.\n\ ! 1022: 4. non-nil if inside a string.\n\ ! 1023: (it is the character that will terminate the string.)\n\ ! 1024: 5. t if inside a comment.\n\ ! 1025: 6. t if following a quote character.\n\ ! 1026: 7. the minimum paren-depth encountered during this scan.\n\ ! 1027: If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\ ! 1028: in parentheses becomes equal to TARGETDEPTH.\n\ ! 1029: Fourth arg STOPBEFORE non-nil means stop when come to\n\ ! 1030: any character that starts a sexp.\n\ ! 1031: Fifth arg STATE is a seven-list like what this function returns.\n\ ! 1032: It is used to initialize the state of the parse.") ! 1033: ! 1034: */ ! 1035: ! 1036: DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 5, 0, ! 1037: 0 /* See immediately above */) ! 1038: (from, to, targetdepth, stopbefore, oldstate) ! 1039: Lisp_Object from, to, targetdepth, stopbefore, oldstate; ! 1040: { ! 1041: struct lisp_parse_state state; ! 1042: int target; ! 1043: ! 1044: if (!NULL (targetdepth)) ! 1045: { ! 1046: CHECK_NUMBER (targetdepth, 3); ! 1047: target = XINT (targetdepth); ! 1048: } ! 1049: else ! 1050: target = -100000; /* We won't reach this depth */ ! 1051: ! 1052: validate_region (&from, &to); ! 1053: state = *scan_sexps_forward (XINT (from), XINT (to), ! 1054: target, !NULL (stopbefore), oldstate); ! 1055: ! 1056: SET_PT (state.location); ! 1057: ! 1058: return Fcons (make_number (state.depth), ! 1059: Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart), ! 1060: Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart), ! 1061: Fcons (state.instring >= 0 ? make_number (state.instring) : Qnil, ! 1062: Fcons (state.incomment ? Qt : Qnil, ! 1063: Fcons (state.quoted ? Qt : Qnil, ! 1064: Fcons (make_number (state.mindepth), Qnil))))))); ! 1065: } ! 1066: ! 1067: init_syntax_once () ! 1068: { ! 1069: register int i; ! 1070: register struct Lisp_Vector *v; ! 1071: ! 1072: /* Set this now, so first buffer creation can refer to it. */ ! 1073: /* Make it nil before calling copy-syntax-table ! 1074: so that copy-syntax-table will know not to try to copy from garbage */ ! 1075: Vstandard_syntax_table = Qnil; ! 1076: Vstandard_syntax_table = Fcopy_syntax_table (Qnil); ! 1077: ! 1078: v = XVECTOR (Vstandard_syntax_table); ! 1079: ! 1080: for (i = 'a'; i <= 'z'; i++) ! 1081: XFASTINT (v->contents[i]) = (int) Sword; ! 1082: for (i = 'A'; i <= 'Z'; i++) ! 1083: XFASTINT (v->contents[i]) = (int) Sword; ! 1084: for (i = '0'; i <= '9'; i++) ! 1085: XFASTINT (v->contents[i]) = (int) Sword; ! 1086: XFASTINT (v->contents['$']) = (int) Sword; ! 1087: XFASTINT (v->contents['%']) = (int) Sword; ! 1088: ! 1089: XFASTINT (v->contents['(']) = (int) Sopen + (')' << 8); ! 1090: XFASTINT (v->contents[')']) = (int) Sclose + ('(' << 8); ! 1091: XFASTINT (v->contents['[']) = (int) Sopen + (']' << 8); ! 1092: XFASTINT (v->contents[']']) = (int) Sclose + ('[' << 8); ! 1093: XFASTINT (v->contents['{']) = (int) Sopen + ('}' << 8); ! 1094: XFASTINT (v->contents['}']) = (int) Sclose + ('{' << 8); ! 1095: XFASTINT (v->contents['"']) = (int) Sstring; ! 1096: XFASTINT (v->contents['\\']) = (int) Sescape; ! 1097: ! 1098: for (i = 0; i < 10; i++) ! 1099: XFASTINT (v->contents["_-+*/&|<>="[i]]) = (int) Ssymbol; ! 1100: ! 1101: for (i = 0; i < 12; i++) ! 1102: XFASTINT (v->contents[".,;:?!#@~^'`"[i]]) = (int) Spunct; ! 1103: } ! 1104: ! 1105: syms_of_syntax () ! 1106: { ! 1107: Qsyntax_table_p = intern ("syntax-table-p"); ! 1108: staticpro (&Qsyntax_table_p); ! 1109: ! 1110: DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments, ! 1111: "Non-nil means forward-sexp, etc., should treat comments as whitespace.\n\ ! 1112: Non-nil works only when the comment terminator is something like *\/,\n\ ! 1113: and appears only when it ends a comment.\n\ ! 1114: If comments are terminated by newlines,\n\ ! 1115: you must make this variable nil."); ! 1116: ! 1117: defsubr (&Ssyntax_table_p); ! 1118: defsubr (&Ssyntax_table); ! 1119: defsubr (&Sstandard_syntax_table); ! 1120: defsubr (&Scopy_syntax_table); ! 1121: defsubr (&Sset_syntax_table); ! 1122: defsubr (&Schar_syntax); ! 1123: defsubr (&Smodify_syntax_entry); ! 1124: defsubr (&Sdescribe_syntax); ! 1125: ! 1126: defsubr (&Sforward_word); ! 1127: ! 1128: defsubr (&Sscan_lists); ! 1129: defsubr (&Sscan_sexps); ! 1130: defsubr (&Sbackward_prefix_chars); ! 1131: defsubr (&Sparse_partial_sexp); ! 1132: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.