4.3BSD - /usr/src/new/emacs/src/search.c

   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: }

Defined functions

Defined variables