![[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] / 43BSDReno / contrib / emacs-18.55 / src|
Return to syntax.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src |
1.1 ! root 1: /* GNU Emacs routines to deal with syntax tables; also word and list parsing. ! 2: Copyright (C) 1985, 1987 Free Software Foundation, Inc. ! 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 (0xFF & XINT (ch))]); ! 151: } ! 152: ! 153: /* This comment supplies the doc string for modify-syntax-entry, ! 154: for make-docfile to see. We cannot put this in the real DEFUN ! 155: due to limits in the Unix cpp. ! 156: ! 157: DEFUN ("modify-syntax-entry", foo, bar, 0, 0, 0, ! 158: "Set syntax for character CHAR according to string S.\n\ ! 159: The syntax is changed only for table TABLE, which defaults to\n\ ! 160: the current buffer's syntax table.\n\ ! 161: The first character of S should be one of the following:\n\ ! 162: Space whitespace syntax. w word constituent.\n\ ! 163: _ symbol constituent. . punctuation.\n\ ! 164: ( open-parenthesis. ) close-parenthesis.\n\ ! 165: \" string quote. \\ character-quote.\n\ ! 166: $ paired delimiter. ' expression prefix operator.\n\ ! 167: < comment starter. > comment ender.\n\ ! 168: Only single-character comment start and end sequences are represented thus.\n\ ! 169: Two-character sequences are represented as described below.\n\ ! 170: The second character of S is the matching parenthesis,\n\ ! 171: used only if the first character is ( or ).\n\ ! 172: Any additional characters are flags.\n\ ! 173: Defined flags are the characters 1, 2, 3 and 4.\n\ ! 174: 1 means C is the start of a two-char comment start sequence.\n\ ! 175: 2 means C is the second character of such a sequence.\n\ ! 176: 3 means C is the start of a two-char comment end sequence.\n\ ! 177: 4 means C is the second character of such a sequence.") ! 178: ! 179: */ ! 180: ! 181: DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3, ! 182: /* I really don't know why this is interactive ! 183: help-form should at least be made useful whilst reading the second arg ! 184: */ ! 185: "cSet syntax for character: \nsSet syntax for %s to: ", ! 186: 0 /* See immediately above */) ! 187: (c, newentry, syntax_table) ! 188: Lisp_Object c, newentry, syntax_table; ! 189: { ! 190: register unsigned char *p, match; ! 191: register enum syntaxcode code; ! 192: Lisp_Object val; ! 193: ! 194: CHECK_NUMBER (c, 0); ! 195: CHECK_STRING (newentry, 1); ! 196: if (NULL (syntax_table)) ! 197: XSET (syntax_table, Lisp_Vector, bf_cur->syntax_table_v); ! 198: else syntax_table = check_syntax_table (syntax_table); ! 199: ! 200: p = XSTRING (newentry)->data; ! 201: code = (enum syntaxcode) syntax_spec_code[*p++]; ! 202: if (((int) code & 0377) == 0377) ! 203: error ("invalid syntax description letter: %c", c); ! 204: ! 205: match = *p; ! 206: if (match) p++; ! 207: if (match == ' ') match = 0; ! 208: ! 209: XFASTINT (val) = (match << 8) + (int) code; ! 210: while (*p) ! 211: switch (*p++) ! 212: { ! 213: case '1': ! 214: XFASTINT (val) |= 1 << 16; ! 215: break; ! 216: ! 217: case '2': ! 218: XFASTINT (val) |= 1 << 17; ! 219: break; ! 220: ! 221: case '3': ! 222: XFASTINT (val) |= 1 << 18; ! 223: break; ! 224: ! 225: case '4': ! 226: XFASTINT (val) |= 1 << 19; ! 227: break; ! 228: } ! 229: ! 230: XVECTOR (syntax_table)->contents[0xFF & XINT (c)] = val; ! 231: ! 232: return Qnil; ! 233: } ! 234: ! 235: /* Dump syntax table to buffer in human-readable format */ ! 236: ! 237: describe_syntax (value) ! 238: Lisp_Object value; ! 239: { ! 240: register enum syntaxcode code; ! 241: char desc, match, start1, start2, end1, end2; ! 242: char str[2]; ! 243: ! 244: if (XTYPE (value) != Lisp_Int) ! 245: { ! 246: InsStr ("invalid"); ! 247: return; ! 248: } ! 249: ! 250: code = (enum syntaxcode) (XINT (value) & 0377); ! 251: match = (XINT (value) >> 8) & 0377; ! 252: start1 = (XINT (value) >> 16) & 1; ! 253: start2 = (XINT (value) >> 17) & 1; ! 254: end1 = (XINT (value) >> 18) & 1; ! 255: end2 = (XINT (value) >> 19) & 1; ! 256: ! 257: if ((int) code < 0 || (int) code >= (int) Smax) ! 258: { ! 259: InsStr ("invalid"); ! 260: return; ! 261: } ! 262: desc = syntax_code_spec[(int) code]; ! 263: ! 264: str[0] = desc, str[1] = 0; ! 265: InsCStr (str, 1); ! 266: ! 267: str[0] = match ? match : ' '; ! 268: InsCStr (str, 1); ! 269: ! 270: ! 271: if (start1) ! 272: InsCStr ("1", 1); ! 273: if (start2) ! 274: InsCStr ("2", 1); ! 275: ! 276: if (end1) ! 277: InsCStr ("3", 1); ! 278: if (end2) ! 279: InsCStr ("4", 1); ! 280: ! 281: InsStr ("\twhich means: "); ! 282: ! 283: #ifdef SWITCH_ENUM_BUG ! 284: switch ((int) code) ! 285: #else ! 286: switch (code) ! 287: #endif ! 288: { ! 289: case Swhitespace: ! 290: InsStr ("whitespace"); break; ! 291: case Spunct: ! 292: InsStr ("punctuation"); break; ! 293: case Sword: ! 294: InsStr ("word"); break; ! 295: case Ssymbol: ! 296: InsStr ("symbol"); break; ! 297: case Sopen: ! 298: InsStr ("open"); break; ! 299: case Sclose: ! 300: InsStr ("close"); break; ! 301: case Squote: ! 302: InsStr ("quote"); break; ! 303: case Sstring: ! 304: InsStr ("string"); break; ! 305: case Smath: ! 306: InsStr ("math"); break; ! 307: case Sescape: ! 308: InsStr ("escape"); break; ! 309: case Scharquote: ! 310: InsStr ("charquote"); break; ! 311: case Scomment: ! 312: InsStr ("comment"); break; ! 313: case Sendcomment: ! 314: InsStr ("endcomment"); break; ! 315: default: ! 316: InsStr ("invalid"); ! 317: return; ! 318: } ! 319: ! 320: if (match) ! 321: { ! 322: InsStr (", matches "); ! 323: ! 324: str[0] = match, str[1] = 0; ! 325: InsCStr (str, 1); ! 326: } ! 327: ! 328: if (start1) ! 329: InsStr (",\n\t is the first character of a comment-start sequence"); ! 330: if (start2) ! 331: InsStr (",\n\t is the second character of a comment-start sequence"); ! 332: ! 333: if (end1) ! 334: InsStr (",\n\t is the first character of a comment-end sequence"); ! 335: if (end2) ! 336: InsStr (",\n\t is the second character of a comment-end sequence"); ! 337: } ! 338: ! 339: Lisp_Object ! 340: describe_syntax_1 (vector) ! 341: Lisp_Object vector; ! 342: { ! 343: struct buffer *old = bf_cur; ! 344: SetBfp (XBUFFER (Vstandard_output)); ! 345: describe_vector (vector, Qnil, describe_syntax, 0, Qnil); ! 346: SetBfp (old); ! 347: return Qnil; ! 348: } ! 349: ! 350: DEFUN ("describe-syntax", Fdescribe_syntax, Sdescribe_syntax, 0, 0, "", ! 351: "Describe the syntax specifications in the syntax table.\n\ ! 352: The descriptions are inserted in a buffer, which is selected so you can see it.") ! 353: () ! 354: { ! 355: register Lisp_Object vector; ! 356: ! 357: XSET (vector, Lisp_Vector, bf_cur->syntax_table_v); ! 358: internal_with_output_to_temp_buffer ! 359: ("*Help*", describe_syntax_1, vector); ! 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 = FirstCharacter; ! 372: register int end = NumCharacters + 1; ! 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(CharAt (from)) == Sword) ! 387: break; ! 388: from++; ! 389: } ! 390: while (1) ! 391: { ! 392: if (from == end) break; ! 393: if (SYNTAX(CharAt (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(CharAt (from - 1)) == Sword) ! 409: break; ! 410: from--; ! 411: } ! 412: while (1) ! 413: { ! 414: if (from == beg) break; ! 415: if (SYNTAX(CharAt (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: SetPoint (XINT (count) > 0 ? NumCharacters + 1 : FirstCharacter); ! 441: return Qnil; ! 442: } ! 443: SetPoint (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 = NumCharacters + 1; ! 471: while (from < stop) ! 472: { ! 473: c = CharAt (from); ! 474: code = SYNTAX(c); ! 475: from++; ! 476: if (from < stop && SYNTAX_COMSTART_FIRST (c) ! 477: && SYNTAX_COMSTART_SECOND (CharAt (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(CharAt (from))) ! 500: #else ! 501: switch (SYNTAX(CharAt (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: break; ! 512: default: ! 513: goto done; ! 514: } ! 515: from++; ! 516: } ! 517: goto done; ! 518: ! 519: case Scomment: ! 520: if (!parse_sexp_ignore_comments) break; ! 521: while (1) ! 522: { ! 523: if (from == stop) goto done; ! 524: if (SYNTAX (c = CharAt (from)) == Sendcomment) ! 525: break; ! 526: from++; ! 527: if (from < stop && SYNTAX_COMEND_FIRST (c) ! 528: && SYNTAX_COMEND_SECOND (CharAt (from))) ! 529: { from++; break; } ! 530: } ! 531: break; ! 532: ! 533: case Smath: ! 534: if (!sexpflag) ! 535: break; ! 536: if (from != stop && c == CharAt (from)) ! 537: from++; ! 538: if (mathexit) ! 539: { ! 540: mathexit = 0; ! 541: goto close1; ! 542: } ! 543: mathexit = 1; ! 544: ! 545: case Sopen: ! 546: if (!++depth) goto done; ! 547: break; ! 548: ! 549: case Sclose: ! 550: close1: ! 551: if (!--depth) goto done; ! 552: if (depth < min_depth) ! 553: error ("Containing expression ends prematurely"); ! 554: break; ! 555: ! 556: case Sstring: ! 557: stringterm = CharAt (from - 1); ! 558: while (1) ! 559: { ! 560: if (from >= stop) goto lose; ! 561: if (CharAt (from) == stringterm) break; ! 562: #ifdef SWITCH_ENUM_BUG ! 563: switch ((int) SYNTAX(CharAt (from))) ! 564: #else ! 565: switch (SYNTAX(CharAt (from))) ! 566: #endif ! 567: { ! 568: case Scharquote: ! 569: case Sescape: ! 570: from++; ! 571: } ! 572: from++; ! 573: } ! 574: from++; ! 575: if (!depth && sexpflag) goto done; ! 576: break; ! 577: } ! 578: } ! 579: ! 580: /* Reached end of buffer. Error if within object, return nil if between */ ! 581: if (depth) goto lose; ! 582: ! 583: immediate_quit = 0; ! 584: return Qnil; ! 585: ! 586: /* End of object reached */ ! 587: done: ! 588: count--; ! 589: } ! 590: ! 591: while (count < 0) ! 592: { ! 593: stop = FirstCharacter; ! 594: while (from > stop) ! 595: { ! 596: from--; ! 597: if (quoted = char_quoted (from)) ! 598: from--; ! 599: c = CharAt (from); ! 600: code = SYNTAX (c); ! 601: if (from > stop && SYNTAX_COMEND_SECOND (c) ! 602: && SYNTAX_COMEND_FIRST (CharAt (from - 1)) ! 603: && !char_quoted (from - 1) ! 604: && parse_sexp_ignore_comments) ! 605: code = Sendcomment, from--; ! 606: ! 607: #ifdef SWITCH_ENUM_BUG ! 608: switch ((int) (quoted ? Sword : code)) ! 609: #else ! 610: switch (quoted ? Sword : code) ! 611: #endif ! 612: { ! 613: case Sword: ! 614: case Ssymbol: ! 615: if (depth || !sexpflag) break; ! 616: /* This word counts as a sexp; count object finished after passing it. */ ! 617: while (from > stop) ! 618: { ! 619: if (quoted = char_quoted (from - 1)) ! 620: from--; ! 621: if (! (quoted || SYNTAX(CharAt (from - 1)) == Sword || ! 622: SYNTAX(CharAt (from - 1)) == Ssymbol)) ! 623: goto done2; ! 624: from--; ! 625: } ! 626: goto done2; ! 627: ! 628: case Smath: ! 629: if (!sexpflag) ! 630: break; ! 631: if (from != stop && c == CharAt (from - 1)) ! 632: from--; ! 633: if (mathexit) ! 634: { ! 635: mathexit = 0; ! 636: goto open2; ! 637: } ! 638: mathexit = 1; ! 639: ! 640: case Sclose: ! 641: if (!++depth) goto done2; ! 642: break; ! 643: ! 644: case Sopen: ! 645: open2: ! 646: if (!--depth) goto done2; ! 647: if (depth < min_depth) ! 648: error ("Containing expression ends prematurely"); ! 649: break; ! 650: ! 651: case Sendcomment: ! 652: if (!parse_sexp_ignore_comments) break; ! 653: if (from != stop) from--; ! 654: while (1) ! 655: { ! 656: if (SYNTAX (c = CharAt (from)) == Scomment) ! 657: break; ! 658: if (from == stop) goto done; ! 659: from--; ! 660: if (SYNTAX_COMSTART_SECOND (c) ! 661: && SYNTAX_COMSTART_FIRST (CharAt (from)) ! 662: && !char_quoted (from)) ! 663: break; ! 664: } ! 665: break; ! 666: ! 667: case Sstring: ! 668: stringterm = CharAt (from); ! 669: while (1) ! 670: { ! 671: if (from == stop) goto lose; ! 672: if (!char_quoted (from - 1) ! 673: && stringterm == CharAt (from - 1)) ! 674: break; ! 675: from--; ! 676: } ! 677: from--; ! 678: if (!depth && sexpflag) goto done2; ! 679: break; ! 680: } ! 681: } ! 682: ! 683: /* Reached start of buffer. Error if within object, return nil if between */ ! 684: if (depth) goto lose; ! 685: ! 686: immediate_quit = 0; ! 687: return Qnil; ! 688: ! 689: done2: ! 690: count++; ! 691: } ! 692: ! 693: ! 694: immediate_quit = 0; ! 695: XFASTINT (val) = from; ! 696: return val; ! 697: ! 698: lose: ! 699: error ("Unbalanced parentheses"); ! 700: /* NOTREACHED */ ! 701: } ! 702: ! 703: char_quoted (pos) ! 704: register int pos; ! 705: { ! 706: register enum syntaxcode code; ! 707: register int beg = FirstCharacter; ! 708: register int quoted = 0; ! 709: ! 710: while (pos > beg && ! 711: ((code = SYNTAX (CharAt (pos - 1))) == Scharquote ! 712: || code == Sescape)) ! 713: pos--, quoted = !quoted; ! 714: return quoted; ! 715: } ! 716: ! 717: DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0, ! 718: "Scan from character number FROM by COUNT lists.\n\ ! 719: Returns the character number of the position thus found.\n\ ! 720: \n\ ! 721: If DEPTH is nonzero, paren depth begins counting from that value,\n\ ! 722: only places where the depth in parentheses becomes zero\n\ ! 723: are candidates for stopping; COUNT such places are counted.\n\ ! 724: Thus, a positive value for DEPTH means go out levels.\n\ ! 725: \n\ ! 726: Comments are ignored if parse-sexp-ignore-comments is non-nil.\n\ ! 727: \n\ ! 728: If the beginning or end of (the visible part of) the buffer is reached\n\ ! 729: and the depth is wrong, an error is signaled.\n\ ! 730: If the depth is right but the count is not used up, nil is returned.") ! 731: (from, count, depth) ! 732: Lisp_Object from, count, depth; ! 733: { ! 734: CHECK_NUMBER (from, 0); ! 735: CHECK_NUMBER (count, 1); ! 736: CHECK_NUMBER (depth, 2); ! 737: ! 738: return scan_lists (XINT (from), XINT (count), XINT (depth), 0); ! 739: } ! 740: ! 741: DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0, ! 742: "Scan from character number FROM by COUNT balanced expressions.\n\ ! 743: Returns the character number of the position thus found.\n\ ! 744: \n\ ! 745: Comments are ignored if parse-sexp-ignore-comments is non-nil.\n\ ! 746: \n\ ! 747: If the beginning or end of (the visible part of) the buffer is reached\n\ ! 748: in the middle of a parenthetical grouping, an error is signaled.\n\ ! 749: If the beginning or end is reached between groupings but before count is used up,\n\ ! 750: nil is returned.") ! 751: (from, count) ! 752: Lisp_Object from, count; ! 753: { ! 754: CHECK_NUMBER (from, 0); ! 755: CHECK_NUMBER (count, 1); ! 756: ! 757: return scan_lists (XINT (from), XINT (count), 0, 1); ! 758: } ! 759: ! 760: DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars, ! 761: 0, 0, 0, ! 762: "Move point backward over any number of chars with syntax \"prefix\".") ! 763: () ! 764: { ! 765: int beg = FirstCharacter; ! 766: int pos = point; ! 767: ! 768: while (pos > beg && !char_quoted (pos - 1) && SYNTAX (CharAt (pos - 1)) == Squote) ! 769: pos--; ! 770: ! 771: SetPoint (pos); ! 772: ! 773: return Qnil; ! 774: } ! 775: ! 776: struct lisp_parse_state ! 777: { ! 778: int depth; /* Depth at end of parsing */ ! 779: int instring; /* -1 if not within string, else desired terminator. */ ! 780: int incomment; /* Nonzero if within a comment at end of parsing */ ! 781: int quoted; /* Nonzero if just after an escape char at end of parsing */ ! 782: int thislevelstart; /* Char number of most recent start-of-expression at current level */ ! 783: int prevlevelstart; /* Char number of start of containing expression */ ! 784: int location; /* Char number at which parsing stopped. */ ! 785: int mindepth; /* Minimum depth seen while scanning. */ ! 786: }; ! 787: ! 788: /* Parse forward from FROM to END, ! 789: assuming that FROM is the start of a function, ! 790: and return a description of the state of the parse at END. */ ! 791: ! 792: struct lisp_parse_state val_scan_sexps_forward; ! 793: ! 794: struct lisp_parse_state * ! 795: scan_sexps_forward (from, end, targetdepth, stopbefore, oldstate) ! 796: register int from; ! 797: int end, targetdepth, stopbefore; ! 798: Lisp_Object oldstate; ! 799: { ! 800: struct lisp_parse_state state; ! 801: ! 802: register enum syntaxcode code; ! 803: struct level { int last, prev; }; ! 804: struct level levelstart[100]; ! 805: register struct level *curlevel = levelstart; ! 806: struct level *endlevel = levelstart + 100; ! 807: char prev; ! 808: register int depth; /* Paren depth of current scanning location. ! 809: level - levelstart equals this except ! 810: when the depth becomes negative. */ ! 811: int mindepth; /* Lowest DEPTH value seen. */ ! 812: int start_quoted = 0; /* Nonzero means starting after a char quote */ ! 813: Lisp_Object tem; ! 814: ! 815: immediate_quit = 1; ! 816: QUIT; ! 817: ! 818: if (NULL (oldstate)) ! 819: { ! 820: depth = 0; ! 821: state.instring = -1; ! 822: state.incomment = 0; ! 823: } ! 824: else ! 825: { ! 826: tem = Fcar (oldstate); ! 827: if (!NULL (tem)) ! 828: depth = XINT (tem); ! 829: else ! 830: depth = 0; ! 831: ! 832: oldstate = Fcdr (oldstate); ! 833: oldstate = Fcdr (oldstate); ! 834: oldstate = Fcdr (oldstate); ! 835: tem = Fcar (oldstate); ! 836: state.instring = !NULL (tem) ? XINT (tem) : -1; ! 837: ! 838: oldstate = Fcdr (oldstate); ! 839: tem = Fcar (oldstate); ! 840: state.incomment = !NULL (tem); ! 841: ! 842: oldstate = Fcdr (oldstate); ! 843: tem = Fcar (oldstate); ! 844: start_quoted = !NULL (tem); ! 845: } ! 846: state.quoted = 0; ! 847: mindepth = depth; ! 848: ! 849: curlevel->prev = -1; ! 850: ! 851: /* Enter the loop at a place appropriate for initial state. */ ! 852: ! 853: if (state.incomment) goto startincomment; ! 854: if (state.instring >= 0) ! 855: { ! 856: if (start_quoted) goto startquotedinstring; ! 857: goto startinstring; ! 858: } ! 859: if (start_quoted) goto startquoted; ! 860: ! 861: while (from < end) ! 862: { ! 863: code = SYNTAX(CharAt (from)); ! 864: from++; ! 865: if (from < end && SYNTAX_COMSTART_FIRST (CharAt (from - 1)) ! 866: && SYNTAX_COMSTART_SECOND (CharAt (from))) ! 867: code = Scomment, from++; ! 868: #ifdef SWITCH_ENUM_BUG ! 869: switch ((int) code) ! 870: #else ! 871: switch (code) ! 872: #endif ! 873: { ! 874: case Sescape: ! 875: case Scharquote: ! 876: if (stopbefore) goto stop; /* this arg means stop at sexp start */ ! 877: curlevel->last = from - 1; ! 878: startquoted: ! 879: if (from == end) goto endquoted; ! 880: from++; ! 881: goto symstarted; ! 882: /* treat following character as a word constituent */ ! 883: case Sword: ! 884: case Ssymbol: ! 885: if (stopbefore) goto stop; /* this arg means stop at sexp start */ ! 886: curlevel->last = from - 1; ! 887: symstarted: ! 888: while (from < end) ! 889: { ! 890: #ifdef SWITCH_ENUM_BUG ! 891: switch ((int) SYNTAX(CharAt (from))) ! 892: #else ! 893: switch (SYNTAX(CharAt (from))) ! 894: #endif ! 895: { ! 896: case Scharquote: ! 897: case Sescape: ! 898: from++; ! 899: if (from == end) goto endquoted; ! 900: break; ! 901: case Sword: ! 902: case Ssymbol: ! 903: break; ! 904: default: ! 905: goto symdone; ! 906: } ! 907: from++; ! 908: } ! 909: symdone: ! 910: curlevel->prev = curlevel->last; ! 911: break; ! 912: ! 913: case Scomment: ! 914: state.incomment = 1; ! 915: startincomment: ! 916: while (1) ! 917: { ! 918: if (from == end) goto done; ! 919: if (SYNTAX (prev = CharAt (from)) == Sendcomment) ! 920: break; ! 921: from++; ! 922: if (from < end && SYNTAX_COMEND_FIRST (prev) ! 923: && SYNTAX_COMEND_SECOND (CharAt (from))) ! 924: { from++; break; } ! 925: } ! 926: state.incomment = 0; ! 927: break; ! 928: ! 929: case Sopen: ! 930: if (stopbefore) goto stop; /* this arg means stop at sexp start */ ! 931: depth++; ! 932: /* curlevel++->last ran into compiler bug on Apollo */ ! 933: curlevel->last = from - 1; ! 934: if (++curlevel == endlevel) ! 935: error ("Nesting too deep for parser"); ! 936: curlevel->prev = -1; ! 937: curlevel->last = -1; ! 938: if (!--targetdepth) goto done; ! 939: break; ! 940: ! 941: case Sclose: ! 942: depth--; ! 943: if (depth < mindepth) ! 944: mindepth = depth; ! 945: if (curlevel != levelstart) ! 946: curlevel--; ! 947: curlevel->prev = curlevel->last; ! 948: if (!++targetdepth) goto done; ! 949: break; ! 950: ! 951: case Sstring: ! 952: if (stopbefore) goto stop; /* this arg means stop at sexp start */ ! 953: curlevel->last = from - 1; ! 954: state.instring = CharAt (from - 1); ! 955: startinstring: ! 956: while (1) ! 957: { ! 958: if (from >= end) goto done; ! 959: if (CharAt (from) == state.instring) break; ! 960: #ifdef SWITCH_ENUM_BUG ! 961: switch ((int) SYNTAX(CharAt (from))) ! 962: #else ! 963: switch (SYNTAX(CharAt (from))) ! 964: #endif ! 965: { ! 966: case Scharquote: ! 967: case Sescape: ! 968: from++; ! 969: startquotedinstring: ! 970: if (from >= end) goto endquoted; ! 971: } ! 972: from++; ! 973: } ! 974: state.instring = -1; ! 975: curlevel->prev = curlevel->last; ! 976: from++; ! 977: break; ! 978: ! 979: case Smath: ! 980: break; ! 981: } ! 982: } ! 983: goto done; ! 984: ! 985: stop: /* Here if stopping before start of sexp. */ ! 986: from--; /* We have just fetched the char that starts it; */ ! 987: goto done; /* but return the position before it. */ ! 988: ! 989: endquoted: ! 990: state.quoted = 1; ! 991: done: ! 992: state.depth = depth; ! 993: state.mindepth = mindepth; ! 994: state.thislevelstart = curlevel->prev; ! 995: state.prevlevelstart ! 996: = (curlevel == levelstart) ? -1 : (curlevel - 1)->last; ! 997: state.location = from; ! 998: immediate_quit = 0; ! 999: ! 1000: val_scan_sexps_forward = state; ! 1001: return &val_scan_sexps_forward; ! 1002: } ! 1003: ! 1004: /* This comment supplies the doc string for parse-partial-sexp, ! 1005: for make-docfile to see. We cannot put this in the real DEFUN ! 1006: due to limits in the Unix cpp. ! 1007: ! 1008: DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 0, 0, 0, ! 1009: "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\ ! 1010: Parsing stops at TO or when certain criteria are met;\n\ ! 1011: point is set to where parsing stops.\n\ ! 1012: If fifth arg STATE is omitted or nil,\n\ ! 1013: parsing assumes that FROM is the beginning of a function.\n\ ! 1014: Value is a list of seven elements describing final state of parsing:\n\ ! 1015: 1. depth in parens.\n\ ! 1016: 2. character address of start of innermost containing list; nil if none.\n\ ! 1017: 3. character address of start of last complete sexp terminated.\n\ ! 1018: 4. non-nil if inside a string.\n\ ! 1019: (it is the character that will terminate the string.)\n\ ! 1020: 5. t if inside a comment.\n\ ! 1021: 6. t if following a quote character.\n\ ! 1022: 7. the minimum paren-depth encountered during this scan.\n\ ! 1023: If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\ ! 1024: in parentheses becomes equal to TARGETDEPTH.\n\ ! 1025: Fourth arg STOPBEFORE non-nil means stop when come to\n\ ! 1026: any character that starts a sexp.\n\ ! 1027: Fifth arg STATE is a seven-list like what this function returns.\n\ ! 1028: It is used to initialize the state of the parse.") ! 1029: ! 1030: */ ! 1031: ! 1032: DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 5, 0, ! 1033: 0 /* See immediately above */) ! 1034: (from, to, targetdepth, stopbefore, oldstate) ! 1035: Lisp_Object from, to, targetdepth, stopbefore, oldstate; ! 1036: { ! 1037: struct lisp_parse_state state; ! 1038: int target; ! 1039: ! 1040: if (!NULL (targetdepth)) ! 1041: { ! 1042: CHECK_NUMBER (targetdepth, 3); ! 1043: target = XINT (targetdepth); ! 1044: } ! 1045: else ! 1046: target = -100000; /* We won't reach this depth */ ! 1047: ! 1048: validate_region (&from, &to); ! 1049: state = *scan_sexps_forward (XINT (from), XINT (to), ! 1050: target, !NULL (stopbefore), oldstate); ! 1051: ! 1052: SetPoint (state.location); ! 1053: ! 1054: return Fcons (make_number (state.depth), ! 1055: Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart), ! 1056: Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart), ! 1057: Fcons (state.instring >= 0 ? make_number (state.instring) : Qnil, ! 1058: Fcons (state.incomment ? Qt : Qnil, ! 1059: Fcons (state.quoted ? Qt : Qnil, ! 1060: Fcons (make_number (state.mindepth), Qnil))))))); ! 1061: } ! 1062: ! 1063: init_syntax_once () ! 1064: { ! 1065: register int i; ! 1066: register struct Lisp_Vector *v; ! 1067: ! 1068: /* Set this now, so first buffer creation can refer to it. */ ! 1069: /* Make it nil before calling copy-syntax-table ! 1070: so that copy-syntax-table will know not to try to copy from garbage */ ! 1071: Vstandard_syntax_table = Qnil; ! 1072: Vstandard_syntax_table = Fcopy_syntax_table (Qnil); ! 1073: ! 1074: v = XVECTOR (Vstandard_syntax_table); ! 1075: ! 1076: for (i = 'a'; i <= 'z'; i++) ! 1077: XFASTINT (v->contents[i]) = (int) Sword; ! 1078: for (i = 'A'; i <= 'Z'; i++) ! 1079: XFASTINT (v->contents[i]) = (int) Sword; ! 1080: for (i = '0'; i <= '9'; i++) ! 1081: XFASTINT (v->contents[i]) = (int) Sword; ! 1082: XFASTINT (v->contents['$']) = (int) Sword; ! 1083: XFASTINT (v->contents['%']) = (int) Sword; ! 1084: ! 1085: XFASTINT (v->contents['(']) = (int) Sopen + (')' << 8); ! 1086: XFASTINT (v->contents[')']) = (int) Sclose + ('(' << 8); ! 1087: XFASTINT (v->contents['[']) = (int) Sopen + (']' << 8); ! 1088: XFASTINT (v->contents[']']) = (int) Sclose + ('[' << 8); ! 1089: XFASTINT (v->contents['{']) = (int) Sopen + ('}' << 8); ! 1090: XFASTINT (v->contents['}']) = (int) Sclose + ('{' << 8); ! 1091: XFASTINT (v->contents['"']) = (int) Sstring; ! 1092: XFASTINT (v->contents['\\']) = (int) Sescape; ! 1093: ! 1094: for (i = 0; i < 10; i++) ! 1095: XFASTINT (v->contents["_-+*/&|<>="[i]]) = (int) Ssymbol; ! 1096: ! 1097: for (i = 0; i < 12; i++) ! 1098: XFASTINT (v->contents[".,;:?!#@~^'`"[i]]) = (int) Spunct; ! 1099: } ! 1100: ! 1101: syms_of_syntax () ! 1102: { ! 1103: Qsyntax_table_p = intern ("syntax-table-p"); ! 1104: staticpro (&Qsyntax_table_p); ! 1105: ! 1106: /* Mustn't let user clobber this! ! 1107: DEFVAR_LISP ("standard-syntax-table", &Vstandard_syntax_table, */ ! 1108: /* "The syntax table used by buffers that don't specify another."); ! 1109: */ ! 1110: staticpro (&Vstandard_syntax_table); ! 1111: ! 1112: DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments, ! 1113: "Non-nil means forward-sexp, etc., should treat comments as whitespace.\n\ ! 1114: Non-nil works only when the comment terminator is something like *\/,\n\ ! 1115: and appears only when it ends a comment.\n\ ! 1116: If comments are terminated by newlines,\n\ ! 1117: you must make this variable nil."); ! 1118: ! 1119: defsubr (&Ssyntax_table_p); ! 1120: defsubr (&Ssyntax_table); ! 1121: defsubr (&Sstandard_syntax_table); ! 1122: defsubr (&Scopy_syntax_table); ! 1123: defsubr (&Sset_syntax_table); ! 1124: defsubr (&Schar_syntax); ! 1125: defsubr (&Smodify_syntax_entry); ! 1126: defsubr (&Sdescribe_syntax); ! 1127: ! 1128: defsubr (&Sforward_word); ! 1129: ! 1130: defsubr (&Sscan_lists); ! 1131: defsubr (&Sscan_sexps); ! 1132: defsubr (&Sbackward_prefix_chars); ! 1133: defsubr (&Sparse_partial_sexp); ! 1134: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.