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