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