]> code.delx.au - gnu-emacs/blob - src/search.c
(make-comint): Error, if start-process is not fboundp.
[gnu-emacs] / src / search.c
1 /* String search routines for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21 #include <config.h>
22 #include "lisp.h"
23 #include "syntax.h"
24 #include "buffer.h"
25 #include "region-cache.h"
26 #include "commands.h"
27 #include "blockinput.h"
28
29 #include <sys/types.h>
30 #include "regex.h"
31
32 #define REGEXP_CACHE_SIZE 5
33
34 /* If the regexp is non-nil, then the buffer contains the compiled form
35 of that regexp, suitable for searching. */
36 struct regexp_cache {
37 struct regexp_cache *next;
38 Lisp_Object regexp;
39 struct re_pattern_buffer buf;
40 char fastmap[0400];
41 /* Nonzero means regexp was compiled to do full POSIX backtracking. */
42 char posix;
43 };
44
45 /* The instances of that struct. */
46 struct regexp_cache searchbufs[REGEXP_CACHE_SIZE];
47
48 /* The head of the linked list; points to the most recently used buffer. */
49 struct regexp_cache *searchbuf_head;
50
51
52 /* Every call to re_match, etc., must pass &search_regs as the regs
53 argument unless you can show it is unnecessary (i.e., if re_match
54 is certainly going to be called again before region-around-match
55 can be called).
56
57 Since the registers are now dynamically allocated, we need to make
58 sure not to refer to the Nth register before checking that it has
59 been allocated by checking search_regs.num_regs.
60
61 The regex code keeps track of whether it has allocated the search
62 buffer using bits in the re_pattern_buffer. This means that whenever
63 you compile a new pattern, it completely forgets whether it has
64 allocated any registers, and will allocate new registers the next
65 time you call a searching or matching function. Therefore, we need
66 to call re_set_registers after compiling a new pattern or after
67 setting the match registers, so that the regex functions will be
68 able to free or re-allocate it properly. */
69 static struct re_registers search_regs;
70
71 /* The buffer in which the last search was performed, or
72 Qt if the last search was done in a string;
73 Qnil if no searching has been done yet. */
74 static Lisp_Object last_thing_searched;
75
76 /* error condition signalled when regexp compile_pattern fails */
77
78 Lisp_Object Qinvalid_regexp;
79
80 static void set_search_regs ();
81 static void save_search_regs ();
82
83 static int search_buffer ();
84
85 static void
86 matcher_overflow ()
87 {
88 error ("Stack overflow in regexp matcher");
89 }
90
91 #ifdef __STDC__
92 #define CONST const
93 #else
94 #define CONST
95 #endif
96
97 /* Compile a regexp and signal a Lisp error if anything goes wrong.
98 PATTERN is the pattern to compile.
99 CP is the place to put the result.
100 TRANSLATE is a translation table for ignoring case, or NULL for none.
101 REGP is the structure that says where to store the "register"
102 values that will result from matching this pattern.
103 If it is 0, we should compile the pattern not to record any
104 subexpression bounds.
105 POSIX is nonzero if we want full backtracking (POSIX style)
106 for this pattern. 0 means backtrack only enough to get a valid match. */
107
108 static void
109 compile_pattern_1 (cp, pattern, translate, regp, posix)
110 struct regexp_cache *cp;
111 Lisp_Object pattern;
112 char *translate;
113 struct re_registers *regp;
114 int posix;
115 {
116 CONST char *val;
117 reg_syntax_t old;
118
119 cp->regexp = Qnil;
120 cp->buf.translate = translate;
121 cp->posix = posix;
122 BLOCK_INPUT;
123 old = re_set_syntax (RE_SYNTAX_EMACS
124 | (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
125 val = (CONST char *) re_compile_pattern ((char *) XSTRING (pattern)->data,
126 XSTRING (pattern)->size, &cp->buf);
127 re_set_syntax (old);
128 UNBLOCK_INPUT;
129 if (val)
130 Fsignal (Qinvalid_regexp, Fcons (build_string (val), Qnil));
131
132 cp->regexp = Fcopy_sequence (pattern);
133 }
134
135 /* Compile a regexp if necessary, but first check to see if there's one in
136 the cache.
137 PATTERN is the pattern to compile.
138 TRANSLATE is a translation table for ignoring case, or NULL for none.
139 REGP is the structure that says where to store the "register"
140 values that will result from matching this pattern.
141 If it is 0, we should compile the pattern not to record any
142 subexpression bounds.
143 POSIX is nonzero if we want full backtracking (POSIX style)
144 for this pattern. 0 means backtrack only enough to get a valid match. */
145
146 struct re_pattern_buffer *
147 compile_pattern (pattern, regp, translate, posix)
148 Lisp_Object pattern;
149 struct re_registers *regp;
150 char *translate;
151 int posix;
152 {
153 struct regexp_cache *cp, **cpp;
154
155 for (cpp = &searchbuf_head; ; cpp = &cp->next)
156 {
157 cp = *cpp;
158 if (!NILP (Fstring_equal (cp->regexp, pattern))
159 && cp->buf.translate == translate
160 && cp->posix == posix)
161 break;
162
163 /* If we're at the end of the cache, compile into the last cell. */
164 if (cp->next == 0)
165 {
166 compile_pattern_1 (cp, pattern, translate, regp, posix);
167 break;
168 }
169 }
170
171 /* When we get here, cp (aka *cpp) contains the compiled pattern,
172 either because we found it in the cache or because we just compiled it.
173 Move it to the front of the queue to mark it as most recently used. */
174 *cpp = cp->next;
175 cp->next = searchbuf_head;
176 searchbuf_head = cp;
177
178 /* Advise the searching functions about the space we have allocated
179 for register data. */
180 if (regp)
181 re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end);
182
183 return &cp->buf;
184 }
185
186 /* Error condition used for failing searches */
187 Lisp_Object Qsearch_failed;
188
189 Lisp_Object
190 signal_failure (arg)
191 Lisp_Object arg;
192 {
193 Fsignal (Qsearch_failed, Fcons (arg, Qnil));
194 return Qnil;
195 }
196 \f
197 static Lisp_Object
198 looking_at_1 (string, posix)
199 Lisp_Object string;
200 int posix;
201 {
202 Lisp_Object val;
203 unsigned char *p1, *p2;
204 int s1, s2;
205 register int i;
206 struct re_pattern_buffer *bufp;
207
208 if (running_asynch_code)
209 save_search_regs ();
210
211 CHECK_STRING (string, 0);
212 bufp = compile_pattern (string, &search_regs,
213 (!NILP (current_buffer->case_fold_search)
214 ? DOWNCASE_TABLE : 0),
215 posix);
216
217 immediate_quit = 1;
218 QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */
219
220 /* Get pointers and sizes of the two strings
221 that make up the visible portion of the buffer. */
222
223 p1 = BEGV_ADDR;
224 s1 = GPT - BEGV;
225 p2 = GAP_END_ADDR;
226 s2 = ZV - GPT;
227 if (s1 < 0)
228 {
229 p2 = p1;
230 s2 = ZV - BEGV;
231 s1 = 0;
232 }
233 if (s2 < 0)
234 {
235 s1 = ZV - BEGV;
236 s2 = 0;
237 }
238
239 i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
240 point - BEGV, &search_regs,
241 ZV - BEGV);
242 if (i == -2)
243 matcher_overflow ();
244
245 val = (0 <= i ? Qt : Qnil);
246 for (i = 0; i < search_regs.num_regs; i++)
247 if (search_regs.start[i] >= 0)
248 {
249 search_regs.start[i] += BEGV;
250 search_regs.end[i] += BEGV;
251 }
252 XSETBUFFER (last_thing_searched, current_buffer);
253 immediate_quit = 0;
254 return val;
255 }
256
257 DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0,
258 "Return t if text after point matches regular expression REGEXP.\n\
259 This function modifies the match data that `match-beginning',\n\
260 `match-end' and `match-data' access; save and restore the match\n\
261 data if you want to preserve them.")
262 (regexp)
263 Lisp_Object regexp;
264 {
265 return looking_at_1 (regexp, 0);
266 }
267
268 DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0,
269 "Return t if text after point matches regular expression REGEXP.\n\
270 Find the longest match, in accord with Posix regular expression rules.\n\
271 This function modifies the match data that `match-beginning',\n\
272 `match-end' and `match-data' access; save and restore the match\n\
273 data if you want to preserve them.")
274 (regexp)
275 Lisp_Object regexp;
276 {
277 return looking_at_1 (regexp, 1);
278 }
279 \f
280 static Lisp_Object
281 string_match_1 (regexp, string, start, posix)
282 Lisp_Object regexp, string, start;
283 int posix;
284 {
285 int val;
286 int s;
287 struct re_pattern_buffer *bufp;
288
289 if (running_asynch_code)
290 save_search_regs ();
291
292 CHECK_STRING (regexp, 0);
293 CHECK_STRING (string, 1);
294
295 if (NILP (start))
296 s = 0;
297 else
298 {
299 int len = XSTRING (string)->size;
300
301 CHECK_NUMBER (start, 2);
302 s = XINT (start);
303 if (s < 0 && -s <= len)
304 s = len + s;
305 else if (0 > s || s > len)
306 args_out_of_range (string, start);
307 }
308
309 bufp = compile_pattern (regexp, &search_regs,
310 (!NILP (current_buffer->case_fold_search)
311 ? DOWNCASE_TABLE : 0),
312 0);
313 immediate_quit = 1;
314 val = re_search (bufp, (char *) XSTRING (string)->data,
315 XSTRING (string)->size, s, XSTRING (string)->size - s,
316 &search_regs);
317 immediate_quit = 0;
318 last_thing_searched = Qt;
319 if (val == -2)
320 matcher_overflow ();
321 if (val < 0) return Qnil;
322 return make_number (val);
323 }
324
325 DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0,
326 "Return index of start of first match for REGEXP in STRING, or nil.\n\
327 If third arg START is non-nil, start search at that index in STRING.\n\
328 For index of first char beyond the match, do (match-end 0).\n\
329 `match-end' and `match-beginning' also give indices of substrings\n\
330 matched by parenthesis constructs in the pattern.")
331 (regexp, string, start)
332 Lisp_Object regexp, string, start;
333 {
334 return string_match_1 (regexp, string, start, 0);
335 }
336
337 DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0,
338 "Return index of start of first match for REGEXP in STRING, or nil.\n\
339 Find the longest match, in accord with Posix regular expression rules.\n\
340 If third arg START is non-nil, start search at that index in STRING.\n\
341 For index of first char beyond the match, do (match-end 0).\n\
342 `match-end' and `match-beginning' also give indices of substrings\n\
343 matched by parenthesis constructs in the pattern.")
344 (regexp, string, start)
345 Lisp_Object regexp, string, start;
346 {
347 return string_match_1 (regexp, string, start, 1);
348 }
349
350 /* Match REGEXP against STRING, searching all of STRING,
351 and return the index of the match, or negative on failure.
352 This does not clobber the match data. */
353
354 int
355 fast_string_match (regexp, string)
356 Lisp_Object regexp, string;
357 {
358 int val;
359 struct re_pattern_buffer *bufp;
360
361 bufp = compile_pattern (regexp, 0, 0, 0);
362 immediate_quit = 1;
363 val = re_search (bufp, (char *) XSTRING (string)->data,
364 XSTRING (string)->size, 0, XSTRING (string)->size,
365 0);
366 immediate_quit = 0;
367 return val;
368 }
369 \f
370 /* max and min. */
371
372 static int
373 max (a, b)
374 int a, b;
375 {
376 return ((a > b) ? a : b);
377 }
378
379 static int
380 min (a, b)
381 int a, b;
382 {
383 return ((a < b) ? a : b);
384 }
385
386 \f
387 /* The newline cache: remembering which sections of text have no newlines. */
388
389 /* If the user has requested newline caching, make sure it's on.
390 Otherwise, make sure it's off.
391 This is our cheezy way of associating an action with the change of
392 state of a buffer-local variable. */
393 static void
394 newline_cache_on_off (buf)
395 struct buffer *buf;
396 {
397 if (NILP (buf->cache_long_line_scans))
398 {
399 /* It should be off. */
400 if (buf->newline_cache)
401 {
402 free_region_cache (buf->newline_cache);
403 buf->newline_cache = 0;
404 }
405 }
406 else
407 {
408 /* It should be on. */
409 if (buf->newline_cache == 0)
410 buf->newline_cache = new_region_cache ();
411 }
412 }
413
414 \f
415 /* Search for COUNT instances of the character TARGET between START and END.
416
417 If COUNT is positive, search forwards; END must be >= START.
418 If COUNT is negative, search backwards for the -COUNTth instance;
419 END must be <= START.
420 If COUNT is zero, do anything you please; run rogue, for all I care.
421
422 If END is zero, use BEGV or ZV instead, as appropriate for the
423 direction indicated by COUNT.
424
425 If we find COUNT instances, set *SHORTAGE to zero, and return the
426 position after the COUNTth match. Note that for reverse motion
427 this is not the same as the usual convention for Emacs motion commands.
428
429 If we don't find COUNT instances before reaching END, set *SHORTAGE
430 to the number of TARGETs left unfound, and return END.
431
432 If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do
433 except when inside redisplay. */
434
435 scan_buffer (target, start, end, count, shortage, allow_quit)
436 register int target;
437 int start, end;
438 int count;
439 int *shortage;
440 int allow_quit;
441 {
442 struct region_cache *newline_cache;
443 int direction;
444
445 if (count > 0)
446 {
447 direction = 1;
448 if (! end) end = ZV;
449 }
450 else
451 {
452 direction = -1;
453 if (! end) end = BEGV;
454 }
455
456 newline_cache_on_off (current_buffer);
457 newline_cache = current_buffer->newline_cache;
458
459 if (shortage != 0)
460 *shortage = 0;
461
462 immediate_quit = allow_quit;
463
464 if (count > 0)
465 while (start != end)
466 {
467 /* Our innermost scanning loop is very simple; it doesn't know
468 about gaps, buffer ends, or the newline cache. ceiling is
469 the position of the last character before the next such
470 obstacle --- the last character the dumb search loop should
471 examine. */
472 register int ceiling = end - 1;
473
474 /* If we're looking for a newline, consult the newline cache
475 to see where we can avoid some scanning. */
476 if (target == '\n' && newline_cache)
477 {
478 int next_change;
479 immediate_quit = 0;
480 while (region_cache_forward
481 (current_buffer, newline_cache, start, &next_change))
482 start = next_change;
483 immediate_quit = allow_quit;
484
485 /* start should never be after end. */
486 if (start >= end)
487 start = end - 1;
488
489 /* Now the text after start is an unknown region, and
490 next_change is the position of the next known region. */
491 ceiling = min (next_change - 1, ceiling);
492 }
493
494 /* The dumb loop can only scan text stored in contiguous
495 bytes. BUFFER_CEILING_OF returns the last character
496 position that is contiguous, so the ceiling is the
497 position after that. */
498 ceiling = min (BUFFER_CEILING_OF (start), ceiling);
499
500 {
501 /* The termination address of the dumb loop. */
502 register unsigned char *ceiling_addr = &FETCH_CHAR (ceiling) + 1;
503 register unsigned char *cursor = &FETCH_CHAR (start);
504 unsigned char *base = cursor;
505
506 while (cursor < ceiling_addr)
507 {
508 unsigned char *scan_start = cursor;
509
510 /* The dumb loop. */
511 while (*cursor != target && ++cursor < ceiling_addr)
512 ;
513
514 /* If we're looking for newlines, cache the fact that
515 the region from start to cursor is free of them. */
516 if (target == '\n' && newline_cache)
517 know_region_cache (current_buffer, newline_cache,
518 start + scan_start - base,
519 start + cursor - base);
520
521 /* Did we find the target character? */
522 if (cursor < ceiling_addr)
523 {
524 if (--count == 0)
525 {
526 immediate_quit = 0;
527 return (start + cursor - base + 1);
528 }
529 cursor++;
530 }
531 }
532
533 start += cursor - base;
534 }
535 }
536 else
537 while (start > end)
538 {
539 /* The last character to check before the next obstacle. */
540 register int ceiling = end;
541
542 /* Consult the newline cache, if appropriate. */
543 if (target == '\n' && newline_cache)
544 {
545 int next_change;
546 immediate_quit = 0;
547 while (region_cache_backward
548 (current_buffer, newline_cache, start, &next_change))
549 start = next_change;
550 immediate_quit = allow_quit;
551
552 /* Start should never be at or before end. */
553 if (start <= end)
554 start = end + 1;
555
556 /* Now the text before start is an unknown region, and
557 next_change is the position of the next known region. */
558 ceiling = max (next_change, ceiling);
559 }
560
561 /* Stop scanning before the gap. */
562 ceiling = max (BUFFER_FLOOR_OF (start - 1), ceiling);
563
564 {
565 /* The termination address of the dumb loop. */
566 register unsigned char *ceiling_addr = &FETCH_CHAR (ceiling);
567 register unsigned char *cursor = &FETCH_CHAR (start - 1);
568 unsigned char *base = cursor;
569
570 while (cursor >= ceiling_addr)
571 {
572 unsigned char *scan_start = cursor;
573
574 while (*cursor != target && --cursor >= ceiling_addr)
575 ;
576
577 /* If we're looking for newlines, cache the fact that
578 the region from after the cursor to start is free of them. */
579 if (target == '\n' && newline_cache)
580 know_region_cache (current_buffer, newline_cache,
581 start + cursor - base,
582 start + scan_start - base);
583
584 /* Did we find the target character? */
585 if (cursor >= ceiling_addr)
586 {
587 if (++count >= 0)
588 {
589 immediate_quit = 0;
590 return (start + cursor - base);
591 }
592 cursor--;
593 }
594 }
595
596 start += cursor - base;
597 }
598 }
599
600 immediate_quit = 0;
601 if (shortage != 0)
602 *shortage = count * direction;
603 return start;
604 }
605
606 int
607 find_next_newline_no_quit (from, cnt)
608 register int from, cnt;
609 {
610 return scan_buffer ('\n', from, 0, cnt, (int *) 0, 0);
611 }
612
613 int
614 find_next_newline (from, cnt)
615 register int from, cnt;
616 {
617 return scan_buffer ('\n', from, 0, cnt, (int *) 0, 1);
618 }
619
620
621 /* Like find_next_newline, but returns position before the newline,
622 not after, and only search up to TO. This isn't just
623 find_next_newline (...)-1, because you might hit TO. */
624 int
625 find_before_next_newline (from, to, cnt)
626 int from, to, cnt;
627 {
628 int shortage;
629 int pos = scan_buffer ('\n', from, to, cnt, &shortage, 1);
630
631 if (shortage == 0)
632 pos--;
633
634 return pos;
635 }
636 \f
637 Lisp_Object skip_chars ();
638
639 DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0,
640 "Move point forward, stopping before a char not in STRING, or at pos LIM.\n\
641 STRING is like the inside of a `[...]' in a regular expression\n\
642 except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\
643 Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
644 With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\
645 Returns the distance traveled, either zero or positive.")
646 (string, lim)
647 Lisp_Object string, lim;
648 {
649 return skip_chars (1, 0, string, lim);
650 }
651
652 DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
653 "Move point backward, stopping after a char not in STRING, or at pos LIM.\n\
654 See `skip-chars-forward' for details.\n\
655 Returns the distance traveled, either zero or negative.")
656 (string, lim)
657 Lisp_Object string, lim;
658 {
659 return skip_chars (0, 0, string, lim);
660 }
661
662 DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0,
663 "Move point forward across chars in specified syntax classes.\n\
664 SYNTAX is a string of syntax code characters.\n\
665 Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\
666 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
667 This function returns the distance traveled, either zero or positive.")
668 (syntax, lim)
669 Lisp_Object syntax, lim;
670 {
671 return skip_chars (1, 1, syntax, lim);
672 }
673
674 DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0,
675 "Move point backward across chars in specified syntax classes.\n\
676 SYNTAX is a string of syntax code characters.\n\
677 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\
678 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
679 This function returns the distance traveled, either zero or negative.")
680 (syntax, lim)
681 Lisp_Object syntax, lim;
682 {
683 return skip_chars (0, 1, syntax, lim);
684 }
685
686 Lisp_Object
687 skip_chars (forwardp, syntaxp, string, lim)
688 int forwardp, syntaxp;
689 Lisp_Object string, lim;
690 {
691 register unsigned char *p, *pend;
692 register unsigned char c;
693 unsigned char fastmap[0400];
694 int negate = 0;
695 register int i;
696
697 CHECK_STRING (string, 0);
698
699 if (NILP (lim))
700 XSETINT (lim, forwardp ? ZV : BEGV);
701 else
702 CHECK_NUMBER_COERCE_MARKER (lim, 1);
703
704 /* In any case, don't allow scan outside bounds of buffer. */
705 /* jla turned this off, for no known reason.
706 bfox turned the ZV part on, and rms turned the
707 BEGV part back on. */
708 if (XINT (lim) > ZV)
709 XSETFASTINT (lim, ZV);
710 if (XINT (lim) < BEGV)
711 XSETFASTINT (lim, BEGV);
712
713 p = XSTRING (string)->data;
714 pend = p + XSTRING (string)->size;
715 bzero (fastmap, sizeof fastmap);
716
717 if (p != pend && *p == '^')
718 {
719 negate = 1; p++;
720 }
721
722 /* Find the characters specified and set their elements of fastmap.
723 If syntaxp, each character counts as itself.
724 Otherwise, handle backslashes and ranges specially */
725
726 while (p != pend)
727 {
728 c = *p++;
729 if (syntaxp)
730 fastmap[c] = 1;
731 else
732 {
733 if (c == '\\')
734 {
735 if (p == pend) break;
736 c = *p++;
737 }
738 if (p != pend && *p == '-')
739 {
740 p++;
741 if (p == pend) break;
742 while (c <= *p)
743 {
744 fastmap[c] = 1;
745 c++;
746 }
747 p++;
748 }
749 else
750 fastmap[c] = 1;
751 }
752 }
753
754 if (syntaxp && fastmap['-'] != 0)
755 fastmap[' '] = 1;
756
757 /* If ^ was the first character, complement the fastmap. */
758
759 if (negate)
760 for (i = 0; i < sizeof fastmap; i++)
761 fastmap[i] ^= 1;
762
763 {
764 int start_point = point;
765
766 immediate_quit = 1;
767 if (syntaxp)
768 {
769
770 if (forwardp)
771 {
772 while (point < XINT (lim)
773 && fastmap[(unsigned char) syntax_code_spec[(int) SYNTAX (FETCH_CHAR (point))]])
774 SET_PT (point + 1);
775 }
776 else
777 {
778 while (point > XINT (lim)
779 && fastmap[(unsigned char) syntax_code_spec[(int) SYNTAX (FETCH_CHAR (point - 1))]])
780 SET_PT (point - 1);
781 }
782 }
783 else
784 {
785 if (forwardp)
786 {
787 while (point < XINT (lim) && fastmap[FETCH_CHAR (point)])
788 SET_PT (point + 1);
789 }
790 else
791 {
792 while (point > XINT (lim) && fastmap[FETCH_CHAR (point - 1)])
793 SET_PT (point - 1);
794 }
795 }
796 immediate_quit = 0;
797
798 return make_number (point - start_point);
799 }
800 }
801 \f
802 /* Subroutines of Lisp buffer search functions. */
803
804 static Lisp_Object
805 search_command (string, bound, noerror, count, direction, RE, posix)
806 Lisp_Object string, bound, noerror, count;
807 int direction;
808 int RE;
809 int posix;
810 {
811 register int np;
812 int lim;
813 int n = direction;
814
815 if (!NILP (count))
816 {
817 CHECK_NUMBER (count, 3);
818 n *= XINT (count);
819 }
820
821 CHECK_STRING (string, 0);
822 if (NILP (bound))
823 lim = n > 0 ? ZV : BEGV;
824 else
825 {
826 CHECK_NUMBER_COERCE_MARKER (bound, 1);
827 lim = XINT (bound);
828 if (n > 0 ? lim < point : lim > point)
829 error ("Invalid search bound (wrong side of point)");
830 if (lim > ZV)
831 lim = ZV;
832 if (lim < BEGV)
833 lim = BEGV;
834 }
835
836 np = search_buffer (string, point, lim, n, RE,
837 (!NILP (current_buffer->case_fold_search)
838 ? XSTRING (current_buffer->case_canon_table)->data : 0),
839 (!NILP (current_buffer->case_fold_search)
840 ? XSTRING (current_buffer->case_eqv_table)->data : 0),
841 posix);
842 if (np <= 0)
843 {
844 if (NILP (noerror))
845 return signal_failure (string);
846 if (!EQ (noerror, Qt))
847 {
848 if (lim < BEGV || lim > ZV)
849 abort ();
850 SET_PT (lim);
851 return Qnil;
852 #if 0 /* This would be clean, but maybe programs depend on
853 a value of nil here. */
854 np = lim;
855 #endif
856 }
857 else
858 return Qnil;
859 }
860
861 if (np < BEGV || np > ZV)
862 abort ();
863
864 SET_PT (np);
865
866 return make_number (np);
867 }
868 \f
869 static int
870 trivial_regexp_p (regexp)
871 Lisp_Object regexp;
872 {
873 int len = XSTRING (regexp)->size;
874 unsigned char *s = XSTRING (regexp)->data;
875 unsigned char c;
876 while (--len >= 0)
877 {
878 switch (*s++)
879 {
880 case '.': case '*': case '+': case '?': case '[': case '^': case '$':
881 return 0;
882 case '\\':
883 if (--len < 0)
884 return 0;
885 switch (*s++)
886 {
887 case '|': case '(': case ')': case '`': case '\'': case 'b':
888 case 'B': case '<': case '>': case 'w': case 'W': case 's':
889 case 'S': case '1': case '2': case '3': case '4': case '5':
890 case '6': case '7': case '8': case '9':
891 return 0;
892 }
893 }
894 }
895 return 1;
896 }
897
898 /* Search for the n'th occurrence of STRING in the current buffer,
899 starting at position POS and stopping at position LIM,
900 treating STRING as a literal string if RE is false or as
901 a regular expression if RE is true.
902
903 If N is positive, searching is forward and LIM must be greater than POS.
904 If N is negative, searching is backward and LIM must be less than POS.
905
906 Returns -x if only N-x occurrences found (x > 0),
907 or else the position at the beginning of the Nth occurrence
908 (if searching backward) or the end (if searching forward).
909
910 POSIX is nonzero if we want full backtracking (POSIX style)
911 for this pattern. 0 means backtrack only enough to get a valid match. */
912
913 static int
914 search_buffer (string, pos, lim, n, RE, trt, inverse_trt, posix)
915 Lisp_Object string;
916 int pos;
917 int lim;
918 int n;
919 int RE;
920 register unsigned char *trt;
921 register unsigned char *inverse_trt;
922 int posix;
923 {
924 int len = XSTRING (string)->size;
925 unsigned char *base_pat = XSTRING (string)->data;
926 register int *BM_tab;
927 int *BM_tab_base;
928 register int direction = ((n > 0) ? 1 : -1);
929 register int dirlen;
930 int infinity, limit, k, stride_for_teases;
931 register unsigned char *pat, *cursor, *p_limit;
932 register int i, j;
933 unsigned char *p1, *p2;
934 int s1, s2;
935
936 if (running_asynch_code)
937 save_search_regs ();
938
939 /* Null string is found at starting position. */
940 if (len == 0)
941 {
942 set_search_regs (pos, 0);
943 return pos;
944 }
945
946 /* Searching 0 times means don't move. */
947 if (n == 0)
948 return pos;
949
950 if (RE && !trivial_regexp_p (string))
951 {
952 struct re_pattern_buffer *bufp;
953
954 bufp = compile_pattern (string, &search_regs, (char *) trt, posix);
955
956 immediate_quit = 1; /* Quit immediately if user types ^G,
957 because letting this function finish
958 can take too long. */
959 QUIT; /* Do a pending quit right away,
960 to avoid paradoxical behavior */
961 /* Get pointers and sizes of the two strings
962 that make up the visible portion of the buffer. */
963
964 p1 = BEGV_ADDR;
965 s1 = GPT - BEGV;
966 p2 = GAP_END_ADDR;
967 s2 = ZV - GPT;
968 if (s1 < 0)
969 {
970 p2 = p1;
971 s2 = ZV - BEGV;
972 s1 = 0;
973 }
974 if (s2 < 0)
975 {
976 s1 = ZV - BEGV;
977 s2 = 0;
978 }
979 while (n < 0)
980 {
981 int val;
982 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
983 pos - BEGV, lim - pos, &search_regs,
984 /* Don't allow match past current point */
985 pos - BEGV);
986 if (val == -2)
987 {
988 matcher_overflow ();
989 }
990 if (val >= 0)
991 {
992 j = BEGV;
993 for (i = 0; i < search_regs.num_regs; i++)
994 if (search_regs.start[i] >= 0)
995 {
996 search_regs.start[i] += j;
997 search_regs.end[i] += j;
998 }
999 XSETBUFFER (last_thing_searched, current_buffer);
1000 /* Set pos to the new position. */
1001 pos = search_regs.start[0];
1002 }
1003 else
1004 {
1005 immediate_quit = 0;
1006 return (n);
1007 }
1008 n++;
1009 }
1010 while (n > 0)
1011 {
1012 int val;
1013 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
1014 pos - BEGV, lim - pos, &search_regs,
1015 lim - BEGV);
1016 if (val == -2)
1017 {
1018 matcher_overflow ();
1019 }
1020 if (val >= 0)
1021 {
1022 j = BEGV;
1023 for (i = 0; i < search_regs.num_regs; i++)
1024 if (search_regs.start[i] >= 0)
1025 {
1026 search_regs.start[i] += j;
1027 search_regs.end[i] += j;
1028 }
1029 XSETBUFFER (last_thing_searched, current_buffer);
1030 pos = search_regs.end[0];
1031 }
1032 else
1033 {
1034 immediate_quit = 0;
1035 return (0 - n);
1036 }
1037 n--;
1038 }
1039 immediate_quit = 0;
1040 return (pos);
1041 }
1042 else /* non-RE case */
1043 {
1044 #ifdef C_ALLOCA
1045 int BM_tab_space[0400];
1046 BM_tab = &BM_tab_space[0];
1047 #else
1048 BM_tab = (int *) alloca (0400 * sizeof (int));
1049 #endif
1050 {
1051 unsigned char *patbuf = (unsigned char *) alloca (len);
1052 pat = patbuf;
1053 while (--len >= 0)
1054 {
1055 /* If we got here and the RE flag is set, it's because we're
1056 dealing with a regexp known to be trivial, so the backslash
1057 just quotes the next character. */
1058 if (RE && *base_pat == '\\')
1059 {
1060 len--;
1061 base_pat++;
1062 }
1063 *pat++ = (trt ? trt[*base_pat++] : *base_pat++);
1064 }
1065 len = pat - patbuf;
1066 pat = base_pat = patbuf;
1067 }
1068 /* The general approach is that we are going to maintain that we know */
1069 /* the first (closest to the present position, in whatever direction */
1070 /* we're searching) character that could possibly be the last */
1071 /* (furthest from present position) character of a valid match. We */
1072 /* advance the state of our knowledge by looking at that character */
1073 /* and seeing whether it indeed matches the last character of the */
1074 /* pattern. If it does, we take a closer look. If it does not, we */
1075 /* move our pointer (to putative last characters) as far as is */
1076 /* logically possible. This amount of movement, which I call a */
1077 /* stride, will be the length of the pattern if the actual character */
1078 /* appears nowhere in the pattern, otherwise it will be the distance */
1079 /* from the last occurrence of that character to the end of the */
1080 /* pattern. */
1081 /* As a coding trick, an enormous stride is coded into the table for */
1082 /* characters that match the last character. This allows use of only */
1083 /* a single test, a test for having gone past the end of the */
1084 /* permissible match region, to test for both possible matches (when */
1085 /* the stride goes past the end immediately) and failure to */
1086 /* match (where you get nudged past the end one stride at a time). */
1087
1088 /* Here we make a "mickey mouse" BM table. The stride of the search */
1089 /* is determined only by the last character of the putative match. */
1090 /* If that character does not match, we will stride the proper */
1091 /* distance to propose a match that superimposes it on the last */
1092 /* instance of a character that matches it (per trt), or misses */
1093 /* it entirely if there is none. */
1094
1095 dirlen = len * direction;
1096 infinity = dirlen - (lim + pos + len + len) * direction;
1097 if (direction < 0)
1098 pat = (base_pat += len - 1);
1099 BM_tab_base = BM_tab;
1100 BM_tab += 0400;
1101 j = dirlen; /* to get it in a register */
1102 /* A character that does not appear in the pattern induces a */
1103 /* stride equal to the pattern length. */
1104 while (BM_tab_base != BM_tab)
1105 {
1106 *--BM_tab = j;
1107 *--BM_tab = j;
1108 *--BM_tab = j;
1109 *--BM_tab = j;
1110 }
1111 i = 0;
1112 while (i != infinity)
1113 {
1114 j = pat[i]; i += direction;
1115 if (i == dirlen) i = infinity;
1116 if (trt != 0)
1117 {
1118 k = (j = trt[j]);
1119 if (i == infinity)
1120 stride_for_teases = BM_tab[j];
1121 BM_tab[j] = dirlen - i;
1122 /* A translation table is accompanied by its inverse -- see */
1123 /* comment following downcase_table for details */
1124 while ((j = inverse_trt[j]) != k)
1125 BM_tab[j] = dirlen - i;
1126 }
1127 else
1128 {
1129 if (i == infinity)
1130 stride_for_teases = BM_tab[j];
1131 BM_tab[j] = dirlen - i;
1132 }
1133 /* stride_for_teases tells how much to stride if we get a */
1134 /* match on the far character but are subsequently */
1135 /* disappointed, by recording what the stride would have been */
1136 /* for that character if the last character had been */
1137 /* different. */
1138 }
1139 infinity = dirlen - infinity;
1140 pos += dirlen - ((direction > 0) ? direction : 0);
1141 /* loop invariant - pos points at where last char (first char if reverse)
1142 of pattern would align in a possible match. */
1143 while (n != 0)
1144 {
1145 /* It's been reported that some (broken) compiler thinks that
1146 Boolean expressions in an arithmetic context are unsigned.
1147 Using an explicit ?1:0 prevents this. */
1148 if ((lim - pos - ((direction > 0) ? 1 : 0)) * direction < 0)
1149 return (n * (0 - direction));
1150 /* First we do the part we can by pointers (maybe nothing) */
1151 QUIT;
1152 pat = base_pat;
1153 limit = pos - dirlen + direction;
1154 limit = ((direction > 0)
1155 ? BUFFER_CEILING_OF (limit)
1156 : BUFFER_FLOOR_OF (limit));
1157 /* LIMIT is now the last (not beyond-last!) value
1158 POS can take on without hitting edge of buffer or the gap. */
1159 limit = ((direction > 0)
1160 ? min (lim - 1, min (limit, pos + 20000))
1161 : max (lim, max (limit, pos - 20000)));
1162 if ((limit - pos) * direction > 20)
1163 {
1164 p_limit = &FETCH_CHAR (limit);
1165 p2 = (cursor = &FETCH_CHAR (pos));
1166 /* In this loop, pos + cursor - p2 is the surrogate for pos */
1167 while (1) /* use one cursor setting as long as i can */
1168 {
1169 if (direction > 0) /* worth duplicating */
1170 {
1171 /* Use signed comparison if appropriate
1172 to make cursor+infinity sure to be > p_limit.
1173 Assuming that the buffer lies in a range of addresses
1174 that are all "positive" (as ints) or all "negative",
1175 either kind of comparison will work as long
1176 as we don't step by infinity. So pick the kind
1177 that works when we do step by infinity. */
1178 if ((EMACS_INT) (p_limit + infinity) > (EMACS_INT) p_limit)
1179 while ((EMACS_INT) cursor <= (int) p_limit)
1180 cursor += BM_tab[*cursor];
1181 else
1182 while ((unsigned EMACS_INT) cursor <= (unsigned EMACS_INT) p_limit)
1183 cursor += BM_tab[*cursor];
1184 }
1185 else
1186 {
1187 if ((EMACS_INT) (p_limit + infinity) < (EMACS_INT) p_limit)
1188 while ((EMACS_INT) cursor >= (EMACS_INT) p_limit)
1189 cursor += BM_tab[*cursor];
1190 else
1191 while ((unsigned EMACS_INT) cursor >= (unsigned EMACS_INT) p_limit)
1192 cursor += BM_tab[*cursor];
1193 }
1194 /* If you are here, cursor is beyond the end of the searched region. */
1195 /* This can happen if you match on the far character of the pattern, */
1196 /* because the "stride" of that character is infinity, a number able */
1197 /* to throw you well beyond the end of the search. It can also */
1198 /* happen if you fail to match within the permitted region and would */
1199 /* otherwise try a character beyond that region */
1200 if ((cursor - p_limit) * direction <= len)
1201 break; /* a small overrun is genuine */
1202 cursor -= infinity; /* large overrun = hit */
1203 i = dirlen - direction;
1204 if (trt != 0)
1205 {
1206 while ((i -= direction) + direction != 0)
1207 if (pat[i] != trt[*(cursor -= direction)])
1208 break;
1209 }
1210 else
1211 {
1212 while ((i -= direction) + direction != 0)
1213 if (pat[i] != *(cursor -= direction))
1214 break;
1215 }
1216 cursor += dirlen - i - direction; /* fix cursor */
1217 if (i + direction == 0)
1218 {
1219 cursor -= direction;
1220
1221 set_search_regs (pos + cursor - p2 + ((direction > 0)
1222 ? 1 - len : 0),
1223 len);
1224
1225 if ((n -= direction) != 0)
1226 cursor += dirlen; /* to resume search */
1227 else
1228 return ((direction > 0)
1229 ? search_regs.end[0] : search_regs.start[0]);
1230 }
1231 else
1232 cursor += stride_for_teases; /* <sigh> we lose - */
1233 }
1234 pos += cursor - p2;
1235 }
1236 else
1237 /* Now we'll pick up a clump that has to be done the hard */
1238 /* way because it covers a discontinuity */
1239 {
1240 limit = ((direction > 0)
1241 ? BUFFER_CEILING_OF (pos - dirlen + 1)
1242 : BUFFER_FLOOR_OF (pos - dirlen - 1));
1243 limit = ((direction > 0)
1244 ? min (limit + len, lim - 1)
1245 : max (limit - len, lim));
1246 /* LIMIT is now the last value POS can have
1247 and still be valid for a possible match. */
1248 while (1)
1249 {
1250 /* This loop can be coded for space rather than */
1251 /* speed because it will usually run only once. */
1252 /* (the reach is at most len + 21, and typically */
1253 /* does not exceed len) */
1254 while ((limit - pos) * direction >= 0)
1255 pos += BM_tab[FETCH_CHAR(pos)];
1256 /* now run the same tests to distinguish going off the */
1257 /* end, a match or a phony match. */
1258 if ((pos - limit) * direction <= len)
1259 break; /* ran off the end */
1260 /* Found what might be a match.
1261 Set POS back to last (first if reverse) char pos. */
1262 pos -= infinity;
1263 i = dirlen - direction;
1264 while ((i -= direction) + direction != 0)
1265 {
1266 pos -= direction;
1267 if (pat[i] != (trt != 0
1268 ? trt[FETCH_CHAR(pos)]
1269 : FETCH_CHAR (pos)))
1270 break;
1271 }
1272 /* Above loop has moved POS part or all the way
1273 back to the first char pos (last char pos if reverse).
1274 Set it once again at the last (first if reverse) char. */
1275 pos += dirlen - i- direction;
1276 if (i + direction == 0)
1277 {
1278 pos -= direction;
1279
1280 set_search_regs (pos + ((direction > 0) ? 1 - len : 0),
1281 len);
1282
1283 if ((n -= direction) != 0)
1284 pos += dirlen; /* to resume search */
1285 else
1286 return ((direction > 0)
1287 ? search_regs.end[0] : search_regs.start[0]);
1288 }
1289 else
1290 pos += stride_for_teases;
1291 }
1292 }
1293 /* We have done one clump. Can we continue? */
1294 if ((lim - pos) * direction < 0)
1295 return ((0 - n) * direction);
1296 }
1297 return pos;
1298 }
1299 }
1300
1301 /* Record beginning BEG and end BEG + LEN
1302 for a match just found in the current buffer. */
1303
1304 static void
1305 set_search_regs (beg, len)
1306 int beg, len;
1307 {
1308 /* Make sure we have registers in which to store
1309 the match position. */
1310 if (search_regs.num_regs == 0)
1311 {
1312 search_regs.start = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
1313 search_regs.end = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
1314 search_regs.num_regs = 2;
1315 }
1316
1317 search_regs.start[0] = beg;
1318 search_regs.end[0] = beg + len;
1319 XSETBUFFER (last_thing_searched, current_buffer);
1320 }
1321 \f
1322 /* Given a string of words separated by word delimiters,
1323 compute a regexp that matches those exact words
1324 separated by arbitrary punctuation. */
1325
1326 static Lisp_Object
1327 wordify (string)
1328 Lisp_Object string;
1329 {
1330 register unsigned char *p, *o;
1331 register int i, len, punct_count = 0, word_count = 0;
1332 Lisp_Object val;
1333
1334 CHECK_STRING (string, 0);
1335 p = XSTRING (string)->data;
1336 len = XSTRING (string)->size;
1337
1338 for (i = 0; i < len; i++)
1339 if (SYNTAX (p[i]) != Sword)
1340 {
1341 punct_count++;
1342 if (i > 0 && SYNTAX (p[i-1]) == Sword) word_count++;
1343 }
1344 if (SYNTAX (p[len-1]) == Sword) word_count++;
1345 if (!word_count) return build_string ("");
1346
1347 val = make_string (p, len - punct_count + 5 * (word_count - 1) + 4);
1348
1349 o = XSTRING (val)->data;
1350 *o++ = '\\';
1351 *o++ = 'b';
1352
1353 for (i = 0; i < len; i++)
1354 if (SYNTAX (p[i]) == Sword)
1355 *o++ = p[i];
1356 else if (i > 0 && SYNTAX (p[i-1]) == Sword && --word_count)
1357 {
1358 *o++ = '\\';
1359 *o++ = 'W';
1360 *o++ = '\\';
1361 *o++ = 'W';
1362 *o++ = '*';
1363 }
1364
1365 *o++ = '\\';
1366 *o++ = 'b';
1367
1368 return val;
1369 }
1370 \f
1371 DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
1372 "sSearch backward: ",
1373 "Search backward from point for STRING.\n\
1374 Set point to the beginning of the occurrence found, and return point.\n\
1375 An optional second argument bounds the search; it is a buffer position.\n\
1376 The match found must not extend before that position.\n\
1377 Optional third argument, if t, means if fail just return nil (no error).\n\
1378 If not nil and not t, position at limit of search and return nil.\n\
1379 Optional fourth argument is repeat count--search for successive occurrences.\n\
1380 See also the functions `match-beginning', `match-end' and `replace-match'.")
1381 (string, bound, noerror, count)
1382 Lisp_Object string, bound, noerror, count;
1383 {
1384 return search_command (string, bound, noerror, count, -1, 0, 0);
1385 }
1386
1387 DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "sSearch: ",
1388 "Search forward from point for STRING.\n\
1389 Set point to the end of the occurrence found, and return point.\n\
1390 An optional second argument bounds the search; it is a buffer position.\n\
1391 The match found must not extend after that position. nil is equivalent\n\
1392 to (point-max).\n\
1393 Optional third argument, if t, means if fail just return nil (no error).\n\
1394 If not nil and not t, move to limit of search and return nil.\n\
1395 Optional fourth argument is repeat count--search for successive occurrences.\n\
1396 See also the functions `match-beginning', `match-end' and `replace-match'.")
1397 (string, bound, noerror, count)
1398 Lisp_Object string, bound, noerror, count;
1399 {
1400 return search_command (string, bound, noerror, count, 1, 0, 0);
1401 }
1402
1403 DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
1404 "sWord search backward: ",
1405 "Search backward from point for STRING, ignoring differences in punctuation.\n\
1406 Set point to the beginning of the occurrence found, and return point.\n\
1407 An optional second argument bounds the search; it is a buffer position.\n\
1408 The match found must not extend before that position.\n\
1409 Optional third argument, if t, means if fail just return nil (no error).\n\
1410 If not nil and not t, move to limit of search and return nil.\n\
1411 Optional fourth argument is repeat count--search for successive occurrences.")
1412 (string, bound, noerror, count)
1413 Lisp_Object string, bound, noerror, count;
1414 {
1415 return search_command (wordify (string), bound, noerror, count, -1, 1, 0);
1416 }
1417
1418 DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
1419 "sWord search: ",
1420 "Search forward from point for STRING, ignoring differences in punctuation.\n\
1421 Set point to the end of the occurrence found, and return point.\n\
1422 An optional second argument bounds the search; it is a buffer position.\n\
1423 The match found must not extend after that position.\n\
1424 Optional third argument, if t, means if fail just return nil (no error).\n\
1425 If not nil and not t, move to limit of search and return nil.\n\
1426 Optional fourth argument is repeat count--search for successive occurrences.")
1427 (string, bound, noerror, count)
1428 Lisp_Object string, bound, noerror, count;
1429 {
1430 return search_command (wordify (string), bound, noerror, count, 1, 1, 0);
1431 }
1432
1433 DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
1434 "sRE search backward: ",
1435 "Search backward from point for match for regular expression REGEXP.\n\
1436 Set point to the beginning of the match, and return point.\n\
1437 The match found is the one starting last in the buffer\n\
1438 and yet ending before the origin of the search.\n\
1439 An optional second argument bounds the search; it is a buffer position.\n\
1440 The match found must start at or after that position.\n\
1441 Optional third argument, if t, means if fail just return nil (no error).\n\
1442 If not nil and not t, move to limit of search and return nil.\n\
1443 Optional fourth argument is repeat count--search for successive occurrences.\n\
1444 See also the functions `match-beginning', `match-end' and `replace-match'.")
1445 (regexp, bound, noerror, count)
1446 Lisp_Object regexp, bound, noerror, count;
1447 {
1448 return search_command (regexp, bound, noerror, count, -1, 1, 0);
1449 }
1450
1451 DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4,
1452 "sRE search: ",
1453 "Search forward from point for regular expression REGEXP.\n\
1454 Set point to the end of the occurrence found, and return point.\n\
1455 An optional second argument bounds the search; it is a buffer position.\n\
1456 The match found must not extend after that position.\n\
1457 Optional third argument, if t, means if fail just return nil (no error).\n\
1458 If not nil and not t, move to limit of search and return nil.\n\
1459 Optional fourth argument is repeat count--search for successive occurrences.\n\
1460 See also the functions `match-beginning', `match-end' and `replace-match'.")
1461 (regexp, bound, noerror, count)
1462 Lisp_Object regexp, bound, noerror, count;
1463 {
1464 return search_command (regexp, bound, noerror, count, 1, 1, 0);
1465 }
1466
1467 DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, 1, 4,
1468 "sPosix search backward: ",
1469 "Search backward from point for match for regular expression REGEXP.\n\
1470 Find the longest match in accord with Posix regular expression rules.\n\
1471 Set point to the beginning of the match, and return point.\n\
1472 The match found is the one starting last in the buffer\n\
1473 and yet ending before the origin of the search.\n\
1474 An optional second argument bounds the search; it is a buffer position.\n\
1475 The match found must start at or after that position.\n\
1476 Optional third argument, if t, means if fail just return nil (no error).\n\
1477 If not nil and not t, move to limit of search and return nil.\n\
1478 Optional fourth argument is repeat count--search for successive occurrences.\n\
1479 See also the functions `match-beginning', `match-end' and `replace-match'.")
1480 (regexp, bound, noerror, count)
1481 Lisp_Object regexp, bound, noerror, count;
1482 {
1483 return search_command (regexp, bound, noerror, count, -1, 1, 1);
1484 }
1485
1486 DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, 1, 4,
1487 "sPosix search: ",
1488 "Search forward from point for regular expression REGEXP.\n\
1489 Find the longest match in accord with Posix regular expression rules.\n\
1490 Set point to the end of the occurrence found, and return point.\n\
1491 An optional second argument bounds the search; it is a buffer position.\n\
1492 The match found must not extend after that position.\n\
1493 Optional third argument, if t, means if fail just return nil (no error).\n\
1494 If not nil and not t, move to limit of search and return nil.\n\
1495 Optional fourth argument is repeat count--search for successive occurrences.\n\
1496 See also the functions `match-beginning', `match-end' and `replace-match'.")
1497 (regexp, bound, noerror, count)
1498 Lisp_Object regexp, bound, noerror, count;
1499 {
1500 return search_command (regexp, bound, noerror, count, 1, 1, 1);
1501 }
1502 \f
1503 DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 4, 0,
1504 "Replace text matched by last search with NEWTEXT.\n\
1505 If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\
1506 Otherwise maybe capitalize the whole text, or maybe just word initials,\n\
1507 based on the replaced text.\n\
1508 If the replaced text has only capital letters\n\
1509 and has at least one multiletter word, convert NEWTEXT to all caps.\n\
1510 If the replaced text has at least one word starting with a capital letter,\n\
1511 then capitalize each word in NEWTEXT.\n\n\
1512 If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\
1513 Otherwise treat `\\' as special:\n\
1514 `\\&' in NEWTEXT means substitute original matched text.\n\
1515 `\\N' means substitute what matched the Nth `\\(...\\)'.\n\
1516 If Nth parens didn't match, substitute nothing.\n\
1517 `\\\\' means insert one `\\'.\n\
1518 FIXEDCASE and LITERAL are optional arguments.\n\
1519 Leaves point at end of replacement text.\n\
1520 \n\
1521 The optional fourth argument STRING can be a string to modify.\n\
1522 In that case, this function creates and returns a new string\n\
1523 which is made by replacing the part of STRING that was matched.")
1524 (newtext, fixedcase, literal, string)
1525 Lisp_Object newtext, fixedcase, literal, string;
1526 {
1527 enum { nochange, all_caps, cap_initial } case_action;
1528 register int pos, last;
1529 int some_multiletter_word;
1530 int some_lowercase;
1531 int some_uppercase;
1532 int some_nonuppercase_initial;
1533 register int c, prevc;
1534 int inslen;
1535
1536 CHECK_STRING (newtext, 0);
1537
1538 if (! NILP (string))
1539 CHECK_STRING (string, 4);
1540
1541 case_action = nochange; /* We tried an initialization */
1542 /* but some C compilers blew it */
1543
1544 if (search_regs.num_regs <= 0)
1545 error ("replace-match called before any match found");
1546
1547 if (NILP (string))
1548 {
1549 if (search_regs.start[0] < BEGV
1550 || search_regs.start[0] > search_regs.end[0]
1551 || search_regs.end[0] > ZV)
1552 args_out_of_range (make_number (search_regs.start[0]),
1553 make_number (search_regs.end[0]));
1554 }
1555 else
1556 {
1557 if (search_regs.start[0] < 0
1558 || search_regs.start[0] > search_regs.end[0]
1559 || search_regs.end[0] > XSTRING (string)->size)
1560 args_out_of_range (make_number (search_regs.start[0]),
1561 make_number (search_regs.end[0]));
1562 }
1563
1564 if (NILP (fixedcase))
1565 {
1566 /* Decide how to casify by examining the matched text. */
1567
1568 last = search_regs.end[0];
1569 prevc = '\n';
1570 case_action = all_caps;
1571
1572 /* some_multiletter_word is set nonzero if any original word
1573 is more than one letter long. */
1574 some_multiletter_word = 0;
1575 some_lowercase = 0;
1576 some_nonuppercase_initial = 0;
1577 some_uppercase = 0;
1578
1579 for (pos = search_regs.start[0]; pos < last; pos++)
1580 {
1581 if (NILP (string))
1582 c = FETCH_CHAR (pos);
1583 else
1584 c = XSTRING (string)->data[pos];
1585
1586 if (LOWERCASEP (c))
1587 {
1588 /* Cannot be all caps if any original char is lower case */
1589
1590 some_lowercase = 1;
1591 if (SYNTAX (prevc) != Sword)
1592 some_nonuppercase_initial = 1;
1593 else
1594 some_multiletter_word = 1;
1595 }
1596 else if (!NOCASEP (c))
1597 {
1598 some_uppercase = 1;
1599 if (SYNTAX (prevc) != Sword)
1600 ;
1601 else
1602 some_multiletter_word = 1;
1603 }
1604 else
1605 {
1606 /* If the initial is a caseless word constituent,
1607 treat that like a lowercase initial. */
1608 if (SYNTAX (prevc) != Sword)
1609 some_nonuppercase_initial = 1;
1610 }
1611
1612 prevc = c;
1613 }
1614
1615 /* Convert to all caps if the old text is all caps
1616 and has at least one multiletter word. */
1617 if (! some_lowercase && some_multiletter_word)
1618 case_action = all_caps;
1619 /* Capitalize each word, if the old text has all capitalized words. */
1620 else if (!some_nonuppercase_initial && some_multiletter_word)
1621 case_action = cap_initial;
1622 else if (!some_nonuppercase_initial && some_uppercase)
1623 /* Should x -> yz, operating on X, give Yz or YZ?
1624 We'll assume the latter. */
1625 case_action = all_caps;
1626 else
1627 case_action = nochange;
1628 }
1629
1630 /* Do replacement in a string. */
1631 if (!NILP (string))
1632 {
1633 Lisp_Object before, after;
1634
1635 before = Fsubstring (string, make_number (0),
1636 make_number (search_regs.start[0]));
1637 after = Fsubstring (string, make_number (search_regs.end[0]), Qnil);
1638
1639 /* Do case substitution into NEWTEXT if desired. */
1640 if (NILP (literal))
1641 {
1642 int lastpos = -1;
1643 /* We build up the substituted string in ACCUM. */
1644 Lisp_Object accum;
1645 Lisp_Object middle;
1646
1647 accum = Qnil;
1648
1649 for (pos = 0; pos < XSTRING (newtext)->size; pos++)
1650 {
1651 int substart = -1;
1652 int subend;
1653
1654 c = XSTRING (newtext)->data[pos];
1655 if (c == '\\')
1656 {
1657 c = XSTRING (newtext)->data[++pos];
1658 if (c == '&')
1659 {
1660 substart = search_regs.start[0];
1661 subend = search_regs.end[0];
1662 }
1663 else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0')
1664 {
1665 if (search_regs.start[c - '0'] >= 1)
1666 {
1667 substart = search_regs.start[c - '0'];
1668 subend = search_regs.end[c - '0'];
1669 }
1670 }
1671 }
1672 if (substart >= 0)
1673 {
1674 if (pos - 1 != lastpos + 1)
1675 middle = Fsubstring (newtext, lastpos + 1, pos - 1);
1676 else
1677 middle = Qnil;
1678 accum = concat3 (accum, middle,
1679 Fsubstring (string, make_number (substart),
1680 make_number (subend)));
1681 lastpos = pos;
1682 }
1683 }
1684
1685 if (pos != lastpos + 1)
1686 middle = Fsubstring (newtext, lastpos + 1, pos);
1687 else
1688 middle = Qnil;
1689
1690 newtext = concat2 (accum, middle);
1691 }
1692
1693 if (case_action == all_caps)
1694 newtext = Fupcase (newtext);
1695 else if (case_action == cap_initial)
1696 newtext = upcase_initials (newtext);
1697
1698 return concat3 (before, newtext, after);
1699 }
1700
1701 /* We insert the replacement text before the old text, and then
1702 delete the original text. This means that markers at the
1703 beginning or end of the original will float to the corresponding
1704 position in the replacement. */
1705 SET_PT (search_regs.start[0]);
1706 if (!NILP (literal))
1707 Finsert_and_inherit (1, &newtext);
1708 else
1709 {
1710 struct gcpro gcpro1;
1711 GCPRO1 (newtext);
1712
1713 for (pos = 0; pos < XSTRING (newtext)->size; pos++)
1714 {
1715 int offset = point - search_regs.start[0];
1716
1717 c = XSTRING (newtext)->data[pos];
1718 if (c == '\\')
1719 {
1720 c = XSTRING (newtext)->data[++pos];
1721 if (c == '&')
1722 Finsert_buffer_substring
1723 (Fcurrent_buffer (),
1724 make_number (search_regs.start[0] + offset),
1725 make_number (search_regs.end[0] + offset));
1726 else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0')
1727 {
1728 if (search_regs.start[c - '0'] >= 1)
1729 Finsert_buffer_substring
1730 (Fcurrent_buffer (),
1731 make_number (search_regs.start[c - '0'] + offset),
1732 make_number (search_regs.end[c - '0'] + offset));
1733 }
1734 else
1735 insert_char (c);
1736 }
1737 else
1738 insert_char (c);
1739 }
1740 UNGCPRO;
1741 }
1742
1743 inslen = point - (search_regs.start[0]);
1744 del_range (search_regs.start[0] + inslen, search_regs.end[0] + inslen);
1745
1746 if (case_action == all_caps)
1747 Fupcase_region (make_number (point - inslen), make_number (point));
1748 else if (case_action == cap_initial)
1749 upcase_initials_region (make_number (point - inslen), make_number (point));
1750 return Qnil;
1751 }
1752 \f
1753 static Lisp_Object
1754 match_limit (num, beginningp)
1755 Lisp_Object num;
1756 int beginningp;
1757 {
1758 register int n;
1759
1760 CHECK_NUMBER (num, 0);
1761 n = XINT (num);
1762 if (n < 0 || n >= search_regs.num_regs)
1763 args_out_of_range (num, make_number (search_regs.num_regs));
1764 if (search_regs.num_regs <= 0
1765 || search_regs.start[n] < 0)
1766 return Qnil;
1767 return (make_number ((beginningp) ? search_regs.start[n]
1768 : search_regs.end[n]));
1769 }
1770
1771 DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
1772 "Return position of start of text matched by last search.\n\
1773 NUM specifies which parenthesized expression in the last regexp.\n\
1774 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.\n\
1775 Zero means the entire text matched by the whole regexp or whole string.")
1776 (num)
1777 Lisp_Object num;
1778 {
1779 return match_limit (num, 1);
1780 }
1781
1782 DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0,
1783 "Return position of end of text matched by last search.\n\
1784 ARG, a number, specifies which parenthesized expression in the last regexp.\n\
1785 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
1786 Zero means the entire text matched by the whole regexp or whole string.")
1787 (num)
1788 Lisp_Object num;
1789 {
1790 return match_limit (num, 0);
1791 }
1792
1793 DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 0, 0,
1794 "Return a list containing all info on what the last search matched.\n\
1795 Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.\n\
1796 All the elements are markers or nil (nil if the Nth pair didn't match)\n\
1797 if the last match was on a buffer; integers or nil if a string was matched.\n\
1798 Use `store-match-data' to reinstate the data in this list.")
1799 ()
1800 {
1801 Lisp_Object *data;
1802 int i, len;
1803
1804 if (NILP (last_thing_searched))
1805 error ("match-data called before any match found");
1806
1807 data = (Lisp_Object *) alloca ((2 * search_regs.num_regs)
1808 * sizeof (Lisp_Object));
1809
1810 len = -1;
1811 for (i = 0; i < search_regs.num_regs; i++)
1812 {
1813 int start = search_regs.start[i];
1814 if (start >= 0)
1815 {
1816 if (EQ (last_thing_searched, Qt))
1817 {
1818 XSETFASTINT (data[2 * i], start);
1819 XSETFASTINT (data[2 * i + 1], search_regs.end[i]);
1820 }
1821 else if (BUFFERP (last_thing_searched))
1822 {
1823 data[2 * i] = Fmake_marker ();
1824 Fset_marker (data[2 * i],
1825 make_number (start),
1826 last_thing_searched);
1827 data[2 * i + 1] = Fmake_marker ();
1828 Fset_marker (data[2 * i + 1],
1829 make_number (search_regs.end[i]),
1830 last_thing_searched);
1831 }
1832 else
1833 /* last_thing_searched must always be Qt, a buffer, or Qnil. */
1834 abort ();
1835
1836 len = i;
1837 }
1838 else
1839 data[2 * i] = data [2 * i + 1] = Qnil;
1840 }
1841 return Flist (2 * len + 2, data);
1842 }
1843
1844
1845 DEFUN ("store-match-data", Fstore_match_data, Sstore_match_data, 1, 1, 0,
1846 "Set internal data on last search match from elements of LIST.\n\
1847 LIST should have been created by calling `match-data' previously.")
1848 (list)
1849 register Lisp_Object list;
1850 {
1851 register int i;
1852 register Lisp_Object marker;
1853
1854 if (running_asynch_code)
1855 save_search_regs ();
1856
1857 if (!CONSP (list) && !NILP (list))
1858 list = wrong_type_argument (Qconsp, list);
1859
1860 /* Unless we find a marker with a buffer in LIST, assume that this
1861 match data came from a string. */
1862 last_thing_searched = Qt;
1863
1864 /* Allocate registers if they don't already exist. */
1865 {
1866 int length = XFASTINT (Flength (list)) / 2;
1867
1868 if (length > search_regs.num_regs)
1869 {
1870 if (search_regs.num_regs == 0)
1871 {
1872 search_regs.start
1873 = (regoff_t *) xmalloc (length * sizeof (regoff_t));
1874 search_regs.end
1875 = (regoff_t *) xmalloc (length * sizeof (regoff_t));
1876 }
1877 else
1878 {
1879 search_regs.start
1880 = (regoff_t *) xrealloc (search_regs.start,
1881 length * sizeof (regoff_t));
1882 search_regs.end
1883 = (regoff_t *) xrealloc (search_regs.end,
1884 length * sizeof (regoff_t));
1885 }
1886
1887 search_regs.num_regs = length;
1888 }
1889 }
1890
1891 for (i = 0; i < search_regs.num_regs; i++)
1892 {
1893 marker = Fcar (list);
1894 if (NILP (marker))
1895 {
1896 search_regs.start[i] = -1;
1897 list = Fcdr (list);
1898 }
1899 else
1900 {
1901 if (MARKERP (marker))
1902 {
1903 if (XMARKER (marker)->buffer == 0)
1904 XSETFASTINT (marker, 0);
1905 else
1906 XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer);
1907 }
1908
1909 CHECK_NUMBER_COERCE_MARKER (marker, 0);
1910 search_regs.start[i] = XINT (marker);
1911 list = Fcdr (list);
1912
1913 marker = Fcar (list);
1914 if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
1915 XSETFASTINT (marker, 0);
1916
1917 CHECK_NUMBER_COERCE_MARKER (marker, 0);
1918 search_regs.end[i] = XINT (marker);
1919 }
1920 list = Fcdr (list);
1921 }
1922
1923 return Qnil;
1924 }
1925
1926 /* If non-zero the match data have been saved in saved_search_regs
1927 during the execution of a sentinel or filter. */
1928 static int search_regs_saved;
1929 static struct re_registers saved_search_regs;
1930
1931 /* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
1932 if asynchronous code (filter or sentinel) is running. */
1933 static void
1934 save_search_regs ()
1935 {
1936 if (!search_regs_saved)
1937 {
1938 saved_search_regs.num_regs = search_regs.num_regs;
1939 saved_search_regs.start = search_regs.start;
1940 saved_search_regs.end = search_regs.end;
1941 search_regs.num_regs = 0;
1942 search_regs.start = 0;
1943 search_regs.end = 0;
1944
1945 search_regs_saved = 1;
1946 }
1947 }
1948
1949 /* Called upon exit from filters and sentinels. */
1950 void
1951 restore_match_data ()
1952 {
1953 if (search_regs_saved)
1954 {
1955 if (search_regs.num_regs > 0)
1956 {
1957 xfree (search_regs.start);
1958 xfree (search_regs.end);
1959 }
1960 search_regs.num_regs = saved_search_regs.num_regs;
1961 search_regs.start = saved_search_regs.start;
1962 search_regs.end = saved_search_regs.end;
1963
1964 search_regs_saved = 0;
1965 }
1966 }
1967
1968 /* Quote a string to inactivate reg-expr chars */
1969
1970 DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
1971 "Return a regexp string which matches exactly STRING and nothing else.")
1972 (str)
1973 Lisp_Object str;
1974 {
1975 register unsigned char *in, *out, *end;
1976 register unsigned char *temp;
1977
1978 CHECK_STRING (str, 0);
1979
1980 temp = (unsigned char *) alloca (XSTRING (str)->size * 2);
1981
1982 /* Now copy the data into the new string, inserting escapes. */
1983
1984 in = XSTRING (str)->data;
1985 end = in + XSTRING (str)->size;
1986 out = temp;
1987
1988 for (; in != end; in++)
1989 {
1990 if (*in == '[' || *in == ']'
1991 || *in == '*' || *in == '.' || *in == '\\'
1992 || *in == '?' || *in == '+'
1993 || *in == '^' || *in == '$')
1994 *out++ = '\\';
1995 *out++ = *in;
1996 }
1997
1998 return make_string (temp, out - temp);
1999 }
2000 \f
2001 syms_of_search ()
2002 {
2003 register int i;
2004
2005 for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
2006 {
2007 searchbufs[i].buf.allocated = 100;
2008 searchbufs[i].buf.buffer = (unsigned char *) malloc (100);
2009 searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
2010 searchbufs[i].regexp = Qnil;
2011 staticpro (&searchbufs[i].regexp);
2012 searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]);
2013 }
2014 searchbuf_head = &searchbufs[0];
2015
2016 Qsearch_failed = intern ("search-failed");
2017 staticpro (&Qsearch_failed);
2018 Qinvalid_regexp = intern ("invalid-regexp");
2019 staticpro (&Qinvalid_regexp);
2020
2021 Fput (Qsearch_failed, Qerror_conditions,
2022 Fcons (Qsearch_failed, Fcons (Qerror, Qnil)));
2023 Fput (Qsearch_failed, Qerror_message,
2024 build_string ("Search failed"));
2025
2026 Fput (Qinvalid_regexp, Qerror_conditions,
2027 Fcons (Qinvalid_regexp, Fcons (Qerror, Qnil)));
2028 Fput (Qinvalid_regexp, Qerror_message,
2029 build_string ("Invalid regexp"));
2030
2031 last_thing_searched = Qnil;
2032 staticpro (&last_thing_searched);
2033
2034 defsubr (&Slooking_at);
2035 defsubr (&Sposix_looking_at);
2036 defsubr (&Sstring_match);
2037 defsubr (&Sposix_string_match);
2038 defsubr (&Sskip_chars_forward);
2039 defsubr (&Sskip_chars_backward);
2040 defsubr (&Sskip_syntax_forward);
2041 defsubr (&Sskip_syntax_backward);
2042 defsubr (&Ssearch_forward);
2043 defsubr (&Ssearch_backward);
2044 defsubr (&Sword_search_forward);
2045 defsubr (&Sword_search_backward);
2046 defsubr (&Sre_search_forward);
2047 defsubr (&Sre_search_backward);
2048 defsubr (&Sposix_search_forward);
2049 defsubr (&Sposix_search_backward);
2050 defsubr (&Sreplace_match);
2051 defsubr (&Smatch_beginning);
2052 defsubr (&Smatch_end);
2053 defsubr (&Smatch_data);
2054 defsubr (&Sstore_match_data);
2055 defsubr (&Sregexp_quote);
2056 }