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