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