![[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.