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