* cus-start.el (all): Add native condition for font-use-system-font.
[emacs.git] / src / search.c
blobfd45d316a46d3107b7ed03c915793bc0768acdf6
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
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 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 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 ? current_buffer->syntax_table : 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, current_buffer->syntax_table))
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 (current_buffer->case_canon_table)->extras[2]
308 = current_buffer->case_eqv_table;
310 CHECK_STRING (string);
311 bufp = compile_pattern (string,
312 (NILP (Vinhibit_changing_match_data)
313 ? &search_regs : NULL),
314 (!NILP (current_buffer->case_fold_search)
315 ? current_buffer->case_canon_table : Qnil),
316 posix,
317 !NILP (current_buffer->enable_multibyte_characters));
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 (current_buffer->case_canon_table)->extras[2]
427 = current_buffer->case_eqv_table;
429 bufp = compile_pattern (regexp,
430 (NILP (Vinhibit_changing_match_data)
431 ? &search_regs : NULL),
432 (!NILP (current_buffer->case_fold_search)
433 ? current_buffer->case_canon_table : 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 (current_buffer->enable_multibyte_characters);
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))
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 (current_buffer->case_canon_table)->extras[2]
1048 = current_buffer->case_eqv_table;
1050 np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE,
1051 (!NILP (current_buffer->case_fold_search)
1052 ? current_buffer->case_canon_table
1053 : Qnil),
1054 (!NILP (current_buffer->case_fold_search)
1055 ? current_buffer->case_eqv_table
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 (current_buffer->enable_multibyte_characters));
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 (current_buffer->enable_multibyte_characters);
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 (current_buffer->enable_multibyte_characters);
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 - len;
1613 EMACS_INT this_pos_byte;
1614 int this_len = len;
1615 unsigned char *p = pat;
1617 if (this_pos < lim || (pos_byte - len_byte) < lim_byte)
1618 goto stop;
1619 this_pos_byte = CHAR_TO_BYTE (this_pos);
1620 match_byte = pos_byte - this_pos_byte;
1622 while (this_len > 0)
1624 int charlen, buf_charlen;
1625 int pat_ch, buf_ch;
1627 pat_ch = STRING_CHAR_AND_LENGTH (p, charlen);
1628 buf_ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (this_pos_byte),
1629 buf_charlen);
1630 TRANSLATE (buf_ch, trt, buf_ch);
1632 if (buf_ch != pat_ch)
1633 break;
1635 this_len--;
1636 p += charlen;
1637 this_pos_byte += buf_charlen;
1638 this_pos++;
1641 if (this_len == 0)
1643 pos -= len;
1644 pos_byte -= match_byte;
1645 break;
1648 DEC_BOTH (pos, pos_byte);
1651 n++;
1653 else if (lim < pos)
1654 while (n < 0)
1656 while (1)
1658 /* Try matching at position POS. */
1659 EMACS_INT this_pos = pos - len;
1660 int this_len = len;
1661 unsigned char *p = pat;
1663 if (this_pos < lim)
1664 goto stop;
1666 while (this_len > 0)
1668 int pat_ch = *p++;
1669 int buf_ch = FETCH_BYTE (this_pos);
1670 TRANSLATE (buf_ch, trt, buf_ch);
1672 if (buf_ch != pat_ch)
1673 break;
1674 this_len--;
1675 this_pos++;
1678 if (this_len == 0)
1680 match_byte = len;
1681 pos -= len;
1682 break;
1685 pos--;
1688 n++;
1691 stop:
1692 if (n == 0)
1694 if (forward)
1695 set_search_regs ((multibyte ? pos_byte : pos) - match_byte, match_byte);
1696 else
1697 set_search_regs (multibyte ? pos_byte : pos, match_byte);
1699 return pos;
1701 else if (n > 0)
1702 return -n;
1703 else
1704 return n;
1707 /* Do Boyer-Moore search N times for the string BASE_PAT,
1708 whose length is LEN/LEN_BYTE,
1709 from buffer position POS/POS_BYTE until LIM/LIM_BYTE.
1710 DIRECTION says which direction we search in.
1711 TRT and INVERSE_TRT are translation tables.
1712 Characters in PAT are already translated by TRT.
1714 This kind of search works if all the characters in BASE_PAT that
1715 have nontrivial translation are the same aside from the last byte.
1716 This makes it possible to translate just the last byte of a
1717 character, and do so after just a simple test of the context.
1718 CHAR_BASE is nonzero if there is such a non-ASCII character.
1720 If that criterion is not satisfied, do not call this function. */
1722 static EMACS_INT
1723 boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt,
1724 pos, pos_byte, lim, lim_byte, char_base)
1725 int n;
1726 unsigned char *base_pat;
1727 int len, len_byte;
1728 Lisp_Object trt;
1729 Lisp_Object inverse_trt;
1730 EMACS_INT pos, pos_byte;
1731 EMACS_INT lim, lim_byte;
1732 int char_base;
1734 int direction = ((n > 0) ? 1 : -1);
1735 register int dirlen;
1736 EMACS_INT limit;
1737 int stride_for_teases = 0;
1738 int BM_tab[0400];
1739 register unsigned char *cursor, *p_limit;
1740 register int i, j;
1741 unsigned char *pat, *pat_end;
1742 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
1744 unsigned char simple_translate[0400];
1745 /* These are set to the preceding bytes of a byte to be translated
1746 if char_base is nonzero. As the maximum byte length of a
1747 multibyte character is 5, we have to check at most four previous
1748 bytes. */
1749 int translate_prev_byte1 = 0;
1750 int translate_prev_byte2 = 0;
1751 int translate_prev_byte3 = 0;
1752 int translate_prev_byte4 = 0;
1754 /* The general approach is that we are going to maintain that we know
1755 the first (closest to the present position, in whatever direction
1756 we're searching) character that could possibly be the last
1757 (furthest from present position) character of a valid match. We
1758 advance the state of our knowledge by looking at that character
1759 and seeing whether it indeed matches the last character of the
1760 pattern. If it does, we take a closer look. If it does not, we
1761 move our pointer (to putative last characters) as far as is
1762 logically possible. This amount of movement, which I call a
1763 stride, will be the length of the pattern if the actual character
1764 appears nowhere in the pattern, otherwise it will be the distance
1765 from the last occurrence of that character to the end of the
1766 pattern. If the amount is zero we have a possible match. */
1768 /* Here we make a "mickey mouse" BM table. The stride of the search
1769 is determined only by the last character of the putative match.
1770 If that character does not match, we will stride the proper
1771 distance to propose a match that superimposes it on the last
1772 instance of a character that matches it (per trt), or misses
1773 it entirely if there is none. */
1775 dirlen = len_byte * direction;
1777 /* Record position after the end of the pattern. */
1778 pat_end = base_pat + len_byte;
1779 /* BASE_PAT points to a character that we start scanning from.
1780 It is the first character in a forward search,
1781 the last character in a backward search. */
1782 if (direction < 0)
1783 base_pat = pat_end - 1;
1785 /* A character that does not appear in the pattern induces a
1786 stride equal to the pattern length. */
1787 for (i = 0; i < 0400; i++)
1788 BM_tab[i] = dirlen;
1790 /* We use this for translation, instead of TRT itself.
1791 We fill this in to handle the characters that actually
1792 occur in the pattern. Others don't matter anyway! */
1793 for (i = 0; i < 0400; i++)
1794 simple_translate[i] = i;
1796 if (char_base)
1798 /* Setup translate_prev_byte1/2/3/4 from CHAR_BASE. Only a
1799 byte following them are the target of translation. */
1800 unsigned char str[MAX_MULTIBYTE_LENGTH];
1801 int len = CHAR_STRING (char_base, str);
1803 translate_prev_byte1 = str[len - 2];
1804 if (len > 2)
1806 translate_prev_byte2 = str[len - 3];
1807 if (len > 3)
1809 translate_prev_byte3 = str[len - 4];
1810 if (len > 4)
1811 translate_prev_byte4 = str[len - 5];
1816 i = 0;
1817 while (i != dirlen)
1819 unsigned char *ptr = base_pat + i;
1820 i += direction;
1821 if (! NILP (trt))
1823 /* If the byte currently looking at is the last of a
1824 character to check case-equivalents, set CH to that
1825 character. An ASCII character and a non-ASCII character
1826 matching with CHAR_BASE are to be checked. */
1827 int ch = -1;
1829 if (ASCII_BYTE_P (*ptr) || ! multibyte)
1830 ch = *ptr;
1831 else if (char_base
1832 && ((pat_end - ptr) == 1 || CHAR_HEAD_P (ptr[1])))
1834 unsigned char *charstart = ptr - 1;
1836 while (! (CHAR_HEAD_P (*charstart)))
1837 charstart--;
1838 ch = STRING_CHAR (charstart);
1839 if (char_base != (ch & ~0x3F))
1840 ch = -1;
1843 if (ch >= 0200)
1844 j = (ch & 0x3F) | 0200;
1845 else
1846 j = *ptr;
1848 if (i == dirlen)
1849 stride_for_teases = BM_tab[j];
1851 BM_tab[j] = dirlen - i;
1852 /* A translation table is accompanied by its inverse -- see */
1853 /* comment following downcase_table for details */
1854 if (ch >= 0)
1856 int starting_ch = ch;
1857 int starting_j = j;
1859 while (1)
1861 TRANSLATE (ch, inverse_trt, ch);
1862 if (ch >= 0200)
1863 j = (ch & 0x3F) | 0200;
1864 else
1865 j = ch;
1867 /* For all the characters that map into CH,
1868 set up simple_translate to map the last byte
1869 into STARTING_J. */
1870 simple_translate[j] = starting_j;
1871 if (ch == starting_ch)
1872 break;
1873 BM_tab[j] = dirlen - i;
1877 else
1879 j = *ptr;
1881 if (i == dirlen)
1882 stride_for_teases = BM_tab[j];
1883 BM_tab[j] = dirlen - i;
1885 /* stride_for_teases tells how much to stride if we get a
1886 match on the far character but are subsequently
1887 disappointed, by recording what the stride would have been
1888 for that character if the last character had been
1889 different. */
1891 pos_byte += dirlen - ((direction > 0) ? direction : 0);
1892 /* loop invariant - POS_BYTE points at where last char (first
1893 char if reverse) of pattern would align in a possible match. */
1894 while (n != 0)
1896 EMACS_INT tail_end;
1897 unsigned char *tail_end_ptr;
1899 /* It's been reported that some (broken) compiler thinks that
1900 Boolean expressions in an arithmetic context are unsigned.
1901 Using an explicit ?1:0 prevents this. */
1902 if ((lim_byte - pos_byte - ((direction > 0) ? 1 : 0)) * direction
1903 < 0)
1904 return (n * (0 - direction));
1905 /* First we do the part we can by pointers (maybe nothing) */
1906 QUIT;
1907 pat = base_pat;
1908 limit = pos_byte - dirlen + direction;
1909 if (direction > 0)
1911 limit = BUFFER_CEILING_OF (limit);
1912 /* LIMIT is now the last (not beyond-last!) value POS_BYTE
1913 can take on without hitting edge of buffer or the gap. */
1914 limit = min (limit, pos_byte + 20000);
1915 limit = min (limit, lim_byte - 1);
1917 else
1919 limit = BUFFER_FLOOR_OF (limit);
1920 /* LIMIT is now the last (not beyond-last!) value POS_BYTE
1921 can take on without hitting edge of buffer or the gap. */
1922 limit = max (limit, pos_byte - 20000);
1923 limit = max (limit, lim_byte);
1925 tail_end = BUFFER_CEILING_OF (pos_byte) + 1;
1926 tail_end_ptr = BYTE_POS_ADDR (tail_end);
1928 if ((limit - pos_byte) * direction > 20)
1930 unsigned char *p2;
1932 p_limit = BYTE_POS_ADDR (limit);
1933 p2 = (cursor = BYTE_POS_ADDR (pos_byte));
1934 /* In this loop, pos + cursor - p2 is the surrogate for pos. */
1935 while (1) /* use one cursor setting as long as i can */
1937 if (direction > 0) /* worth duplicating */
1939 while (cursor <= p_limit)
1941 if (BM_tab[*cursor] == 0)
1942 goto hit;
1943 cursor += BM_tab[*cursor];
1946 else
1948 while (cursor >= p_limit)
1950 if (BM_tab[*cursor] == 0)
1951 goto hit;
1952 cursor += BM_tab[*cursor];
1955 /* If you are here, cursor is beyond the end of the
1956 searched region. You fail to match within the
1957 permitted region and would otherwise try a character
1958 beyond that region. */
1959 break;
1961 hit:
1962 i = dirlen - direction;
1963 if (! NILP (trt))
1965 while ((i -= direction) + direction != 0)
1967 int ch;
1968 cursor -= direction;
1969 /* Translate only the last byte of a character. */
1970 if (! multibyte
1971 || ((cursor == tail_end_ptr
1972 || CHAR_HEAD_P (cursor[1]))
1973 && (CHAR_HEAD_P (cursor[0])
1974 /* Check if this is the last byte of
1975 a translable character. */
1976 || (translate_prev_byte1 == cursor[-1]
1977 && (CHAR_HEAD_P (translate_prev_byte1)
1978 || (translate_prev_byte2 == cursor[-2]
1979 && (CHAR_HEAD_P (translate_prev_byte2)
1980 || (translate_prev_byte3 == cursor[-3]))))))))
1981 ch = simple_translate[*cursor];
1982 else
1983 ch = *cursor;
1984 if (pat[i] != ch)
1985 break;
1988 else
1990 while ((i -= direction) + direction != 0)
1992 cursor -= direction;
1993 if (pat[i] != *cursor)
1994 break;
1997 cursor += dirlen - i - direction; /* fix cursor */
1998 if (i + direction == 0)
2000 EMACS_INT position, start, end;
2002 cursor -= direction;
2004 position = pos_byte + cursor - p2 + ((direction > 0)
2005 ? 1 - len_byte : 0);
2006 set_search_regs (position, len_byte);
2008 if (NILP (Vinhibit_changing_match_data))
2010 start = search_regs.start[0];
2011 end = search_regs.end[0];
2013 else
2014 /* If Vinhibit_changing_match_data is non-nil,
2015 search_regs will not be changed. So let's
2016 compute start and end here. */
2018 start = BYTE_TO_CHAR (position);
2019 end = BYTE_TO_CHAR (position + len_byte);
2022 if ((n -= direction) != 0)
2023 cursor += dirlen; /* to resume search */
2024 else
2025 return direction > 0 ? end : start;
2027 else
2028 cursor += stride_for_teases; /* <sigh> we lose - */
2030 pos_byte += cursor - p2;
2032 else
2033 /* Now we'll pick up a clump that has to be done the hard
2034 way because it covers a discontinuity. */
2036 limit = ((direction > 0)
2037 ? BUFFER_CEILING_OF (pos_byte - dirlen + 1)
2038 : BUFFER_FLOOR_OF (pos_byte - dirlen - 1));
2039 limit = ((direction > 0)
2040 ? min (limit + len_byte, lim_byte - 1)
2041 : max (limit - len_byte, lim_byte));
2042 /* LIMIT is now the last value POS_BYTE can have
2043 and still be valid for a possible match. */
2044 while (1)
2046 /* This loop can be coded for space rather than
2047 speed because it will usually run only once.
2048 (the reach is at most len + 21, and typically
2049 does not exceed len). */
2050 while ((limit - pos_byte) * direction >= 0)
2052 int ch = FETCH_BYTE (pos_byte);
2053 if (BM_tab[ch] == 0)
2054 goto hit2;
2055 pos_byte += BM_tab[ch];
2057 break; /* ran off the end */
2059 hit2:
2060 /* Found what might be a match. */
2061 i = dirlen - direction;
2062 while ((i -= direction) + direction != 0)
2064 int ch;
2065 unsigned char *ptr;
2066 pos_byte -= direction;
2067 ptr = BYTE_POS_ADDR (pos_byte);
2068 /* Translate only the last byte of a character. */
2069 if (! multibyte
2070 || ((ptr == tail_end_ptr
2071 || CHAR_HEAD_P (ptr[1]))
2072 && (CHAR_HEAD_P (ptr[0])
2073 /* Check if this is the last byte of a
2074 translable character. */
2075 || (translate_prev_byte1 == ptr[-1]
2076 && (CHAR_HEAD_P (translate_prev_byte1)
2077 || (translate_prev_byte2 == ptr[-2]
2078 && (CHAR_HEAD_P (translate_prev_byte2)
2079 || translate_prev_byte3 == ptr[-3])))))))
2080 ch = simple_translate[*ptr];
2081 else
2082 ch = *ptr;
2083 if (pat[i] != ch)
2084 break;
2086 /* Above loop has moved POS_BYTE part or all the way
2087 back to the first pos (last pos if reverse).
2088 Set it once again at the last (first if reverse) char. */
2089 pos_byte += dirlen - i - direction;
2090 if (i + direction == 0)
2092 EMACS_INT position, start, end;
2093 pos_byte -= direction;
2095 position = pos_byte + ((direction > 0) ? 1 - len_byte : 0);
2096 set_search_regs (position, len_byte);
2098 if (NILP (Vinhibit_changing_match_data))
2100 start = search_regs.start[0];
2101 end = search_regs.end[0];
2103 else
2104 /* If Vinhibit_changing_match_data is non-nil,
2105 search_regs will not be changed. So let's
2106 compute start and end here. */
2108 start = BYTE_TO_CHAR (position);
2109 end = BYTE_TO_CHAR (position + len_byte);
2112 if ((n -= direction) != 0)
2113 pos_byte += dirlen; /* to resume search */
2114 else
2115 return direction > 0 ? end : start;
2117 else
2118 pos_byte += stride_for_teases;
2121 /* We have done one clump. Can we continue? */
2122 if ((lim_byte - pos_byte) * direction < 0)
2123 return ((0 - n) * direction);
2125 return BYTE_TO_CHAR (pos_byte);
2128 /* Record beginning BEG_BYTE and end BEG_BYTE + NBYTES
2129 for the overall match just found in the current buffer.
2130 Also clear out the match data for registers 1 and up. */
2132 static void
2133 set_search_regs (beg_byte, nbytes)
2134 EMACS_INT beg_byte, nbytes;
2136 int i;
2138 if (!NILP (Vinhibit_changing_match_data))
2139 return;
2141 /* Make sure we have registers in which to store
2142 the match position. */
2143 if (search_regs.num_regs == 0)
2145 search_regs.start = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
2146 search_regs.end = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
2147 search_regs.num_regs = 2;
2150 /* Clear out the other registers. */
2151 for (i = 1; i < search_regs.num_regs; i++)
2153 search_regs.start[i] = -1;
2154 search_regs.end[i] = -1;
2157 search_regs.start[0] = BYTE_TO_CHAR (beg_byte);
2158 search_regs.end[0] = BYTE_TO_CHAR (beg_byte + nbytes);
2159 XSETBUFFER (last_thing_searched, current_buffer);
2162 /* Given STRING, a string of words separated by word delimiters,
2163 compute a regexp that matches those exact words separated by
2164 arbitrary punctuation. If LAX is nonzero, the end of the string
2165 need not match a word boundary unless it ends in whitespace. */
2167 static Lisp_Object
2168 wordify (string, lax)
2169 Lisp_Object string;
2170 int lax;
2172 register unsigned char *p, *o;
2173 register int i, i_byte, len, punct_count = 0, word_count = 0;
2174 Lisp_Object val;
2175 int prev_c = 0;
2176 int adjust, whitespace_at_end;
2178 CHECK_STRING (string);
2179 p = SDATA (string);
2180 len = SCHARS (string);
2182 for (i = 0, i_byte = 0; i < len; )
2184 int c;
2186 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
2188 if (SYNTAX (c) != Sword)
2190 punct_count++;
2191 if (i > 0 && SYNTAX (prev_c) == Sword)
2192 word_count++;
2195 prev_c = c;
2198 if (SYNTAX (prev_c) == Sword)
2200 word_count++;
2201 whitespace_at_end = 0;
2203 else
2204 whitespace_at_end = 1;
2206 if (!word_count)
2207 return empty_unibyte_string;
2209 adjust = - punct_count + 5 * (word_count - 1)
2210 + ((lax && !whitespace_at_end) ? 2 : 4);
2211 if (STRING_MULTIBYTE (string))
2212 val = make_uninit_multibyte_string (len + adjust,
2213 SBYTES (string)
2214 + adjust);
2215 else
2216 val = make_uninit_string (len + adjust);
2218 o = SDATA (val);
2219 *o++ = '\\';
2220 *o++ = 'b';
2221 prev_c = 0;
2223 for (i = 0, i_byte = 0; i < len; )
2225 int c;
2226 int i_byte_orig = i_byte;
2228 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
2230 if (SYNTAX (c) == Sword)
2232 bcopy (SDATA (string) + i_byte_orig, o,
2233 i_byte - i_byte_orig);
2234 o += i_byte - i_byte_orig;
2236 else if (i > 0 && SYNTAX (prev_c) == Sword && --word_count)
2238 *o++ = '\\';
2239 *o++ = 'W';
2240 *o++ = '\\';
2241 *o++ = 'W';
2242 *o++ = '*';
2245 prev_c = c;
2248 if (!lax || whitespace_at_end)
2250 *o++ = '\\';
2251 *o++ = 'b';
2254 return val;
2257 DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
2258 "MSearch backward: ",
2259 doc: /* Search backward from point for STRING.
2260 Set point to the beginning of the occurrence found, and return point.
2261 An optional second argument bounds the search; it is a buffer position.
2262 The match found must not extend before that position.
2263 Optional third argument, if t, means if fail just return nil (no error).
2264 If not nil and not t, position at limit of search and return nil.
2265 Optional fourth argument is repeat count--search for successive occurrences.
2267 Search case-sensitivity is determined by the value of the variable
2268 `case-fold-search', which see.
2270 See also the functions `match-beginning', `match-end' and `replace-match'. */)
2271 (string, bound, noerror, count)
2272 Lisp_Object string, bound, noerror, count;
2274 return search_command (string, bound, noerror, count, -1, 0, 0);
2277 DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "MSearch: ",
2278 doc: /* Search forward from point for STRING.
2279 Set point to the end of the occurrence found, and return point.
2280 An optional second argument bounds the search; it is a buffer position.
2281 The match found must not extend after that position. A value of nil is
2282 equivalent to (point-max).
2283 Optional third argument, if t, means if fail just return nil (no error).
2284 If not nil and not t, move to limit of search and return nil.
2285 Optional fourth argument is repeat count--search for successive occurrences.
2287 Search case-sensitivity is determined by the value of the variable
2288 `case-fold-search', which see.
2290 See also the functions `match-beginning', `match-end' and `replace-match'. */)
2291 (string, bound, noerror, count)
2292 Lisp_Object string, bound, noerror, count;
2294 return search_command (string, bound, noerror, count, 1, 0, 0);
2297 DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
2298 "sWord search backward: ",
2299 doc: /* Search backward from point for STRING, ignoring differences in punctuation.
2300 Set point to the beginning of the occurrence found, and return point.
2301 An optional second argument bounds the search; it is a buffer position.
2302 The match found must not extend before that position.
2303 Optional third argument, if t, means if fail just return nil (no error).
2304 If not nil and not t, move to limit of search and return nil.
2305 Optional fourth argument is repeat count--search for successive occurrences. */)
2306 (string, bound, noerror, count)
2307 Lisp_Object string, bound, noerror, count;
2309 return search_command (wordify (string, 0), bound, noerror, count, -1, 1, 0);
2312 DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
2313 "sWord search: ",
2314 doc: /* Search forward from point for STRING, ignoring differences in punctuation.
2315 Set point to the end of the occurrence found, and return point.
2316 An optional second argument bounds the search; it is a buffer position.
2317 The match found must not extend after that position.
2318 Optional third argument, if t, means if fail just return nil (no error).
2319 If not nil and not t, move to limit of search and return nil.
2320 Optional fourth argument is repeat count--search for successive occurrences. */)
2321 (string, bound, noerror, count)
2322 Lisp_Object string, bound, noerror, count;
2324 return search_command (wordify (string, 0), bound, noerror, count, 1, 1, 0);
2327 DEFUN ("word-search-backward-lax", Fword_search_backward_lax, Sword_search_backward_lax, 1, 4,
2328 "sWord search backward: ",
2329 doc: /* Search backward from point for STRING, ignoring differences in punctuation.
2330 Set point to the beginning of the occurrence found, and return point.
2332 Unlike `word-search-backward', the end of STRING need not match a word
2333 boundary unless it ends in whitespace.
2335 An optional second argument bounds the search; it is a buffer position.
2336 The match found must not extend before that position.
2337 Optional third argument, if t, means if fail just return nil (no error).
2338 If not nil and not t, move to limit of search and return nil.
2339 Optional fourth argument is repeat count--search for successive occurrences. */)
2340 (string, bound, noerror, count)
2341 Lisp_Object string, bound, noerror, count;
2343 return search_command (wordify (string, 1), bound, noerror, count, -1, 1, 0);
2346 DEFUN ("word-search-forward-lax", Fword_search_forward_lax, Sword_search_forward_lax, 1, 4,
2347 "sWord search: ",
2348 doc: /* Search forward from point for STRING, ignoring differences in punctuation.
2349 Set point to the end of the occurrence found, and return point.
2351 Unlike `word-search-forward', the end of STRING need not match a word
2352 boundary unless it ends in whitespace.
2354 An optional second argument bounds the search; it is a buffer position.
2355 The match found must not extend after that position.
2356 Optional third argument, if t, means if fail just return nil (no error).
2357 If not nil and not t, move to limit of search and return nil.
2358 Optional fourth argument is repeat count--search for successive occurrences. */)
2359 (string, bound, noerror, count)
2360 Lisp_Object string, bound, noerror, count;
2362 return search_command (wordify (string, 1), bound, noerror, count, 1, 1, 0);
2365 DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
2366 "sRE search backward: ",
2367 doc: /* Search backward from point for match for regular expression REGEXP.
2368 Set point to the beginning of the match, and return point.
2369 The match found is the one starting last in the buffer
2370 and yet ending before the origin of the search.
2371 An optional second argument bounds the search; it is a buffer position.
2372 The match found must start at or after that position.
2373 Optional third argument, if t, means if fail just return nil (no error).
2374 If not nil and not t, move to limit of search and return nil.
2375 Optional fourth argument is repeat count--search for successive occurrences.
2376 See also the functions `match-beginning', `match-end', `match-string',
2377 and `replace-match'. */)
2378 (regexp, bound, noerror, count)
2379 Lisp_Object regexp, bound, noerror, count;
2381 return search_command (regexp, bound, noerror, count, -1, 1, 0);
2384 DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4,
2385 "sRE search: ",
2386 doc: /* Search forward from point for regular expression REGEXP.
2387 Set point to the end of the occurrence found, and return point.
2388 An optional second argument bounds the search; it is a buffer position.
2389 The match found must not extend after that position.
2390 Optional third argument, if t, means if fail just return nil (no error).
2391 If not nil and not t, move to limit of search and return nil.
2392 Optional fourth argument is repeat count--search for successive occurrences.
2393 See also the functions `match-beginning', `match-end', `match-string',
2394 and `replace-match'. */)
2395 (regexp, bound, noerror, count)
2396 Lisp_Object regexp, bound, noerror, count;
2398 return search_command (regexp, bound, noerror, count, 1, 1, 0);
2401 DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, 1, 4,
2402 "sPosix search backward: ",
2403 doc: /* Search backward from point for match for regular expression REGEXP.
2404 Find the longest match in accord with Posix regular expression rules.
2405 Set point to the beginning of the match, and return point.
2406 The match found is the one starting last in the buffer
2407 and yet ending before the origin of the search.
2408 An optional second argument bounds the search; it is a buffer position.
2409 The match found must start at or after that position.
2410 Optional third argument, if t, means if fail just return nil (no error).
2411 If not nil and not t, move to limit of search and return nil.
2412 Optional fourth argument is repeat count--search for successive occurrences.
2413 See also the functions `match-beginning', `match-end', `match-string',
2414 and `replace-match'. */)
2415 (regexp, bound, noerror, count)
2416 Lisp_Object regexp, bound, noerror, count;
2418 return search_command (regexp, bound, noerror, count, -1, 1, 1);
2421 DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, 1, 4,
2422 "sPosix search: ",
2423 doc: /* Search forward from point for regular expression REGEXP.
2424 Find the longest match in accord with Posix regular expression rules.
2425 Set point to the end of the occurrence found, and return point.
2426 An optional second argument bounds the search; it is a buffer position.
2427 The match found must not extend after that position.
2428 Optional third argument, if t, means if fail just return nil (no error).
2429 If not nil and not t, move to limit of search and return nil.
2430 Optional fourth argument is repeat count--search for successive occurrences.
2431 See also the functions `match-beginning', `match-end', `match-string',
2432 and `replace-match'. */)
2433 (regexp, bound, noerror, count)
2434 Lisp_Object regexp, bound, noerror, count;
2436 return search_command (regexp, bound, noerror, count, 1, 1, 1);
2439 DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0,
2440 doc: /* Replace text matched by last search with NEWTEXT.
2441 Leave point at the end of the replacement text.
2443 If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
2444 Otherwise maybe capitalize the whole text, or maybe just word initials,
2445 based on the replaced text.
2446 If the replaced text has only capital letters
2447 and has at least one multiletter word, convert NEWTEXT to all caps.
2448 Otherwise if all words are capitalized in the replaced text,
2449 capitalize each word in NEWTEXT.
2451 If third arg LITERAL is non-nil, insert NEWTEXT literally.
2452 Otherwise treat `\\' as special:
2453 `\\&' in NEWTEXT means substitute original matched text.
2454 `\\N' means substitute what matched the Nth `\\(...\\)'.
2455 If Nth parens didn't match, substitute nothing.
2456 `\\\\' means insert one `\\'.
2457 Case conversion does not apply to these substitutions.
2459 FIXEDCASE and LITERAL are optional arguments.
2461 The optional fourth argument STRING can be a string to modify.
2462 This is meaningful when the previous match was done against STRING,
2463 using `string-match'. When used this way, `replace-match'
2464 creates and returns a new string made by copying STRING and replacing
2465 the part of STRING that was matched.
2467 The optional fifth argument SUBEXP specifies a subexpression;
2468 it says to replace just that subexpression with NEWTEXT,
2469 rather than replacing the entire matched text.
2470 This is, in a vague sense, the inverse of using `\\N' in NEWTEXT;
2471 `\\N' copies subexp N into NEWTEXT, but using N as SUBEXP puts
2472 NEWTEXT in place of subexp N.
2473 This is useful only after a regular expression search or match,
2474 since only regular expressions have distinguished subexpressions. */)
2475 (newtext, fixedcase, literal, string, subexp)
2476 Lisp_Object newtext, fixedcase, literal, string, subexp;
2478 enum { nochange, all_caps, cap_initial } case_action;
2479 register int pos, pos_byte;
2480 int some_multiletter_word;
2481 int some_lowercase;
2482 int some_uppercase;
2483 int some_nonuppercase_initial;
2484 register int c, prevc;
2485 int sub;
2486 EMACS_INT opoint, newpoint;
2488 CHECK_STRING (newtext);
2490 if (! NILP (string))
2491 CHECK_STRING (string);
2493 case_action = nochange; /* We tried an initialization */
2494 /* but some C compilers blew it */
2496 if (search_regs.num_regs <= 0)
2497 error ("`replace-match' called before any match found");
2499 if (NILP (subexp))
2500 sub = 0;
2501 else
2503 CHECK_NUMBER (subexp);
2504 sub = XINT (subexp);
2505 if (sub < 0 || sub >= search_regs.num_regs)
2506 args_out_of_range (subexp, make_number (search_regs.num_regs));
2509 if (NILP (string))
2511 if (search_regs.start[sub] < BEGV
2512 || search_regs.start[sub] > search_regs.end[sub]
2513 || search_regs.end[sub] > ZV)
2514 args_out_of_range (make_number (search_regs.start[sub]),
2515 make_number (search_regs.end[sub]));
2517 else
2519 if (search_regs.start[sub] < 0
2520 || search_regs.start[sub] > search_regs.end[sub]
2521 || search_regs.end[sub] > SCHARS (string))
2522 args_out_of_range (make_number (search_regs.start[sub]),
2523 make_number (search_regs.end[sub]));
2526 if (NILP (fixedcase))
2528 /* Decide how to casify by examining the matched text. */
2529 EMACS_INT last;
2531 pos = search_regs.start[sub];
2532 last = search_regs.end[sub];
2534 if (NILP (string))
2535 pos_byte = CHAR_TO_BYTE (pos);
2536 else
2537 pos_byte = string_char_to_byte (string, pos);
2539 prevc = '\n';
2540 case_action = all_caps;
2542 /* some_multiletter_word is set nonzero if any original word
2543 is more than one letter long. */
2544 some_multiletter_word = 0;
2545 some_lowercase = 0;
2546 some_nonuppercase_initial = 0;
2547 some_uppercase = 0;
2549 while (pos < last)
2551 if (NILP (string))
2553 c = FETCH_CHAR_AS_MULTIBYTE (pos_byte);
2554 INC_BOTH (pos, pos_byte);
2556 else
2557 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, pos, pos_byte);
2559 if (LOWERCASEP (c))
2561 /* Cannot be all caps if any original char is lower case */
2563 some_lowercase = 1;
2564 if (SYNTAX (prevc) != Sword)
2565 some_nonuppercase_initial = 1;
2566 else
2567 some_multiletter_word = 1;
2569 else if (UPPERCASEP (c))
2571 some_uppercase = 1;
2572 if (SYNTAX (prevc) != Sword)
2574 else
2575 some_multiletter_word = 1;
2577 else
2579 /* If the initial is a caseless word constituent,
2580 treat that like a lowercase initial. */
2581 if (SYNTAX (prevc) != Sword)
2582 some_nonuppercase_initial = 1;
2585 prevc = c;
2588 /* Convert to all caps if the old text is all caps
2589 and has at least one multiletter word. */
2590 if (! some_lowercase && some_multiletter_word)
2591 case_action = all_caps;
2592 /* Capitalize each word, if the old text has all capitalized words. */
2593 else if (!some_nonuppercase_initial && some_multiletter_word)
2594 case_action = cap_initial;
2595 else if (!some_nonuppercase_initial && some_uppercase)
2596 /* Should x -> yz, operating on X, give Yz or YZ?
2597 We'll assume the latter. */
2598 case_action = all_caps;
2599 else
2600 case_action = nochange;
2603 /* Do replacement in a string. */
2604 if (!NILP (string))
2606 Lisp_Object before, after;
2608 before = Fsubstring (string, make_number (0),
2609 make_number (search_regs.start[sub]));
2610 after = Fsubstring (string, make_number (search_regs.end[sub]), Qnil);
2612 /* Substitute parts of the match into NEWTEXT
2613 if desired. */
2614 if (NILP (literal))
2616 EMACS_INT lastpos = 0;
2617 EMACS_INT lastpos_byte = 0;
2618 /* We build up the substituted string in ACCUM. */
2619 Lisp_Object accum;
2620 Lisp_Object middle;
2621 int length = SBYTES (newtext);
2623 accum = Qnil;
2625 for (pos_byte = 0, pos = 0; pos_byte < length;)
2627 int substart = -1;
2628 int subend = 0;
2629 int delbackslash = 0;
2631 FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
2633 if (c == '\\')
2635 FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
2637 if (c == '&')
2639 substart = search_regs.start[sub];
2640 subend = search_regs.end[sub];
2642 else if (c >= '1' && c <= '9')
2644 if (search_regs.start[c - '0'] >= 0
2645 && c <= search_regs.num_regs + '0')
2647 substart = search_regs.start[c - '0'];
2648 subend = search_regs.end[c - '0'];
2650 else
2652 /* If that subexp did not match,
2653 replace \\N with nothing. */
2654 substart = 0;
2655 subend = 0;
2658 else if (c == '\\')
2659 delbackslash = 1;
2660 else
2661 error ("Invalid use of `\\' in replacement text");
2663 if (substart >= 0)
2665 if (pos - 2 != lastpos)
2666 middle = substring_both (newtext, lastpos,
2667 lastpos_byte,
2668 pos - 2, pos_byte - 2);
2669 else
2670 middle = Qnil;
2671 accum = concat3 (accum, middle,
2672 Fsubstring (string,
2673 make_number (substart),
2674 make_number (subend)));
2675 lastpos = pos;
2676 lastpos_byte = pos_byte;
2678 else if (delbackslash)
2680 middle = substring_both (newtext, lastpos,
2681 lastpos_byte,
2682 pos - 1, pos_byte - 1);
2684 accum = concat2 (accum, middle);
2685 lastpos = pos;
2686 lastpos_byte = pos_byte;
2690 if (pos != lastpos)
2691 middle = substring_both (newtext, lastpos,
2692 lastpos_byte,
2693 pos, pos_byte);
2694 else
2695 middle = Qnil;
2697 newtext = concat2 (accum, middle);
2700 /* Do case substitution in NEWTEXT if desired. */
2701 if (case_action == all_caps)
2702 newtext = Fupcase (newtext);
2703 else if (case_action == cap_initial)
2704 newtext = Fupcase_initials (newtext);
2706 return concat3 (before, newtext, after);
2709 /* Record point, then move (quietly) to the start of the match. */
2710 if (PT >= search_regs.end[sub])
2711 opoint = PT - ZV;
2712 else if (PT > search_regs.start[sub])
2713 opoint = search_regs.end[sub] - ZV;
2714 else
2715 opoint = PT;
2717 /* If we want non-literal replacement,
2718 perform substitution on the replacement string. */
2719 if (NILP (literal))
2721 int length = SBYTES (newtext);
2722 unsigned char *substed;
2723 int substed_alloc_size, substed_len;
2724 int buf_multibyte = !NILP (current_buffer->enable_multibyte_characters);
2725 int str_multibyte = STRING_MULTIBYTE (newtext);
2726 Lisp_Object rev_tbl;
2727 int really_changed = 0;
2729 rev_tbl = Qnil;
2731 substed_alloc_size = length * 2 + 100;
2732 substed = (unsigned char *) xmalloc (substed_alloc_size + 1);
2733 substed_len = 0;
2735 /* Go thru NEWTEXT, producing the actual text to insert in
2736 SUBSTED while adjusting multibyteness to that of the current
2737 buffer. */
2739 for (pos_byte = 0, pos = 0; pos_byte < length;)
2741 unsigned char str[MAX_MULTIBYTE_LENGTH];
2742 unsigned char *add_stuff = NULL;
2743 int add_len = 0;
2744 int idx = -1;
2746 if (str_multibyte)
2748 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext, pos, pos_byte);
2749 if (!buf_multibyte)
2750 c = multibyte_char_to_unibyte (c, rev_tbl);
2752 else
2754 /* Note that we don't have to increment POS. */
2755 c = SREF (newtext, pos_byte++);
2756 if (buf_multibyte)
2757 MAKE_CHAR_MULTIBYTE (c);
2760 /* Either set ADD_STUFF and ADD_LEN to the text to put in SUBSTED,
2761 or set IDX to a match index, which means put that part
2762 of the buffer text into SUBSTED. */
2764 if (c == '\\')
2766 really_changed = 1;
2768 if (str_multibyte)
2770 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext,
2771 pos, pos_byte);
2772 if (!buf_multibyte && !ASCII_CHAR_P (c))
2773 c = multibyte_char_to_unibyte (c, rev_tbl);
2775 else
2777 c = SREF (newtext, pos_byte++);
2778 if (buf_multibyte)
2779 MAKE_CHAR_MULTIBYTE (c);
2782 if (c == '&')
2783 idx = sub;
2784 else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0')
2786 if (search_regs.start[c - '0'] >= 1)
2787 idx = c - '0';
2789 else if (c == '\\')
2790 add_len = 1, add_stuff = "\\";
2791 else
2793 xfree (substed);
2794 error ("Invalid use of `\\' in replacement text");
2797 else
2799 add_len = CHAR_STRING (c, str);
2800 add_stuff = str;
2803 /* If we want to copy part of a previous match,
2804 set up ADD_STUFF and ADD_LEN to point to it. */
2805 if (idx >= 0)
2807 EMACS_INT begbyte = CHAR_TO_BYTE (search_regs.start[idx]);
2808 add_len = CHAR_TO_BYTE (search_regs.end[idx]) - begbyte;
2809 if (search_regs.start[idx] < GPT && GPT < search_regs.end[idx])
2810 move_gap (search_regs.start[idx]);
2811 add_stuff = BYTE_POS_ADDR (begbyte);
2814 /* Now the stuff we want to add to SUBSTED
2815 is invariably ADD_LEN bytes starting at ADD_STUFF. */
2817 /* Make sure SUBSTED is big enough. */
2818 if (substed_len + add_len >= substed_alloc_size)
2820 substed_alloc_size = substed_len + add_len + 500;
2821 substed = (unsigned char *) xrealloc (substed,
2822 substed_alloc_size + 1);
2825 /* Now add to the end of SUBSTED. */
2826 if (add_stuff)
2828 bcopy (add_stuff, substed + substed_len, add_len);
2829 substed_len += add_len;
2833 if (really_changed)
2835 if (buf_multibyte)
2837 int nchars = multibyte_chars_in_text (substed, substed_len);
2839 newtext = make_multibyte_string (substed, nchars, substed_len);
2841 else
2842 newtext = make_unibyte_string (substed, substed_len);
2844 xfree (substed);
2847 /* Replace the old text with the new in the cleanest possible way. */
2848 replace_range (search_regs.start[sub], search_regs.end[sub],
2849 newtext, 1, 0, 1);
2850 newpoint = search_regs.start[sub] + SCHARS (newtext);
2852 if (case_action == all_caps)
2853 Fupcase_region (make_number (search_regs.start[sub]),
2854 make_number (newpoint));
2855 else if (case_action == cap_initial)
2856 Fupcase_initials_region (make_number (search_regs.start[sub]),
2857 make_number (newpoint));
2859 /* Adjust search data for this change. */
2861 EMACS_INT oldend = search_regs.end[sub];
2862 EMACS_INT oldstart = search_regs.start[sub];
2863 EMACS_INT change = newpoint - search_regs.end[sub];
2864 int i;
2866 for (i = 0; i < search_regs.num_regs; i++)
2868 if (search_regs.start[i] >= oldend)
2869 search_regs.start[i] += change;
2870 else if (search_regs.start[i] > oldstart)
2871 search_regs.start[i] = oldstart;
2872 if (search_regs.end[i] >= oldend)
2873 search_regs.end[i] += change;
2874 else if (search_regs.end[i] > oldstart)
2875 search_regs.end[i] = oldstart;
2879 /* Put point back where it was in the text. */
2880 if (opoint <= 0)
2881 TEMP_SET_PT (opoint + ZV);
2882 else
2883 TEMP_SET_PT (opoint);
2885 /* Now move point "officially" to the start of the inserted replacement. */
2886 move_if_not_intangible (newpoint);
2888 return Qnil;
2891 static Lisp_Object
2892 match_limit (num, beginningp)
2893 Lisp_Object num;
2894 int beginningp;
2896 register int n;
2898 CHECK_NUMBER (num);
2899 n = XINT (num);
2900 if (n < 0)
2901 args_out_of_range (num, make_number (0));
2902 if (search_regs.num_regs <= 0)
2903 error ("No match data, because no search succeeded");
2904 if (n >= search_regs.num_regs
2905 || search_regs.start[n] < 0)
2906 return Qnil;
2907 return (make_number ((beginningp) ? search_regs.start[n]
2908 : search_regs.end[n]));
2911 DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
2912 doc: /* Return position of start of text matched by last search.
2913 SUBEXP, a number, specifies which parenthesized expression in the last
2914 regexp.
2915 Value is nil if SUBEXPth pair didn't match, or there were less than
2916 SUBEXP pairs.
2917 Zero means the entire text matched by the whole regexp or whole string. */)
2918 (subexp)
2919 Lisp_Object subexp;
2921 return match_limit (subexp, 1);
2924 DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0,
2925 doc: /* Return position of end of text matched by last search.
2926 SUBEXP, a number, specifies which parenthesized expression in the last
2927 regexp.
2928 Value is nil if SUBEXPth pair didn't match, or there were less than
2929 SUBEXP pairs.
2930 Zero means the entire text matched by the whole regexp or whole string. */)
2931 (subexp)
2932 Lisp_Object subexp;
2934 return match_limit (subexp, 0);
2937 DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 3, 0,
2938 doc: /* Return a list containing all info on what the last search matched.
2939 Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.
2940 All the elements are markers or nil (nil if the Nth pair didn't match)
2941 if the last match was on a buffer; integers or nil if a string was matched.
2942 Use `set-match-data' to reinstate the data in this list.
2944 If INTEGERS (the optional first argument) is non-nil, always use
2945 integers \(rather than markers) to represent buffer positions. In
2946 this case, and if the last match was in a buffer, the buffer will get
2947 stored as one additional element at the end of the list.
2949 If REUSE is a list, reuse it as part of the value. If REUSE is long
2950 enough to hold all the values, and if INTEGERS is non-nil, no consing
2951 is done.
2953 If optional third arg RESEAT is non-nil, any previous markers on the
2954 REUSE list will be modified to point to nowhere.
2956 Return value is undefined if the last search failed. */)
2957 (integers, reuse, reseat)
2958 Lisp_Object integers, reuse, reseat;
2960 Lisp_Object tail, prev;
2961 Lisp_Object *data;
2962 int i, len;
2964 if (!NILP (reseat))
2965 for (tail = reuse; CONSP (tail); tail = XCDR (tail))
2966 if (MARKERP (XCAR (tail)))
2968 unchain_marker (XMARKER (XCAR (tail)));
2969 XSETCAR (tail, Qnil);
2972 if (NILP (last_thing_searched))
2973 return Qnil;
2975 prev = Qnil;
2977 data = (Lisp_Object *) alloca ((2 * search_regs.num_regs + 1)
2978 * sizeof (Lisp_Object));
2980 len = 0;
2981 for (i = 0; i < search_regs.num_regs; i++)
2983 int start = search_regs.start[i];
2984 if (start >= 0)
2986 if (EQ (last_thing_searched, Qt)
2987 || ! NILP (integers))
2989 XSETFASTINT (data[2 * i], start);
2990 XSETFASTINT (data[2 * i + 1], search_regs.end[i]);
2992 else if (BUFFERP (last_thing_searched))
2994 data[2 * i] = Fmake_marker ();
2995 Fset_marker (data[2 * i],
2996 make_number (start),
2997 last_thing_searched);
2998 data[2 * i + 1] = Fmake_marker ();
2999 Fset_marker (data[2 * i + 1],
3000 make_number (search_regs.end[i]),
3001 last_thing_searched);
3003 else
3004 /* last_thing_searched must always be Qt, a buffer, or Qnil. */
3005 abort ();
3007 len = 2 * i + 2;
3009 else
3010 data[2 * i] = data[2 * i + 1] = Qnil;
3013 if (BUFFERP (last_thing_searched) && !NILP (integers))
3015 data[len] = last_thing_searched;
3016 len++;
3019 /* If REUSE is not usable, cons up the values and return them. */
3020 if (! CONSP (reuse))
3021 return Flist (len, data);
3023 /* If REUSE is a list, store as many value elements as will fit
3024 into the elements of REUSE. */
3025 for (i = 0, tail = reuse; CONSP (tail);
3026 i++, tail = XCDR (tail))
3028 if (i < len)
3029 XSETCAR (tail, data[i]);
3030 else
3031 XSETCAR (tail, Qnil);
3032 prev = tail;
3035 /* If we couldn't fit all value elements into REUSE,
3036 cons up the rest of them and add them to the end of REUSE. */
3037 if (i < len)
3038 XSETCDR (prev, Flist (len - i, data + i));
3040 return reuse;
3043 /* We used to have an internal use variant of `reseat' described as:
3045 If RESEAT is `evaporate', put the markers back on the free list
3046 immediately. No other references to the markers must exist in this
3047 case, so it is used only internally on the unwind stack and
3048 save-match-data from Lisp.
3050 But it was ill-conceived: those supposedly-internal markers get exposed via
3051 the undo-list, so freeing them here is unsafe. */
3053 DEFUN ("set-match-data", Fset_match_data, Sset_match_data, 1, 2, 0,
3054 doc: /* Set internal data on last search match from elements of LIST.
3055 LIST should have been created by calling `match-data' previously.
3057 If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */)
3058 (list, reseat)
3059 register Lisp_Object list, reseat;
3061 register int i;
3062 register Lisp_Object marker;
3064 if (running_asynch_code)
3065 save_search_regs ();
3067 CHECK_LIST (list);
3069 /* Unless we find a marker with a buffer or an explicit buffer
3070 in LIST, assume that this match data came from a string. */
3071 last_thing_searched = Qt;
3073 /* Allocate registers if they don't already exist. */
3075 int length = XFASTINT (Flength (list)) / 2;
3077 if (length > search_regs.num_regs)
3079 if (search_regs.num_regs == 0)
3081 search_regs.start
3082 = (regoff_t *) xmalloc (length * sizeof (regoff_t));
3083 search_regs.end
3084 = (regoff_t *) xmalloc (length * sizeof (regoff_t));
3086 else
3088 search_regs.start
3089 = (regoff_t *) xrealloc (search_regs.start,
3090 length * sizeof (regoff_t));
3091 search_regs.end
3092 = (regoff_t *) xrealloc (search_regs.end,
3093 length * sizeof (regoff_t));
3096 for (i = search_regs.num_regs; i < length; i++)
3097 search_regs.start[i] = -1;
3099 search_regs.num_regs = length;
3102 for (i = 0; CONSP (list); i++)
3104 marker = XCAR (list);
3105 if (BUFFERP (marker))
3107 last_thing_searched = marker;
3108 break;
3110 if (i >= length)
3111 break;
3112 if (NILP (marker))
3114 search_regs.start[i] = -1;
3115 list = XCDR (list);
3117 else
3119 EMACS_INT from;
3120 Lisp_Object m;
3122 m = marker;
3123 if (MARKERP (marker))
3125 if (XMARKER (marker)->buffer == 0)
3126 XSETFASTINT (marker, 0);
3127 else
3128 XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer);
3131 CHECK_NUMBER_COERCE_MARKER (marker);
3132 from = XINT (marker);
3134 if (!NILP (reseat) && MARKERP (m))
3136 unchain_marker (XMARKER (m));
3137 XSETCAR (list, Qnil);
3140 if ((list = XCDR (list), !CONSP (list)))
3141 break;
3143 m = marker = XCAR (list);
3145 if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
3146 XSETFASTINT (marker, 0);
3148 CHECK_NUMBER_COERCE_MARKER (marker);
3149 search_regs.start[i] = from;
3150 search_regs.end[i] = XINT (marker);
3152 if (!NILP (reseat) && MARKERP (m))
3154 unchain_marker (XMARKER (m));
3155 XSETCAR (list, Qnil);
3158 list = XCDR (list);
3161 for (; i < search_regs.num_regs; i++)
3162 search_regs.start[i] = -1;
3165 return Qnil;
3168 /* If non-zero the match data have been saved in saved_search_regs
3169 during the execution of a sentinel or filter. */
3170 static int search_regs_saved;
3171 static struct re_registers saved_search_regs;
3172 static Lisp_Object saved_last_thing_searched;
3174 /* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
3175 if asynchronous code (filter or sentinel) is running. */
3176 static void
3177 save_search_regs ()
3179 if (!search_regs_saved)
3181 saved_search_regs.num_regs = search_regs.num_regs;
3182 saved_search_regs.start = search_regs.start;
3183 saved_search_regs.end = search_regs.end;
3184 saved_last_thing_searched = last_thing_searched;
3185 last_thing_searched = Qnil;
3186 search_regs.num_regs = 0;
3187 search_regs.start = 0;
3188 search_regs.end = 0;
3190 search_regs_saved = 1;
3194 /* Called upon exit from filters and sentinels. */
3195 void
3196 restore_search_regs ()
3198 if (search_regs_saved)
3200 if (search_regs.num_regs > 0)
3202 xfree (search_regs.start);
3203 xfree (search_regs.end);
3205 search_regs.num_regs = saved_search_regs.num_regs;
3206 search_regs.start = saved_search_regs.start;
3207 search_regs.end = saved_search_regs.end;
3208 last_thing_searched = saved_last_thing_searched;
3209 saved_last_thing_searched = Qnil;
3210 search_regs_saved = 0;
3214 static Lisp_Object
3215 unwind_set_match_data (list)
3216 Lisp_Object list;
3218 /* It is NOT ALWAYS safe to free (evaporate) the markers immediately. */
3219 return Fset_match_data (list, Qt);
3222 /* Called to unwind protect the match data. */
3223 void
3224 record_unwind_save_match_data ()
3226 record_unwind_protect (unwind_set_match_data,
3227 Fmatch_data (Qnil, Qnil, Qnil));
3230 /* Quote a string to inactivate reg-expr chars */
3232 DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
3233 doc: /* Return a regexp string which matches exactly STRING and nothing else. */)
3234 (string)
3235 Lisp_Object string;
3237 register unsigned char *in, *out, *end;
3238 register unsigned char *temp;
3239 int backslashes_added = 0;
3241 CHECK_STRING (string);
3243 temp = (unsigned char *) alloca (SBYTES (string) * 2);
3245 /* Now copy the data into the new string, inserting escapes. */
3247 in = SDATA (string);
3248 end = in + SBYTES (string);
3249 out = temp;
3251 for (; in != end; in++)
3253 if (*in == '['
3254 || *in == '*' || *in == '.' || *in == '\\'
3255 || *in == '?' || *in == '+'
3256 || *in == '^' || *in == '$')
3257 *out++ = '\\', backslashes_added++;
3258 *out++ = *in;
3261 return make_specified_string (temp,
3262 SCHARS (string) + backslashes_added,
3263 out - temp,
3264 STRING_MULTIBYTE (string));
3267 void
3268 syms_of_search ()
3270 register int i;
3272 for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
3274 searchbufs[i].buf.allocated = 100;
3275 searchbufs[i].buf.buffer = (unsigned char *) xmalloc (100);
3276 searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
3277 searchbufs[i].regexp = Qnil;
3278 searchbufs[i].whitespace_regexp = Qnil;
3279 searchbufs[i].syntax_table = Qnil;
3280 staticpro (&searchbufs[i].regexp);
3281 staticpro (&searchbufs[i].whitespace_regexp);
3282 staticpro (&searchbufs[i].syntax_table);
3283 searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]);
3285 searchbuf_head = &searchbufs[0];
3287 Qsearch_failed = intern_c_string ("search-failed");
3288 staticpro (&Qsearch_failed);
3289 Qinvalid_regexp = intern_c_string ("invalid-regexp");
3290 staticpro (&Qinvalid_regexp);
3292 Fput (Qsearch_failed, Qerror_conditions,
3293 pure_cons (Qsearch_failed, pure_cons (Qerror, Qnil)));
3294 Fput (Qsearch_failed, Qerror_message,
3295 make_pure_c_string ("Search failed"));
3297 Fput (Qinvalid_regexp, Qerror_conditions,
3298 pure_cons (Qinvalid_regexp, pure_cons (Qerror, Qnil)));
3299 Fput (Qinvalid_regexp, Qerror_message,
3300 make_pure_c_string ("Invalid regexp"));
3302 last_thing_searched = Qnil;
3303 staticpro (&last_thing_searched);
3305 saved_last_thing_searched = Qnil;
3306 staticpro (&saved_last_thing_searched);
3308 DEFVAR_LISP ("search-spaces-regexp", &Vsearch_spaces_regexp,
3309 doc: /* Regexp to substitute for bunches of spaces in regexp search.
3310 Some commands use this for user-specified regexps.
3311 Spaces that occur inside character classes or repetition operators
3312 or other such regexp constructs are not replaced with this.
3313 A value of nil (which is the normal value) means treat spaces literally. */);
3314 Vsearch_spaces_regexp = Qnil;
3316 DEFVAR_LISP ("inhibit-changing-match-data", &Vinhibit_changing_match_data,
3317 doc: /* Internal use only.
3318 If non-nil, the primitive searching and matching functions
3319 such as `looking-at', `string-match', `re-search-forward', etc.,
3320 do not set the match data. The proper way to use this variable
3321 is to bind it with `let' around a small expression. */);
3322 Vinhibit_changing_match_data = Qnil;
3324 defsubr (&Slooking_at);
3325 defsubr (&Sposix_looking_at);
3326 defsubr (&Sstring_match);
3327 defsubr (&Sposix_string_match);
3328 defsubr (&Ssearch_forward);
3329 defsubr (&Ssearch_backward);
3330 defsubr (&Sword_search_forward);
3331 defsubr (&Sword_search_backward);
3332 defsubr (&Sword_search_forward_lax);
3333 defsubr (&Sword_search_backward_lax);
3334 defsubr (&Sre_search_forward);
3335 defsubr (&Sre_search_backward);
3336 defsubr (&Sposix_search_forward);
3337 defsubr (&Sposix_search_backward);
3338 defsubr (&Sreplace_match);
3339 defsubr (&Smatch_beginning);
3340 defsubr (&Smatch_end);
3341 defsubr (&Smatch_data);
3342 defsubr (&Sset_match_data);
3343 defsubr (&Sregexp_quote);
3346 /* arch-tag: a6059d79-0552-4f14-a2cb-d379a4e3c78f
3347 (do not change this comment) */