Make buffer-objfwd variables work per-thread.
[emacs.git] / src / search.c
blobe5959460590efe6fd3d2baef94a19053edf5e24f
1 /* String search routines for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1993, 1994, 1997, 1998, 1999, 2001, 2002,
3 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 #include <config.h>
23 #include <setjmp.h>
24 #include "lisp.h"
25 #include "syntax.h"
26 #include "category.h"
27 #include "buffer.h"
28 #include "character.h"
29 #include "charset.h"
30 #include "region-cache.h"
31 #include "commands.h"
32 #include "blockinput.h"
33 #include "intervals.h"
35 #include <sys/types.h>
36 #include "regex.h"
38 #define REGEXP_CACHE_SIZE 20
40 /* If the regexp is non-nil, then the buffer contains the compiled form
41 of that regexp, suitable for searching. */
42 struct regexp_cache
44 struct regexp_cache *next;
45 Lisp_Object regexp, whitespace_regexp;
46 /* Syntax table for which the regexp applies. We need this because
47 of character classes. If this is t, then the compiled pattern is valid
48 for any syntax-table. */
49 Lisp_Object syntax_table;
50 struct re_pattern_buffer buf;
51 char fastmap[0400];
52 /* Nonzero means regexp was compiled to do full POSIX backtracking. */
53 char posix;
56 /* The instances of that struct. */
57 struct regexp_cache searchbufs[REGEXP_CACHE_SIZE];
59 /* The head of the linked list; points to the most recently used buffer. */
60 struct regexp_cache *searchbuf_head;
63 /* Every call to re_match, etc., must pass &search_regs as the regs
64 argument unless you can show it is unnecessary (i.e., if re_match
65 is certainly going to be called again before region-around-match
66 can be called).
68 Since the registers are now dynamically allocated, we need to make
69 sure not to refer to the Nth register before checking that it has
70 been allocated by checking search_regs.num_regs.
72 The regex code keeps track of whether it has allocated the search
73 buffer using bits in the re_pattern_buffer. This means that whenever
74 you compile a new pattern, it completely forgets whether it has
75 allocated any registers, and will allocate new registers the next
76 time you call a searching or matching function. Therefore, we need
77 to call re_set_registers after compiling a new pattern or after
78 setting the match registers, so that the regex functions will be
79 able to free or re-allocate it properly. */
80 static struct re_registers search_regs;
82 /* The buffer in which the last search was performed, or
83 Qt if the last search was done in a string;
84 Qnil if no searching has been done yet. */
85 static Lisp_Object last_thing_searched;
87 /* error condition signaled when regexp compile_pattern fails */
89 Lisp_Object Qinvalid_regexp;
91 /* Error condition used for failing searches */
92 Lisp_Object Qsearch_failed;
94 Lisp_Object impl_Vsearch_spaces_regexp;
96 /* If non-nil, the match data will not be changed during call to
97 searching or matching functions. This variable is for internal use
98 only. */
99 Lisp_Object impl_Vinhibit_changing_match_data;
101 static void set_search_regs P_ ((EMACS_INT, EMACS_INT));
102 static void save_search_regs P_ ((void));
103 static EMACS_INT simple_search P_ ((int, unsigned char *, int, int,
104 Lisp_Object, EMACS_INT, EMACS_INT,
105 EMACS_INT, EMACS_INT));
106 static EMACS_INT boyer_moore P_ ((int, unsigned char *, int, int,
107 Lisp_Object, Lisp_Object,
108 EMACS_INT, EMACS_INT,
109 EMACS_INT, EMACS_INT, int));
110 static EMACS_INT search_buffer P_ ((Lisp_Object, EMACS_INT, EMACS_INT,
111 EMACS_INT, EMACS_INT, int, int,
112 Lisp_Object, Lisp_Object, int));
113 static void matcher_overflow () NO_RETURN;
115 static void
116 matcher_overflow ()
118 error ("Stack overflow in regexp matcher");
121 /* Compile a regexp and signal a Lisp error if anything goes wrong.
122 PATTERN is the pattern to compile.
123 CP is the place to put the result.
124 TRANSLATE is a translation table for ignoring case, or nil for none.
125 REGP is the structure that says where to store the "register"
126 values that will result from matching this pattern.
127 If it is 0, we should compile the pattern not to record any
128 subexpression bounds.
129 POSIX is nonzero if we want full backtracking (POSIX style)
130 for this pattern. 0 means backtrack only enough to get a valid match.
132 The behavior also depends on Vsearch_spaces_regexp. */
134 static void
135 compile_pattern_1 (cp, pattern, translate, regp, posix)
136 struct regexp_cache *cp;
137 Lisp_Object pattern;
138 Lisp_Object translate;
139 struct re_registers *regp;
140 int posix;
142 char *val;
143 reg_syntax_t old;
145 cp->regexp = Qnil;
146 cp->buf.translate = (! NILP (translate) ? translate : make_number (0));
147 cp->posix = posix;
148 cp->buf.multibyte = STRING_MULTIBYTE (pattern);
149 cp->buf.charset_unibyte = charset_unibyte;
150 if (STRINGP (Vsearch_spaces_regexp))
151 cp->whitespace_regexp = Vsearch_spaces_regexp;
152 else
153 cp->whitespace_regexp = Qnil;
155 /* rms: I think BLOCK_INPUT is not needed here any more,
156 because regex.c defines malloc to call xmalloc.
157 Using BLOCK_INPUT here means the debugger won't run if an error occurs.
158 So let's turn it off. */
159 /* BLOCK_INPUT; */
160 old = re_set_syntax (RE_SYNTAX_EMACS
161 | (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
163 if (STRINGP (Vsearch_spaces_regexp))
164 re_set_whitespace_regexp (SDATA (Vsearch_spaces_regexp));
165 else
166 re_set_whitespace_regexp (NULL);
168 val = (char *) re_compile_pattern ((char *) SDATA (pattern),
169 SBYTES (pattern), &cp->buf);
171 /* If the compiled pattern hard codes some of the contents of the
172 syntax-table, it can only be reused with *this* syntax table. */
173 cp->syntax_table = cp->buf.used_syntax ? BUF_SYNTAX_TABLE (current_buffer) : Qt;
175 re_set_whitespace_regexp (NULL);
177 re_set_syntax (old);
178 /* UNBLOCK_INPUT; */
179 if (val)
180 xsignal1 (Qinvalid_regexp, build_string (val));
182 cp->regexp = Fcopy_sequence (pattern);
185 /* Shrink each compiled regexp buffer in the cache
186 to the size actually used right now.
187 This is called from garbage collection. */
189 void
190 shrink_regexp_cache ()
192 struct regexp_cache *cp;
194 for (cp = searchbuf_head; cp != 0; cp = cp->next)
196 cp->buf.allocated = cp->buf.used;
197 cp->buf.buffer
198 = (unsigned char *) xrealloc (cp->buf.buffer, cp->buf.used);
202 /* Clear the regexp cache w.r.t. a particular syntax table,
203 because it was changed.
204 There is no danger of memory leak here because re_compile_pattern
205 automagically manages the memory in each re_pattern_buffer struct,
206 based on its `allocated' and `buffer' values. */
207 void
208 clear_regexp_cache ()
210 int i;
212 for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
213 /* It's tempting to compare with the syntax-table we've actually changed,
214 but it's not sufficient because char-table inheritance means that
215 modifying one syntax-table can change others at the same time. */
216 if (!EQ (searchbufs[i].syntax_table, Qt))
217 searchbufs[i].regexp = Qnil;
220 /* Compile a regexp if necessary, but first check to see if there's one in
221 the cache.
222 PATTERN is the pattern to compile.
223 TRANSLATE is a translation table for ignoring case, or nil for none.
224 REGP is the structure that says where to store the "register"
225 values that will result from matching this pattern.
226 If it is 0, we should compile the pattern not to record any
227 subexpression bounds.
228 POSIX is nonzero if we want full backtracking (POSIX style)
229 for this pattern. 0 means backtrack only enough to get a valid match. */
231 struct re_pattern_buffer *
232 compile_pattern (pattern, regp, translate, posix, multibyte)
233 Lisp_Object pattern;
234 struct re_registers *regp;
235 Lisp_Object translate;
236 int posix, multibyte;
238 struct regexp_cache *cp, **cpp;
240 for (cpp = &searchbuf_head; ; cpp = &cp->next)
242 cp = *cpp;
243 /* Entries are initialized to nil, and may be set to nil by
244 compile_pattern_1 if the pattern isn't valid. Don't apply
245 string accessors in those cases. However, compile_pattern_1
246 is only applied to the cache entry we pick here to reuse. So
247 nil should never appear before a non-nil entry. */
248 if (NILP (cp->regexp))
249 goto compile_it;
250 if (SCHARS (cp->regexp) == SCHARS (pattern)
251 && STRING_MULTIBYTE (cp->regexp) == STRING_MULTIBYTE (pattern)
252 && !NILP (Fstring_equal (cp->regexp, pattern))
253 && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0)))
254 && cp->posix == posix
255 && (EQ (cp->syntax_table, Qt)
256 || EQ (cp->syntax_table, BUF_SYNTAX_TABLE (current_buffer)))
257 && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp))
258 && cp->buf.charset_unibyte == charset_unibyte)
259 break;
261 /* If we're at the end of the cache, compile into the nil cell
262 we found, or the last (least recently used) cell with a
263 string value. */
264 if (cp->next == 0)
266 compile_it:
267 compile_pattern_1 (cp, pattern, translate, regp, posix);
268 break;
272 /* When we get here, cp (aka *cpp) contains the compiled pattern,
273 either because we found it in the cache or because we just compiled it.
274 Move it to the front of the queue to mark it as most recently used. */
275 *cpp = cp->next;
276 cp->next = searchbuf_head;
277 searchbuf_head = cp;
279 /* Advise the searching functions about the space we have allocated
280 for register data. */
281 if (regp)
282 re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end);
284 /* The compiled pattern can be used both for mulitbyte and unibyte
285 target. But, we have to tell which the pattern is used for. */
286 cp->buf.target_multibyte = multibyte;
288 return &cp->buf;
292 static Lisp_Object
293 looking_at_1 (string, posix)
294 Lisp_Object string;
295 int posix;
297 Lisp_Object val;
298 unsigned char *p1, *p2;
299 EMACS_INT s1, s2;
300 register int i;
301 struct re_pattern_buffer *bufp;
303 if (running_asynch_code)
304 save_search_regs ();
306 /* This is so set_image_of_range_1 in regex.c can find the EQV table. */
307 XCHAR_TABLE (BUF_CASE_CANON_TABLE (current_buffer))->extras[2]
308 = BUF_CASE_EQV_TABLE (current_buffer);
310 CHECK_STRING (string);
311 bufp = compile_pattern (string,
312 (NILP (Vinhibit_changing_match_data)
313 ? &search_regs : NULL),
314 (!NILP (BUF_CASE_FOLD_SEARCH (current_buffer))
315 ? BUF_CASE_CANON_TABLE (current_buffer) : Qnil),
316 posix,
317 !NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer)));
319 immediate_quit = 1;
320 QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */
322 /* Get pointers and sizes of the two strings
323 that make up the visible portion of the buffer. */
325 p1 = BEGV_ADDR;
326 s1 = GPT_BYTE - BEGV_BYTE;
327 p2 = GAP_END_ADDR;
328 s2 = ZV_BYTE - GPT_BYTE;
329 if (s1 < 0)
331 p2 = p1;
332 s2 = ZV_BYTE - BEGV_BYTE;
333 s1 = 0;
335 if (s2 < 0)
337 s1 = ZV_BYTE - BEGV_BYTE;
338 s2 = 0;
341 re_match_object = Qnil;
343 i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
344 PT_BYTE - BEGV_BYTE,
345 (NILP (Vinhibit_changing_match_data)
346 ? &search_regs : NULL),
347 ZV_BYTE - BEGV_BYTE);
348 immediate_quit = 0;
350 if (i == -2)
351 matcher_overflow ();
353 val = (0 <= i ? Qt : Qnil);
354 if (NILP (Vinhibit_changing_match_data) && i >= 0)
355 for (i = 0; i < search_regs.num_regs; i++)
356 if (search_regs.start[i] >= 0)
358 search_regs.start[i]
359 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
360 search_regs.end[i]
361 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
364 /* Set last_thing_searched only when match data is changed. */
365 if (NILP (Vinhibit_changing_match_data))
366 XSETBUFFER (last_thing_searched, current_buffer);
368 return val;
371 DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0,
372 doc: /* Return t if text after point matches regular expression REGEXP.
373 This function modifies the match data that `match-beginning',
374 `match-end' and `match-data' access; save and restore the match
375 data if you want to preserve them. */)
376 (regexp)
377 Lisp_Object regexp;
379 return looking_at_1 (regexp, 0);
382 DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0,
383 doc: /* Return t if text after point matches regular expression REGEXP.
384 Find the longest match, in accord with Posix regular expression rules.
385 This function modifies the match data that `match-beginning',
386 `match-end' and `match-data' access; save and restore the match
387 data if you want to preserve them. */)
388 (regexp)
389 Lisp_Object regexp;
391 return looking_at_1 (regexp, 1);
394 static Lisp_Object
395 string_match_1 (regexp, string, start, posix)
396 Lisp_Object regexp, string, start;
397 int posix;
399 int val;
400 struct re_pattern_buffer *bufp;
401 EMACS_INT pos, pos_byte;
402 int i;
404 if (running_asynch_code)
405 save_search_regs ();
407 CHECK_STRING (regexp);
408 CHECK_STRING (string);
410 if (NILP (start))
411 pos = 0, pos_byte = 0;
412 else
414 int len = SCHARS (string);
416 CHECK_NUMBER (start);
417 pos = XINT (start);
418 if (pos < 0 && -pos <= len)
419 pos = len + pos;
420 else if (0 > pos || pos > len)
421 args_out_of_range (string, start);
422 pos_byte = string_char_to_byte (string, pos);
425 /* This is so set_image_of_range_1 in regex.c can find the EQV table. */
426 XCHAR_TABLE (BUF_CASE_CANON_TABLE (current_buffer))->extras[2]
427 = BUF_CASE_EQV_TABLE (current_buffer);
429 bufp = compile_pattern (regexp,
430 (NILP (Vinhibit_changing_match_data)
431 ? &search_regs : NULL),
432 (!NILP (BUF_CASE_FOLD_SEARCH (current_buffer))
433 ? BUF_CASE_CANON_TABLE (current_buffer) : Qnil),
434 posix,
435 STRING_MULTIBYTE (string));
436 immediate_quit = 1;
437 re_match_object = string;
439 val = re_search (bufp, (char *) SDATA (string),
440 SBYTES (string), pos_byte,
441 SBYTES (string) - pos_byte,
442 (NILP (Vinhibit_changing_match_data)
443 ? &search_regs : NULL));
444 immediate_quit = 0;
446 /* Set last_thing_searched only when match data is changed. */
447 if (NILP (Vinhibit_changing_match_data))
448 last_thing_searched = Qt;
450 if (val == -2)
451 matcher_overflow ();
452 if (val < 0) return Qnil;
454 if (NILP (Vinhibit_changing_match_data))
455 for (i = 0; i < search_regs.num_regs; i++)
456 if (search_regs.start[i] >= 0)
458 search_regs.start[i]
459 = string_byte_to_char (string, search_regs.start[i]);
460 search_regs.end[i]
461 = string_byte_to_char (string, search_regs.end[i]);
464 return make_number (string_byte_to_char (string, val));
467 DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0,
468 doc: /* Return index of start of first match for REGEXP in STRING, or nil.
469 Matching ignores case if `case-fold-search' is non-nil.
470 If third arg START is non-nil, start search at that index in STRING.
471 For index of first char beyond the match, do (match-end 0).
472 `match-end' and `match-beginning' also give indices of substrings
473 matched by parenthesis constructs in the pattern.
475 You can use the function `match-string' to extract the substrings
476 matched by the parenthesis constructions in REGEXP. */)
477 (regexp, string, start)
478 Lisp_Object regexp, string, start;
480 return string_match_1 (regexp, string, start, 0);
483 DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0,
484 doc: /* Return index of start of first match for REGEXP in STRING, or nil.
485 Find the longest match, in accord with Posix regular expression rules.
486 Case is ignored if `case-fold-search' is non-nil in the current buffer.
487 If third arg START is non-nil, start search at that index in STRING.
488 For index of first char beyond the match, do (match-end 0).
489 `match-end' and `match-beginning' also give indices of substrings
490 matched by parenthesis constructs in the pattern. */)
491 (regexp, string, start)
492 Lisp_Object regexp, string, start;
494 return string_match_1 (regexp, string, start, 1);
497 /* Match REGEXP against STRING, searching all of STRING,
498 and return the index of the match, or negative on failure.
499 This does not clobber the match data. */
502 fast_string_match (regexp, string)
503 Lisp_Object regexp, string;
505 int val;
506 struct re_pattern_buffer *bufp;
508 bufp = compile_pattern (regexp, 0, Qnil,
509 0, STRING_MULTIBYTE (string));
510 immediate_quit = 1;
511 re_match_object = string;
513 val = re_search (bufp, (char *) SDATA (string),
514 SBYTES (string), 0,
515 SBYTES (string), 0);
516 immediate_quit = 0;
517 return val;
520 /* Match REGEXP against STRING, searching all of STRING ignoring case,
521 and return the index of the match, or negative on failure.
522 This does not clobber the match data.
523 We assume that STRING contains single-byte characters. */
525 extern Lisp_Object Vascii_downcase_table;
528 fast_c_string_match_ignore_case (regexp, string)
529 Lisp_Object regexp;
530 const char *string;
532 int val;
533 struct re_pattern_buffer *bufp;
534 int len = strlen (string);
536 regexp = string_make_unibyte (regexp);
537 re_match_object = Qt;
538 bufp = compile_pattern (regexp, 0,
539 Vascii_canon_table, 0,
541 immediate_quit = 1;
542 val = re_search (bufp, string, len, 0, len, 0);
543 immediate_quit = 0;
544 return val;
547 /* Like fast_string_match but ignore case. */
550 fast_string_match_ignore_case (regexp, string)
551 Lisp_Object regexp, string;
553 int val;
554 struct re_pattern_buffer *bufp;
556 bufp = compile_pattern (regexp, 0, Vascii_canon_table,
557 0, STRING_MULTIBYTE (string));
558 immediate_quit = 1;
559 re_match_object = string;
561 val = re_search (bufp, (char *) SDATA (string),
562 SBYTES (string), 0,
563 SBYTES (string), 0);
564 immediate_quit = 0;
565 return val;
568 /* Match REGEXP against the characters after POS to LIMIT, and return
569 the number of matched characters. If STRING is non-nil, match
570 against the characters in it. In that case, POS and LIMIT are
571 indices into the string. This function doesn't modify the match
572 data. */
574 EMACS_INT
575 fast_looking_at (regexp, pos, pos_byte, limit, limit_byte, string)
576 Lisp_Object regexp;
577 EMACS_INT pos, pos_byte, limit, limit_byte;
578 Lisp_Object string;
580 int multibyte;
581 struct re_pattern_buffer *buf;
582 unsigned char *p1, *p2;
583 EMACS_INT s1, s2;
584 EMACS_INT len;
586 if (STRINGP (string))
588 if (pos_byte < 0)
589 pos_byte = string_char_to_byte (string, pos);
590 if (limit_byte < 0)
591 limit_byte = string_char_to_byte (string, limit);
592 p1 = NULL;
593 s1 = 0;
594 p2 = SDATA (string);
595 s2 = SBYTES (string);
596 re_match_object = string;
597 multibyte = STRING_MULTIBYTE (string);
599 else
601 if (pos_byte < 0)
602 pos_byte = CHAR_TO_BYTE (pos);
603 if (limit_byte < 0)
604 limit_byte = CHAR_TO_BYTE (limit);
605 pos_byte -= BEGV_BYTE;
606 limit_byte -= BEGV_BYTE;
607 p1 = BEGV_ADDR;
608 s1 = GPT_BYTE - BEGV_BYTE;
609 p2 = GAP_END_ADDR;
610 s2 = ZV_BYTE - GPT_BYTE;
611 if (s1 < 0)
613 p2 = p1;
614 s2 = ZV_BYTE - BEGV_BYTE;
615 s1 = 0;
617 if (s2 < 0)
619 s1 = ZV_BYTE - BEGV_BYTE;
620 s2 = 0;
622 re_match_object = Qnil;
623 multibyte = ! NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer));
626 buf = compile_pattern (regexp, 0, Qnil, 0, multibyte);
627 immediate_quit = 1;
628 len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2,
629 pos_byte, NULL, limit_byte);
630 immediate_quit = 0;
632 return len;
636 /* The newline cache: remembering which sections of text have no newlines. */
638 /* If the user has requested newline caching, make sure it's on.
639 Otherwise, make sure it's off.
640 This is our cheezy way of associating an action with the change of
641 state of a buffer-local variable. */
642 static void
643 newline_cache_on_off (buf)
644 struct buffer *buf;
646 if (NILP (BUF_CACHE_LONG_LINE_SCANS (buf)))
648 /* It should be off. */
649 if (buf->newline_cache)
651 free_region_cache (buf->newline_cache);
652 buf->newline_cache = 0;
655 else
657 /* It should be on. */
658 if (buf->newline_cache == 0)
659 buf->newline_cache = new_region_cache ();
664 /* Search for COUNT instances of the character TARGET between START and END.
666 If COUNT is positive, search forwards; END must be >= START.
667 If COUNT is negative, search backwards for the -COUNTth instance;
668 END must be <= START.
669 If COUNT is zero, do anything you please; run rogue, for all I care.
671 If END is zero, use BEGV or ZV instead, as appropriate for the
672 direction indicated by COUNT.
674 If we find COUNT instances, set *SHORTAGE to zero, and return the
675 position past the COUNTth match. Note that for reverse motion
676 this is not the same as the usual convention for Emacs motion commands.
678 If we don't find COUNT instances before reaching END, set *SHORTAGE
679 to the number of TARGETs left unfound, and return END.
681 If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do
682 except when inside redisplay. */
685 scan_buffer (target, start, end, count, shortage, allow_quit)
686 register int target;
687 EMACS_INT start, end;
688 int count;
689 int *shortage;
690 int allow_quit;
692 struct region_cache *newline_cache;
693 int direction;
695 if (count > 0)
697 direction = 1;
698 if (! end) end = ZV;
700 else
702 direction = -1;
703 if (! end) end = BEGV;
706 newline_cache_on_off (current_buffer);
707 newline_cache = current_buffer->newline_cache;
709 if (shortage != 0)
710 *shortage = 0;
712 immediate_quit = allow_quit;
714 if (count > 0)
715 while (start != end)
717 /* Our innermost scanning loop is very simple; it doesn't know
718 about gaps, buffer ends, or the newline cache. ceiling is
719 the position of the last character before the next such
720 obstacle --- the last character the dumb search loop should
721 examine. */
722 EMACS_INT ceiling_byte = CHAR_TO_BYTE (end) - 1;
723 EMACS_INT start_byte = CHAR_TO_BYTE (start);
724 EMACS_INT tem;
726 /* If we're looking for a newline, consult the newline cache
727 to see where we can avoid some scanning. */
728 if (target == '\n' && newline_cache)
730 int next_change;
731 immediate_quit = 0;
732 while (region_cache_forward
733 (current_buffer, newline_cache, start_byte, &next_change))
734 start_byte = next_change;
735 immediate_quit = allow_quit;
737 /* START should never be after END. */
738 if (start_byte > ceiling_byte)
739 start_byte = ceiling_byte;
741 /* Now the text after start is an unknown region, and
742 next_change is the position of the next known region. */
743 ceiling_byte = min (next_change - 1, ceiling_byte);
746 /* The dumb loop can only scan text stored in contiguous
747 bytes. BUFFER_CEILING_OF returns the last character
748 position that is contiguous, so the ceiling is the
749 position after that. */
750 tem = BUFFER_CEILING_OF (start_byte);
751 ceiling_byte = min (tem, ceiling_byte);
754 /* The termination address of the dumb loop. */
755 register unsigned char *ceiling_addr
756 = BYTE_POS_ADDR (ceiling_byte) + 1;
757 register unsigned char *cursor
758 = BYTE_POS_ADDR (start_byte);
759 unsigned char *base = cursor;
761 while (cursor < ceiling_addr)
763 unsigned char *scan_start = cursor;
765 /* The dumb loop. */
766 while (*cursor != target && ++cursor < ceiling_addr)
769 /* If we're looking for newlines, cache the fact that
770 the region from start to cursor is free of them. */
771 if (target == '\n' && newline_cache)
772 know_region_cache (current_buffer, newline_cache,
773 start_byte + scan_start - base,
774 start_byte + cursor - base);
776 /* Did we find the target character? */
777 if (cursor < ceiling_addr)
779 if (--count == 0)
781 immediate_quit = 0;
782 return BYTE_TO_CHAR (start_byte + cursor - base + 1);
784 cursor++;
788 start = BYTE_TO_CHAR (start_byte + cursor - base);
791 else
792 while (start > end)
794 /* The last character to check before the next obstacle. */
795 EMACS_INT ceiling_byte = CHAR_TO_BYTE (end);
796 EMACS_INT start_byte = CHAR_TO_BYTE (start);
797 EMACS_INT tem;
799 /* Consult the newline cache, if appropriate. */
800 if (target == '\n' && newline_cache)
802 int next_change;
803 immediate_quit = 0;
804 while (region_cache_backward
805 (current_buffer, newline_cache, start_byte, &next_change))
806 start_byte = next_change;
807 immediate_quit = allow_quit;
809 /* Start should never be at or before end. */
810 if (start_byte <= ceiling_byte)
811 start_byte = ceiling_byte + 1;
813 /* Now the text before start is an unknown region, and
814 next_change is the position of the next known region. */
815 ceiling_byte = max (next_change, ceiling_byte);
818 /* Stop scanning before the gap. */
819 tem = BUFFER_FLOOR_OF (start_byte - 1);
820 ceiling_byte = max (tem, ceiling_byte);
823 /* The termination address of the dumb loop. */
824 register unsigned char *ceiling_addr = BYTE_POS_ADDR (ceiling_byte);
825 register unsigned char *cursor = BYTE_POS_ADDR (start_byte - 1);
826 unsigned char *base = cursor;
828 while (cursor >= ceiling_addr)
830 unsigned char *scan_start = cursor;
832 while (*cursor != target && --cursor >= ceiling_addr)
835 /* If we're looking for newlines, cache the fact that
836 the region from after the cursor to start is free of them. */
837 if (target == '\n' && newline_cache)
838 know_region_cache (current_buffer, newline_cache,
839 start_byte + cursor - base,
840 start_byte + scan_start - base);
842 /* Did we find the target character? */
843 if (cursor >= ceiling_addr)
845 if (++count >= 0)
847 immediate_quit = 0;
848 return BYTE_TO_CHAR (start_byte + cursor - base);
850 cursor--;
854 start = BYTE_TO_CHAR (start_byte + cursor - base);
858 immediate_quit = 0;
859 if (shortage != 0)
860 *shortage = count * direction;
861 return start;
864 /* Search for COUNT instances of a line boundary, which means either a
865 newline or (if selective display enabled) a carriage return.
866 Start at START. If COUNT is negative, search backwards.
868 We report the resulting position by calling TEMP_SET_PT_BOTH.
870 If we find COUNT instances. we position after (always after,
871 even if scanning backwards) the COUNTth match, and return 0.
873 If we don't find COUNT instances before reaching the end of the
874 buffer (or the beginning, if scanning backwards), we return
875 the number of line boundaries left unfound, and position at
876 the limit we bumped up against.
878 If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do
879 except in special cases. */
882 scan_newline (start, start_byte, limit, limit_byte, count, allow_quit)
883 EMACS_INT start, start_byte;
884 EMACS_INT limit, limit_byte;
885 register int count;
886 int allow_quit;
888 int direction = ((count > 0) ? 1 : -1);
890 register unsigned char *cursor;
891 unsigned char *base;
893 EMACS_INT ceiling;
894 register unsigned char *ceiling_addr;
896 int old_immediate_quit = immediate_quit;
898 /* The code that follows is like scan_buffer
899 but checks for either newline or carriage return. */
901 if (allow_quit)
902 immediate_quit++;
904 start_byte = CHAR_TO_BYTE (start);
906 if (count > 0)
908 while (start_byte < limit_byte)
910 ceiling = BUFFER_CEILING_OF (start_byte);
911 ceiling = min (limit_byte - 1, ceiling);
912 ceiling_addr = BYTE_POS_ADDR (ceiling) + 1;
913 base = (cursor = BYTE_POS_ADDR (start_byte));
914 while (1)
916 while (*cursor != '\n' && ++cursor != ceiling_addr)
919 if (cursor != ceiling_addr)
921 if (--count == 0)
923 immediate_quit = old_immediate_quit;
924 start_byte = start_byte + cursor - base + 1;
925 start = BYTE_TO_CHAR (start_byte);
926 TEMP_SET_PT_BOTH (start, start_byte);
927 return 0;
929 else
930 if (++cursor == ceiling_addr)
931 break;
933 else
934 break;
936 start_byte += cursor - base;
939 else
941 while (start_byte > limit_byte)
943 ceiling = BUFFER_FLOOR_OF (start_byte - 1);
944 ceiling = max (limit_byte, ceiling);
945 ceiling_addr = BYTE_POS_ADDR (ceiling) - 1;
946 base = (cursor = BYTE_POS_ADDR (start_byte - 1) + 1);
947 while (1)
949 while (--cursor != ceiling_addr && *cursor != '\n')
952 if (cursor != ceiling_addr)
954 if (++count == 0)
956 immediate_quit = old_immediate_quit;
957 /* Return the position AFTER the match we found. */
958 start_byte = start_byte + cursor - base + 1;
959 start = BYTE_TO_CHAR (start_byte);
960 TEMP_SET_PT_BOTH (start, start_byte);
961 return 0;
964 else
965 break;
967 /* Here we add 1 to compensate for the last decrement
968 of CURSOR, which took it past the valid range. */
969 start_byte += cursor - base + 1;
973 TEMP_SET_PT_BOTH (limit, limit_byte);
974 immediate_quit = old_immediate_quit;
976 return count * direction;
980 find_next_newline_no_quit (from, cnt)
981 EMACS_INT from;
982 int cnt;
984 return scan_buffer ('\n', from, 0, cnt, (int *) 0, 0);
987 /* Like find_next_newline, but returns position before the newline,
988 not after, and only search up to TO. This isn't just
989 find_next_newline (...)-1, because you might hit TO. */
992 find_before_next_newline (from, to, cnt)
993 EMACS_INT from, to;
994 int cnt;
996 int shortage;
997 int pos = scan_buffer ('\n', from, to, cnt, &shortage, 1);
999 if (shortage == 0)
1000 pos--;
1002 return pos;
1005 /* Subroutines of Lisp buffer search functions. */
1007 static Lisp_Object
1008 search_command (string, bound, noerror, count, direction, RE, posix)
1009 Lisp_Object string, bound, noerror, count;
1010 int direction;
1011 int RE;
1012 int posix;
1014 register int np;
1015 int lim, lim_byte;
1016 int n = direction;
1018 if (!NILP (count))
1020 CHECK_NUMBER (count);
1021 n *= XINT (count);
1024 CHECK_STRING (string);
1025 if (NILP (bound))
1027 if (n > 0)
1028 lim = ZV, lim_byte = ZV_BYTE;
1029 else
1030 lim = BEGV, lim_byte = BEGV_BYTE;
1032 else
1034 CHECK_NUMBER_COERCE_MARKER (bound);
1035 lim = XINT (bound);
1036 if (n > 0 ? lim < PT : lim > PT)
1037 error ("Invalid search bound (wrong side of point)");
1038 if (lim > ZV)
1039 lim = ZV, lim_byte = ZV_BYTE;
1040 else if (lim < BEGV)
1041 lim = BEGV, lim_byte = BEGV_BYTE;
1042 else
1043 lim_byte = CHAR_TO_BYTE (lim);
1046 /* This is so set_image_of_range_1 in regex.c can find the EQV table. */
1047 XCHAR_TABLE (BUF_CASE_CANON_TABLE (current_buffer))->extras[2]
1048 = BUF_CASE_EQV_TABLE (current_buffer);
1050 np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE,
1051 (!NILP (BUF_CASE_FOLD_SEARCH (current_buffer))
1052 ? BUF_CASE_CANON_TABLE (current_buffer)
1053 : Qnil),
1054 (!NILP (BUF_CASE_FOLD_SEARCH (current_buffer))
1055 ? BUF_CASE_EQV_TABLE (current_buffer)
1056 : Qnil),
1057 posix);
1058 if (np <= 0)
1060 if (NILP (noerror))
1061 xsignal1 (Qsearch_failed, string);
1063 if (!EQ (noerror, Qt))
1065 if (lim < BEGV || lim > ZV)
1066 abort ();
1067 SET_PT_BOTH (lim, lim_byte);
1068 return Qnil;
1069 #if 0 /* This would be clean, but maybe programs depend on
1070 a value of nil here. */
1071 np = lim;
1072 #endif
1074 else
1075 return Qnil;
1078 if (np < BEGV || np > ZV)
1079 abort ();
1081 SET_PT (np);
1083 return make_number (np);
1086 /* Return 1 if REGEXP it matches just one constant string. */
1088 static int
1089 trivial_regexp_p (regexp)
1090 Lisp_Object regexp;
1092 int len = SBYTES (regexp);
1093 unsigned char *s = SDATA (regexp);
1094 while (--len >= 0)
1096 switch (*s++)
1098 case '.': case '*': case '+': case '?': case '[': case '^': case '$':
1099 return 0;
1100 case '\\':
1101 if (--len < 0)
1102 return 0;
1103 switch (*s++)
1105 case '|': case '(': case ')': case '`': case '\'': case 'b':
1106 case 'B': case '<': case '>': case 'w': case 'W': case 's':
1107 case 'S': case '=': case '{': case '}': case '_':
1108 case 'c': case 'C': /* for categoryspec and notcategoryspec */
1109 case '1': case '2': case '3': case '4': case '5':
1110 case '6': case '7': case '8': case '9':
1111 return 0;
1115 return 1;
1118 /* Search for the n'th occurrence of STRING in the current buffer,
1119 starting at position POS and stopping at position LIM,
1120 treating STRING as a literal string if RE is false or as
1121 a regular expression if RE is true.
1123 If N is positive, searching is forward and LIM must be greater than POS.
1124 If N is negative, searching is backward and LIM must be less than POS.
1126 Returns -x if x occurrences remain to be found (x > 0),
1127 or else the position at the beginning of the Nth occurrence
1128 (if searching backward) or the end (if searching forward).
1130 POSIX is nonzero if we want full backtracking (POSIX style)
1131 for this pattern. 0 means backtrack only enough to get a valid match. */
1133 #define TRANSLATE(out, trt, d) \
1134 do \
1136 if (! NILP (trt)) \
1138 Lisp_Object temp; \
1139 temp = Faref (trt, make_number (d)); \
1140 if (INTEGERP (temp)) \
1141 out = XINT (temp); \
1142 else \
1143 out = d; \
1145 else \
1146 out = d; \
1148 while (0)
1150 /* Only used in search_buffer, to record the end position of the match
1151 when searching regexps and SEARCH_REGS should not be changed
1152 (i.e. Vinhibit_changing_match_data is non-nil). */
1153 static struct re_registers search_regs_1;
1155 static EMACS_INT
1156 search_buffer (string, pos, pos_byte, lim, lim_byte, n,
1157 RE, trt, inverse_trt, posix)
1158 Lisp_Object string;
1159 EMACS_INT pos;
1160 EMACS_INT pos_byte;
1161 EMACS_INT lim;
1162 EMACS_INT lim_byte;
1163 int n;
1164 int RE;
1165 Lisp_Object trt;
1166 Lisp_Object inverse_trt;
1167 int posix;
1169 int len = SCHARS (string);
1170 int len_byte = SBYTES (string);
1171 register int i;
1173 if (running_asynch_code)
1174 save_search_regs ();
1176 /* Searching 0 times means don't move. */
1177 /* Null string is found at starting position. */
1178 if (len == 0 || n == 0)
1180 set_search_regs (pos_byte, 0);
1181 return pos;
1184 if (RE && !(trivial_regexp_p (string) && NILP (Vsearch_spaces_regexp)))
1186 unsigned char *p1, *p2;
1187 int s1, s2;
1188 struct re_pattern_buffer *bufp;
1190 bufp = compile_pattern (string,
1191 (NILP (Vinhibit_changing_match_data)
1192 ? &search_regs : &search_regs_1),
1193 trt, posix,
1194 !NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer)));
1196 immediate_quit = 1; /* Quit immediately if user types ^G,
1197 because letting this function finish
1198 can take too long. */
1199 QUIT; /* Do a pending quit right away,
1200 to avoid paradoxical behavior */
1201 /* Get pointers and sizes of the two strings
1202 that make up the visible portion of the buffer. */
1204 p1 = BEGV_ADDR;
1205 s1 = GPT_BYTE - BEGV_BYTE;
1206 p2 = GAP_END_ADDR;
1207 s2 = ZV_BYTE - GPT_BYTE;
1208 if (s1 < 0)
1210 p2 = p1;
1211 s2 = ZV_BYTE - BEGV_BYTE;
1212 s1 = 0;
1214 if (s2 < 0)
1216 s1 = ZV_BYTE - BEGV_BYTE;
1217 s2 = 0;
1219 re_match_object = Qnil;
1221 while (n < 0)
1223 int val;
1224 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
1225 pos_byte - BEGV_BYTE, lim_byte - pos_byte,
1226 (NILP (Vinhibit_changing_match_data)
1227 ? &search_regs : &search_regs_1),
1228 /* Don't allow match past current point */
1229 pos_byte - BEGV_BYTE);
1230 if (val == -2)
1232 matcher_overflow ();
1234 if (val >= 0)
1236 if (NILP (Vinhibit_changing_match_data))
1238 pos_byte = search_regs.start[0] + BEGV_BYTE;
1239 for (i = 0; i < search_regs.num_regs; i++)
1240 if (search_regs.start[i] >= 0)
1242 search_regs.start[i]
1243 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
1244 search_regs.end[i]
1245 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
1247 XSETBUFFER (last_thing_searched, current_buffer);
1248 /* Set pos to the new position. */
1249 pos = search_regs.start[0];
1251 else
1253 pos_byte = search_regs_1.start[0] + BEGV_BYTE;
1254 /* Set pos to the new position. */
1255 pos = BYTE_TO_CHAR (search_regs_1.start[0] + BEGV_BYTE);
1258 else
1260 immediate_quit = 0;
1261 return (n);
1263 n++;
1265 while (n > 0)
1267 int val;
1268 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
1269 pos_byte - BEGV_BYTE, lim_byte - pos_byte,
1270 (NILP (Vinhibit_changing_match_data)
1271 ? &search_regs : &search_regs_1),
1272 lim_byte - BEGV_BYTE);
1273 if (val == -2)
1275 matcher_overflow ();
1277 if (val >= 0)
1279 if (NILP (Vinhibit_changing_match_data))
1281 pos_byte = search_regs.end[0] + BEGV_BYTE;
1282 for (i = 0; i < search_regs.num_regs; i++)
1283 if (search_regs.start[i] >= 0)
1285 search_regs.start[i]
1286 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
1287 search_regs.end[i]
1288 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
1290 XSETBUFFER (last_thing_searched, current_buffer);
1291 pos = search_regs.end[0];
1293 else
1295 pos_byte = search_regs_1.end[0] + BEGV_BYTE;
1296 pos = BYTE_TO_CHAR (search_regs_1.end[0] + BEGV_BYTE);
1299 else
1301 immediate_quit = 0;
1302 return (0 - n);
1304 n--;
1306 immediate_quit = 0;
1307 return (pos);
1309 else /* non-RE case */
1311 unsigned char *raw_pattern, *pat;
1312 int raw_pattern_size;
1313 int raw_pattern_size_byte;
1314 unsigned char *patbuf;
1315 int multibyte = !NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer));
1316 unsigned char *base_pat;
1317 /* Set to positive if we find a non-ASCII char that need
1318 translation. Otherwise set to zero later. */
1319 int char_base = -1;
1320 int boyer_moore_ok = 1;
1322 /* MULTIBYTE says whether the text to be searched is multibyte.
1323 We must convert PATTERN to match that, or we will not really
1324 find things right. */
1326 if (multibyte == STRING_MULTIBYTE (string))
1328 raw_pattern = (unsigned char *) SDATA (string);
1329 raw_pattern_size = SCHARS (string);
1330 raw_pattern_size_byte = SBYTES (string);
1332 else if (multibyte)
1334 raw_pattern_size = SCHARS (string);
1335 raw_pattern_size_byte
1336 = count_size_as_multibyte (SDATA (string),
1337 raw_pattern_size);
1338 raw_pattern = (unsigned char *) alloca (raw_pattern_size_byte + 1);
1339 copy_text (SDATA (string), raw_pattern,
1340 SCHARS (string), 0, 1);
1342 else
1344 /* Converting multibyte to single-byte.
1346 ??? Perhaps this conversion should be done in a special way
1347 by subtracting nonascii-insert-offset from each non-ASCII char,
1348 so that only the multibyte chars which really correspond to
1349 the chosen single-byte character set can possibly match. */
1350 raw_pattern_size = SCHARS (string);
1351 raw_pattern_size_byte = SCHARS (string);
1352 raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
1353 copy_text (SDATA (string), raw_pattern,
1354 SBYTES (string), 1, 0);
1357 /* Copy and optionally translate the pattern. */
1358 len = raw_pattern_size;
1359 len_byte = raw_pattern_size_byte;
1360 patbuf = (unsigned char *) alloca (len * MAX_MULTIBYTE_LENGTH);
1361 pat = patbuf;
1362 base_pat = raw_pattern;
1363 if (multibyte)
1365 /* Fill patbuf by translated characters in STRING while
1366 checking if we can use boyer-moore search. If TRT is
1367 non-nil, we can use boyer-moore search only if TRT can be
1368 represented by the byte array of 256 elements. For that,
1369 all non-ASCII case-equivalents of all case-senstive
1370 characters in STRING must belong to the same charset and
1371 row. */
1373 while (--len >= 0)
1375 unsigned char str_base[MAX_MULTIBYTE_LENGTH], *str;
1376 int c, translated, inverse;
1377 int in_charlen, charlen;
1379 /* If we got here and the RE flag is set, it's because we're
1380 dealing with a regexp known to be trivial, so the backslash
1381 just quotes the next character. */
1382 if (RE && *base_pat == '\\')
1384 len--;
1385 raw_pattern_size--;
1386 len_byte--;
1387 base_pat++;
1390 c = STRING_CHAR_AND_LENGTH (base_pat, in_charlen);
1392 if (NILP (trt))
1394 str = base_pat;
1395 charlen = in_charlen;
1397 else
1399 /* Translate the character. */
1400 TRANSLATE (translated, trt, c);
1401 charlen = CHAR_STRING (translated, str_base);
1402 str = str_base;
1404 /* Check if C has any other case-equivalents. */
1405 TRANSLATE (inverse, inverse_trt, c);
1406 /* If so, check if we can use boyer-moore. */
1407 if (c != inverse && boyer_moore_ok)
1409 /* Check if all equivalents belong to the same
1410 group of characters. Note that the check of C
1411 itself is done by the last iteration. */
1412 int this_char_base = -1;
1414 while (boyer_moore_ok)
1416 if (ASCII_BYTE_P (inverse))
1418 if (this_char_base > 0)
1419 boyer_moore_ok = 0;
1420 else
1421 this_char_base = 0;
1423 else if (CHAR_BYTE8_P (inverse))
1424 /* Boyer-moore search can't handle a
1425 translation of an eight-bit
1426 character. */
1427 boyer_moore_ok = 0;
1428 else if (this_char_base < 0)
1430 this_char_base = inverse & ~0x3F;
1431 if (char_base < 0)
1432 char_base = this_char_base;
1433 else if (this_char_base != char_base)
1434 boyer_moore_ok = 0;
1436 else if ((inverse & ~0x3F) != this_char_base)
1437 boyer_moore_ok = 0;
1438 if (c == inverse)
1439 break;
1440 TRANSLATE (inverse, inverse_trt, inverse);
1445 /* Store this character into the translated pattern. */
1446 bcopy (str, pat, charlen);
1447 pat += charlen;
1448 base_pat += in_charlen;
1449 len_byte -= in_charlen;
1452 /* If char_base is still negative we didn't find any translated
1453 non-ASCII characters. */
1454 if (char_base < 0)
1455 char_base = 0;
1457 else
1459 /* Unibyte buffer. */
1460 char_base = 0;
1461 while (--len >= 0)
1463 int c, translated;
1465 /* If we got here and the RE flag is set, it's because we're
1466 dealing with a regexp known to be trivial, so the backslash
1467 just quotes the next character. */
1468 if (RE && *base_pat == '\\')
1470 len--;
1471 raw_pattern_size--;
1472 base_pat++;
1474 c = *base_pat++;
1475 TRANSLATE (translated, trt, c);
1476 *pat++ = translated;
1480 len_byte = pat - patbuf;
1481 len = raw_pattern_size;
1482 pat = base_pat = patbuf;
1484 if (boyer_moore_ok)
1485 return boyer_moore (n, pat, len, len_byte, trt, inverse_trt,
1486 pos, pos_byte, lim, lim_byte,
1487 char_base);
1488 else
1489 return simple_search (n, pat, len, len_byte, trt,
1490 pos, pos_byte, lim, lim_byte);
1494 /* Do a simple string search N times for the string PAT,
1495 whose length is LEN/LEN_BYTE,
1496 from buffer position POS/POS_BYTE until LIM/LIM_BYTE.
1497 TRT is the translation table.
1499 Return the character position where the match is found.
1500 Otherwise, if M matches remained to be found, return -M.
1502 This kind of search works regardless of what is in PAT and
1503 regardless of what is in TRT. It is used in cases where
1504 boyer_moore cannot work. */
1506 static EMACS_INT
1507 simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte)
1508 int n;
1509 unsigned char *pat;
1510 int len, len_byte;
1511 Lisp_Object trt;
1512 EMACS_INT pos, pos_byte;
1513 EMACS_INT lim, lim_byte;
1515 int multibyte = ! NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer));
1516 int forward = n > 0;
1517 /* Number of buffer bytes matched. Note that this may be different
1518 from len_byte in a multibyte buffer. */
1519 int match_byte;
1521 if (lim > pos && multibyte)
1522 while (n > 0)
1524 while (1)
1526 /* Try matching at position POS. */
1527 EMACS_INT this_pos = pos;
1528 EMACS_INT this_pos_byte = pos_byte;
1529 int this_len = len;
1530 unsigned char *p = pat;
1531 if (pos + len > lim || pos_byte + len_byte > lim_byte)
1532 goto stop;
1534 while (this_len > 0)
1536 int charlen, buf_charlen;
1537 int pat_ch, buf_ch;
1539 pat_ch = STRING_CHAR_AND_LENGTH (p, charlen);
1540 buf_ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (this_pos_byte),
1541 buf_charlen);
1542 TRANSLATE (buf_ch, trt, buf_ch);
1544 if (buf_ch != pat_ch)
1545 break;
1547 this_len--;
1548 p += charlen;
1550 this_pos_byte += buf_charlen;
1551 this_pos++;
1554 if (this_len == 0)
1556 match_byte = this_pos_byte - pos_byte;
1557 pos += len;
1558 pos_byte += match_byte;
1559 break;
1562 INC_BOTH (pos, pos_byte);
1565 n--;
1567 else if (lim > pos)
1568 while (n > 0)
1570 while (1)
1572 /* Try matching at position POS. */
1573 EMACS_INT this_pos = pos;
1574 int this_len = len;
1575 unsigned char *p = pat;
1577 if (pos + len > lim)
1578 goto stop;
1580 while (this_len > 0)
1582 int pat_ch = *p++;
1583 int buf_ch = FETCH_BYTE (this_pos);
1584 TRANSLATE (buf_ch, trt, buf_ch);
1586 if (buf_ch != pat_ch)
1587 break;
1589 this_len--;
1590 this_pos++;
1593 if (this_len == 0)
1595 match_byte = len;
1596 pos += len;
1597 break;
1600 pos++;
1603 n--;
1605 /* Backwards search. */
1606 else if (lim < pos && multibyte)
1607 while (n < 0)
1609 while (1)
1611 /* Try matching at position POS. */
1612 EMACS_INT this_pos = pos;
1613 EMACS_INT this_pos_byte = pos_byte;
1614 int this_len = len;
1615 const unsigned char *p = pat + len_byte;
1617 if (this_pos - len < lim || (pos_byte - len_byte) < lim_byte)
1618 goto stop;
1620 while (this_len > 0)
1622 int charlen;
1623 int pat_ch, buf_ch;
1625 DEC_BOTH (this_pos, this_pos_byte);
1626 PREV_CHAR_BOUNDARY (p, pat);
1627 pat_ch = STRING_CHAR (p);
1628 buf_ch = STRING_CHAR (BYTE_POS_ADDR (this_pos_byte));
1629 TRANSLATE (buf_ch, trt, buf_ch);
1631 if (buf_ch != pat_ch)
1632 break;
1634 this_len--;
1637 if (this_len == 0)
1639 match_byte = pos_byte - this_pos_byte;
1640 pos = this_pos;
1641 pos_byte = this_pos_byte;
1642 break;
1645 DEC_BOTH (pos, pos_byte);
1648 n++;
1650 else if (lim < pos)
1651 while (n < 0)
1653 while (1)
1655 /* Try matching at position POS. */
1656 EMACS_INT this_pos = pos - len;
1657 int this_len = len;
1658 unsigned char *p = pat;
1660 if (this_pos < lim)
1661 goto stop;
1663 while (this_len > 0)
1665 int pat_ch = *p++;
1666 int buf_ch = FETCH_BYTE (this_pos);
1667 TRANSLATE (buf_ch, trt, buf_ch);
1669 if (buf_ch != pat_ch)
1670 break;
1671 this_len--;
1672 this_pos++;
1675 if (this_len == 0)
1677 match_byte = len;
1678 pos -= len;
1679 break;
1682 pos--;
1685 n++;
1688 stop:
1689 if (n == 0)
1691 if (forward)
1692 set_search_regs ((multibyte ? pos_byte : pos) - match_byte, match_byte);
1693 else
1694 set_search_regs (multibyte ? pos_byte : pos, match_byte);
1696 return pos;
1698 else if (n > 0)
1699 return -n;
1700 else
1701 return n;
1704 /* Do Boyer-Moore search N times for the string BASE_PAT,
1705 whose length is LEN/LEN_BYTE,
1706 from buffer position POS/POS_BYTE until LIM/LIM_BYTE.
1707 DIRECTION says which direction we search in.
1708 TRT and INVERSE_TRT are translation tables.
1709 Characters in PAT are already translated by TRT.
1711 This kind of search works if all the characters in BASE_PAT that
1712 have nontrivial translation are the same aside from the last byte.
1713 This makes it possible to translate just the last byte of a
1714 character, and do so after just a simple test of the context.
1715 CHAR_BASE is nonzero if there is such a non-ASCII character.
1717 If that criterion is not satisfied, do not call this function. */
1719 static EMACS_INT
1720 boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt,
1721 pos, pos_byte, lim, lim_byte, char_base)
1722 int n;
1723 unsigned char *base_pat;
1724 int len, len_byte;
1725 Lisp_Object trt;
1726 Lisp_Object inverse_trt;
1727 EMACS_INT pos, pos_byte;
1728 EMACS_INT lim, lim_byte;
1729 int char_base;
1731 int direction = ((n > 0) ? 1 : -1);
1732 register int dirlen;
1733 EMACS_INT limit;
1734 int stride_for_teases = 0;
1735 int BM_tab[0400];
1736 register unsigned char *cursor, *p_limit;
1737 register int i, j;
1738 unsigned char *pat, *pat_end;
1739 int multibyte = ! NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer));
1741 unsigned char simple_translate[0400];
1742 /* These are set to the preceding bytes of a byte to be translated
1743 if char_base is nonzero. As the maximum byte length of a
1744 multibyte character is 5, we have to check at most four previous
1745 bytes. */
1746 int translate_prev_byte1 = 0;
1747 int translate_prev_byte2 = 0;
1748 int translate_prev_byte3 = 0;
1749 int translate_prev_byte4 = 0;
1751 /* The general approach is that we are going to maintain that we know
1752 the first (closest to the present position, in whatever direction
1753 we're searching) character that could possibly be the last
1754 (furthest from present position) character of a valid match. We
1755 advance the state of our knowledge by looking at that character
1756 and seeing whether it indeed matches the last character of the
1757 pattern. If it does, we take a closer look. If it does not, we
1758 move our pointer (to putative last characters) as far as is
1759 logically possible. This amount of movement, which I call a
1760 stride, will be the length of the pattern if the actual character
1761 appears nowhere in the pattern, otherwise it will be the distance
1762 from the last occurrence of that character to the end of the
1763 pattern. If the amount is zero we have a possible match. */
1765 /* Here we make a "mickey mouse" BM table. The stride of the search
1766 is determined only by the last character of the putative match.
1767 If that character does not match, we will stride the proper
1768 distance to propose a match that superimposes it on the last
1769 instance of a character that matches it (per trt), or misses
1770 it entirely if there is none. */
1772 dirlen = len_byte * direction;
1774 /* Record position after the end of the pattern. */
1775 pat_end = base_pat + len_byte;
1776 /* BASE_PAT points to a character that we start scanning from.
1777 It is the first character in a forward search,
1778 the last character in a backward search. */
1779 if (direction < 0)
1780 base_pat = pat_end - 1;
1782 /* A character that does not appear in the pattern induces a
1783 stride equal to the pattern length. */
1784 for (i = 0; i < 0400; i++)
1785 BM_tab[i] = dirlen;
1787 /* We use this for translation, instead of TRT itself.
1788 We fill this in to handle the characters that actually
1789 occur in the pattern. Others don't matter anyway! */
1790 for (i = 0; i < 0400; i++)
1791 simple_translate[i] = i;
1793 if (char_base)
1795 /* Setup translate_prev_byte1/2/3/4 from CHAR_BASE. Only a
1796 byte following them are the target of translation. */
1797 unsigned char str[MAX_MULTIBYTE_LENGTH];
1798 int len = CHAR_STRING (char_base, str);
1800 translate_prev_byte1 = str[len - 2];
1801 if (len > 2)
1803 translate_prev_byte2 = str[len - 3];
1804 if (len > 3)
1806 translate_prev_byte3 = str[len - 4];
1807 if (len > 4)
1808 translate_prev_byte4 = str[len - 5];
1813 i = 0;
1814 while (i != dirlen)
1816 unsigned char *ptr = base_pat + i;
1817 i += direction;
1818 if (! NILP (trt))
1820 /* If the byte currently looking at is the last of a
1821 character to check case-equivalents, set CH to that
1822 character. An ASCII character and a non-ASCII character
1823 matching with CHAR_BASE are to be checked. */
1824 int ch = -1;
1826 if (ASCII_BYTE_P (*ptr) || ! multibyte)
1827 ch = *ptr;
1828 else if (char_base
1829 && ((pat_end - ptr) == 1 || CHAR_HEAD_P (ptr[1])))
1831 unsigned char *charstart = ptr - 1;
1833 while (! (CHAR_HEAD_P (*charstart)))
1834 charstart--;
1835 ch = STRING_CHAR (charstart);
1836 if (char_base != (ch & ~0x3F))
1837 ch = -1;
1840 if (ch >= 0200)
1841 j = (ch & 0x3F) | 0200;
1842 else
1843 j = *ptr;
1845 if (i == dirlen)
1846 stride_for_teases = BM_tab[j];
1848 BM_tab[j] = dirlen - i;
1849 /* A translation table is accompanied by its inverse -- see */
1850 /* comment following downcase_table for details */
1851 if (ch >= 0)
1853 int starting_ch = ch;
1854 int starting_j = j;
1856 while (1)
1858 TRANSLATE (ch, inverse_trt, ch);
1859 if (ch >= 0200)
1860 j = (ch & 0x3F) | 0200;
1861 else
1862 j = ch;
1864 /* For all the characters that map into CH,
1865 set up simple_translate to map the last byte
1866 into STARTING_J. */
1867 simple_translate[j] = starting_j;
1868 if (ch == starting_ch)
1869 break;
1870 BM_tab[j] = dirlen - i;
1874 else
1876 j = *ptr;
1878 if (i == dirlen)
1879 stride_for_teases = BM_tab[j];
1880 BM_tab[j] = dirlen - i;
1882 /* stride_for_teases tells how much to stride if we get a
1883 match on the far character but are subsequently
1884 disappointed, by recording what the stride would have been
1885 for that character if the last character had been
1886 different. */
1888 pos_byte += dirlen - ((direction > 0) ? direction : 0);
1889 /* loop invariant - POS_BYTE points at where last char (first
1890 char if reverse) of pattern would align in a possible match. */
1891 while (n != 0)
1893 EMACS_INT tail_end;
1894 unsigned char *tail_end_ptr;
1896 /* It's been reported that some (broken) compiler thinks that
1897 Boolean expressions in an arithmetic context are unsigned.
1898 Using an explicit ?1:0 prevents this. */
1899 if ((lim_byte - pos_byte - ((direction > 0) ? 1 : 0)) * direction
1900 < 0)
1901 return (n * (0 - direction));
1902 /* First we do the part we can by pointers (maybe nothing) */
1903 QUIT;
1904 pat = base_pat;
1905 limit = pos_byte - dirlen + direction;
1906 if (direction > 0)
1908 limit = BUFFER_CEILING_OF (limit);
1909 /* LIMIT is now the last (not beyond-last!) value POS_BYTE
1910 can take on without hitting edge of buffer or the gap. */
1911 limit = min (limit, pos_byte + 20000);
1912 limit = min (limit, lim_byte - 1);
1914 else
1916 limit = BUFFER_FLOOR_OF (limit);
1917 /* LIMIT is now the last (not beyond-last!) value POS_BYTE
1918 can take on without hitting edge of buffer or the gap. */
1919 limit = max (limit, pos_byte - 20000);
1920 limit = max (limit, lim_byte);
1922 tail_end = BUFFER_CEILING_OF (pos_byte) + 1;
1923 tail_end_ptr = BYTE_POS_ADDR (tail_end);
1925 if ((limit - pos_byte) * direction > 20)
1927 unsigned char *p2;
1929 p_limit = BYTE_POS_ADDR (limit);
1930 p2 = (cursor = BYTE_POS_ADDR (pos_byte));
1931 /* In this loop, pos + cursor - p2 is the surrogate for pos. */
1932 while (1) /* use one cursor setting as long as i can */
1934 if (direction > 0) /* worth duplicating */
1936 while (cursor <= p_limit)
1938 if (BM_tab[*cursor] == 0)
1939 goto hit;
1940 cursor += BM_tab[*cursor];
1943 else
1945 while (cursor >= p_limit)
1947 if (BM_tab[*cursor] == 0)
1948 goto hit;
1949 cursor += BM_tab[*cursor];
1952 /* If you are here, cursor is beyond the end of the
1953 searched region. You fail to match within the
1954 permitted region and would otherwise try a character
1955 beyond that region. */
1956 break;
1958 hit:
1959 i = dirlen - direction;
1960 if (! NILP (trt))
1962 while ((i -= direction) + direction != 0)
1964 int ch;
1965 cursor -= direction;
1966 /* Translate only the last byte of a character. */
1967 if (! multibyte
1968 || ((cursor == tail_end_ptr
1969 || CHAR_HEAD_P (cursor[1]))
1970 && (CHAR_HEAD_P (cursor[0])
1971 /* Check if this is the last byte of
1972 a translable character. */
1973 || (translate_prev_byte1 == cursor[-1]
1974 && (CHAR_HEAD_P (translate_prev_byte1)
1975 || (translate_prev_byte2 == cursor[-2]
1976 && (CHAR_HEAD_P (translate_prev_byte2)
1977 || (translate_prev_byte3 == cursor[-3]))))))))
1978 ch = simple_translate[*cursor];
1979 else
1980 ch = *cursor;
1981 if (pat[i] != ch)
1982 break;
1985 else
1987 while ((i -= direction) + direction != 0)
1989 cursor -= direction;
1990 if (pat[i] != *cursor)
1991 break;
1994 cursor += dirlen - i - direction; /* fix cursor */
1995 if (i + direction == 0)
1997 EMACS_INT position, start, end;
1999 cursor -= direction;
2001 position = pos_byte + cursor - p2 + ((direction > 0)
2002 ? 1 - len_byte : 0);
2003 set_search_regs (position, len_byte);
2005 if (NILP (Vinhibit_changing_match_data))
2007 start = search_regs.start[0];
2008 end = search_regs.end[0];
2010 else
2011 /* If Vinhibit_changing_match_data is non-nil,
2012 search_regs will not be changed. So let's
2013 compute start and end here. */
2015 start = BYTE_TO_CHAR (position);
2016 end = BYTE_TO_CHAR (position + len_byte);
2019 if ((n -= direction) != 0)
2020 cursor += dirlen; /* to resume search */
2021 else
2022 return direction > 0 ? end : start;
2024 else
2025 cursor += stride_for_teases; /* <sigh> we lose - */
2027 pos_byte += cursor - p2;
2029 else
2030 /* Now we'll pick up a clump that has to be done the hard
2031 way because it covers a discontinuity. */
2033 limit = ((direction > 0)
2034 ? BUFFER_CEILING_OF (pos_byte - dirlen + 1)
2035 : BUFFER_FLOOR_OF (pos_byte - dirlen - 1));
2036 limit = ((direction > 0)
2037 ? min (limit + len_byte, lim_byte - 1)
2038 : max (limit - len_byte, lim_byte));
2039 /* LIMIT is now the last value POS_BYTE can have
2040 and still be valid for a possible match. */
2041 while (1)
2043 /* This loop can be coded for space rather than
2044 speed because it will usually run only once.
2045 (the reach is at most len + 21, and typically
2046 does not exceed len). */
2047 while ((limit - pos_byte) * direction >= 0)
2049 int ch = FETCH_BYTE (pos_byte);
2050 if (BM_tab[ch] == 0)
2051 goto hit2;
2052 pos_byte += BM_tab[ch];
2054 break; /* ran off the end */
2056 hit2:
2057 /* Found what might be a match. */
2058 i = dirlen - direction;
2059 while ((i -= direction) + direction != 0)
2061 int ch;
2062 unsigned char *ptr;
2063 pos_byte -= direction;
2064 ptr = BYTE_POS_ADDR (pos_byte);
2065 /* Translate only the last byte of a character. */
2066 if (! multibyte
2067 || ((ptr == tail_end_ptr
2068 || CHAR_HEAD_P (ptr[1]))
2069 && (CHAR_HEAD_P (ptr[0])
2070 /* Check if this is the last byte of a
2071 translable character. */
2072 || (translate_prev_byte1 == ptr[-1]
2073 && (CHAR_HEAD_P (translate_prev_byte1)
2074 || (translate_prev_byte2 == ptr[-2]
2075 && (CHAR_HEAD_P (translate_prev_byte2)
2076 || translate_prev_byte3 == ptr[-3])))))))
2077 ch = simple_translate[*ptr];
2078 else
2079 ch = *ptr;
2080 if (pat[i] != ch)
2081 break;
2083 /* Above loop has moved POS_BYTE part or all the way
2084 back to the first pos (last pos if reverse).
2085 Set it once again at the last (first if reverse) char. */
2086 pos_byte += dirlen - i - direction;
2087 if (i + direction == 0)
2089 EMACS_INT position, start, end;
2090 pos_byte -= direction;
2092 position = pos_byte + ((direction > 0) ? 1 - len_byte : 0);
2093 set_search_regs (position, len_byte);
2095 if (NILP (Vinhibit_changing_match_data))
2097 start = search_regs.start[0];
2098 end = search_regs.end[0];
2100 else
2101 /* If Vinhibit_changing_match_data is non-nil,
2102 search_regs will not be changed. So let's
2103 compute start and end here. */
2105 start = BYTE_TO_CHAR (position);
2106 end = BYTE_TO_CHAR (position + len_byte);
2109 if ((n -= direction) != 0)
2110 pos_byte += dirlen; /* to resume search */
2111 else
2112 return direction > 0 ? end : start;
2114 else
2115 pos_byte += stride_for_teases;
2118 /* We have done one clump. Can we continue? */
2119 if ((lim_byte - pos_byte) * direction < 0)
2120 return ((0 - n) * direction);
2122 return BYTE_TO_CHAR (pos_byte);
2125 /* Record beginning BEG_BYTE and end BEG_BYTE + NBYTES
2126 for the overall match just found in the current buffer.
2127 Also clear out the match data for registers 1 and up. */
2129 static void
2130 set_search_regs (beg_byte, nbytes)
2131 EMACS_INT beg_byte, nbytes;
2133 int i;
2135 if (!NILP (Vinhibit_changing_match_data))
2136 return;
2138 /* Make sure we have registers in which to store
2139 the match position. */
2140 if (search_regs.num_regs == 0)
2142 search_regs.start = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
2143 search_regs.end = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
2144 search_regs.num_regs = 2;
2147 /* Clear out the other registers. */
2148 for (i = 1; i < search_regs.num_regs; i++)
2150 search_regs.start[i] = -1;
2151 search_regs.end[i] = -1;
2154 search_regs.start[0] = BYTE_TO_CHAR (beg_byte);
2155 search_regs.end[0] = BYTE_TO_CHAR (beg_byte + nbytes);
2156 XSETBUFFER (last_thing_searched, current_buffer);
2159 /* Given STRING, a string of words separated by word delimiters,
2160 compute a regexp that matches those exact words separated by
2161 arbitrary punctuation. If LAX is nonzero, the end of the string
2162 need not match a word boundary unless it ends in whitespace. */
2164 static Lisp_Object
2165 wordify (string, lax)
2166 Lisp_Object string;
2167 int lax;
2169 register unsigned char *p, *o;
2170 register int i, i_byte, len, punct_count = 0, word_count = 0;
2171 Lisp_Object val;
2172 int prev_c = 0;
2173 int adjust, whitespace_at_end;
2175 CHECK_STRING (string);
2176 p = SDATA (string);
2177 len = SCHARS (string);
2179 for (i = 0, i_byte = 0; i < len; )
2181 int c;
2183 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
2185 if (SYNTAX (c) != Sword)
2187 punct_count++;
2188 if (i > 0 && SYNTAX (prev_c) == Sword)
2189 word_count++;
2192 prev_c = c;
2195 if (SYNTAX (prev_c) == Sword)
2197 word_count++;
2198 whitespace_at_end = 0;
2200 else
2201 whitespace_at_end = 1;
2203 if (!word_count)
2204 return empty_unibyte_string;
2206 adjust = - punct_count + 5 * (word_count - 1)
2207 + ((lax && !whitespace_at_end) ? 2 : 4);
2208 if (STRING_MULTIBYTE (string))
2209 val = make_uninit_multibyte_string (len + adjust,
2210 SBYTES (string)
2211 + adjust);
2212 else
2213 val = make_uninit_string (len + adjust);
2215 o = SDATA (val);
2216 *o++ = '\\';
2217 *o++ = 'b';
2218 prev_c = 0;
2220 for (i = 0, i_byte = 0; i < len; )
2222 int c;
2223 int i_byte_orig = i_byte;
2225 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
2227 if (SYNTAX (c) == Sword)
2229 bcopy (SDATA (string) + i_byte_orig, o,
2230 i_byte - i_byte_orig);
2231 o += i_byte - i_byte_orig;
2233 else if (i > 0 && SYNTAX (prev_c) == Sword && --word_count)
2235 *o++ = '\\';
2236 *o++ = 'W';
2237 *o++ = '\\';
2238 *o++ = 'W';
2239 *o++ = '*';
2242 prev_c = c;
2245 if (!lax || whitespace_at_end)
2247 *o++ = '\\';
2248 *o++ = 'b';
2251 return val;
2254 DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
2255 "MSearch backward: ",
2256 doc: /* Search backward from point for STRING.
2257 Set point to the beginning of the occurrence found, and return point.
2258 An optional second argument bounds the search; it is a buffer position.
2259 The match found must not extend before that position.
2260 Optional third argument, if t, means if fail just return nil (no error).
2261 If not nil and not t, position at limit of search and return nil.
2262 Optional fourth argument is repeat count--search for successive occurrences.
2264 Search case-sensitivity is determined by the value of the variable
2265 `case-fold-search', which see.
2267 See also the functions `match-beginning', `match-end' and `replace-match'. */)
2268 (string, bound, noerror, count)
2269 Lisp_Object string, bound, noerror, count;
2271 return search_command (string, bound, noerror, count, -1, 0, 0);
2274 DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "MSearch: ",
2275 doc: /* Search forward from point for STRING.
2276 Set point to the end of the occurrence found, and return point.
2277 An optional second argument bounds the search; it is a buffer position.
2278 The match found must not extend after that position. A value of nil is
2279 equivalent to (point-max).
2280 Optional third argument, if t, means if fail just return nil (no error).
2281 If not nil and not t, move to limit of search and return nil.
2282 Optional fourth argument is repeat count--search for successive occurrences.
2284 Search case-sensitivity is determined by the value of the variable
2285 `case-fold-search', which see.
2287 See also the functions `match-beginning', `match-end' and `replace-match'. */)
2288 (string, bound, noerror, count)
2289 Lisp_Object string, bound, noerror, count;
2291 return search_command (string, bound, noerror, count, 1, 0, 0);
2294 DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
2295 "sWord search backward: ",
2296 doc: /* Search backward from point for STRING, ignoring differences in punctuation.
2297 Set point to the beginning of the occurrence found, and return point.
2298 An optional second argument bounds the search; it is a buffer position.
2299 The match found must not extend before that position.
2300 Optional third argument, if t, means if fail just return nil (no error).
2301 If not nil and not t, move to limit of search and return nil.
2302 Optional fourth argument is repeat count--search for successive occurrences. */)
2303 (string, bound, noerror, count)
2304 Lisp_Object string, bound, noerror, count;
2306 return search_command (wordify (string, 0), bound, noerror, count, -1, 1, 0);
2309 DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
2310 "sWord search: ",
2311 doc: /* Search forward from point for STRING, ignoring differences in punctuation.
2312 Set point to the end of the occurrence found, and return point.
2313 An optional second argument bounds the search; it is a buffer position.
2314 The match found must not extend after that position.
2315 Optional third argument, if t, means if fail just return nil (no error).
2316 If not nil and not t, move to limit of search and return nil.
2317 Optional fourth argument is repeat count--search for successive occurrences. */)
2318 (string, bound, noerror, count)
2319 Lisp_Object string, bound, noerror, count;
2321 return search_command (wordify (string, 0), bound, noerror, count, 1, 1, 0);
2324 DEFUN ("word-search-backward-lax", Fword_search_backward_lax, Sword_search_backward_lax, 1, 4,
2325 "sWord search backward: ",
2326 doc: /* Search backward from point for STRING, ignoring differences in punctuation.
2327 Set point to the beginning of the occurrence found, and return point.
2329 Unlike `word-search-backward', the end of STRING need not match a word
2330 boundary unless it ends in whitespace.
2332 An optional second argument bounds the search; it is a buffer position.
2333 The match found must not extend before that position.
2334 Optional third argument, if t, means if fail just return nil (no error).
2335 If not nil and not t, move to limit of search and return nil.
2336 Optional fourth argument is repeat count--search for successive occurrences. */)
2337 (string, bound, noerror, count)
2338 Lisp_Object string, bound, noerror, count;
2340 return search_command (wordify (string, 1), bound, noerror, count, -1, 1, 0);
2343 DEFUN ("word-search-forward-lax", Fword_search_forward_lax, Sword_search_forward_lax, 1, 4,
2344 "sWord search: ",
2345 doc: /* Search forward from point for STRING, ignoring differences in punctuation.
2346 Set point to the end of the occurrence found, and return point.
2348 Unlike `word-search-forward', the end of STRING need not match a word
2349 boundary unless it ends in whitespace.
2351 An optional second argument bounds the search; it is a buffer position.
2352 The match found must not extend after that position.
2353 Optional third argument, if t, means if fail just return nil (no error).
2354 If not nil and not t, move to limit of search and return nil.
2355 Optional fourth argument is repeat count--search for successive occurrences. */)
2356 (string, bound, noerror, count)
2357 Lisp_Object string, bound, noerror, count;
2359 return search_command (wordify (string, 1), bound, noerror, count, 1, 1, 0);
2362 DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
2363 "sRE search backward: ",
2364 doc: /* Search backward from point for match for regular expression REGEXP.
2365 Set point to the beginning of the match, and return point.
2366 The match found is the one starting last in the buffer
2367 and yet ending before the origin of the search.
2368 An optional second argument bounds the search; it is a buffer position.
2369 The match found must start at or after that position.
2370 Optional third argument, if t, means if fail just return nil (no error).
2371 If not nil and not t, move to limit of search and return nil.
2372 Optional fourth argument is repeat count--search for successive occurrences.
2373 See also the functions `match-beginning', `match-end', `match-string',
2374 and `replace-match'. */)
2375 (regexp, bound, noerror, count)
2376 Lisp_Object regexp, bound, noerror, count;
2378 return search_command (regexp, bound, noerror, count, -1, 1, 0);
2381 DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4,
2382 "sRE search: ",
2383 doc: /* Search forward from point for regular expression REGEXP.
2384 Set point to the end of the occurrence found, and return point.
2385 An optional second argument bounds the search; it is a buffer position.
2386 The match found must not extend after that position.
2387 Optional third argument, if t, means if fail just return nil (no error).
2388 If not nil and not t, move to limit of search and return nil.
2389 Optional fourth argument is repeat count--search for successive occurrences.
2390 See also the functions `match-beginning', `match-end', `match-string',
2391 and `replace-match'. */)
2392 (regexp, bound, noerror, count)
2393 Lisp_Object regexp, bound, noerror, count;
2395 return search_command (regexp, bound, noerror, count, 1, 1, 0);
2398 DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, 1, 4,
2399 "sPosix search backward: ",
2400 doc: /* Search backward from point for match for regular expression REGEXP.
2401 Find the longest match in accord with Posix regular expression rules.
2402 Set point to the beginning of the match, and return point.
2403 The match found is the one starting last in the buffer
2404 and yet ending before the origin of the search.
2405 An optional second argument bounds the search; it is a buffer position.
2406 The match found must start at or after that position.
2407 Optional third argument, if t, means if fail just return nil (no error).
2408 If not nil and not t, move to limit of search and return nil.
2409 Optional fourth argument is repeat count--search for successive occurrences.
2410 See also the functions `match-beginning', `match-end', `match-string',
2411 and `replace-match'. */)
2412 (regexp, bound, noerror, count)
2413 Lisp_Object regexp, bound, noerror, count;
2415 return search_command (regexp, bound, noerror, count, -1, 1, 1);
2418 DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, 1, 4,
2419 "sPosix search: ",
2420 doc: /* Search forward from point for regular expression REGEXP.
2421 Find the longest match in accord with Posix regular expression rules.
2422 Set point to the end of the occurrence found, and return point.
2423 An optional second argument bounds the search; it is a buffer position.
2424 The match found must not extend after that position.
2425 Optional third argument, if t, means if fail just return nil (no error).
2426 If not nil and not t, move to limit of search and return nil.
2427 Optional fourth argument is repeat count--search for successive occurrences.
2428 See also the functions `match-beginning', `match-end', `match-string',
2429 and `replace-match'. */)
2430 (regexp, bound, noerror, count)
2431 Lisp_Object regexp, bound, noerror, count;
2433 return search_command (regexp, bound, noerror, count, 1, 1, 1);
2436 DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0,
2437 doc: /* Replace text matched by last search with NEWTEXT.
2438 Leave point at the end of the replacement text.
2440 If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
2441 Otherwise maybe capitalize the whole text, or maybe just word initials,
2442 based on the replaced text.
2443 If the replaced text has only capital letters
2444 and has at least one multiletter word, convert NEWTEXT to all caps.
2445 Otherwise if all words are capitalized in the replaced text,
2446 capitalize each word in NEWTEXT.
2448 If third arg LITERAL is non-nil, insert NEWTEXT literally.
2449 Otherwise treat `\\' as special:
2450 `\\&' in NEWTEXT means substitute original matched text.
2451 `\\N' means substitute what matched the Nth `\\(...\\)'.
2452 If Nth parens didn't match, substitute nothing.
2453 `\\\\' means insert one `\\'.
2454 Case conversion does not apply to these substitutions.
2456 FIXEDCASE and LITERAL are optional arguments.
2458 The optional fourth argument STRING can be a string to modify.
2459 This is meaningful when the previous match was done against STRING,
2460 using `string-match'. When used this way, `replace-match'
2461 creates and returns a new string made by copying STRING and replacing
2462 the part of STRING that was matched.
2464 The optional fifth argument SUBEXP specifies a subexpression;
2465 it says to replace just that subexpression with NEWTEXT,
2466 rather than replacing the entire matched text.
2467 This is, in a vague sense, the inverse of using `\\N' in NEWTEXT;
2468 `\\N' copies subexp N into NEWTEXT, but using N as SUBEXP puts
2469 NEWTEXT in place of subexp N.
2470 This is useful only after a regular expression search or match,
2471 since only regular expressions have distinguished subexpressions. */)
2472 (newtext, fixedcase, literal, string, subexp)
2473 Lisp_Object newtext, fixedcase, literal, string, subexp;
2475 enum { nochange, all_caps, cap_initial } case_action;
2476 register int pos, pos_byte;
2477 int some_multiletter_word;
2478 int some_lowercase;
2479 int some_uppercase;
2480 int some_nonuppercase_initial;
2481 register int c, prevc;
2482 int sub;
2483 EMACS_INT opoint, newpoint;
2485 CHECK_STRING (newtext);
2487 if (! NILP (string))
2488 CHECK_STRING (string);
2490 case_action = nochange; /* We tried an initialization */
2491 /* but some C compilers blew it */
2493 if (search_regs.num_regs <= 0)
2494 error ("`replace-match' called before any match found");
2496 if (NILP (subexp))
2497 sub = 0;
2498 else
2500 CHECK_NUMBER (subexp);
2501 sub = XINT (subexp);
2502 if (sub < 0 || sub >= search_regs.num_regs)
2503 args_out_of_range (subexp, make_number (search_regs.num_regs));
2506 if (NILP (string))
2508 if (search_regs.start[sub] < BEGV
2509 || search_regs.start[sub] > search_regs.end[sub]
2510 || search_regs.end[sub] > ZV)
2511 args_out_of_range (make_number (search_regs.start[sub]),
2512 make_number (search_regs.end[sub]));
2514 else
2516 if (search_regs.start[sub] < 0
2517 || search_regs.start[sub] > search_regs.end[sub]
2518 || search_regs.end[sub] > SCHARS (string))
2519 args_out_of_range (make_number (search_regs.start[sub]),
2520 make_number (search_regs.end[sub]));
2523 if (NILP (fixedcase))
2525 /* Decide how to casify by examining the matched text. */
2526 EMACS_INT last;
2528 pos = search_regs.start[sub];
2529 last = search_regs.end[sub];
2531 if (NILP (string))
2532 pos_byte = CHAR_TO_BYTE (pos);
2533 else
2534 pos_byte = string_char_to_byte (string, pos);
2536 prevc = '\n';
2537 case_action = all_caps;
2539 /* some_multiletter_word is set nonzero if any original word
2540 is more than one letter long. */
2541 some_multiletter_word = 0;
2542 some_lowercase = 0;
2543 some_nonuppercase_initial = 0;
2544 some_uppercase = 0;
2546 while (pos < last)
2548 if (NILP (string))
2550 c = FETCH_CHAR_AS_MULTIBYTE (pos_byte);
2551 INC_BOTH (pos, pos_byte);
2553 else
2554 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, pos, pos_byte);
2556 if (LOWERCASEP (c))
2558 /* Cannot be all caps if any original char is lower case */
2560 some_lowercase = 1;
2561 if (SYNTAX (prevc) != Sword)
2562 some_nonuppercase_initial = 1;
2563 else
2564 some_multiletter_word = 1;
2566 else if (UPPERCASEP (c))
2568 some_uppercase = 1;
2569 if (SYNTAX (prevc) != Sword)
2571 else
2572 some_multiletter_word = 1;
2574 else
2576 /* If the initial is a caseless word constituent,
2577 treat that like a lowercase initial. */
2578 if (SYNTAX (prevc) != Sword)
2579 some_nonuppercase_initial = 1;
2582 prevc = c;
2585 /* Convert to all caps if the old text is all caps
2586 and has at least one multiletter word. */
2587 if (! some_lowercase && some_multiletter_word)
2588 case_action = all_caps;
2589 /* Capitalize each word, if the old text has all capitalized words. */
2590 else if (!some_nonuppercase_initial && some_multiletter_word)
2591 case_action = cap_initial;
2592 else if (!some_nonuppercase_initial && some_uppercase)
2593 /* Should x -> yz, operating on X, give Yz or YZ?
2594 We'll assume the latter. */
2595 case_action = all_caps;
2596 else
2597 case_action = nochange;
2600 /* Do replacement in a string. */
2601 if (!NILP (string))
2603 Lisp_Object before, after;
2605 before = Fsubstring (string, make_number (0),
2606 make_number (search_regs.start[sub]));
2607 after = Fsubstring (string, make_number (search_regs.end[sub]), Qnil);
2609 /* Substitute parts of the match into NEWTEXT
2610 if desired. */
2611 if (NILP (literal))
2613 EMACS_INT lastpos = 0;
2614 EMACS_INT lastpos_byte = 0;
2615 /* We build up the substituted string in ACCUM. */
2616 Lisp_Object accum;
2617 Lisp_Object middle;
2618 int length = SBYTES (newtext);
2620 accum = Qnil;
2622 for (pos_byte = 0, pos = 0; pos_byte < length;)
2624 int substart = -1;
2625 int subend = 0;
2626 int delbackslash = 0;
2628 FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
2630 if (c == '\\')
2632 FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
2634 if (c == '&')
2636 substart = search_regs.start[sub];
2637 subend = search_regs.end[sub];
2639 else if (c >= '1' && c <= '9')
2641 if (search_regs.start[c - '0'] >= 0
2642 && c <= search_regs.num_regs + '0')
2644 substart = search_regs.start[c - '0'];
2645 subend = search_regs.end[c - '0'];
2647 else
2649 /* If that subexp did not match,
2650 replace \\N with nothing. */
2651 substart = 0;
2652 subend = 0;
2655 else if (c == '\\')
2656 delbackslash = 1;
2657 else
2658 error ("Invalid use of `\\' in replacement text");
2660 if (substart >= 0)
2662 if (pos - 2 != lastpos)
2663 middle = substring_both (newtext, lastpos,
2664 lastpos_byte,
2665 pos - 2, pos_byte - 2);
2666 else
2667 middle = Qnil;
2668 accum = concat3 (accum, middle,
2669 Fsubstring (string,
2670 make_number (substart),
2671 make_number (subend)));
2672 lastpos = pos;
2673 lastpos_byte = pos_byte;
2675 else if (delbackslash)
2677 middle = substring_both (newtext, lastpos,
2678 lastpos_byte,
2679 pos - 1, pos_byte - 1);
2681 accum = concat2 (accum, middle);
2682 lastpos = pos;
2683 lastpos_byte = pos_byte;
2687 if (pos != lastpos)
2688 middle = substring_both (newtext, lastpos,
2689 lastpos_byte,
2690 pos, pos_byte);
2691 else
2692 middle = Qnil;
2694 newtext = concat2 (accum, middle);
2697 /* Do case substitution in NEWTEXT if desired. */
2698 if (case_action == all_caps)
2699 newtext = Fupcase (newtext);
2700 else if (case_action == cap_initial)
2701 newtext = Fupcase_initials (newtext);
2703 return concat3 (before, newtext, after);
2706 /* Record point, then move (quietly) to the start of the match. */
2707 if (PT >= search_regs.end[sub])
2708 opoint = PT - ZV;
2709 else if (PT > search_regs.start[sub])
2710 opoint = search_regs.end[sub] - ZV;
2711 else
2712 opoint = PT;
2714 /* If we want non-literal replacement,
2715 perform substitution on the replacement string. */
2716 if (NILP (literal))
2718 int length = SBYTES (newtext);
2719 unsigned char *substed;
2720 int substed_alloc_size, substed_len;
2721 int buf_multibyte = !NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer));
2722 int str_multibyte = STRING_MULTIBYTE (newtext);
2723 Lisp_Object rev_tbl;
2724 int really_changed = 0;
2726 rev_tbl = Qnil;
2728 substed_alloc_size = length * 2 + 100;
2729 substed = (unsigned char *) xmalloc (substed_alloc_size + 1);
2730 substed_len = 0;
2732 /* Go thru NEWTEXT, producing the actual text to insert in
2733 SUBSTED while adjusting multibyteness to that of the current
2734 buffer. */
2736 for (pos_byte = 0, pos = 0; pos_byte < length;)
2738 unsigned char str[MAX_MULTIBYTE_LENGTH];
2739 unsigned char *add_stuff = NULL;
2740 int add_len = 0;
2741 int idx = -1;
2743 if (str_multibyte)
2745 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext, pos, pos_byte);
2746 if (!buf_multibyte)
2747 c = multibyte_char_to_unibyte (c, rev_tbl);
2749 else
2751 /* Note that we don't have to increment POS. */
2752 c = SREF (newtext, pos_byte++);
2753 if (buf_multibyte)
2754 MAKE_CHAR_MULTIBYTE (c);
2757 /* Either set ADD_STUFF and ADD_LEN to the text to put in SUBSTED,
2758 or set IDX to a match index, which means put that part
2759 of the buffer text into SUBSTED. */
2761 if (c == '\\')
2763 really_changed = 1;
2765 if (str_multibyte)
2767 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext,
2768 pos, pos_byte);
2769 if (!buf_multibyte && !ASCII_CHAR_P (c))
2770 c = multibyte_char_to_unibyte (c, rev_tbl);
2772 else
2774 c = SREF (newtext, pos_byte++);
2775 if (buf_multibyte)
2776 MAKE_CHAR_MULTIBYTE (c);
2779 if (c == '&')
2780 idx = sub;
2781 else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0')
2783 if (search_regs.start[c - '0'] >= 1)
2784 idx = c - '0';
2786 else if (c == '\\')
2787 add_len = 1, add_stuff = "\\";
2788 else
2790 xfree (substed);
2791 error ("Invalid use of `\\' in replacement text");
2794 else
2796 add_len = CHAR_STRING (c, str);
2797 add_stuff = str;
2800 /* If we want to copy part of a previous match,
2801 set up ADD_STUFF and ADD_LEN to point to it. */
2802 if (idx >= 0)
2804 EMACS_INT begbyte = CHAR_TO_BYTE (search_regs.start[idx]);
2805 add_len = CHAR_TO_BYTE (search_regs.end[idx]) - begbyte;
2806 if (search_regs.start[idx] < GPT && GPT < search_regs.end[idx])
2807 move_gap (search_regs.start[idx]);
2808 add_stuff = BYTE_POS_ADDR (begbyte);
2811 /* Now the stuff we want to add to SUBSTED
2812 is invariably ADD_LEN bytes starting at ADD_STUFF. */
2814 /* Make sure SUBSTED is big enough. */
2815 if (substed_len + add_len >= substed_alloc_size)
2817 substed_alloc_size = substed_len + add_len + 500;
2818 substed = (unsigned char *) xrealloc (substed,
2819 substed_alloc_size + 1);
2822 /* Now add to the end of SUBSTED. */
2823 if (add_stuff)
2825 bcopy (add_stuff, substed + substed_len, add_len);
2826 substed_len += add_len;
2830 if (really_changed)
2832 if (buf_multibyte)
2834 int nchars = multibyte_chars_in_text (substed, substed_len);
2836 newtext = make_multibyte_string (substed, nchars, substed_len);
2838 else
2839 newtext = make_unibyte_string (substed, substed_len);
2841 xfree (substed);
2844 /* Replace the old text with the new in the cleanest possible way. */
2845 replace_range (search_regs.start[sub], search_regs.end[sub],
2846 newtext, 1, 0, 1);
2847 newpoint = search_regs.start[sub] + SCHARS (newtext);
2849 if (case_action == all_caps)
2850 Fupcase_region (make_number (search_regs.start[sub]),
2851 make_number (newpoint));
2852 else if (case_action == cap_initial)
2853 Fupcase_initials_region (make_number (search_regs.start[sub]),
2854 make_number (newpoint));
2856 /* Adjust search data for this change. */
2858 EMACS_INT oldend = search_regs.end[sub];
2859 EMACS_INT oldstart = search_regs.start[sub];
2860 EMACS_INT change = newpoint - search_regs.end[sub];
2861 int i;
2863 for (i = 0; i < search_regs.num_regs; i++)
2865 if (search_regs.start[i] >= oldend)
2866 search_regs.start[i] += change;
2867 else if (search_regs.start[i] > oldstart)
2868 search_regs.start[i] = oldstart;
2869 if (search_regs.end[i] >= oldend)
2870 search_regs.end[i] += change;
2871 else if (search_regs.end[i] > oldstart)
2872 search_regs.end[i] = oldstart;
2876 /* Put point back where it was in the text. */
2877 if (opoint <= 0)
2878 TEMP_SET_PT (opoint + ZV);
2879 else
2880 TEMP_SET_PT (opoint);
2882 /* Now move point "officially" to the start of the inserted replacement. */
2883 move_if_not_intangible (newpoint);
2885 return Qnil;
2888 static Lisp_Object
2889 match_limit (num, beginningp)
2890 Lisp_Object num;
2891 int beginningp;
2893 register int n;
2895 CHECK_NUMBER (num);
2896 n = XINT (num);
2897 if (n < 0)
2898 args_out_of_range (num, make_number (0));
2899 if (search_regs.num_regs <= 0)
2900 error ("No match data, because no search succeeded");
2901 if (n >= search_regs.num_regs
2902 || search_regs.start[n] < 0)
2903 return Qnil;
2904 return (make_number ((beginningp) ? search_regs.start[n]
2905 : search_regs.end[n]));
2908 DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
2909 doc: /* Return position of start of text matched by last search.
2910 SUBEXP, a number, specifies which parenthesized expression in the last
2911 regexp.
2912 Value is nil if SUBEXPth pair didn't match, or there were less than
2913 SUBEXP pairs.
2914 Zero means the entire text matched by the whole regexp or whole string. */)
2915 (subexp)
2916 Lisp_Object subexp;
2918 return match_limit (subexp, 1);
2921 DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0,
2922 doc: /* Return position of end of text matched by last search.
2923 SUBEXP, a number, specifies which parenthesized expression in the last
2924 regexp.
2925 Value is nil if SUBEXPth pair didn't match, or there were less than
2926 SUBEXP pairs.
2927 Zero means the entire text matched by the whole regexp or whole string. */)
2928 (subexp)
2929 Lisp_Object subexp;
2931 return match_limit (subexp, 0);
2934 DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 3, 0,
2935 doc: /* Return a list containing all info on what the last search matched.
2936 Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.
2937 All the elements are markers or nil (nil if the Nth pair didn't match)
2938 if the last match was on a buffer; integers or nil if a string was matched.
2939 Use `set-match-data' to reinstate the data in this list.
2941 If INTEGERS (the optional first argument) is non-nil, always use
2942 integers \(rather than markers) to represent buffer positions. In
2943 this case, and if the last match was in a buffer, the buffer will get
2944 stored as one additional element at the end of the list.
2946 If REUSE is a list, reuse it as part of the value. If REUSE is long
2947 enough to hold all the values, and if INTEGERS is non-nil, no consing
2948 is done.
2950 If optional third arg RESEAT is non-nil, any previous markers on the
2951 REUSE list will be modified to point to nowhere.
2953 Return value is undefined if the last search failed. */)
2954 (integers, reuse, reseat)
2955 Lisp_Object integers, reuse, reseat;
2957 Lisp_Object tail, prev;
2958 Lisp_Object *data;
2959 int i, len;
2961 if (!NILP (reseat))
2962 for (tail = reuse; CONSP (tail); tail = XCDR (tail))
2963 if (MARKERP (XCAR (tail)))
2965 unchain_marker (XMARKER (XCAR (tail)));
2966 XSETCAR (tail, Qnil);
2969 if (NILP (last_thing_searched))
2970 return Qnil;
2972 prev = Qnil;
2974 data = (Lisp_Object *) alloca ((2 * search_regs.num_regs + 1)
2975 * sizeof (Lisp_Object));
2977 len = 0;
2978 for (i = 0; i < search_regs.num_regs; i++)
2980 int start = search_regs.start[i];
2981 if (start >= 0)
2983 if (EQ (last_thing_searched, Qt)
2984 || ! NILP (integers))
2986 XSETFASTINT (data[2 * i], start);
2987 XSETFASTINT (data[2 * i + 1], search_regs.end[i]);
2989 else if (BUFFERP (last_thing_searched))
2991 data[2 * i] = Fmake_marker ();
2992 Fset_marker (data[2 * i],
2993 make_number (start),
2994 last_thing_searched);
2995 data[2 * i + 1] = Fmake_marker ();
2996 Fset_marker (data[2 * i + 1],
2997 make_number (search_regs.end[i]),
2998 last_thing_searched);
3000 else
3001 /* last_thing_searched must always be Qt, a buffer, or Qnil. */
3002 abort ();
3004 len = 2 * i + 2;
3006 else
3007 data[2 * i] = data[2 * i + 1] = Qnil;
3010 if (BUFFERP (last_thing_searched) && !NILP (integers))
3012 data[len] = last_thing_searched;
3013 len++;
3016 /* If REUSE is not usable, cons up the values and return them. */
3017 if (! CONSP (reuse))
3018 return Flist (len, data);
3020 /* If REUSE is a list, store as many value elements as will fit
3021 into the elements of REUSE. */
3022 for (i = 0, tail = reuse; CONSP (tail);
3023 i++, tail = XCDR (tail))
3025 if (i < len)
3026 XSETCAR (tail, data[i]);
3027 else
3028 XSETCAR (tail, Qnil);
3029 prev = tail;
3032 /* If we couldn't fit all value elements into REUSE,
3033 cons up the rest of them and add them to the end of REUSE. */
3034 if (i < len)
3035 XSETCDR (prev, Flist (len - i, data + i));
3037 return reuse;
3040 /* We used to have an internal use variant of `reseat' described as:
3042 If RESEAT is `evaporate', put the markers back on the free list
3043 immediately. No other references to the markers must exist in this
3044 case, so it is used only internally on the unwind stack and
3045 save-match-data from Lisp.
3047 But it was ill-conceived: those supposedly-internal markers get exposed via
3048 the undo-list, so freeing them here is unsafe. */
3050 DEFUN ("set-match-data", Fset_match_data, Sset_match_data, 1, 2, 0,
3051 doc: /* Set internal data on last search match from elements of LIST.
3052 LIST should have been created by calling `match-data' previously.
3054 If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */)
3055 (list, reseat)
3056 register Lisp_Object list, reseat;
3058 register int i;
3059 register Lisp_Object marker;
3061 if (running_asynch_code)
3062 save_search_regs ();
3064 CHECK_LIST (list);
3066 /* Unless we find a marker with a buffer or an explicit buffer
3067 in LIST, assume that this match data came from a string. */
3068 last_thing_searched = Qt;
3070 /* Allocate registers if they don't already exist. */
3072 int length = XFASTINT (Flength (list)) / 2;
3074 if (length > search_regs.num_regs)
3076 if (search_regs.num_regs == 0)
3078 search_regs.start
3079 = (regoff_t *) xmalloc (length * sizeof (regoff_t));
3080 search_regs.end
3081 = (regoff_t *) xmalloc (length * sizeof (regoff_t));
3083 else
3085 search_regs.start
3086 = (regoff_t *) xrealloc (search_regs.start,
3087 length * sizeof (regoff_t));
3088 search_regs.end
3089 = (regoff_t *) xrealloc (search_regs.end,
3090 length * sizeof (regoff_t));
3093 for (i = search_regs.num_regs; i < length; i++)
3094 search_regs.start[i] = -1;
3096 search_regs.num_regs = length;
3099 for (i = 0; CONSP (list); i++)
3101 marker = XCAR (list);
3102 if (BUFFERP (marker))
3104 last_thing_searched = marker;
3105 break;
3107 if (i >= length)
3108 break;
3109 if (NILP (marker))
3111 search_regs.start[i] = -1;
3112 list = XCDR (list);
3114 else
3116 EMACS_INT from;
3117 Lisp_Object m;
3119 m = marker;
3120 if (MARKERP (marker))
3122 if (XMARKER (marker)->buffer == 0)
3123 XSETFASTINT (marker, 0);
3124 else
3125 XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer);
3128 CHECK_NUMBER_COERCE_MARKER (marker);
3129 from = XINT (marker);
3131 if (!NILP (reseat) && MARKERP (m))
3133 unchain_marker (XMARKER (m));
3134 XSETCAR (list, Qnil);
3137 if ((list = XCDR (list), !CONSP (list)))
3138 break;
3140 m = marker = XCAR (list);
3142 if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
3143 XSETFASTINT (marker, 0);
3145 CHECK_NUMBER_COERCE_MARKER (marker);
3146 search_regs.start[i] = from;
3147 search_regs.end[i] = XINT (marker);
3149 if (!NILP (reseat) && MARKERP (m))
3151 unchain_marker (XMARKER (m));
3152 XSETCAR (list, Qnil);
3155 list = XCDR (list);
3158 for (; i < search_regs.num_regs; i++)
3159 search_regs.start[i] = -1;
3162 return Qnil;
3165 /* If non-zero the match data have been saved in saved_search_regs
3166 during the execution of a sentinel or filter. */
3167 static int search_regs_saved;
3168 static struct re_registers saved_search_regs;
3169 static Lisp_Object saved_last_thing_searched;
3171 /* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
3172 if asynchronous code (filter or sentinel) is running. */
3173 static void
3174 save_search_regs ()
3176 if (!search_regs_saved)
3178 saved_search_regs.num_regs = search_regs.num_regs;
3179 saved_search_regs.start = search_regs.start;
3180 saved_search_regs.end = search_regs.end;
3181 saved_last_thing_searched = last_thing_searched;
3182 last_thing_searched = Qnil;
3183 search_regs.num_regs = 0;
3184 search_regs.start = 0;
3185 search_regs.end = 0;
3187 search_regs_saved = 1;
3191 /* Called upon exit from filters and sentinels. */
3192 void
3193 restore_search_regs ()
3195 if (search_regs_saved)
3197 if (search_regs.num_regs > 0)
3199 xfree (search_regs.start);
3200 xfree (search_regs.end);
3202 search_regs.num_regs = saved_search_regs.num_regs;
3203 search_regs.start = saved_search_regs.start;
3204 search_regs.end = saved_search_regs.end;
3205 last_thing_searched = saved_last_thing_searched;
3206 saved_last_thing_searched = Qnil;
3207 search_regs_saved = 0;
3211 static Lisp_Object
3212 unwind_set_match_data (list)
3213 Lisp_Object list;
3215 /* It is NOT ALWAYS safe to free (evaporate) the markers immediately. */
3216 return Fset_match_data (list, Qt);
3219 /* Called to unwind protect the match data. */
3220 void
3221 record_unwind_save_match_data ()
3223 record_unwind_protect (unwind_set_match_data,
3224 Fmatch_data (Qnil, Qnil, Qnil));
3227 /* Quote a string to inactivate reg-expr chars */
3229 DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
3230 doc: /* Return a regexp string which matches exactly STRING and nothing else. */)
3231 (string)
3232 Lisp_Object string;
3234 register unsigned char *in, *out, *end;
3235 register unsigned char *temp;
3236 int backslashes_added = 0;
3238 CHECK_STRING (string);
3240 temp = (unsigned char *) alloca (SBYTES (string) * 2);
3242 /* Now copy the data into the new string, inserting escapes. */
3244 in = SDATA (string);
3245 end = in + SBYTES (string);
3246 out = temp;
3248 for (; in != end; in++)
3250 if (*in == '['
3251 || *in == '*' || *in == '.' || *in == '\\'
3252 || *in == '?' || *in == '+'
3253 || *in == '^' || *in == '$')
3254 *out++ = '\\', backslashes_added++;
3255 *out++ = *in;
3258 return make_specified_string (temp,
3259 SCHARS (string) + backslashes_added,
3260 out - temp,
3261 STRING_MULTIBYTE (string));
3264 void
3265 syms_of_search ()
3267 register int i;
3269 for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
3271 searchbufs[i].buf.allocated = 100;
3272 searchbufs[i].buf.buffer = (unsigned char *) xmalloc (100);
3273 searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
3274 searchbufs[i].regexp = Qnil;
3275 searchbufs[i].whitespace_regexp = Qnil;
3276 searchbufs[i].syntax_table = Qnil;
3277 staticpro (&searchbufs[i].regexp);
3278 staticpro (&searchbufs[i].whitespace_regexp);
3279 staticpro (&searchbufs[i].syntax_table);
3280 searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]);
3282 searchbuf_head = &searchbufs[0];
3284 Qsearch_failed = intern_c_string ("search-failed");
3285 staticpro (&Qsearch_failed);
3286 Qinvalid_regexp = intern_c_string ("invalid-regexp");
3287 staticpro (&Qinvalid_regexp);
3289 Fput (Qsearch_failed, Qerror_conditions,
3290 pure_cons (Qsearch_failed, pure_cons (Qerror, Qnil)));
3291 Fput (Qsearch_failed, Qerror_message,
3292 make_pure_c_string ("Search failed"));
3294 Fput (Qinvalid_regexp, Qerror_conditions,
3295 pure_cons (Qinvalid_regexp, pure_cons (Qerror, Qnil)));
3296 Fput (Qinvalid_regexp, Qerror_message,
3297 make_pure_c_string ("Invalid regexp"));
3299 last_thing_searched = Qnil;
3300 staticpro (&last_thing_searched);
3302 saved_last_thing_searched = Qnil;
3303 staticpro (&saved_last_thing_searched);
3305 DEFVAR_LISP ("search-spaces-regexp", &Vsearch_spaces_regexp,
3306 doc: /* Regexp to substitute for bunches of spaces in regexp search.
3307 Some commands use this for user-specified regexps.
3308 Spaces that occur inside character classes or repetition operators
3309 or other such regexp constructs are not replaced with this.
3310 A value of nil (which is the normal value) means treat spaces literally. */);
3311 Vsearch_spaces_regexp = Qnil;
3313 DEFVAR_LISP ("inhibit-changing-match-data", &Vinhibit_changing_match_data,
3314 doc: /* Internal use only.
3315 If non-nil, the primitive searching and matching functions
3316 such as `looking-at', `string-match', `re-search-forward', etc.,
3317 do not set the match data. The proper way to use this variable
3318 is to bind it with `let' around a small expression. */);
3319 Vinhibit_changing_match_data = Qnil;
3321 defsubr (&Slooking_at);
3322 defsubr (&Sposix_looking_at);
3323 defsubr (&Sstring_match);
3324 defsubr (&Sposix_string_match);
3325 defsubr (&Ssearch_forward);
3326 defsubr (&Ssearch_backward);
3327 defsubr (&Sword_search_forward);
3328 defsubr (&Sword_search_backward);
3329 defsubr (&Sword_search_forward_lax);
3330 defsubr (&Sword_search_backward_lax);
3331 defsubr (&Sre_search_forward);
3332 defsubr (&Sre_search_backward);
3333 defsubr (&Sposix_search_forward);
3334 defsubr (&Sposix_search_backward);
3335 defsubr (&Sreplace_match);
3336 defsubr (&Smatch_beginning);
3337 defsubr (&Smatch_end);
3338 defsubr (&Smatch_data);
3339 defsubr (&Sset_match_data);
3340 defsubr (&Sregexp_quote);
3343 /* arch-tag: a6059d79-0552-4f14-a2cb-d379a4e3c78f
3344 (do not change this comment) */