![[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 [Apple XNU] / GNUtools / emacs / src|
Return to search.c CVS log | Up to [Apple XNU] / GNUtools / emacs / src |
1.1 root 1: /* String search routines for GNU Emacs.
2: Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is free software; you can redistribute it and/or modify
7: it under the terms of the GNU General Public License as published by
8: the Free Software Foundation; either version 1, or (at your option)
9: any later version.
10:
11: GNU Emacs is distributed in the hope that it will be useful,
12: but WITHOUT ANY WARRANTY; without even the implied warranty of
13: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: GNU General Public License for more details.
15:
16: You should have received a copy of the GNU General Public License
17: along with GNU Emacs; see the file COPYING. If not, write to
18: the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19:
20:
21: #include "config.h"
22: #include "lisp.h"
23: #include "syntax.h"
24: #include "buffer.h"
25: #include "commands.h"
26: #include "regex.h"
27:
28: #define max(a, b) ((a) > (b) ? (a) : (b))
29: #define min(a, b) ((a) < (b) ? (a) : (b))
30:
31: unsigned char downcase_table[01000] = {0}; /* folds upper to lower case */
32: /* A WHEEL WILL FALL OFF IF, IN A trt, CHARACTER A */
33: /* TRANSLATES INTO CHARACTER B AND CHARACTER B DOES NOT */
34: /* ALSO TRANSLATE INTO CHARACTER B. */
35: /* If that constraint is met, compute_trt_inverse will follow a */
36: /* translation table with its inverse. The inverse of a table */
37: /* follows the table at table[0400]. The form of this is that if */
38: /* table[a]=b then the chain starting at table[0400+b], linked by */
39: /* link(x)=table[0400+x] and ended by b must include a. */
40:
41: /* At present compute_trt_inverse is blinded and the inverse for this */
42: /* particular table is created by a single-purpose loop. */
43: /* compute_trt_inverse has been tested on the following cases: */
44: /* trt[x]=x, trt[x]=(+ 3 (logand x, 0370)), trt[x]='a', and the */
45: /* downcase table. */
46:
47: /* We compile regexps into this buffer and then use it for searching. */
48:
49: struct re_pattern_buffer searchbuf;
50:
51: extern int re_max_failures;
52:
53: char search_fastmap[0400];
54:
55: /* Last regexp we compiled */
56:
57: Lisp_Object last_regexp;
58:
59: /* Every call to re_match, etc., must pass &search_regs as the regs argument
60: unless you can show it is unnecessary (i.e., if re_match is certainly going
61: to be called again before region-around-match can be called). */
62:
63: static struct re_registers search_regs;
64:
65: /* error condition signalled when regexp compile_pattern fails */
66:
67: Lisp_Object Qinvalid_regexp;
68:
69: /* Compile a regexp and signal a Lisp error if anything goes wrong. */
70:
71: compile_pattern (pattern, bufp, translate)
72: Lisp_Object pattern;
73: struct re_pattern_buffer *bufp;
74: char *translate;
75: {
76: char *val;
77: Lisp_Object dummy;
78:
79: if (EQ (pattern, last_regexp)
80: && translate == bufp->translate)
81: return;
82:
83: last_regexp = Qnil;
84: bufp->translate = translate;
85: val = re_compile_pattern (XSTRING (pattern)->data,
86: XSTRING (pattern)->size,
87: bufp);
88: if (val)
89: {
90: dummy = build_string (val);
91: while (1)
92: Fsignal (Qinvalid_regexp, Fcons (dummy, Qnil));
93: }
94: last_regexp = pattern;
95: return;
96: }
97:
98: /* Error condition used for failing searches */
99: Lisp_Object Qsearch_failed;
100:
101: Lisp_Object
102: signal_failure (arg)
103: Lisp_Object arg;
104: {
105: Fsignal (Qsearch_failed, Fcons (arg, Qnil));
106: return Qnil;
107: }
108:
109: DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0,
110: "t if text after point matches regular expression PAT.")
111: (string)
112: Lisp_Object string;
113: {
114: Lisp_Object val;
115: unsigned char *p1, *p2;
116: int s1, s2;
117: register int i;
118:
119: CHECK_STRING (string, 0);
120: compile_pattern (string, &searchbuf,
121: !NULL (current_buffer->case_fold_search) ? (char *) downcase_table : 0);
122:
123: immediate_quit = 1;
124: QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */
125:
126: /* Get pointers and sizes of the two strings
127: that make up the visible portion of the buffer. */
128:
129: p1 = BEGV_ADDR;
130: s1 = GPT - BEGV;
131: p2 = GAP_END_ADDR;
132: s2 = ZV - GPT;
133: if (s1 < 0)
134: {
135: p2 = p1;
136: s2 = ZV - BEGV;
137: s1 = 0;
138: }
139: if (s2 < 0)
140: {
141: s1 = ZV - BEGV;
142: s2 = 0;
143: }
144:
145: val = (0 <= re_match_2 (&searchbuf, p1, s1, p2, s2,
146: point - BEGV, &search_regs, ZV - BEGV)
147: ? Qt : Qnil);
148: for (i = 0; i < RE_NREGS; i++)
149: if (search_regs.start[i] >= 0)
150: {
151: search_regs.start[i] += BEGV;
152: search_regs.end[i] += BEGV;
153: }
154: immediate_quit = 0;
155: return val;
156: }
157:
158: DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0,
159: "Return index of start of first match for REGEXP in STRING, or nil.\n\
160: If third arg START is non-nil, start search at that index in STRING.\n\
161: For index of first char beyond the match, do (match-end 0).\n\
162: match-end and match-beginning also give indices of substrings\n\
163: matched by parenthesis constructs in the pattern.")
164: (regexp, string, start)
165: Lisp_Object regexp, string, start;
166: {
167: int val;
168: int s;
169:
170: CHECK_STRING (regexp, 0);
171: CHECK_STRING (string, 1);
172:
173: if (NULL (start))
174: s = 0;
175: else
176: {
177: int len = XSTRING (string)->size;
178:
179: CHECK_NUMBER (start, 2);
180: s = XINT (start);
181: if (s < 0 && -s <= len)
182: s = len - s;
183: else if (0 > s || s > len)
184: args_out_of_range (string, start);
185: }
186:
187: compile_pattern (regexp, &searchbuf,
188: !NULL (current_buffer->case_fold_search) ? (char *) downcase_table : 0);
189: immediate_quit = 1;
190: val = re_search (&searchbuf, XSTRING (string)->data, XSTRING (string)->size,
191: s, XSTRING (string)->size - s, &search_regs);
192: immediate_quit = 0;
193: if (val == -2)
194: error ("Overflow in regular expression matching");
195: if (val < 0) return Qnil;
196: return make_number (val);
197: }
198:
199: scan_buffer (target, pos, cnt, shortage)
200: int *shortage, pos;
201: register int cnt, target;
202: {
203: int lim = ((cnt > 0) ? ZV - 1 : BEGV);
204: int direction = ((cnt > 0) ? 1 : -1);
205: register int lim0;
206: unsigned char *base;
207: register unsigned char *cursor, *limit;
208:
209: if (shortage != 0)
210: *shortage = 0;
211:
212: immediate_quit = 1;
213:
214: if (cnt > 0)
215: while (pos != lim + 1)
216: {
217: lim0 = BufferSafeCeiling (pos);
218: lim0 = min (lim, lim0);
219: limit = &FETCH_CHAR (lim0) + 1;
220: base = (cursor = &FETCH_CHAR (pos));
221: while (1)
222: {
223: while (*cursor != target && ++cursor != limit)
224: ;
225: if (cursor != limit)
226: {
227: if (--cnt == 0)
228: {
229: immediate_quit = 0;
230: return (pos + cursor - base + 1);
231: }
232: else
233: if (++cursor == limit)
234: break;
235: }
236: else
237: break;
238: }
239: pos += cursor - base;
240: }
241: else
242: {
243: pos--; /* first character we scan */
244: while (pos > lim - 1)
245: { /* we WILL scan under pos */
246: lim0 = BufferSafeFloor (pos);
247: lim0 = max (lim, lim0);
248: limit = &FETCH_CHAR (lim0) - 1;
249: base = (cursor = &FETCH_CHAR (pos));
250: cursor++;
251: while (1)
252: {
253: while (--cursor != limit && *cursor != target)
254: ;
255: if (cursor != limit)
256: {
257: if (++cnt == 0)
258: {
259: immediate_quit = 0;
260: return (pos + cursor - base + 1);
261: }
262: }
263: else
264: break;
265: }
266: pos += cursor - base;
267: }
268: }
269: immediate_quit = 0;
270: if (shortage != 0)
271: *shortage = cnt * direction;
272: return (pos + ((direction == 1 ? 0 : 1)));
273: }
274:
275: int
276: find_next_newline (from, cnt)
277: register int from, cnt;
278: {
279: return (scan_buffer ('\n', from, cnt, (int *) 0));
280: }
281:
282: DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0,
283: "Move point forward, stopping before a char not in CHARS, or at position LIM.\n\
284: CHARS is like the inside of a [...] in a regular expression\n\
285: except that ] is never special and \\ quotes ^, - or \\.\n\
286: Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
287: With arg \"^a-zA-Z\", skips nonletters stopping before first letter.")
288: (string, lim)
289: Lisp_Object string, lim;
290: {
291: skip_chars (1, string, lim);
292: return Qnil;
293: }
294:
295: DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
296: "Move point backward, stopping after a char not in CHARS, or at position LIM.\n\
297: See skip-chars-forward for details.")
298: (string, lim)
299: Lisp_Object string, lim;
300: {
301: skip_chars (0, string, lim);
302: return Qnil;
303: }
304:
305: skip_chars (forwardp, string, lim)
306: int forwardp;
307: Lisp_Object string, lim;
308: {
309: register unsigned char *p, *pend;
310: register unsigned char c;
311: unsigned char fastmap[0400];
312: int negate = 0;
313: register int i;
314:
315: CHECK_STRING (string, 0);
316:
317: if (NULL (lim))
318: XFASTINT (lim) = forwardp ? ZV : BEGV;
319: else
320: CHECK_NUMBER_COERCE_MARKER (lim, 1);
321:
322: /* In any case, don't allow scan outside bounds of buffer. */
323: if (XFASTINT (lim) > ZV)
324: XFASTINT (lim) = ZV;
325: if (XFASTINT (lim) < BEGV)
326: XFASTINT (lim) = BEGV;
327:
328: p = XSTRING (string)->data;
329: pend = p + XSTRING (string)->size;
330: bzero (fastmap, sizeof fastmap);
331:
332: if (p != pend && *p == '^')
333: {
334: negate = 1; p++;
335: }
336:
337: /* Find the characters specified and set their elements of fastmap. */
338:
339: while (p != pend)
340: {
341: c = *p++;
342: if (c == '\\')
343: {
344: if (p == pend) break;
345: c = *p++;
346: }
347: if (p != pend && *p == '-')
348: {
349: p++;
350: if (p == pend) break;
351: while (c <= *p)
352: {
353: fastmap[c] = 1;
354: c++;
355: }
356: p++;
357: }
358: else
359: fastmap[c] = 1;
360: }
361:
362: /* If ^ was the first character, complement the fastmap. */
363:
364: if (negate)
365: for (i = 0; i < sizeof fastmap; i++)
366: fastmap[i] ^= 1;
367:
368: immediate_quit = 1;
369: if (forwardp)
370: {
371: while (point < XINT (lim) && fastmap[FETCH_CHAR (point)])
372: SET_PT (point + 1);
373: }
374: else
375: {
376: while (point > XINT (lim) && fastmap[FETCH_CHAR (point - 1)])
377: SET_PT (point - 1);
378: }
379: immediate_quit = 0;
380: }
381:
382: /* Subroutines of Lisp buffer search functions. */
383:
384: static Lisp_Object
385: search_command (string, bound, noerror, count, direction, RE)
386: Lisp_Object string, bound, noerror, count;
387: int direction;
388: int RE;
389: {
390: register int np;
391: int lim;
392: int n = direction;
393:
394: if (!NULL (count))
395: {
396: CHECK_NUMBER (count, 3);
397: n *= XINT (count);
398: }
399:
400: CHECK_STRING (string, 0);
401: if (NULL (bound))
402: lim = n > 0 ? ZV : BEGV;
403: else
404: {
405: CHECK_NUMBER_COERCE_MARKER (bound, 1);
406: lim = XINT (bound);
407: if (n > 0 ? lim < point : lim > point)
408: error ("Invalid search bound (wrong side of point)");
409: if (lim > ZV)
410: lim = ZV;
411: if (lim < BEGV)
412: lim = BEGV;
413: }
414:
415: np = search_buffer (string, point, lim, n, RE,
416: !NULL (current_buffer->case_fold_search) ? downcase_table : 0);
417: if (np <= 0)
418: {
419: if (NULL (noerror))
420: return signal_failure (string);
421: if (!EQ (noerror, Qt))
422: {
423: if (lim < BEGV || lim > ZV)
424: abort ();
425: SET_PT (lim);
426: }
427: return Qnil;
428: }
429:
430: if (np < BEGV || np > ZV)
431: abort ();
432:
433: SET_PT (np);
434:
435: return Qt;
436: }
437:
438: /* search for the n'th occurrence of `string' in the current buffer,
439: starting at position `from' and stopping at position `lim',
440: treating `pat' as a literal string if `RE' is false or as
441: a regular expression if `RE' is true.
442:
443: If `n' is positive, searching is forward and `lim' must be greater than `from'.
444: If `n' is negative, searching is backward and `lim' must be less than `from'.
445:
446: Returns -x if only `n'-x occurrences found (x > 0),
447: or else the position at the beginning of the `n'th occurrence (if searching backward)
448: or the end (if searching forward). */
449:
450: /* INTERFACE CHANGE ALERT!!!! search_buffer now returns -x if only */
451: /* n-x occurences are found. */
452:
453: search_buffer (string, pos, lim, n, RE, trt)
454: Lisp_Object string;
455: int pos;
456: int lim;
457: int n;
458: int RE;
459: register unsigned char *trt;
460: {
461: int len = XSTRING (string)->size;
462: unsigned char *base_pat = XSTRING (string)->data;
463: register int *BM_tab;
464: int *BM_tab_base;
465: register int direction = ((n > 0) ? 1 : -1);
466: register int dirlen;
467: int infinity, limit, k, stride_for_teases;
468: register unsigned char *pat, *cursor, *p_limit;
469: register int i, j;
470: unsigned char *p1, *p2;
471: int s1, s2;
472:
473:
474: if (!len)
475: return (0);
476:
477: if (RE)
478: compile_pattern (string, &searchbuf, (char *) trt);
479:
480: if (RE /* Here we detect whether the */
481: /* generality of an RE search is */
482: /* really needed. */
483: && *(searchbuf.buffer) == (char) exactn /* first item is "exact match" */
484: && searchbuf.buffer[1] + 2 == searchbuf.used) /*first is ONLY item */
485: {
486: RE = 0; /* can do straight (non RE) search */
487: pat = (base_pat = (unsigned char *) searchbuf.buffer + 2);
488: /* trt already applied */
489: len = searchbuf.used - 2;
490: }
491: else if (!RE)
492: {
493: pat = (unsigned char *) alloca (len);
494:
495: for (i = len; i--;) /* Copy the pattern; apply trt */
496: *pat++ = (((int) trt) ? trt [*base_pat++] : *base_pat++);
497: pat -= len; base_pat = pat;
498: }
499:
500: if (RE)
501: {
502: immediate_quit = 1; /* Quit immediately if user types ^G,
503: because letting this function finish
504: can take too long. */
505: QUIT; /* Do a pending quit right away,
506: to avoid paradoxical behavior */
507: /* Get pointers and sizes of the two strings
508: that make up the visible portion of the buffer. */
509:
510: p1 = BEGV_ADDR;
511: s1 = GPT - BEGV;
512: p2 = GAP_END_ADDR;
513: s2 = ZV - GPT;
514: if (s1 < 0)
515: {
516: p2 = p1;
517: s2 = ZV - BEGV;
518: s1 = 0;
519: }
520: if (s2 < 0)
521: {
522: s1 = ZV - BEGV;
523: s2 = 0;
524: }
525: while (n < 0)
526: {
527: int value = re_search_2 (&searchbuf, p1, s1, p2, s2,
528: pos - BEGV, lim - pos, &search_regs,
529: /* Don't allow match past current point */
530: pos - BEGV);
531: if (value == -2)
532: error ("Overflow in regular expression matching");
533:
534: if (value >= 0)
535: {
536: j = BEGV;
537: for (i = 0; i < RE_NREGS; i++)
538: if (search_regs.start[i] >= 0)
539: {
540: search_regs.start[i] += j;
541: search_regs.end[i] += j;
542: }
543: /* Set pos to the new position. */
544: pos = search_regs.start[0];
545: }
546: else
547: {
548: immediate_quit = 0;
549: return (n);
550: }
551: n++;
552: }
553: while (n > 0)
554: {
555: int value = re_search_2 (&searchbuf, p1, s1, p2, s2,
556: pos - BEGV, lim - pos, &search_regs,
557: lim - BEGV);
558: if (value == -2)
559: error ("Overflow in regular expression matching");
560:
561: if (value >= 0)
562: {
563: j = BEGV;
564: for (i = 0; i < RE_NREGS; i++)
565: if (search_regs.start[i] >= 0)
566: {
567: search_regs.start[i] += j;
568: search_regs.end[i] += j;
569: }
570: pos = search_regs.end[0];
571: }
572: else
573: {
574: immediate_quit = 0;
575: return (0 - n);
576: }
577: n--;
578: }
579: immediate_quit = 0;
580: return (pos);
581: }
582: else /* non-RE case */
583: {
584: #ifdef C_ALLOCA
585: int BM_tab_space[0400];
586: BM_tab = &BM_tab_space[0];
587: #else
588: BM_tab = (int *) alloca (0400 * sizeof (int));
589: #endif
590: /* The general approach is that we are going to maintain that we know */
591: /* the first (closest to the present position, in whatever direction */
592: /* we're searching) character that could possibly be the last */
593: /* (furthest from present position) character of a valid match. We */
594: /* advance the state of our knowledge by looking at that character */
595: /* and seeing whether it indeed matches the last character of the */
596: /* pattern. If it does, we take a closer look. If it does not, we */
597: /* move our pointer (to putative last characters) as far as is */
598: /* logically possible. This amount of movement, which I call a */
599: /* stride, will be the length of the pattern if the actual character */
600: /* appears nowhere in the pattern, otherwise it will be the distance */
601: /* from the last occurrence of that character to the end of the */
602: /* pattern. */
603: /* As a coding trick, an enormous stride is coded into the table for */
604: /* characters that match the last character. This allows use of only */
605: /* a single test, a test for having gone past the end of the */
606: /* permissible match region, to test for both possible matches (when */
607: /* the stride goes past the end immediately) and failure to */
608: /* match (where you get nudged past the end one stride at a time). */
609:
610: /* Here we make a "mickey mouse" BM table. The stride of the search */
611: /* is determined only by the last character of the putative match. */
612: /* If that character does not match, we will stride the proper */
613: /* distance to propose a match that superimposes it on the last */
614: /* instance of a character that matches it (per trt), or misses */
615: /* it entirely if there is none. */
616:
617: dirlen = len * direction;
618: infinity = dirlen - (lim + pos + len + len) * direction;
619: if (direction < 0)
620: pat = (base_pat += len - 1);
621: BM_tab_base = BM_tab;
622: BM_tab += 0400;
623: j = dirlen; /* to get it in a register */
624: /* A character that does not appear in the pattern induces a */
625: /* stride equal to the pattern length. */
626: while (BM_tab_base != BM_tab)
627: {
628: *--BM_tab = j;
629: *--BM_tab = j;
630: *--BM_tab = j;
631: *--BM_tab = j;
632: }
633: i = 0;
634: while (i != infinity)
635: {
636: j = pat[i]; i += direction;
637: if (i == dirlen) i = infinity;
638: if ((int) trt)
639: {
640: k = (j = trt[j]);
641: if (i == infinity)
642: stride_for_teases = BM_tab[j];
643: BM_tab[j] = dirlen - i;
644: /* A translation table is followed by its inverse -- see */
645: /* comment following downcase_table for details */
646:
647: while ((j = trt[0400+j]) != k)
648: BM_tab[j] = dirlen - i;
649: }
650: else
651: {
652: if (i == infinity)
653: stride_for_teases = BM_tab[j];
654: BM_tab[j] = dirlen - i;
655: }
656: /* stride_for_teases tells how much to stride if we get a */
657: /* match on the far character but are subsequently */
658: /* disappointed, by recording what the stride would have been */
659: /* for that character if the last character had been */
660: /* different. */
661: }
662: infinity = dirlen - infinity;
663: pos += dirlen - ((direction > 0) ? direction : 0);
664: /* loop invariant - pos points at where last char (first char if reverse)
665: of pattern would align in a possible match. */
666: while (n != 0)
667: {
668: if ((lim - pos - (direction > 0)) * direction < 0)
669: return (n * (0 - direction));
670: /* First we do the part we can by pointers (maybe nothing) */
671: QUIT;
672: pat = base_pat;
673: limit = pos - dirlen + direction;
674: limit = ((direction > 0)
675: ? BufferSafeCeiling (limit)
676: : BufferSafeFloor (limit));
677: /* LIMIT is now the last (not beyond-last!) value
678: POS can take on without hitting edge of buffer or the gap. */
679: limit = ((direction > 0)
680: ? min (lim - 1, min (limit, pos + 20000))
681: : max (lim, max (limit, pos - 20000)));
682: if ((limit - pos) * direction > 20)
683: {
684: p_limit = &FETCH_CHAR (limit);
685: p2 = (cursor = &FETCH_CHAR (pos));
686: /* In this loop, pos + cursor - p2 is the surrogate for pos */
687: while (1) /* use one cursor setting as long as i can */
688: {
689: if (direction > 0) /* worth duplicating */
690: {
691: /* Use signed comparison if appropriate
692: to make cursor+infinity sure to be > p_limit.
693: Assuming that the buffer lies in a range of addresses
694: that are all "positive" (as ints) or all "negative",
695: either kind of comparison will work as long
696: as we don't step by infinity. So pick the kind
697: that works when we do step by infinity. */
698: if ((int) (p_limit + infinity) > (int) p_limit)
699: while ((int) cursor <= (int) p_limit)
700: cursor += BM_tab[*cursor];
701: else
702: while ((unsigned int) cursor <= (unsigned int) p_limit)
703: cursor += BM_tab[*cursor];
704: }
705: else
706: {
707: if ((int) (p_limit + infinity) < (int) p_limit)
708: while ((int) cursor >= (int) p_limit)
709: cursor += BM_tab[*cursor];
710: else
711: while ((unsigned int) cursor >= (unsigned int) p_limit)
712: cursor += BM_tab[*cursor];
713: }
714: /* If you are here, cursor is beyond the end of the searched region. */
715: /* This can happen if you match on the far character of the pattern, */
716: /* because the "stride" of that character is infinity, a number able */
717: /* to throw you well beyond the end of the search. It can also */
718: /* happen if you fail to match within the permitted region and would */
719: /* otherwise try a character beyond that region */
720: if ((cursor - p_limit) * direction <= len)
721: break; /* a small overrun is genuine */
722: cursor -= infinity; /* large overrun = hit */
723: i = dirlen - direction;
724: if ((int) trt)
725: {
726: while ((i -= direction) + direction != 0)
727: if (pat[i] != trt[*(cursor -= direction)])
728: break;
729: }
730: else
731: {
732: while ((i -= direction) + direction != 0)
733: if (pat[i] != *(cursor -= direction))
734: break;
735: }
736: cursor += dirlen - i - direction; /* fix cursor */
737: if (i + direction == 0)
738: {
739: cursor -= direction;
740: search_regs.start[0]
741: = pos + cursor - p2 + ((direction > 0)
742: ? 1 - len : 0);
743: search_regs.end[0] = len + search_regs.start[0];
744: if ((n -= direction) != 0)
745: cursor += dirlen; /* to resume search */
746: else
747: return ((direction > 0)
748: ? search_regs.end[0] : search_regs.start[0]);
749: }
750: else
751: cursor += stride_for_teases; /* <sigh> we lose - */
752: }
753: pos += cursor - p2;
754: }
755: else
756: /* Now we'll pick up a clump that has to be done the hard */
757: /* way because it covers a discontinuity */
758: {
759: limit = ((direction > 0)
760: ? BufferSafeCeiling (pos - dirlen + 1)
761: : BufferSafeFloor (pos - dirlen - 1));
762: limit = ((direction > 0)
763: ? min (limit + len, lim - 1)
764: : max (limit - len, lim));
765: /* LIMIT is now the last value POS can have
766: and still be valid for a possible match. */
767: while (1)
768: {
769: /* This loop can be coded for space rather than */
770: /* speed because it will usually run only once. */
771: /* (the reach is at most len + 21, and typically */
772: /* does not exceed len) */
773: while ((limit - pos) * direction >= 0)
774: pos += BM_tab[FETCH_CHAR(pos)];
775: /* now run the same tests to distinguish going off the */
776: /* end, a match or a phoney match. */
777: if ((pos - limit) * direction <= len)
778: break; /* ran off the end */
779: /* Found what might be a match.
780: Set POS back to last (first if reverse) char pos. */
781: pos -= infinity;
782: i = dirlen - direction;
783: while ((i -= direction) + direction != 0)
784: {
785: pos -= direction;
786: if (pat[i] != (((int) trt)
787: ? trt[FETCH_CHAR(pos)]
788: : FETCH_CHAR (pos)))
789: break;
790: }
791: /* Above loop has moved POS part or all the way
792: back to the first char pos (last char pos if reverse).
793: Set it once again at the last (first if reverse) char. */
794: pos += dirlen - i- direction;
795: if (i + direction == 0)
796: {
797: pos -= direction;
798: search_regs.start[0]
799: = pos + ((direction > 0) ? 1 - len : 0);
800: search_regs.end[0] = len + search_regs.start[0];
801: if ((n -= direction) != 0)
802: pos += dirlen; /* to resume search */
803: else
804: return ((direction > 0)
805: ? search_regs.end[0] : search_regs.start[0]);
806: }
807: else
808: pos += stride_for_teases;
809: }
810: }
811: /* We have done one clump. Can we continue? */
812: if ((lim - pos) * direction < 0)
813: return ((0 - n) * direction);
814: }
815: return pos;
816: }
817: }
818:
819: /* Given a string of words separated by word delimiters,
820: compute a regexp that matches those exact words
821: separated by arbitrary punctuation. */
822:
823: static Lisp_Object
824: wordify (string)
825: Lisp_Object string;
826: {
827: register unsigned char *p, *o;
828: register int i, len, punct_count = 0, word_count = 0;
829: Lisp_Object val;
830:
831: CHECK_STRING (string, 0);
832: p = XSTRING (string)->data;
833: len = XSTRING (string)->size;
834:
835: for (i = 0; i < len; i++)
836: if (SYNTAX (p[i]) != Sword)
837: {
838: punct_count++;
839: if (i > 0 && SYNTAX (p[i-1]) == Sword) word_count++;
840: }
841: if (SYNTAX (p[len-1]) == Sword) word_count++;
842: if (!word_count) return build_string ("");
843:
844: val = make_string (p, len - punct_count + 5 * (word_count - 1) + 4);
845:
846: o = XSTRING (val)->data;
847: *o++ = '\\';
848: *o++ = 'b';
849:
850: for (i = 0; i < len; i++)
851: if (SYNTAX (p[i]) == Sword)
852: *o++ = p[i];
853: else if (i > 0 && SYNTAX (p[i-1]) == Sword && --word_count)
854: {
855: *o++ = '\\';
856: *o++ = 'W';
857: *o++ = '\\';
858: *o++ = 'W';
859: *o++ = '*';
860: }
861:
862: *o++ = '\\';
863: *o++ = 'b';
864:
865: return val;
866: }
867:
868: DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
869: "sSearch backward: ",
870: "Search backward from point for STRING.\n\
871: Set point to the beginning of the occurrence found, and return t.\n\
872: An optional second argument bounds the search; it is a buffer position.\n\
873: The match found must not extend before that position.\n\
874: Optional third argument, if t, means if fail just return nil (no error).\n\
875: If not nil and not t, position at limit of search and return nil.\n\
876: Optional fourth argument is repeat count--search for successive occurrences.\n\
877: See also the functions match-beginning and match-end and replace-match.")
878: (string, bound, noerror, count)
879: Lisp_Object string, bound, noerror, count;
880: {
881: return search_command (string, bound, noerror, count, -1, 0);
882: }
883:
884: DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "sSearch: ",
885: "Search forward from point for STRING.\n\
886: Set point to the end of the occurrence found, and return t.\n\
887: An optional second argument bounds the search; it is a buffer position.\n\
888: The match found must not extend after that position.\n\
889: Optional third argument, if t, means if fail just return nil (no error).\n\
890: If not nil and not t, move to limit of search and return nil.\n\
891: Optional fourth argument is repeat count--search for successive occurrences.\n\
892: See also the functions match-beginning and match-end and replace-match.")
893: (string, bound, noerror, count)
894: Lisp_Object string, bound, noerror, count;
895: {
896: return search_command (string, bound, noerror, count, 1, 0);
897: }
898:
899: DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
900: "sWord search backward: ",
901: "Search backward from point for STRING, ignoring differences in punctuation.\n\
902: Set point to the beginning of the occurrence found, and return t.\n\
903: An optional second argument bounds the search; it is a buffer position.\n\
904: The match found must not extend before that position.\n\
905: Optional third argument, if t, means if fail just return nil (no error).\n\
906: If not nil and not t, move to limit of search and return nil.\n\
907: Optional fourth argument is repeat count--search for successive occurrences.")
908: (string, bound, noerror, count)
909: Lisp_Object string, bound, noerror, count;
910: {
911: return search_command (wordify (string), bound, noerror, count, -1, 1);
912: }
913:
914: DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
915: "sWord search: ",
916: "Search forward from point for STRING, ignoring differences in punctuation.\n\
917: Set point to the end of the occurrence found, and return t.\n\
918: An optional second argument bounds the search; it is a buffer position.\n\
919: The match found must not extend after that position.\n\
920: Optional third argument, if t, means if fail just return nil (no error).\n\
921: If not nil and not t, move to limit of search and return nil.\n\
922: Optional fourth argument is repeat count--search for successive occurrences.")
923: (string, bound, noerror, count)
924: Lisp_Object string, bound, noerror, count;
925: {
926: return search_command (wordify (string), bound, noerror, count, 1, 1);
927: }
928:
929: DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
930: "sRE search backward: ",
931: "Search backward from point for match for regular expression REGEXP.\n\
932: Set point to the beginning of the match, and return t.\n\
933: The match found is the one starting last in the buffer\n\
934: and yet ending before the place the origin of the search.\n\
935: An optional second argument bounds the search; it is a buffer position.\n\
936: The match found must start at or after that position.\n\
937: Optional third argument, if t, means if fail just return nil (no error).\n\
938: If not nil and not t, move to limit of search and return nil.\n\
939: Optional fourth argument is repeat count--search for successive occurrences.\n\
940: See also the functions match-beginning and match-end and replace-match.")
941: (string, bound, noerror, count)
942: Lisp_Object string, bound, noerror, count;
943: {
944: return search_command (string, bound, noerror, count, -1, 1);
945: }
946:
947: DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4,
948: "sRE search: ",
949: "Search forward from point for regular expression REGEXP.\n\
950: Set point to the end of the occurrence found, and return t.\n\
951: An optional second argument bounds the search; it is a buffer position.\n\
952: The match found must not extend after that position.\n\
953: Optional third argument, if t, means if fail just return nil (no error).\n\
954: If not nil and not t, move to limit of search and return nil.\n\
955: Optional fourth argument is repeat count--search for successive occurrences.\n\
956: See also the functions match-beginning and match-end and replace-match.")
957: (string, bound, noerror, count)
958: Lisp_Object string, bound, noerror, count;
959: {
960: return search_command (string, bound, noerror, count, 1, 1);
961: }
962:
963: DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 3, 0,
964: "Replace text matched by last search with NEWTEXT.\n\
965: If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\
966: Otherwise convert to all caps or cap initials, like replaced text.\n\
967: If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\
968: Otherwise treat \\ as special:\n\
969: \\& in NEWTEXT means substitute original matched text,\n\
970: \\N means substitute match for \\(...\\) number N,\n\
971: \\\\ means insert one \\.\n\
972: Leaves point at end of replacement text.")
973: (string, fixedcase, literal)
974: Lisp_Object string, fixedcase, literal;
975: {
976: enum { nochange, all_caps, cap_initial } case_action;
977: register int pos, last;
978: int some_multiletter_word;
979: int some_letter = 0;
980: register int c, prevc;
981: int inslen;
982:
983: CHECK_STRING (string, 0);
984:
985: case_action = nochange; /* We tried an initialization */
986: /* but some C compilers blew it */
987: if (search_regs.start[0] < BEGV
988: || search_regs.start[0] > search_regs.end[0]
989: || search_regs.end[0] > ZV)
990: args_out_of_range(make_number (search_regs.start[0]),
991: make_number (search_regs.end[0]));
992:
993: if (NULL (fixedcase))
994: {
995: /* Decide how to casify by examining the matched text. */
996:
997: last = search_regs.end[0];
998: prevc = '\n';
999: case_action = all_caps;
1000:
1001: /* some_multiletter_word is set nonzero if any original word
1002: is more than one letter long. */
1003: some_multiletter_word = 0;
1004:
1005: for (pos = search_regs.start[0]; pos < last; pos++)
1006: {
1007: c = FETCH_CHAR (pos);
1008: if (LOWERCASEP (c))
1009: {
1010: /* Cannot be all caps if any original char is lower case */
1011:
1012: case_action = cap_initial;
1013: if (SYNTAX (prevc) != Sword)
1014: {
1015: /* Cannot even be cap initials
1016: if some original initial is lower case */
1017: case_action = nochange;
1018: break;
1019: }
1020: else
1021: some_multiletter_word = 1;
1022: }
1023: else if (!NOCASEP (c))
1024: {
1025: some_letter = 1;
1026: if (!some_multiletter_word && SYNTAX (prevc) == Sword)
1027: some_multiletter_word = 1;
1028: }
1029:
1030: prevc = c;
1031: }
1032:
1033: /* Do not make new text all caps
1034: if the original text contained only single letter words. */
1035: if (case_action == all_caps && !some_multiletter_word)
1036: case_action = cap_initial;
1037:
1038: if (!some_letter) case_action = nochange;
1039: }
1040:
1041: SET_PT (search_regs.end[0]);
1042: if (!NULL (literal))
1043: Finsert (1, &string);
1044: else
1045: {
1046: struct gcpro gcpro1;
1047: GCPRO1 (string);
1048: for (pos = 0; pos < XSTRING (string)->size; pos++)
1049: {
1050: c = XSTRING (string)->data[pos];
1051: if (c == '\\')
1052: {
1053: c = XSTRING (string)->data[++pos];
1054: if (c == '&')
1055: Finsert_buffer_substring (Fcurrent_buffer (),
1056: make_number (search_regs.start[0]),
1057: make_number (search_regs.end[0]));
1058: else if (c >= '1' && c <= RE_NREGS + '0')
1059: {
1060: if (search_regs.start[c - '0'] >= 1)
1061: Finsert_buffer_substring (Fcurrent_buffer (),
1062: make_number (search_regs.start[c - '0']),
1063: make_number (search_regs.end[c - '0']));
1064: }
1065: else
1066: insert_char (c);
1067: }
1068: else
1069: insert_char (c);
1070: }
1071: UNGCPRO;
1072: }
1073:
1074: inslen = point - (search_regs.end[0]);
1075: del_range (search_regs.start[0], search_regs.end[0]);
1076:
1077: if (case_action == all_caps)
1078: Fupcase_region (make_number (point - inslen), make_number (point));
1079: else if (case_action == cap_initial)
1080: upcase_initials_region (make_number (point - inslen), make_number (point));
1081: return Qnil;
1082: }
1083:
1084: static Lisp_Object
1085: match_limit (num, beginningp)
1086: Lisp_Object num;
1087: int beginningp;
1088: {
1089: register int n;
1090:
1091: CHECK_NUMBER (num, 0);
1092: n = XINT (num);
1093: if (n < 0 || n >= RE_NREGS)
1094: args_out_of_range (num, make_number (RE_NREGS));
1095: if (search_regs.start[n] < 0)
1096: return Qnil;
1097: return (make_number ((beginningp) ? search_regs.start[n]
1098: : search_regs.end[n]));
1099: }
1100:
1101: DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
1102: "Return the character number of start of text matched by last search.\n\
1103: ARG, a number, specifies which parenthesized expression in the last regexp.\n\
1104: Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
1105: Zero means the entire text matched by the whole regexp or whole string.")
1106: (num)
1107: Lisp_Object num;
1108: {
1109: return match_limit (num, 1);
1110: }
1111:
1112: DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0,
1113: "Return the character number of end of text matched by last search.\n\
1114: ARG, a number, specifies which parenthesized expression in the last regexp.\n\
1115: Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
1116: Zero means the entire text matched by the whole regexp or whole string.")
1117: (num)
1118: Lisp_Object num;
1119: {
1120: return match_limit (num, 0);
1121: }
1122:
1123: DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 0, 0,
1124: "Return list containing all info on what the last search matched.\n\
1125: Element 2N is (match-beginning N); element 2N + 1 is (match-end N).\n\
1126: All the elements are normally markers, or nil if the Nth pair didn't match.\n\
1127: 0 is also possible, when matching was done with `string-match',\n\
1128: if a match began at index 0 in the string.")
1129: ()
1130: {
1131: Lisp_Object data[2 * RE_NREGS];
1132: int i, len;
1133:
1134: len = -1;
1135: for (i = 0; i < RE_NREGS; i++)
1136: {
1137: int start = search_regs.start[i];
1138: if (start >= 0)
1139: {
1140: /* Use an integer if the value is out of range for the
1141: size of the current buffer. */
1142: if (start < BEG || start > Z)
1143: XFASTINT (data[2 * i]) = start;
1144: else
1145: {
1146: data[2 * i] = Fmake_marker ();
1147: Fset_marker (data[2 * i], make_number (start), Qnil);
1148: }
1149:
1150: if (search_regs.end[i] < BEG || search_regs.end[i] > Z)
1151: XFASTINT (data[2 * i + 1]) = search_regs.end[i];
1152: else
1153: {
1154: data[2 * i + 1] = Fmake_marker ();
1155: Fset_marker (data[2 * i + 1],
1156: make_number (search_regs.end[i]), Qnil);
1157: }
1158: len = i;
1159: }
1160: else
1161: data[2 * i] = data [2 * i + 1] = Qnil;
1162: }
1163: return Flist (2 * len + 2, data);
1164: }
1165:
1166:
1167: DEFUN ("store-match-data", Fstore_match_data, Sstore_match_data, 1, 1, 0,
1168: "Set internal data on last search match from elements of LIST.\n\
1169: LIST should have been created by calling match-data previously.")
1170: (list)
1171: register Lisp_Object list;
1172: {
1173: register int i;
1174: register Lisp_Object marker;
1175:
1176: if (!CONSP (list) && !NULL (list))
1177: list = wrong_type_argument (Qconsp, list, 0);
1178:
1179: for (i = 0; i < RE_NREGS; i++)
1180: {
1181: marker = Fcar (list);
1182: if (NULL (marker))
1183: {
1184: search_regs.start[i] = -1;
1185: list = Fcdr (list);
1186: }
1187: else
1188: {
1189: if (XTYPE (marker) == Lisp_Marker
1190: && XMARKER (marker)->buffer == 0)
1191: XFASTINT (marker) = 0;
1192:
1193: CHECK_NUMBER_COERCE_MARKER (marker, 0);
1194: search_regs.start[i] = XINT (marker);
1195: list = Fcdr (list);
1196:
1197: marker = Fcar (list);
1198: if (XTYPE (marker) == Lisp_Marker
1199: && XMARKER (marker)->buffer == 0)
1200: XFASTINT (marker) = 0;
1201:
1202: CHECK_NUMBER_COERCE_MARKER (marker, 0);
1203: search_regs.end[i] = XINT (marker);
1204: }
1205: list = Fcdr (list);
1206: }
1207:
1208: return Qnil;
1209: }
1210:
1211: /* Quote a string to inactivate reg-expr chars */
1212:
1213: DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
1214: "Return a regexp string which matches exactly STRING and nothing else.")
1215: (str)
1216: Lisp_Object str;
1217: {
1218: register unsigned char *in, *out, *end;
1219: register unsigned char *temp;
1220:
1221: CHECK_STRING (str, 0);
1222:
1223: temp = (unsigned char *) alloca (XSTRING (str)->size * 2);
1224:
1225: /* Now copy the data into the new string, inserting escapes. */
1226:
1227: in = XSTRING (str)->data;
1228: end = in + XSTRING (str)->size;
1229: out = temp;
1230:
1231: for (; in != end; in++)
1232: {
1233: if (*in == '[' || *in == ']'
1234: || *in == '*' || *in == '.' || *in == '\\'
1235: || *in == '?' || *in == '+'
1236: || *in == '^' || *in == '$')
1237: *out++ = '\\';
1238: *out++ = *in;
1239: }
1240:
1241: return make_string (temp, out - temp);
1242: }
1243:
1244: /* This code should be unzapped when there comes to be multiple */
1245: /* translation tables. It has been certified on various cases. */
1246: /*
1247: void
1248: compute_trt_inverse (trt)
1249: register unsigned char *trt;
1250: {
1251: register int i = 0400;
1252: register unsigned char c, q;
1253:
1254: while (i--)
1255: trt[0400+i] = i;
1256: i = 0400;
1257: while (i--)
1258: {
1259: if ((q = trt[i]) != (unsigned char) i)
1260: {
1261: c = trt[q + 0400];
1262: trt[q + 0400] = i;
1263: trt[0400 + i] = c;
1264: }
1265: }
1266: }
1267: */
1268:
1269: syms_of_search ()
1270: {
1271: register int i;
1272:
1273: /* Avoid running out of regexp stack quite so soon. */
1274: re_max_failures = 10000;
1275:
1276: for (i = 0; i < 0400; i++)
1277: {
1278: downcase_table[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i;
1279: /* We do this instead of using compute_trt_inverse to save space. */
1280: /* Does it? */
1281: downcase_table[0400+i]
1282: = ((i >= 'A' && i <= 'Z')
1283: ? i + ('a' - 'A')
1284: : ((i >= 'a' && i <= 'z')
1285: ? i + ('A' - 'a')
1286: : i));
1287: }
1288: /* Use this instead when there come to be multiple translation tables.
1289: compute_trt_inverse (downcase_table); */
1290:
1291: searchbuf.allocated = 100;
1292: searchbuf.buffer = (char *) malloc (searchbuf.allocated);
1293: searchbuf.fastmap = search_fastmap;
1294:
1295: Qsearch_failed = intern ("search-failed");
1296: staticpro (&Qsearch_failed);
1297: Qinvalid_regexp = intern ("invalid-regexp");
1298: staticpro (&Qinvalid_regexp);
1299:
1300: Fput (Qsearch_failed, Qerror_conditions,
1301: Fcons (Qsearch_failed, Fcons (Qerror, Qnil)));
1302: Fput (Qsearch_failed, Qerror_message,
1303: build_string ("Search failed"));
1304:
1305: Fput (Qinvalid_regexp, Qerror_conditions,
1306: Fcons (Qinvalid_regexp, Fcons (Qerror, Qnil)));
1307: Fput (Qinvalid_regexp, Qerror_message,
1308: build_string ("Invalid regexp"));
1309:
1310: last_regexp = Qnil;
1311: staticpro (&last_regexp);
1312:
1313: defsubr (&Sstring_match);
1314: defsubr (&Slooking_at);
1315: defsubr (&Sskip_chars_forward);
1316: defsubr (&Sskip_chars_backward);
1317: defsubr (&Ssearch_forward);
1318: defsubr (&Ssearch_backward);
1319: defsubr (&Sword_search_forward);
1320: defsubr (&Sword_search_backward);
1321: defsubr (&Sre_search_forward);
1322: defsubr (&Sre_search_backward);
1323: defsubr (&Sreplace_match);
1324: defsubr (&Smatch_beginning);
1325: defsubr (&Smatch_end);
1326: defsubr (&Smatch_data);
1327: defsubr (&Sstore_match_data);
1328: defsubr (&Sregexp_quote);
1329: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.