![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to search.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 search.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src |
1.1 ! root 1: /* String search routines for GNU Emacs. ! 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 <ctype.h> ! 23: #include "config.h" ! 24: #include "lisp.h" ! 25: #include "syntax.h" ! 26: #include "buffer.h" ! 27: #include "commands.h" ! 28: #include "regex.h" ! 29: ! 30: unsigned char downcase_table[0400] = {0}; /* folds upper to lower case */ ! 31: ! 32: /* We compile regexps into this buffer and then use it for searching. */ ! 33: ! 34: static struct re_pattern_buffer searchbuf; ! 35: ! 36: char search_fastmap[0400]; ! 37: ! 38: /* Last regexp we compiled */ ! 39: ! 40: Lisp_Object last_regexp; ! 41: ! 42: /* Every call to re_match, etc., must pass &search_regs as the regs argument ! 43: unless you can show it is unnecessary (i.e., if re_match is certainly going ! 44: to be called again before region-around-match can be called). */ ! 45: ! 46: static struct re_registers search_regs; ! 47: ! 48: /* error condition signalled when regexp compile_pattern fails */ ! 49: ! 50: Lisp_Object Qinvalid_regexp; ! 51: ! 52: /* Compile a regexp and signal a Lisp error if anything goes wrong. */ ! 53: ! 54: compile_pattern (pattern, bufp, translate) ! 55: Lisp_Object pattern; ! 56: struct re_pattern_buffer *bufp; ! 57: char *translate; ! 58: { ! 59: char *val; ! 60: Lisp_Object dummy; ! 61: ! 62: if (EQ (pattern, last_regexp) ! 63: && translate == bufp->translate) ! 64: return; ! 65: last_regexp = Qnil; ! 66: bufp->translate = translate; ! 67: val = re_compile_pattern (XSTRING (pattern)->data, ! 68: XSTRING (pattern)->size, ! 69: bufp); ! 70: if (val) ! 71: { ! 72: dummy = build_string (val); ! 73: while (1) ! 74: Fsignal (Qinvalid_regexp, Fcons (dummy, Qnil)); ! 75: } ! 76: last_regexp = pattern; ! 77: return; ! 78: } ! 79: ! 80: /* Error condition used for failing searches */ ! 81: Lisp_Object Qsearch_failed; ! 82: ! 83: Lisp_Object ! 84: signal_failure (arg) ! 85: Lisp_Object arg; ! 86: { ! 87: Fsignal (Qsearch_failed, Fcons (arg, Qnil)); ! 88: return Qnil; ! 89: } ! 90: ! 91: DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0, ! 92: "t if text after point matches regular expression PAT.") ! 93: (string) ! 94: Lisp_Object string; ! 95: { ! 96: Lisp_Object val; ! 97: unsigned char *p1, *p2; ! 98: int s1, s2; ! 99: register int i; ! 100: ! 101: CHECK_STRING (string, 0); ! 102: compile_pattern (string, &searchbuf, ! 103: !NULL (bf_cur->case_fold_search) ? (char *) downcase_table : 0); ! 104: ! 105: immediate_quit = 1; ! 106: QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ ! 107: ! 108: /* Get pointers and sizes of the two strings ! 109: that make up the visible portion of the buffer. */ ! 110: ! 111: p1 = bf_p1 + bf_head_clip; ! 112: s1 = bf_s1 - (bf_head_clip - 1); ! 113: p2 = bf_p2 + bf_s1 + 1; ! 114: s2 = bf_s2 - bf_tail_clip; ! 115: if (s1 < 0) ! 116: { ! 117: p2 -= s1; ! 118: s2 += s1; ! 119: s1 = 0; ! 120: } ! 121: if (s2 < 0) ! 122: { ! 123: s1 += s2; ! 124: s2 = 0; ! 125: } ! 126: ! 127: val = (0 <= re_match_2 (&searchbuf, p1, s1, p2, s2, ! 128: point - FirstCharacter, &search_regs, ! 129: NumCharacters + 1 - FirstCharacter) ! 130: ? Qt : Qnil); ! 131: for (i = 0; i < RE_NREGS; i++) ! 132: { ! 133: search_regs.start[i] += FirstCharacter - 1; ! 134: search_regs.end[i] += FirstCharacter - 1; ! 135: } ! 136: immediate_quit = 0; ! 137: return val; ! 138: } ! 139: ! 140: DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0, ! 141: "Return index of start of first match for REGEXP in STRING, or nil.\n\ ! 142: If third arg START is non-nil, start search at that index in STRING.\n\ ! 143: For index of first char beyond the match, do (match-end 0).\n\ ! 144: match-end and match-beginning also give indices of substrings\n\ ! 145: matched by parenthesis constructs in the pattern.") ! 146: (regexp, string, start) ! 147: Lisp_Object regexp, string, start; ! 148: { ! 149: int val; ! 150: int s; ! 151: ! 152: CHECK_STRING (regexp, 0); ! 153: CHECK_STRING (string, 1); ! 154: ! 155: if (NULL (start)) ! 156: s = 0; ! 157: else ! 158: { ! 159: CHECK_NUMBER (start, 2); ! 160: s = XINT (start); ! 161: } ! 162: ! 163: compile_pattern (regexp, &searchbuf, ! 164: !NULL (bf_cur->case_fold_search) ? (char *) downcase_table : 0); ! 165: val = re_search (&searchbuf, XSTRING (string)->data, XSTRING (string)->size, ! 166: s, XSTRING (string)->size - s, &search_regs); ! 167: /* Correct for propensity of match-beginning and match-end ! 168: to add 1 to each of these (which is correct for buffer positions ! 169: since they are origin-1, but not for indices in strings). */ ! 170: for (s = 0; s < RE_NREGS; s++) ! 171: { ! 172: search_regs.start[s]--; ! 173: search_regs.end[s]--; ! 174: } ! 175: if (val < 0) return Qnil; ! 176: return make_number (val); ! 177: } ! 178: ! 179: DEFUN ("scan-buffer", Fscan_buffer, Sscan_buffer, 3, 3, 0, ! 180: "Scan from character number FROM for COUNT occurrences of character C.\n\ ! 181: Returns the character number of the position after the character found.\n\ ! 182: If not found, returns char number of beginning or end of buffer.\n\ ! 183: Note that this does -not- take take case-fold-search into consideration.") ! 184: (from, count, c) ! 185: Lisp_Object from, count, c; ! 186: { ! 187: CHECK_NUMBER_COERCE_MARKER (from, 0); ! 188: CHECK_NUMBER (count, 1); ! 189: CHECK_NUMBER (c, 2); ! 190: ! 191: return make_number (ScanBf (XINT (c), XINT (from), XINT (count))); ! 192: } ! 193: ! 194: ScanBf (target, pos, cnt) ! 195: register int target, pos, cnt; ! 196: { ! 197: register int end; ! 198: if (cnt > 0) ! 199: { ! 200: end = NumCharacters + 1; ! 201: while (pos < end) ! 202: { ! 203: if (CharAt (pos) == target && !--cnt) ! 204: return pos + 1; ! 205: pos++; ! 206: } ! 207: return pos; ! 208: } ! 209: if (cnt < 0) ! 210: { ! 211: end = FirstCharacter; ! 212: do pos--; ! 213: while (pos >= end && ! 214: (CharAt (pos) != target || ++cnt)); ! 215: } ! 216: return pos + 1; ! 217: } ! 218: ! 219: DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0, ! 220: "Move point forward, stopping before a char not in CHARS, or at position LIM.\n\ ! 221: CHARS is like the inside of a [...] in a regular expression\n\ ! 222: except that ] is never special and \\ quotes ^, - or \\.\n\ ! 223: Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\ ! 224: With arg \"^a-zA-Z\", skips nonletters stopping before first letter.") ! 225: (string, lim) ! 226: Lisp_Object string, lim; ! 227: { ! 228: skip_chars (1, string, lim); ! 229: return Qnil; ! 230: } ! 231: ! 232: DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0, ! 233: "Move point backward, stopping after a char not in CHARS, or at position LIM.\n\ ! 234: See skip-chars-forward for details.") ! 235: (string, lim) ! 236: Lisp_Object string, lim; ! 237: { ! 238: skip_chars (0, string, lim); ! 239: return Qnil; ! 240: } ! 241: ! 242: skip_chars (forwardp, string, lim) ! 243: int forwardp; ! 244: Lisp_Object string, lim; ! 245: { ! 246: register unsigned char *p, *pend; ! 247: register unsigned char c; ! 248: unsigned char fastmap[0400]; ! 249: int negate = 0; ! 250: register int i; ! 251: ! 252: CHECK_STRING (string, 0); ! 253: ! 254: if (NULL (lim)) ! 255: XSETINT (lim, forwardp ? NumCharacters + 1 : FirstCharacter); ! 256: else ! 257: CHECK_NUMBER_COERCE_MARKER (lim, 1); ! 258: ! 259: p = XSTRING (string)->data; ! 260: pend = p + XSTRING (string)->size; ! 261: bzero (fastmap, sizeof fastmap); ! 262: ! 263: if (p != pend && *p == '^') ! 264: { ! 265: negate = 1; p++; ! 266: } ! 267: ! 268: /* Find the characters specified and set their elements of fastmap. */ ! 269: ! 270: while (p != pend) ! 271: { ! 272: c = *p++; ! 273: if (*p == '\\') ! 274: { ! 275: if (p == pend) break; ! 276: c = *p++; ! 277: } ! 278: if (p != pend && *p == '-') ! 279: { ! 280: p++; ! 281: if (p == pend) break; ! 282: while (c <= *p) ! 283: { ! 284: fastmap[c] = 1; ! 285: c++; ! 286: } ! 287: p++; ! 288: } ! 289: else ! 290: fastmap[c] = 1; ! 291: } ! 292: ! 293: /* If ^ was the first character, complement the fastmap. */ ! 294: ! 295: if (negate) ! 296: for (i = 0; i < sizeof fastmap; i++) ! 297: fastmap[i] ^= 1; ! 298: ! 299: if (forwardp) ! 300: { ! 301: while (point < XINT (lim) && fastmap[CharAt (point)]) ! 302: PointRight (1); ! 303: } ! 304: else ! 305: { ! 306: while (point > XINT (lim) && fastmap[CharAt (point - 1)]) ! 307: PointLeft (1); ! 308: } ! 309: } ! 310: ! 311: /* Subroutines of Lisp buffer search functions. */ ! 312: ! 313: static Lisp_Object ! 314: search_command (string, bound, noerror, count, direction, RE) ! 315: Lisp_Object string, bound, noerror, count; ! 316: int direction; ! 317: int RE; ! 318: { ! 319: register int np; ! 320: int lim; ! 321: int n = direction; ! 322: ! 323: if (!NULL (count)) ! 324: { ! 325: CHECK_NUMBER (count, 3); ! 326: n *= XINT (count); ! 327: } ! 328: ! 329: CHECK_STRING (string, 0); ! 330: if (NULL (bound)) ! 331: lim = n > 0 ? NumCharacters + 1 : FirstCharacter; ! 332: else ! 333: { ! 334: CHECK_NUMBER_COERCE_MARKER (bound, 1); ! 335: lim = XINT (bound); ! 336: if (n > 0 ? lim < point : lim > point) ! 337: error ("Invalid search bound (wrong side of point)"); ! 338: if (lim > NumCharacters + 1) ! 339: lim = NumCharacters + 1; ! 340: if (lim < FirstCharacter) ! 341: lim = FirstCharacter; ! 342: } ! 343: ! 344: np = search_buffer (string, point, lim, n, RE, ! 345: !NULL (bf_cur->case_fold_search) ? downcase_table : 0); ! 346: if (np == 0) ! 347: { ! 348: if (NULL (noerror)) ! 349: return signal_failure (string); ! 350: if (!EQ (noerror, Qt)) ! 351: SetPoint (lim); ! 352: return Qnil; ! 353: } ! 354: else ! 355: SetPoint (np); ! 356: ! 357: return Qt; ! 358: } ! 359: ! 360: /* search for the n'th occurrence of `string' in the current buffer, ! 361: starting at position `from' and stopping at position `lim', ! 362: treating `pat' as a literal string if `RE' is false or as ! 363: a regular expression if `RE' is true. ! 364: ! 365: If `n' is positive, searching is forward and `lim' must be greater than `from'. ! 366: If `n' is negative, searching is backward and `lim' must be less than `from'. ! 367: ! 368: Returns 0 if `n' occurrences are not found, ! 369: or else the position at the beginning of the `n'th occurrence (if searching backward) ! 370: or the end (if searching forward). */ ! 371: ! 372: search_buffer (string, from, lim, n, RE, trt) ! 373: Lisp_Object string; ! 374: int from; ! 375: register int lim; ! 376: int n; ! 377: int RE; ! 378: unsigned char *trt; ! 379: { ! 380: register int pos = from; ! 381: unsigned char *pat = XSTRING (string)->data; ! 382: register int len = XSTRING (string)->size; ! 383: register int i, j; ! 384: unsigned char *p1, *p2; ! 385: int s1, s2; ! 386: ! 387: immediate_quit = 1; /* Quit immediately if user types ^G, ! 388: because letting this function finish can take too long. */ ! 389: QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ ! 390: ! 391: if (RE) ! 392: { ! 393: compile_pattern (string, &searchbuf, (char *) trt); ! 394: ! 395: /* Get pointers and sizes of the two strings ! 396: that make up the visible portion of the buffer. */ ! 397: ! 398: p1 = bf_p1 + bf_head_clip; ! 399: s1 = bf_s1 - (bf_head_clip - 1); ! 400: p2 = bf_p2 + bf_s1 + 1; ! 401: s2 = bf_s2 - bf_tail_clip; ! 402: if (s1 < 0) ! 403: { ! 404: p2 -= s1; ! 405: s2 += s1; ! 406: s1 = 0; ! 407: } ! 408: if (s2 < 0) ! 409: { ! 410: s1 += s2; ! 411: s2 = 0; ! 412: } ! 413: } ! 414: ! 415: while (n < 0) ! 416: { ! 417: if (!RE) ! 418: { ! 419: pos -= len; ! 420: if (trt && !(trt == downcase_table && !isalpha (pat[0]))) ! 421: { ! 422: j = trt[pat[0]]; ! 423: while (pos >= lim ! 424: && (j != trt[CharAt (pos)] ! 425: || bcmp_buffer_translated (pat, len, pos, trt))) ! 426: pos--; ! 427: } ! 428: else ! 429: { ! 430: j = pat[0]; ! 431: while (pos >= lim ! 432: && (j != CharAt (pos) ! 433: || bcmp_buffer_translated (pat, len, pos, trt))) ! 434: pos--; ! 435: } ! 436: ! 437: if (pos < lim) ! 438: { ! 439: immediate_quit = 0; ! 440: return 0; ! 441: } ! 442: search_regs.start[0] = pos - 1; ! 443: search_regs.end[0] = pos - 1 + len; ! 444: } ! 445: else ! 446: { ! 447: if (re_search_2 (&searchbuf, p1, s1, p2, s2, ! 448: pos - FirstCharacter, lim - pos, &search_regs, ! 449: /* Don't allow match past current point */ ! 450: pos - FirstCharacter) ! 451: >= 0) ! 452: { ! 453: j = FirstCharacter - 1; ! 454: for (i = 0; i < RE_NREGS; i++) ! 455: { ! 456: search_regs.start[i] += j; ! 457: search_regs.end[i] += j; ! 458: } ! 459: /* Set pos to the new position. */ ! 460: pos = search_regs.start[0] + 1; ! 461: } ! 462: else ! 463: { ! 464: immediate_quit = 0; ! 465: return 0; ! 466: } ! 467: } ! 468: n++; ! 469: } ! 470: ! 471: while (n > 0) ! 472: { ! 473: if (!RE) ! 474: { ! 475: lim -= len; ! 476: if (trt && !(trt == downcase_table && !isalpha (pat[0]))) ! 477: { ! 478: j = trt[pat[0]]; ! 479: while (pos <= lim ! 480: && (j != trt[CharAt (pos)] ! 481: || bcmp_buffer_translated (pat, len, pos, trt))) ! 482: pos++; ! 483: } ! 484: else ! 485: { ! 486: j = pat[0]; ! 487: while (pos <= lim ! 488: && (j != CharAt (pos) ! 489: || bcmp_buffer_translated (pat, len, pos, trt))) ! 490: pos++; ! 491: } ! 492: ! 493: if (pos > lim) ! 494: { ! 495: immediate_quit = 0; ! 496: return 0; ! 497: } ! 498: ! 499: lim += len; ! 500: ! 501: search_regs.start[0] = pos - 1; ! 502: pos += len; ! 503: search_regs.end[0] = pos - 1; ! 504: } ! 505: else ! 506: { ! 507: if (re_search_2 (&searchbuf, p1, s1, p2, s2, ! 508: pos - FirstCharacter, lim - pos, &search_regs, ! 509: lim - FirstCharacter) ! 510: >= 0) ! 511: { ! 512: j = FirstCharacter - 1; ! 513: for (i = 0; i < RE_NREGS; i++) ! 514: { ! 515: search_regs.start[i] += j; ! 516: search_regs.end[i] += j; ! 517: } ! 518: pos = 1 + search_regs.end[0]; ! 519: } ! 520: else ! 521: { ! 522: immediate_quit = 0; ! 523: return 0; ! 524: } ! 525: } ! 526: n--; ! 527: } ! 528: immediate_quit = 0; ! 529: return pos; ! 530: } ! 531: ! 532: /* Return nonzero unless the `len' characters in the buffer starting at position `pos' ! 533: match the `len' characters at `pat', with all characters going through the ! 534: translate table `trt' if `trt' is nonzero. */ ! 535: ! 536: static int ! 537: bcmp_buffer_translated (pat, len, pos, trt) ! 538: unsigned char *pat; ! 539: int len; ! 540: int pos; ! 541: register char *trt; ! 542: { ! 543: int dist1 = 0; ! 544: register int i; ! 545: register unsigned char *p1, *p2; ! 546: ! 547: if (pos - 1 < bf_s1) ! 548: { ! 549: p1 = pat, p2 = &CharAt (pos); ! 550: dist1 = bf_s1 - (pos - 1); ! 551: if (dist1 > len) dist1 = len; ! 552: i = dist1; ! 553: ! 554: if (trt) ! 555: { ! 556: for (; i; i--) ! 557: if (trt[*p1++] != trt [*p2++]) return 1; ! 558: } ! 559: else ! 560: { ! 561: for (; i; i--) ! 562: if (*p1++ != *p2++) return 1; ! 563: } ! 564: } ! 565: ! 566: if (dist1 < len) ! 567: { ! 568: p1 = pat + dist1, p2 = &CharAt (pos + dist1); ! 569: i = len - dist1; ! 570: ! 571: if (trt) ! 572: { ! 573: for (; i; i--) ! 574: if (trt[*p1++] != trt [*p2++]) return 1; ! 575: } ! 576: else ! 577: { ! 578: for (; i; i--) ! 579: if (*p1++ != *p2++) return 1; ! 580: } ! 581: } ! 582: return 0; ! 583: } ! 584: ! 585: /* Given a string of words separated by word delimiters, ! 586: compute a regexp that matches those exact words ! 587: separated by arbitrary punctuation. */ ! 588: ! 589: static Lisp_Object ! 590: wordify (string) ! 591: Lisp_Object string; ! 592: { ! 593: register unsigned char *p, *o; ! 594: register int i, len, punct_count = 0, word_count = 0; ! 595: Lisp_Object val; ! 596: ! 597: CHECK_STRING (string, 0); ! 598: p = XSTRING (string)->data; ! 599: len = XSTRING (string)->size; ! 600: ! 601: for (i = 0; i < len; i++) ! 602: if (SYNTAX (p[i]) != Sword) ! 603: { ! 604: punct_count++; ! 605: if (i > 0 && SYNTAX (p[i-1]) == Sword) word_count++; ! 606: } ! 607: if (SYNTAX (p[len-1]) == Sword) word_count++; ! 608: if (!word_count) return build_string (""); ! 609: ! 610: val = make_string (p, len - punct_count + 5 * (word_count - 1) + 4); ! 611: ! 612: o = XSTRING (val)->data; ! 613: *o++ = '\\'; ! 614: *o++ = 'b'; ! 615: ! 616: for (i = 0; i < len; i++) ! 617: if (SYNTAX (p[i]) == Sword) ! 618: *o++ = p[i]; ! 619: else if (i > 0 && SYNTAX (p[i-1]) == Sword && --word_count) ! 620: { ! 621: *o++ = '\\'; ! 622: *o++ = 'W'; ! 623: *o++ = '\\'; ! 624: *o++ = 'W'; ! 625: *o++ = '*'; ! 626: } ! 627: ! 628: *o++ = '\\'; ! 629: *o++ = 'b'; ! 630: ! 631: return val; ! 632: } ! 633: ! 634: DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4, ! 635: "sSearch backward: ", ! 636: "Search backward from point for STRING.\n\ ! 637: Set point to the beginning of the occurrence found, and return t.\n\ ! 638: An optional second argument bounds the search; it is a buffer position.\n\ ! 639: The match found must not extend before that position.\n\ ! 640: Optional third argument, if t, means if fail just return nil (no error).\n\ ! 641: If not nil and not t, position at limit of search and return nil.\n\ ! 642: Optional fourth argument is repeat count--search for successive occurrences.") ! 643: (string, bound, noerror, count) ! 644: Lisp_Object string, bound, noerror, count; ! 645: { ! 646: return search_command (string, bound, noerror, count, -1, 0); ! 647: } ! 648: ! 649: DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "sSearch: ", ! 650: "Search forward from point for STRING.\n\ ! 651: Set point to the end of the occurrence found, and return t.\n\ ! 652: An optional second argument bounds the search; it is a buffer position.\n\ ! 653: The match found must not extend after that position.\n\ ! 654: Optional third argument, if t, means if fail just return nil (no error).\n\ ! 655: If not nil and not t, move to limit of search and return nil.\n\ ! 656: Optional fourth argument is repeat count--search for successive occurrences.") ! 657: (string, bound, noerror, count) ! 658: Lisp_Object string, bound, noerror, count; ! 659: { ! 660: return search_command (string, bound, noerror, count, 1, 0); ! 661: } ! 662: ! 663: DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4, ! 664: "sWord search backward: ", ! 665: "Search backward from point for STRING, ignoring differences in punctuation.\n\ ! 666: Set point to the beginning of the occurrence found, and return t.\n\ ! 667: An optional second argument bounds the search; it is a buffer position.\n\ ! 668: The match found must not extend before that position.\n\ ! 669: Optional third argument, if t, means if fail just return nil (no error).\n\ ! 670: If not nil and not t, move to limit of search and return nil.\n\ ! 671: Optional fourth argument is repeat count--search for successive occurrences.") ! 672: (string, bound, noerror, count) ! 673: Lisp_Object string, bound, noerror, count; ! 674: { ! 675: return search_command (wordify (string), bound, noerror, count, -1, 1); ! 676: } ! 677: ! 678: DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4, ! 679: "sWord search: ", ! 680: "Search forward from point for STRING, ignoring differences in punctuation.\n\ ! 681: Set point to the end of the occurrence found, and return t.\n\ ! 682: An optional second argument bounds the search; it is a buffer position.\n\ ! 683: The match found must not extend after that position.\n\ ! 684: Optional third argument, if t, means if fail just return nil (no error).\n\ ! 685: If not nil and not t, move to limit of search and return nil.\n\ ! 686: Optional fourth argument is repeat count--search for successive occurrences.") ! 687: (string, bound, noerror, count) ! 688: Lisp_Object string, bound, noerror, count; ! 689: { ! 690: return search_command (wordify (string), bound, noerror, count, 1, 1); ! 691: } ! 692: ! 693: DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4, ! 694: "sRE search backward: ", ! 695: "Search backward from point for regular expression REGEXP.\n\ ! 696: Set point to the beginning of the occurrence found, and return t.\n\ ! 697: An optional second argument bounds the search; it is a buffer position.\n\ ! 698: The match found must not extend before that position.\n\ ! 699: Optional third argument, if t, means if fail just return nil (no error).\n\ ! 700: If not nil and not t, move to limit of search and return nil.\n\ ! 701: Optional fourth argument is repeat count--search for successive occurrences.\n\ ! 702: See also the functions match-beginning and match-end and replace-match.") ! 703: (string, bound, noerror, count) ! 704: Lisp_Object string, bound, noerror, count; ! 705: { ! 706: return search_command (string, bound, noerror, count, -1, 1); ! 707: } ! 708: ! 709: DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4, ! 710: "sRE search: ", ! 711: "Search forward from point for regular expression REGEXP.\n\ ! 712: Set point to the end of the occurrence found, and return t.\n\ ! 713: An optional second argument bounds the search; it is a buffer position.\n\ ! 714: The match found must not extend after that position.\n\ ! 715: Optional third argument, if t, means if fail just return nil (no error).\n\ ! 716: If not nil and not t, move to limit of search and return nil.\n\ ! 717: Optional fourth argument is repeat count--search for successive occurrences.\n\ ! 718: See also the functions match-beginning and match-end and replace-match.") ! 719: (string, bound, noerror, count) ! 720: Lisp_Object string, bound, noerror, count; ! 721: { ! 722: return search_command (string, bound, noerror, count, 1, 1); ! 723: } ! 724: ! 725: DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 3, 0, ! 726: "Replace text matched by last search with NEWTEXT.\n\ ! 727: If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\ ! 728: Otherwise convert to all caps or cap initials, like replaced text.\n\ ! 729: If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\ ! 730: Otherwise treat \\ as special:\n\ ! 731: \\& in NEWTEXT means substitute original matched text,\n\ ! 732: \\<n> means substitute match for \\(...\\) number <n>,\n\ ! 733: \\\\ means insert one \\.\n\ ! 734: Leaves point at end of replacement text.") ! 735: (string, fixedcase, literal) ! 736: Lisp_Object string, fixedcase, literal; ! 737: { ! 738: enum { nochange, all_caps, cap_initial } case_action = nochange; ! 739: register int pos, last; ! 740: int some_multiletter_word = 0; ! 741: int some_letter = 0; ! 742: register char c, prevc; ! 743: int inslen; ! 744: ! 745: if (search_regs.start[0] + 1 < FirstCharacter ! 746: || search_regs.start[0] > search_regs.end[0] ! 747: || search_regs.end[0] > NumCharacters) ! 748: args_out_of_range(make_number (search_regs.start[0]), ! 749: make_number (search_regs.end[0])); ! 750: ! 751: if (NULL (fixedcase)) ! 752: { ! 753: /* Decide how to casify by examining the matched text. */ ! 754: ! 755: last = search_regs.end[0]; ! 756: prevc = '\n'; ! 757: case_action = all_caps; ! 758: ! 759: /* some_multiletter_word is set nonzero if any original word ! 760: is more than one letter long. */ ! 761: some_multiletter_word = 0; ! 762: ! 763: for (pos = search_regs.start[0] + 1; pos <= last; pos++) ! 764: { ! 765: c = CharAt (pos); ! 766: if (c >= 'a' && c <= 'z') ! 767: { ! 768: /* Cannot be all caps if any original char is lower case */ ! 769: ! 770: case_action = cap_initial; ! 771: if (SYNTAX (prevc) != Sword) ! 772: { ! 773: /* Cannot even be cap initials ! 774: if some original initial is lower case */ ! 775: case_action = nochange; ! 776: break; ! 777: } ! 778: else ! 779: some_multiletter_word = 1; ! 780: } ! 781: else if (c >= 'A' && c <= 'Z') ! 782: { ! 783: some_letter = 1; ! 784: if (!some_multiletter_word && SYNTAX (prevc) == Sword) ! 785: some_multiletter_word = 1; ! 786: } ! 787: ! 788: prevc = c; ! 789: } ! 790: ! 791: /* Do not make new text all caps ! 792: if the original text contained only single letter words. */ ! 793: if (case_action == all_caps && !some_multiletter_word) ! 794: case_action = cap_initial; ! 795: ! 796: if (!some_letter) case_action = nochange; ! 797: } ! 798: ! 799: SetPoint (search_regs.end[0] + 1); ! 800: if (!NULL (literal)) ! 801: Finsert (1, &string); ! 802: else ! 803: { ! 804: for (pos = 0; pos < XSTRING (string)->size; pos++) ! 805: { ! 806: c = XSTRING (string)->data[pos]; ! 807: if (c == '\\') ! 808: { ! 809: c = XSTRING (string)->data[++pos]; ! 810: if (c == '&') ! 811: place (search_regs.start[0] + 1, ! 812: search_regs.end[0] + 1); ! 813: else if (c >= '1' && c <= RE_NREGS + '0') ! 814: place (search_regs.start[c - '0'] + 1, ! 815: search_regs.end[c - '0'] + 1); ! 816: else ! 817: insert_char (c); ! 818: } ! 819: else ! 820: insert_char (c); ! 821: } ! 822: } ! 823: ! 824: inslen = point - (search_regs.end[0] + 1); ! 825: del_range (search_regs.start[0] + 1, search_regs.end[0] + 1); ! 826: ! 827: if (case_action == all_caps) ! 828: Fupcase_region (make_number (point - inslen), make_number (point)); ! 829: else if (case_action == cap_initial) ! 830: { /* Fcapitalize_region won't do; must not downcase anything. */ ! 831: last = 0; ! 832: for (pos = point - inslen; pos < point; pos++) ! 833: { ! 834: c = CharAt (pos); ! 835: if (!last && (c >= 'a' && c <= 'z')) ! 836: CharAt (pos) = c ^ ('a' - 'A'); ! 837: last = SYNTAX (c) == Sword; ! 838: } ! 839: } ! 840: return Qnil; ! 841: } ! 842: ! 843: static ! 844: place (l1, l2) ! 845: int l1, l2; ! 846: { ! 847: if (l1 < FirstCharacter) ! 848: l1 = FirstCharacter; ! 849: if (l1 >= NumCharacters) ! 850: l1 = NumCharacters; ! 851: if (l2 < l1) l2 = l1; ! 852: if (l2 >= NumCharacters) ! 853: l2 = NumCharacters; ! 854: GapTo (point); ! 855: InsCStr (&CharAt (l1), l2 - l1); ! 856: } ! 857: ! 858: DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0, ! 859: "Return the character number of start of text matched by last regexp searched for.\n\ ! 860: ARG, a number, specifies which parenthesized expression in the last regexp.\n\ ! 861: Zero means the entire text matched by the whole regexp.") ! 862: (num) ! 863: Lisp_Object num; ! 864: { ! 865: register n; ! 866: CHECK_NUMBER (num, 0); ! 867: n = XINT (num); ! 868: if (n < 0 || n >= RE_NREGS) ! 869: error ("Out-of-bounds argument"); ! 870: return make_number (search_regs.start[n] + 1); ! 871: } ! 872: ! 873: DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0, ! 874: "Return the character number of end of text matched by last regexp searched for.\n\ ! 875: ARG, a number, specifies which parenthesized expression in the last regexp.\n\ ! 876: Zero means the entire text matched by the whole regexp.") ! 877: (num) ! 878: Lisp_Object num; ! 879: { ! 880: register n; ! 881: CHECK_NUMBER (num, 0); ! 882: n = XINT (num); ! 883: if (n < 0 || n >= RE_NREGS) ! 884: error ("Out-of-bounds argument"); ! 885: return make_number (search_regs.end[n] + 1); ! 886: } ! 887: ! 888: DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 0, 0, ! 889: "Return list containing all info on what the last search matched.\n\ ! 890: Element 2N is (match-beginning N); element 2N + 1 is (match-end N).\n\ ! 891: All are represented as markers.") ! 892: () ! 893: { ! 894: Lisp_Object data[2 * RE_NREGS]; ! 895: int i; ! 896: ! 897: for (i = 0; i < RE_NREGS; i++) ! 898: { ! 899: data[2 * i] = Fmake_marker (); ! 900: Fset_marker (data[2*i], make_number (search_regs.start[i] + 1), Qnil); ! 901: data[2 * i + 1] = Fmake_marker (); ! 902: Fset_marker (data[2*i + 1], make_number (search_regs.end[i] + 1), Qnil); ! 903: } ! 904: ! 905: return Flist (2 * RE_NREGS, data); ! 906: } ! 907: ! 908: ! 909: DEFUN ("store-match-data", Fstore_match_data, Sstore_match_data, 1, 1, 0, ! 910: "Set internal data on last search match from elements of LIST.\n\ ! 911: LIST should have been created by calling match-data previously.") ! 912: (list) ! 913: register Lisp_Object list; ! 914: { ! 915: register int i; ! 916: register Lisp_Object marker; ! 917: ! 918: if (!LISTP (list)) ! 919: list = wrong_type_argument (Qlistp, list, 0); ! 920: ! 921: for (i = 0; i < RE_NREGS; i++) ! 922: { ! 923: marker = Fcar (list); ! 924: CHECK_MARKER (marker, 0); ! 925: search_regs.start[i] = marker_position (marker) - 1; ! 926: list = Fcdr (list); ! 927: ! 928: marker = Fcar (list); ! 929: CHECK_MARKER (marker, 0); ! 930: search_regs.end[i] = marker_position (marker) - 1; ! 931: list = Fcdr (list); ! 932: } ! 933: ! 934: return Qnil; ! 935: } ! 936: ! 937: /* Quote a string to inactivate reg-expr chars */ ! 938: ! 939: DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0, ! 940: "Return a regexp string which matches exactly STRING and nothing else.") ! 941: (str) ! 942: Lisp_Object str; ! 943: { ! 944: register unsigned char *p, *cp, *end; ! 945: register int size; ! 946: Lisp_Object ostr; ! 947: ! 948: CHECK_STRING (str, 0); ! 949: size = XSTRING (str)->size; ! 950: ! 951: /* Increment `size' for the escapes we will need to insert */ ! 952: ! 953: for (cp = XSTRING (str)->data, end = cp + size; cp != end; cp++) ! 954: if (*cp == '[' || *cp == ']' ! 955: || *cp == '*' || *cp == '.' || *cp == '\\' ! 956: || *cp == '?' || *cp == '+' ! 957: || *cp == '^' || *cp == '$') ! 958: size++; ! 959: ! 960: ostr = Fmake_string (make_number (size), make_number (0)); ! 961: ! 962: /* Now copy the data into the new string, inserting escapes. */ ! 963: ! 964: p = XSTRING (ostr)->data; ! 965: for (cp = XSTRING (str)->data; cp != end; cp++) ! 966: { ! 967: if (*cp == '[' || *cp == ']' ! 968: || *cp == '*' || *cp == '.' || *cp == '\\' ! 969: || *cp == '?' || *cp == '+' ! 970: || *cp == '^' || *cp == '$') ! 971: *p++ = '\\'; ! 972: *p++ = *cp; ! 973: } ! 974: return ostr; ! 975: } ! 976: ! 977: syms_of_search () ! 978: { ! 979: register int i; ! 980: ! 981: for (i = 0; i < 0400; i++) ! 982: downcase_table[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i; ! 983: ! 984: searchbuf.allocated = 100; ! 985: searchbuf.buffer = (char *) malloc (searchbuf.allocated); ! 986: searchbuf.fastmap = search_fastmap; ! 987: ! 988: Qsearch_failed = intern ("search-failed"); ! 989: staticpro (&Qsearch_failed); ! 990: Qinvalid_regexp = intern ("invalid-regexp"); ! 991: staticpro (&Qinvalid_regexp); ! 992: ! 993: Fput (Qsearch_failed, Qerror_conditions, ! 994: Fcons (Qsearch_failed, Fcons (Qerror, Qnil))); ! 995: Fput (Qsearch_failed, Qerror_message, ! 996: build_string ("Search failed")); ! 997: ! 998: Fput (Qinvalid_regexp, Qerror_conditions, ! 999: Fcons (Qinvalid_regexp, Fcons (Qerror, Qnil))); ! 1000: Fput (Qinvalid_regexp, Qerror_message, ! 1001: build_string ("Invalid regexp")); ! 1002: ! 1003: last_regexp = Qnil; ! 1004: staticpro (&last_regexp); ! 1005: ! 1006: defsubr (&Sstring_match); ! 1007: defsubr (&Slooking_at); ! 1008: defsubr (&Sscan_buffer); ! 1009: defsubr (&Sskip_chars_forward); ! 1010: defsubr (&Sskip_chars_backward); ! 1011: defsubr (&Ssearch_forward); ! 1012: defsubr (&Ssearch_backward); ! 1013: defsubr (&Sword_search_forward); ! 1014: defsubr (&Sword_search_backward); ! 1015: defsubr (&Sre_search_forward); ! 1016: defsubr (&Sre_search_backward); ! 1017: defsubr (&Sreplace_match); ! 1018: defsubr (&Smatch_beginning); ! 1019: defsubr (&Smatch_end); ! 1020: defsubr (&Smatch_data); ! 1021: defsubr (&Sstore_match_data); ! 1022: defsubr (&Sregexp_quote); ! 1023: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.