* net/soap-client.el: Add "comm" and "hypermedia" to the
[emacs.git] / src / search.c
blob1e2036f6dc2af26033b1a23f361cce4684a2275d
1 /* String search routines for GNU Emacs.
2 Copyright (C) 1985-1987, 1993-1994, 1997-1999, 2001-2011
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
22 #include <setjmp.h>
23 #include "lisp.h"
24 #include "syntax.h"
25 #include "category.h"
26 #include "buffer.h"
27 #include "character.h"
28 #include "charset.h"
29 #include "region-cache.h"
30 #include "commands.h"
31 #include "blockinput.h"
32 #include "intervals.h"
34 #include <sys/types.h>
35 #include "regex.h"
37 #define REGEXP_CACHE_SIZE 20
39 /* If the regexp is non-nil, then the buffer contains the compiled form
40 of that regexp, suitable for searching. */
41 struct regexp_cache
43 struct regexp_cache *next;
44 Lisp_Object regexp, whitespace_regexp;
45 /* Syntax table for which the regexp applies. We need this because
46 of character classes. If this is t, then the compiled pattern is valid
47 for any syntax-table. */
48 Lisp_Object syntax_table;
49 struct re_pattern_buffer buf;
50 char fastmap[0400];
51 /* Nonzero means regexp was compiled to do full POSIX backtracking. */
52 char posix;
55 /* The instances of that struct. */
56 struct regexp_cache searchbufs[REGEXP_CACHE_SIZE];
58 /* The head of the linked list; points to the most recently used buffer. */
59 struct regexp_cache *searchbuf_head;
62 /* Every call to re_match, etc., must pass &search_regs as the regs
63 argument unless you can show it is unnecessary (i.e., if re_match
64 is certainly going to be called again before region-around-match
65 can be called).
67 Since the registers are now dynamically allocated, we need to make
68 sure not to refer to the Nth register before checking that it has
69 been allocated by checking search_regs.num_regs.
71 The regex code keeps track of whether it has allocated the search
72 buffer using bits in the re_pattern_buffer. This means that whenever
73 you compile a new pattern, it completely forgets whether it has
74 allocated any registers, and will allocate new registers the next
75 time you call a searching or matching function. Therefore, we need
76 to call re_set_registers after compiling a new pattern or after
77 setting the match registers, so that the regex functions will be
78 able to free or re-allocate it properly. */
79 static struct re_registers search_regs;
81 /* The buffer in which the last search was performed, or
82 Qt if the last search was done in a string;
83 Qnil if no searching has been done yet. */
84 static Lisp_Object last_thing_searched;
86 /* error condition signaled when regexp compile_pattern fails */
88 Lisp_Object Qinvalid_regexp;
90 /* Error condition used for failing searches */
91 Lisp_Object Qsearch_failed;
93 static void set_search_regs (EMACS_INT, EMACS_INT);
94 static void save_search_regs (void);
95 static EMACS_INT simple_search (EMACS_INT, unsigned char *, EMACS_INT,
96 EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT,
97 EMACS_INT, EMACS_INT);
98 static EMACS_INT boyer_moore (EMACS_INT, unsigned char *, EMACS_INT, EMACS_INT,
99 Lisp_Object, Lisp_Object,
100 EMACS_INT, EMACS_INT,
101 EMACS_INT, EMACS_INT, int);
102 static EMACS_INT search_buffer (Lisp_Object, EMACS_INT, EMACS_INT,
103 EMACS_INT, EMACS_INT, EMACS_INT, int,
104 Lisp_Object, Lisp_Object, int);
105 static void matcher_overflow (void) NO_RETURN;
107 static void
108 matcher_overflow (void)
110 error ("Stack overflow in regexp matcher");
113 /* Compile a regexp and signal a Lisp error if anything goes wrong.
114 PATTERN is the pattern to compile.
115 CP is the place to put the result.
116 TRANSLATE is a translation table for ignoring case, or nil for none.
117 REGP is the structure that says where to store the "register"
118 values that will result from matching this pattern.
119 If it is 0, we should compile the pattern not to record any
120 subexpression bounds.
121 POSIX is nonzero if we want full backtracking (POSIX style)
122 for this pattern. 0 means backtrack only enough to get a valid match.
124 The behavior also depends on Vsearch_spaces_regexp. */
126 static void
127 compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, Lisp_Object translate, struct re_registers *regp, int posix)
129 char *val;
130 reg_syntax_t old;
132 cp->regexp = Qnil;
133 cp->buf.translate = (! NILP (translate) ? translate : make_number (0));
134 cp->posix = posix;
135 cp->buf.multibyte = STRING_MULTIBYTE (pattern);
136 cp->buf.charset_unibyte = charset_unibyte;
137 if (STRINGP (Vsearch_spaces_regexp))
138 cp->whitespace_regexp = Vsearch_spaces_regexp;
139 else
140 cp->whitespace_regexp = Qnil;
142 /* rms: I think BLOCK_INPUT is not needed here any more,
143 because regex.c defines malloc to call xmalloc.
144 Using BLOCK_INPUT here means the debugger won't run if an error occurs.
145 So let's turn it off. */
146 /* BLOCK_INPUT; */
147 old = re_set_syntax (RE_SYNTAX_EMACS
148 | (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
150 if (STRINGP (Vsearch_spaces_regexp))
151 re_set_whitespace_regexp (SSDATA (Vsearch_spaces_regexp));
152 else
153 re_set_whitespace_regexp (NULL);
155 val = (char *) re_compile_pattern (SSDATA (pattern),
156 SBYTES (pattern), &cp->buf);
158 /* If the compiled pattern hard codes some of the contents of the
159 syntax-table, it can only be reused with *this* syntax table. */
160 cp->syntax_table = cp->buf.used_syntax ? BVAR (current_buffer, syntax_table) : Qt;
162 re_set_whitespace_regexp (NULL);
164 re_set_syntax (old);
165 /* UNBLOCK_INPUT; */
166 if (val)
167 xsignal1 (Qinvalid_regexp, build_string (val));
169 cp->regexp = Fcopy_sequence (pattern);
172 /* Shrink each compiled regexp buffer in the cache
173 to the size actually used right now.
174 This is called from garbage collection. */
176 void
177 shrink_regexp_cache (void)
179 struct regexp_cache *cp;
181 for (cp = searchbuf_head; cp != 0; cp = cp->next)
183 cp->buf.allocated = cp->buf.used;
184 cp->buf.buffer
185 = (unsigned char *) xrealloc (cp->buf.buffer, cp->buf.used);
189 /* Clear the regexp cache w.r.t. a particular syntax table,
190 because it was changed.
191 There is no danger of memory leak here because re_compile_pattern
192 automagically manages the memory in each re_pattern_buffer struct,
193 based on its `allocated' and `buffer' values. */
194 void
195 clear_regexp_cache (void)
197 int i;
199 for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
200 /* It's tempting to compare with the syntax-table we've actually changed,
201 but it's not sufficient because char-table inheritance means that
202 modifying one syntax-table can change others at the same time. */
203 if (!EQ (searchbufs[i].syntax_table, Qt))
204 searchbufs[i].regexp = Qnil;
207 /* Compile a regexp if necessary, but first check to see if there's one in
208 the cache.
209 PATTERN is the pattern to compile.
210 TRANSLATE is a translation table for ignoring case, or nil for none.
211 REGP is the structure that says where to store the "register"
212 values that will result from matching this pattern.
213 If it is 0, we should compile the pattern not to record any
214 subexpression bounds.
215 POSIX is nonzero if we want full backtracking (POSIX style)
216 for this pattern. 0 means backtrack only enough to get a valid match. */
218 struct re_pattern_buffer *
219 compile_pattern (Lisp_Object pattern, struct re_registers *regp, Lisp_Object translate, int posix, int multibyte)
221 struct regexp_cache *cp, **cpp;
223 for (cpp = &searchbuf_head; ; cpp = &cp->next)
225 cp = *cpp;
226 /* Entries are initialized to nil, and may be set to nil by
227 compile_pattern_1 if the pattern isn't valid. Don't apply
228 string accessors in those cases. However, compile_pattern_1
229 is only applied to the cache entry we pick here to reuse. So
230 nil should never appear before a non-nil entry. */
231 if (NILP (cp->regexp))
232 goto compile_it;
233 if (SCHARS (cp->regexp) == SCHARS (pattern)
234 && STRING_MULTIBYTE (cp->regexp) == STRING_MULTIBYTE (pattern)
235 && !NILP (Fstring_equal (cp->regexp, pattern))
236 && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0)))
237 && cp->posix == posix
238 && (EQ (cp->syntax_table, Qt)
239 || EQ (cp->syntax_table, BVAR (current_buffer, syntax_table)))
240 && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp))
241 && cp->buf.charset_unibyte == charset_unibyte)
242 break;
244 /* If we're at the end of the cache, compile into the nil cell
245 we found, or the last (least recently used) cell with a
246 string value. */
247 if (cp->next == 0)
249 compile_it:
250 compile_pattern_1 (cp, pattern, translate, regp, posix);
251 break;
255 /* When we get here, cp (aka *cpp) contains the compiled pattern,
256 either because we found it in the cache or because we just compiled it.
257 Move it to the front of the queue to mark it as most recently used. */
258 *cpp = cp->next;
259 cp->next = searchbuf_head;
260 searchbuf_head = cp;
262 /* Advise the searching functions about the space we have allocated
263 for register data. */
264 if (regp)
265 re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end);
267 /* The compiled pattern can be used both for multibyte and unibyte
268 target. But, we have to tell which the pattern is used for. */
269 cp->buf.target_multibyte = multibyte;
271 return &cp->buf;
275 static Lisp_Object
276 looking_at_1 (Lisp_Object string, int posix)
278 Lisp_Object val;
279 unsigned char *p1, *p2;
280 EMACS_INT s1, s2;
281 register EMACS_INT i;
282 struct re_pattern_buffer *bufp;
284 if (running_asynch_code)
285 save_search_regs ();
287 /* This is so set_image_of_range_1 in regex.c can find the EQV table. */
288 XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2]
289 = BVAR (current_buffer, case_eqv_table);
291 CHECK_STRING (string);
292 bufp = compile_pattern (string,
293 (NILP (Vinhibit_changing_match_data)
294 ? &search_regs : NULL),
295 (!NILP (BVAR (current_buffer, case_fold_search))
296 ? BVAR (current_buffer, case_canon_table) : Qnil),
297 posix,
298 !NILP (BVAR (current_buffer, enable_multibyte_characters)));
300 immediate_quit = 1;
301 QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */
303 /* Get pointers and sizes of the two strings
304 that make up the visible portion of the buffer. */
306 p1 = BEGV_ADDR;
307 s1 = GPT_BYTE - BEGV_BYTE;
308 p2 = GAP_END_ADDR;
309 s2 = ZV_BYTE - GPT_BYTE;
310 if (s1 < 0)
312 p2 = p1;
313 s2 = ZV_BYTE - BEGV_BYTE;
314 s1 = 0;
316 if (s2 < 0)
318 s1 = ZV_BYTE - BEGV_BYTE;
319 s2 = 0;
322 re_match_object = Qnil;
324 i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
325 PT_BYTE - BEGV_BYTE,
326 (NILP (Vinhibit_changing_match_data)
327 ? &search_regs : NULL),
328 ZV_BYTE - BEGV_BYTE);
329 immediate_quit = 0;
331 if (i == -2)
332 matcher_overflow ();
334 val = (0 <= i ? Qt : Qnil);
335 if (NILP (Vinhibit_changing_match_data) && i >= 0)
336 for (i = 0; i < search_regs.num_regs; i++)
337 if (search_regs.start[i] >= 0)
339 search_regs.start[i]
340 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
341 search_regs.end[i]
342 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
345 /* Set last_thing_searched only when match data is changed. */
346 if (NILP (Vinhibit_changing_match_data))
347 XSETBUFFER (last_thing_searched, current_buffer);
349 return val;
352 DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0,
353 doc: /* Return t if text after point matches regular expression REGEXP.
354 This function modifies the match data that `match-beginning',
355 `match-end' and `match-data' access; save and restore the match
356 data if you want to preserve them. */)
357 (Lisp_Object regexp)
359 return looking_at_1 (regexp, 0);
362 DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0,
363 doc: /* Return t if text after point matches regular expression REGEXP.
364 Find the longest match, in accord with Posix regular expression rules.
365 This function modifies the match data that `match-beginning',
366 `match-end' and `match-data' access; save and restore the match
367 data if you want to preserve them. */)
368 (Lisp_Object regexp)
370 return looking_at_1 (regexp, 1);
373 static Lisp_Object
374 string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, int posix)
376 int val;
377 struct re_pattern_buffer *bufp;
378 EMACS_INT pos, pos_byte;
379 int i;
381 if (running_asynch_code)
382 save_search_regs ();
384 CHECK_STRING (regexp);
385 CHECK_STRING (string);
387 if (NILP (start))
388 pos = 0, pos_byte = 0;
389 else
391 EMACS_INT len = SCHARS (string);
393 CHECK_NUMBER (start);
394 pos = XINT (start);
395 if (pos < 0 && -pos <= len)
396 pos = len + pos;
397 else if (0 > pos || pos > len)
398 args_out_of_range (string, start);
399 pos_byte = string_char_to_byte (string, pos);
402 /* This is so set_image_of_range_1 in regex.c can find the EQV table. */
403 XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2]
404 = BVAR (current_buffer, case_eqv_table);
406 bufp = compile_pattern (regexp,
407 (NILP (Vinhibit_changing_match_data)
408 ? &search_regs : NULL),
409 (!NILP (BVAR (current_buffer, case_fold_search))
410 ? BVAR (current_buffer, case_canon_table) : Qnil),
411 posix,
412 STRING_MULTIBYTE (string));
413 immediate_quit = 1;
414 re_match_object = string;
416 val = re_search (bufp, SSDATA (string),
417 SBYTES (string), pos_byte,
418 SBYTES (string) - pos_byte,
419 (NILP (Vinhibit_changing_match_data)
420 ? &search_regs : NULL));
421 immediate_quit = 0;
423 /* Set last_thing_searched only when match data is changed. */
424 if (NILP (Vinhibit_changing_match_data))
425 last_thing_searched = Qt;
427 if (val == -2)
428 matcher_overflow ();
429 if (val < 0) return Qnil;
431 if (NILP (Vinhibit_changing_match_data))
432 for (i = 0; i < search_regs.num_regs; i++)
433 if (search_regs.start[i] >= 0)
435 search_regs.start[i]
436 = string_byte_to_char (string, search_regs.start[i]);
437 search_regs.end[i]
438 = string_byte_to_char (string, search_regs.end[i]);
441 return make_number (string_byte_to_char (string, val));
444 DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0,
445 doc: /* Return index of start of first match for REGEXP in STRING, or nil.
446 Matching ignores case if `case-fold-search' is non-nil.
447 If third arg START is non-nil, start search at that index in STRING.
448 For index of first char beyond the match, do (match-end 0).
449 `match-end' and `match-beginning' also give indices of substrings
450 matched by parenthesis constructs in the pattern.
452 You can use the function `match-string' to extract the substrings
453 matched by the parenthesis constructions in REGEXP. */)
454 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start)
456 return string_match_1 (regexp, string, start, 0);
459 DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0,
460 doc: /* Return index of start of first match for REGEXP in STRING, or nil.
461 Find the longest match, in accord with Posix regular expression rules.
462 Case is ignored if `case-fold-search' is non-nil in the current buffer.
463 If third arg START is non-nil, start search at that index in STRING.
464 For index of first char beyond the match, do (match-end 0).
465 `match-end' and `match-beginning' also give indices of substrings
466 matched by parenthesis constructs in the pattern. */)
467 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start)
469 return string_match_1 (regexp, string, start, 1);
472 /* Match REGEXP against STRING, searching all of STRING,
473 and return the index of the match, or negative on failure.
474 This does not clobber the match data. */
477 fast_string_match (Lisp_Object regexp, Lisp_Object string)
479 int val;
480 struct re_pattern_buffer *bufp;
482 bufp = compile_pattern (regexp, 0, Qnil,
483 0, STRING_MULTIBYTE (string));
484 immediate_quit = 1;
485 re_match_object = string;
487 val = re_search (bufp, SSDATA (string),
488 SBYTES (string), 0,
489 SBYTES (string), 0);
490 immediate_quit = 0;
491 return val;
494 /* Match REGEXP against STRING, searching all of STRING ignoring case,
495 and return the index of the match, or negative on failure.
496 This does not clobber the match data.
497 We assume that STRING contains single-byte characters. */
500 fast_c_string_match_ignore_case (Lisp_Object regexp, const char *string)
502 int val;
503 struct re_pattern_buffer *bufp;
504 size_t len = strlen (string);
506 regexp = string_make_unibyte (regexp);
507 re_match_object = Qt;
508 bufp = compile_pattern (regexp, 0,
509 Vascii_canon_table, 0,
511 immediate_quit = 1;
512 val = re_search (bufp, string, len, 0, len, 0);
513 immediate_quit = 0;
514 return val;
517 /* Like fast_string_match but ignore case. */
520 fast_string_match_ignore_case (Lisp_Object regexp, Lisp_Object string)
522 int val;
523 struct re_pattern_buffer *bufp;
525 bufp = compile_pattern (regexp, 0, Vascii_canon_table,
526 0, STRING_MULTIBYTE (string));
527 immediate_quit = 1;
528 re_match_object = string;
530 val = re_search (bufp, SSDATA (string),
531 SBYTES (string), 0,
532 SBYTES (string), 0);
533 immediate_quit = 0;
534 return val;
537 /* Match REGEXP against the characters after POS to LIMIT, and return
538 the number of matched characters. If STRING is non-nil, match
539 against the characters in it. In that case, POS and LIMIT are
540 indices into the string. This function doesn't modify the match
541 data. */
543 EMACS_INT
544 fast_looking_at (Lisp_Object regexp, EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT limit, EMACS_INT limit_byte, Lisp_Object string)
546 int multibyte;
547 struct re_pattern_buffer *buf;
548 unsigned char *p1, *p2;
549 EMACS_INT s1, s2;
550 EMACS_INT len;
552 if (STRINGP (string))
554 if (pos_byte < 0)
555 pos_byte = string_char_to_byte (string, pos);
556 if (limit_byte < 0)
557 limit_byte = string_char_to_byte (string, limit);
558 p1 = NULL;
559 s1 = 0;
560 p2 = SDATA (string);
561 s2 = SBYTES (string);
562 re_match_object = string;
563 multibyte = STRING_MULTIBYTE (string);
565 else
567 if (pos_byte < 0)
568 pos_byte = CHAR_TO_BYTE (pos);
569 if (limit_byte < 0)
570 limit_byte = CHAR_TO_BYTE (limit);
571 pos_byte -= BEGV_BYTE;
572 limit_byte -= BEGV_BYTE;
573 p1 = BEGV_ADDR;
574 s1 = GPT_BYTE - BEGV_BYTE;
575 p2 = GAP_END_ADDR;
576 s2 = ZV_BYTE - GPT_BYTE;
577 if (s1 < 0)
579 p2 = p1;
580 s2 = ZV_BYTE - BEGV_BYTE;
581 s1 = 0;
583 if (s2 < 0)
585 s1 = ZV_BYTE - BEGV_BYTE;
586 s2 = 0;
588 re_match_object = Qnil;
589 multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
592 buf = compile_pattern (regexp, 0, Qnil, 0, multibyte);
593 immediate_quit = 1;
594 len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2,
595 pos_byte, NULL, limit_byte);
596 immediate_quit = 0;
598 return len;
602 /* The newline cache: remembering which sections of text have no newlines. */
604 /* If the user has requested newline caching, make sure it's on.
605 Otherwise, make sure it's off.
606 This is our cheezy way of associating an action with the change of
607 state of a buffer-local variable. */
608 static void
609 newline_cache_on_off (struct buffer *buf)
611 if (NILP (BVAR (buf, cache_long_line_scans)))
613 /* It should be off. */
614 if (buf->newline_cache)
616 free_region_cache (buf->newline_cache);
617 buf->newline_cache = 0;
620 else
622 /* It should be on. */
623 if (buf->newline_cache == 0)
624 buf->newline_cache = new_region_cache ();
629 /* Search for COUNT instances of the character TARGET between START and END.
631 If COUNT is positive, search forwards; END must be >= START.
632 If COUNT is negative, search backwards for the -COUNTth instance;
633 END must be <= START.
634 If COUNT is zero, do anything you please; run rogue, for all I care.
636 If END is zero, use BEGV or ZV instead, as appropriate for the
637 direction indicated by COUNT.
639 If we find COUNT instances, set *SHORTAGE to zero, and return the
640 position past the COUNTth match. Note that for reverse motion
641 this is not the same as the usual convention for Emacs motion commands.
643 If we don't find COUNT instances before reaching END, set *SHORTAGE
644 to the number of TARGETs left unfound, and return END.
646 If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do
647 except when inside redisplay. */
649 EMACS_INT
650 scan_buffer (register int target, EMACS_INT start, EMACS_INT end,
651 EMACS_INT count, int *shortage, int allow_quit)
653 struct region_cache *newline_cache;
654 int direction;
656 if (count > 0)
658 direction = 1;
659 if (! end) end = ZV;
661 else
663 direction = -1;
664 if (! end) end = BEGV;
667 newline_cache_on_off (current_buffer);
668 newline_cache = current_buffer->newline_cache;
670 if (shortage != 0)
671 *shortage = 0;
673 immediate_quit = allow_quit;
675 if (count > 0)
676 while (start != end)
678 /* Our innermost scanning loop is very simple; it doesn't know
679 about gaps, buffer ends, or the newline cache. ceiling is
680 the position of the last character before the next such
681 obstacle --- the last character the dumb search loop should
682 examine. */
683 EMACS_INT ceiling_byte = CHAR_TO_BYTE (end) - 1;
684 EMACS_INT start_byte = CHAR_TO_BYTE (start);
685 EMACS_INT tem;
687 /* If we're looking for a newline, consult the newline cache
688 to see where we can avoid some scanning. */
689 if (target == '\n' && newline_cache)
691 EMACS_INT next_change;
692 immediate_quit = 0;
693 while (region_cache_forward
694 (current_buffer, newline_cache, start_byte, &next_change))
695 start_byte = next_change;
696 immediate_quit = allow_quit;
698 /* START should never be after END. */
699 if (start_byte > ceiling_byte)
700 start_byte = ceiling_byte;
702 /* Now the text after start is an unknown region, and
703 next_change is the position of the next known region. */
704 ceiling_byte = min (next_change - 1, ceiling_byte);
707 /* The dumb loop can only scan text stored in contiguous
708 bytes. BUFFER_CEILING_OF returns the last character
709 position that is contiguous, so the ceiling is the
710 position after that. */
711 tem = BUFFER_CEILING_OF (start_byte);
712 ceiling_byte = min (tem, ceiling_byte);
715 /* The termination address of the dumb loop. */
716 register unsigned char *ceiling_addr
717 = BYTE_POS_ADDR (ceiling_byte) + 1;
718 register unsigned char *cursor
719 = BYTE_POS_ADDR (start_byte);
720 unsigned char *base = cursor;
722 while (cursor < ceiling_addr)
724 unsigned char *scan_start = cursor;
726 /* The dumb loop. */
727 while (*cursor != target && ++cursor < ceiling_addr)
730 /* If we're looking for newlines, cache the fact that
731 the region from start to cursor is free of them. */
732 if (target == '\n' && newline_cache)
733 know_region_cache (current_buffer, newline_cache,
734 start_byte + scan_start - base,
735 start_byte + cursor - base);
737 /* Did we find the target character? */
738 if (cursor < ceiling_addr)
740 if (--count == 0)
742 immediate_quit = 0;
743 return BYTE_TO_CHAR (start_byte + cursor - base + 1);
745 cursor++;
749 start = BYTE_TO_CHAR (start_byte + cursor - base);
752 else
753 while (start > end)
755 /* The last character to check before the next obstacle. */
756 EMACS_INT ceiling_byte = CHAR_TO_BYTE (end);
757 EMACS_INT start_byte = CHAR_TO_BYTE (start);
758 EMACS_INT tem;
760 /* Consult the newline cache, if appropriate. */
761 if (target == '\n' && newline_cache)
763 EMACS_INT next_change;
764 immediate_quit = 0;
765 while (region_cache_backward
766 (current_buffer, newline_cache, start_byte, &next_change))
767 start_byte = next_change;
768 immediate_quit = allow_quit;
770 /* Start should never be at or before end. */
771 if (start_byte <= ceiling_byte)
772 start_byte = ceiling_byte + 1;
774 /* Now the text before start is an unknown region, and
775 next_change is the position of the next known region. */
776 ceiling_byte = max (next_change, ceiling_byte);
779 /* Stop scanning before the gap. */
780 tem = BUFFER_FLOOR_OF (start_byte - 1);
781 ceiling_byte = max (tem, ceiling_byte);
784 /* The termination address of the dumb loop. */
785 register unsigned char *ceiling_addr = BYTE_POS_ADDR (ceiling_byte);
786 register unsigned char *cursor = BYTE_POS_ADDR (start_byte - 1);
787 unsigned char *base = cursor;
789 while (cursor >= ceiling_addr)
791 unsigned char *scan_start = cursor;
793 while (*cursor != target && --cursor >= ceiling_addr)
796 /* If we're looking for newlines, cache the fact that
797 the region from after the cursor to start is free of them. */
798 if (target == '\n' && newline_cache)
799 know_region_cache (current_buffer, newline_cache,
800 start_byte + cursor - base,
801 start_byte + scan_start - base);
803 /* Did we find the target character? */
804 if (cursor >= ceiling_addr)
806 if (++count >= 0)
808 immediate_quit = 0;
809 return BYTE_TO_CHAR (start_byte + cursor - base);
811 cursor--;
815 start = BYTE_TO_CHAR (start_byte + cursor - base);
819 immediate_quit = 0;
820 if (shortage != 0)
821 *shortage = count * direction;
822 return start;
825 /* Search for COUNT instances of a line boundary, which means either a
826 newline or (if selective display enabled) a carriage return.
827 Start at START. If COUNT is negative, search backwards.
829 We report the resulting position by calling TEMP_SET_PT_BOTH.
831 If we find COUNT instances. we position after (always after,
832 even if scanning backwards) the COUNTth match, and return 0.
834 If we don't find COUNT instances before reaching the end of the
835 buffer (or the beginning, if scanning backwards), we return
836 the number of line boundaries left unfound, and position at
837 the limit we bumped up against.
839 If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do
840 except in special cases. */
842 EMACS_INT
843 scan_newline (EMACS_INT start, EMACS_INT start_byte,
844 EMACS_INT limit, EMACS_INT limit_byte,
845 register EMACS_INT count, int allow_quit)
847 int direction = ((count > 0) ? 1 : -1);
849 register unsigned char *cursor;
850 unsigned char *base;
852 EMACS_INT ceiling;
853 register unsigned char *ceiling_addr;
855 int old_immediate_quit = immediate_quit;
857 /* The code that follows is like scan_buffer
858 but checks for either newline or carriage return. */
860 if (allow_quit)
861 immediate_quit++;
863 start_byte = CHAR_TO_BYTE (start);
865 if (count > 0)
867 while (start_byte < limit_byte)
869 ceiling = BUFFER_CEILING_OF (start_byte);
870 ceiling = min (limit_byte - 1, ceiling);
871 ceiling_addr = BYTE_POS_ADDR (ceiling) + 1;
872 base = (cursor = BYTE_POS_ADDR (start_byte));
873 while (1)
875 while (*cursor != '\n' && ++cursor != ceiling_addr)
878 if (cursor != ceiling_addr)
880 if (--count == 0)
882 immediate_quit = old_immediate_quit;
883 start_byte = start_byte + cursor - base + 1;
884 start = BYTE_TO_CHAR (start_byte);
885 TEMP_SET_PT_BOTH (start, start_byte);
886 return 0;
888 else
889 if (++cursor == ceiling_addr)
890 break;
892 else
893 break;
895 start_byte += cursor - base;
898 else
900 while (start_byte > limit_byte)
902 ceiling = BUFFER_FLOOR_OF (start_byte - 1);
903 ceiling = max (limit_byte, ceiling);
904 ceiling_addr = BYTE_POS_ADDR (ceiling) - 1;
905 base = (cursor = BYTE_POS_ADDR (start_byte - 1) + 1);
906 while (1)
908 while (--cursor != ceiling_addr && *cursor != '\n')
911 if (cursor != ceiling_addr)
913 if (++count == 0)
915 immediate_quit = old_immediate_quit;
916 /* Return the position AFTER the match we found. */
917 start_byte = start_byte + cursor - base + 1;
918 start = BYTE_TO_CHAR (start_byte);
919 TEMP_SET_PT_BOTH (start, start_byte);
920 return 0;
923 else
924 break;
926 /* Here we add 1 to compensate for the last decrement
927 of CURSOR, which took it past the valid range. */
928 start_byte += cursor - base + 1;
932 TEMP_SET_PT_BOTH (limit, limit_byte);
933 immediate_quit = old_immediate_quit;
935 return count * direction;
938 EMACS_INT
939 find_next_newline_no_quit (EMACS_INT from, EMACS_INT cnt)
941 return scan_buffer ('\n', from, 0, cnt, (int *) 0, 0);
944 /* Like find_next_newline, but returns position before the newline,
945 not after, and only search up to TO. This isn't just
946 find_next_newline (...)-1, because you might hit TO. */
948 EMACS_INT
949 find_before_next_newline (EMACS_INT from, EMACS_INT to, EMACS_INT cnt)
951 int shortage;
952 EMACS_INT pos = scan_buffer ('\n', from, to, cnt, &shortage, 1);
954 if (shortage == 0)
955 pos--;
957 return pos;
960 /* Subroutines of Lisp buffer search functions. */
962 static Lisp_Object
963 search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
964 Lisp_Object count, int direction, int RE, int posix)
966 register int np;
967 EMACS_INT lim, lim_byte;
968 int n = direction;
970 if (!NILP (count))
972 CHECK_NUMBER (count);
973 n *= XINT (count);
976 CHECK_STRING (string);
977 if (NILP (bound))
979 if (n > 0)
980 lim = ZV, lim_byte = ZV_BYTE;
981 else
982 lim = BEGV, lim_byte = BEGV_BYTE;
984 else
986 CHECK_NUMBER_COERCE_MARKER (bound);
987 lim = XINT (bound);
988 if (n > 0 ? lim < PT : lim > PT)
989 error ("Invalid search bound (wrong side of point)");
990 if (lim > ZV)
991 lim = ZV, lim_byte = ZV_BYTE;
992 else if (lim < BEGV)
993 lim = BEGV, lim_byte = BEGV_BYTE;
994 else
995 lim_byte = CHAR_TO_BYTE (lim);
998 /* This is so set_image_of_range_1 in regex.c can find the EQV table. */
999 XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2]
1000 = BVAR (current_buffer, case_eqv_table);
1002 np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE,
1003 (!NILP (BVAR (current_buffer, case_fold_search))
1004 ? BVAR (current_buffer, case_canon_table)
1005 : Qnil),
1006 (!NILP (BVAR (current_buffer, case_fold_search))
1007 ? BVAR (current_buffer, case_eqv_table)
1008 : Qnil),
1009 posix);
1010 if (np <= 0)
1012 if (NILP (noerror))
1013 xsignal1 (Qsearch_failed, string);
1015 if (!EQ (noerror, Qt))
1017 if (lim < BEGV || lim > ZV)
1018 abort ();
1019 SET_PT_BOTH (lim, lim_byte);
1020 return Qnil;
1021 #if 0 /* This would be clean, but maybe programs depend on
1022 a value of nil here. */
1023 np = lim;
1024 #endif
1026 else
1027 return Qnil;
1030 if (np < BEGV || np > ZV)
1031 abort ();
1033 SET_PT (np);
1035 return make_number (np);
1038 /* Return 1 if REGEXP it matches just one constant string. */
1040 static int
1041 trivial_regexp_p (Lisp_Object regexp)
1043 EMACS_INT len = SBYTES (regexp);
1044 unsigned char *s = SDATA (regexp);
1045 while (--len >= 0)
1047 switch (*s++)
1049 case '.': case '*': case '+': case '?': case '[': case '^': case '$':
1050 return 0;
1051 case '\\':
1052 if (--len < 0)
1053 return 0;
1054 switch (*s++)
1056 case '|': case '(': case ')': case '`': case '\'': case 'b':
1057 case 'B': case '<': case '>': case 'w': case 'W': case 's':
1058 case 'S': case '=': case '{': case '}': case '_':
1059 case 'c': case 'C': /* for categoryspec and notcategoryspec */
1060 case '1': case '2': case '3': case '4': case '5':
1061 case '6': case '7': case '8': case '9':
1062 return 0;
1066 return 1;
1069 /* Search for the n'th occurrence of STRING in the current buffer,
1070 starting at position POS and stopping at position LIM,
1071 treating STRING as a literal string if RE is false or as
1072 a regular expression if RE is true.
1074 If N is positive, searching is forward and LIM must be greater than POS.
1075 If N is negative, searching is backward and LIM must be less than POS.
1077 Returns -x if x occurrences remain to be found (x > 0),
1078 or else the position at the beginning of the Nth occurrence
1079 (if searching backward) or the end (if searching forward).
1081 POSIX is nonzero if we want full backtracking (POSIX style)
1082 for this pattern. 0 means backtrack only enough to get a valid match. */
1084 #define TRANSLATE(out, trt, d) \
1085 do \
1087 if (! NILP (trt)) \
1089 Lisp_Object temp; \
1090 temp = Faref (trt, make_number (d)); \
1091 if (INTEGERP (temp)) \
1092 out = XINT (temp); \
1093 else \
1094 out = d; \
1096 else \
1097 out = d; \
1099 while (0)
1101 /* Only used in search_buffer, to record the end position of the match
1102 when searching regexps and SEARCH_REGS should not be changed
1103 (i.e. Vinhibit_changing_match_data is non-nil). */
1104 static struct re_registers search_regs_1;
1106 static EMACS_INT
1107 search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
1108 EMACS_INT lim, EMACS_INT lim_byte, EMACS_INT n,
1109 int RE, Lisp_Object trt, Lisp_Object inverse_trt, int posix)
1111 EMACS_INT len = SCHARS (string);
1112 EMACS_INT len_byte = SBYTES (string);
1113 register int i;
1115 if (running_asynch_code)
1116 save_search_regs ();
1118 /* Searching 0 times means don't move. */
1119 /* Null string is found at starting position. */
1120 if (len == 0 || n == 0)
1122 set_search_regs (pos_byte, 0);
1123 return pos;
1126 if (RE && !(trivial_regexp_p (string) && NILP (Vsearch_spaces_regexp)))
1128 unsigned char *p1, *p2;
1129 EMACS_INT s1, s2;
1130 struct re_pattern_buffer *bufp;
1132 bufp = compile_pattern (string,
1133 (NILP (Vinhibit_changing_match_data)
1134 ? &search_regs : &search_regs_1),
1135 trt, posix,
1136 !NILP (BVAR (current_buffer, enable_multibyte_characters)));
1138 immediate_quit = 1; /* Quit immediately if user types ^G,
1139 because letting this function finish
1140 can take too long. */
1141 QUIT; /* Do a pending quit right away,
1142 to avoid paradoxical behavior */
1143 /* Get pointers and sizes of the two strings
1144 that make up the visible portion of the buffer. */
1146 p1 = BEGV_ADDR;
1147 s1 = GPT_BYTE - BEGV_BYTE;
1148 p2 = GAP_END_ADDR;
1149 s2 = ZV_BYTE - GPT_BYTE;
1150 if (s1 < 0)
1152 p2 = p1;
1153 s2 = ZV_BYTE - BEGV_BYTE;
1154 s1 = 0;
1156 if (s2 < 0)
1158 s1 = ZV_BYTE - BEGV_BYTE;
1159 s2 = 0;
1161 re_match_object = Qnil;
1163 while (n < 0)
1165 EMACS_INT val;
1166 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
1167 pos_byte - BEGV_BYTE, lim_byte - pos_byte,
1168 (NILP (Vinhibit_changing_match_data)
1169 ? &search_regs : &search_regs_1),
1170 /* Don't allow match past current point */
1171 pos_byte - BEGV_BYTE);
1172 if (val == -2)
1174 matcher_overflow ();
1176 if (val >= 0)
1178 if (NILP (Vinhibit_changing_match_data))
1180 pos_byte = search_regs.start[0] + BEGV_BYTE;
1181 for (i = 0; i < search_regs.num_regs; i++)
1182 if (search_regs.start[i] >= 0)
1184 search_regs.start[i]
1185 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
1186 search_regs.end[i]
1187 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
1189 XSETBUFFER (last_thing_searched, current_buffer);
1190 /* Set pos to the new position. */
1191 pos = search_regs.start[0];
1193 else
1195 pos_byte = search_regs_1.start[0] + BEGV_BYTE;
1196 /* Set pos to the new position. */
1197 pos = BYTE_TO_CHAR (search_regs_1.start[0] + BEGV_BYTE);
1200 else
1202 immediate_quit = 0;
1203 return (n);
1205 n++;
1207 while (n > 0)
1209 EMACS_INT val;
1210 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
1211 pos_byte - BEGV_BYTE, lim_byte - pos_byte,
1212 (NILP (Vinhibit_changing_match_data)
1213 ? &search_regs : &search_regs_1),
1214 lim_byte - BEGV_BYTE);
1215 if (val == -2)
1217 matcher_overflow ();
1219 if (val >= 0)
1221 if (NILP (Vinhibit_changing_match_data))
1223 pos_byte = search_regs.end[0] + BEGV_BYTE;
1224 for (i = 0; i < search_regs.num_regs; i++)
1225 if (search_regs.start[i] >= 0)
1227 search_regs.start[i]
1228 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
1229 search_regs.end[i]
1230 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
1232 XSETBUFFER (last_thing_searched, current_buffer);
1233 pos = search_regs.end[0];
1235 else
1237 pos_byte = search_regs_1.end[0] + BEGV_BYTE;
1238 pos = BYTE_TO_CHAR (search_regs_1.end[0] + BEGV_BYTE);
1241 else
1243 immediate_quit = 0;
1244 return (0 - n);
1246 n--;
1248 immediate_quit = 0;
1249 return (pos);
1251 else /* non-RE case */
1253 unsigned char *raw_pattern, *pat;
1254 EMACS_INT raw_pattern_size;
1255 EMACS_INT raw_pattern_size_byte;
1256 unsigned char *patbuf;
1257 int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
1258 unsigned char *base_pat;
1259 /* Set to positive if we find a non-ASCII char that need
1260 translation. Otherwise set to zero later. */
1261 int char_base = -1;
1262 int boyer_moore_ok = 1;
1264 /* MULTIBYTE says whether the text to be searched is multibyte.
1265 We must convert PATTERN to match that, or we will not really
1266 find things right. */
1268 if (multibyte == STRING_MULTIBYTE (string))
1270 raw_pattern = SDATA (string);
1271 raw_pattern_size = SCHARS (string);
1272 raw_pattern_size_byte = SBYTES (string);
1274 else if (multibyte)
1276 raw_pattern_size = SCHARS (string);
1277 raw_pattern_size_byte
1278 = count_size_as_multibyte (SDATA (string),
1279 raw_pattern_size);
1280 raw_pattern = (unsigned char *) alloca (raw_pattern_size_byte + 1);
1281 copy_text (SDATA (string), raw_pattern,
1282 SCHARS (string), 0, 1);
1284 else
1286 /* Converting multibyte to single-byte.
1288 ??? Perhaps this conversion should be done in a special way
1289 by subtracting nonascii-insert-offset from each non-ASCII char,
1290 so that only the multibyte chars which really correspond to
1291 the chosen single-byte character set can possibly match. */
1292 raw_pattern_size = SCHARS (string);
1293 raw_pattern_size_byte = SCHARS (string);
1294 raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
1295 copy_text (SDATA (string), raw_pattern,
1296 SBYTES (string), 1, 0);
1299 /* Copy and optionally translate the pattern. */
1300 len = raw_pattern_size;
1301 len_byte = raw_pattern_size_byte;
1302 patbuf = (unsigned char *) alloca (len * MAX_MULTIBYTE_LENGTH);
1303 pat = patbuf;
1304 base_pat = raw_pattern;
1305 if (multibyte)
1307 /* Fill patbuf by translated characters in STRING while
1308 checking if we can use boyer-moore search. If TRT is
1309 non-nil, we can use boyer-moore search only if TRT can be
1310 represented by the byte array of 256 elements. For that,
1311 all non-ASCII case-equivalents of all case-senstive
1312 characters in STRING must belong to the same charset and
1313 row. */
1315 while (--len >= 0)
1317 unsigned char str_base[MAX_MULTIBYTE_LENGTH], *str;
1318 int c, translated, inverse;
1319 int in_charlen, charlen;
1321 /* If we got here and the RE flag is set, it's because we're
1322 dealing with a regexp known to be trivial, so the backslash
1323 just quotes the next character. */
1324 if (RE && *base_pat == '\\')
1326 len--;
1327 raw_pattern_size--;
1328 len_byte--;
1329 base_pat++;
1332 c = STRING_CHAR_AND_LENGTH (base_pat, in_charlen);
1334 if (NILP (trt))
1336 str = base_pat;
1337 charlen = in_charlen;
1339 else
1341 /* Translate the character. */
1342 TRANSLATE (translated, trt, c);
1343 charlen = CHAR_STRING (translated, str_base);
1344 str = str_base;
1346 /* Check if C has any other case-equivalents. */
1347 TRANSLATE (inverse, inverse_trt, c);
1348 /* If so, check if we can use boyer-moore. */
1349 if (c != inverse && boyer_moore_ok)
1351 /* Check if all equivalents belong to the same
1352 group of characters. Note that the check of C
1353 itself is done by the last iteration. */
1354 int this_char_base = -1;
1356 while (boyer_moore_ok)
1358 if (ASCII_BYTE_P (inverse))
1360 if (this_char_base > 0)
1361 boyer_moore_ok = 0;
1362 else
1363 this_char_base = 0;
1365 else if (CHAR_BYTE8_P (inverse))
1366 /* Boyer-moore search can't handle a
1367 translation of an eight-bit
1368 character. */
1369 boyer_moore_ok = 0;
1370 else if (this_char_base < 0)
1372 this_char_base = inverse & ~0x3F;
1373 if (char_base < 0)
1374 char_base = this_char_base;
1375 else if (this_char_base != char_base)
1376 boyer_moore_ok = 0;
1378 else if ((inverse & ~0x3F) != this_char_base)
1379 boyer_moore_ok = 0;
1380 if (c == inverse)
1381 break;
1382 TRANSLATE (inverse, inverse_trt, inverse);
1387 /* Store this character into the translated pattern. */
1388 memcpy (pat, str, charlen);
1389 pat += charlen;
1390 base_pat += in_charlen;
1391 len_byte -= in_charlen;
1394 /* If char_base is still negative we didn't find any translated
1395 non-ASCII characters. */
1396 if (char_base < 0)
1397 char_base = 0;
1399 else
1401 /* Unibyte buffer. */
1402 char_base = 0;
1403 while (--len >= 0)
1405 int c, translated;
1407 /* If we got here and the RE flag is set, it's because we're
1408 dealing with a regexp known to be trivial, so the backslash
1409 just quotes the next character. */
1410 if (RE && *base_pat == '\\')
1412 len--;
1413 raw_pattern_size--;
1414 base_pat++;
1416 c = *base_pat++;
1417 TRANSLATE (translated, trt, c);
1418 *pat++ = translated;
1422 len_byte = pat - patbuf;
1423 len = raw_pattern_size;
1424 pat = base_pat = patbuf;
1426 if (boyer_moore_ok)
1427 return boyer_moore (n, pat, len, len_byte, trt, inverse_trt,
1428 pos, pos_byte, lim, lim_byte,
1429 char_base);
1430 else
1431 return simple_search (n, pat, len, len_byte, trt,
1432 pos, pos_byte, lim, lim_byte);
1436 /* Do a simple string search N times for the string PAT,
1437 whose length is LEN/LEN_BYTE,
1438 from buffer position POS/POS_BYTE until LIM/LIM_BYTE.
1439 TRT is the translation table.
1441 Return the character position where the match is found.
1442 Otherwise, if M matches remained to be found, return -M.
1444 This kind of search works regardless of what is in PAT and
1445 regardless of what is in TRT. It is used in cases where
1446 boyer_moore cannot work. */
1448 static EMACS_INT
1449 simple_search (EMACS_INT n, unsigned char *pat,
1450 EMACS_INT len, EMACS_INT len_byte, Lisp_Object trt,
1451 EMACS_INT pos, EMACS_INT pos_byte,
1452 EMACS_INT lim, EMACS_INT lim_byte)
1454 int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
1455 int forward = n > 0;
1456 /* Number of buffer bytes matched. Note that this may be different
1457 from len_byte in a multibyte buffer. */
1458 EMACS_INT match_byte;
1460 if (lim > pos && multibyte)
1461 while (n > 0)
1463 while (1)
1465 /* Try matching at position POS. */
1466 EMACS_INT this_pos = pos;
1467 EMACS_INT this_pos_byte = pos_byte;
1468 EMACS_INT this_len = len;
1469 unsigned char *p = pat;
1470 if (pos + len > lim || pos_byte + len_byte > lim_byte)
1471 goto stop;
1473 while (this_len > 0)
1475 int charlen, buf_charlen;
1476 int pat_ch, buf_ch;
1478 pat_ch = STRING_CHAR_AND_LENGTH (p, charlen);
1479 buf_ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (this_pos_byte),
1480 buf_charlen);
1481 TRANSLATE (buf_ch, trt, buf_ch);
1483 if (buf_ch != pat_ch)
1484 break;
1486 this_len--;
1487 p += charlen;
1489 this_pos_byte += buf_charlen;
1490 this_pos++;
1493 if (this_len == 0)
1495 match_byte = this_pos_byte - pos_byte;
1496 pos += len;
1497 pos_byte += match_byte;
1498 break;
1501 INC_BOTH (pos, pos_byte);
1504 n--;
1506 else if (lim > pos)
1507 while (n > 0)
1509 while (1)
1511 /* Try matching at position POS. */
1512 EMACS_INT this_pos = pos;
1513 EMACS_INT this_len = len;
1514 unsigned char *p = pat;
1516 if (pos + len > lim)
1517 goto stop;
1519 while (this_len > 0)
1521 int pat_ch = *p++;
1522 int buf_ch = FETCH_BYTE (this_pos);
1523 TRANSLATE (buf_ch, trt, buf_ch);
1525 if (buf_ch != pat_ch)
1526 break;
1528 this_len--;
1529 this_pos++;
1532 if (this_len == 0)
1534 match_byte = len;
1535 pos += len;
1536 break;
1539 pos++;
1542 n--;
1544 /* Backwards search. */
1545 else if (lim < pos && multibyte)
1546 while (n < 0)
1548 while (1)
1550 /* Try matching at position POS. */
1551 EMACS_INT this_pos = pos;
1552 EMACS_INT this_pos_byte = pos_byte;
1553 EMACS_INT this_len = len;
1554 const unsigned char *p = pat + len_byte;
1556 if (this_pos - len < lim || (pos_byte - len_byte) < lim_byte)
1557 goto stop;
1559 while (this_len > 0)
1561 int charlen;
1562 int pat_ch, buf_ch;
1564 DEC_BOTH (this_pos, this_pos_byte);
1565 PREV_CHAR_BOUNDARY (p, pat);
1566 pat_ch = STRING_CHAR (p);
1567 buf_ch = STRING_CHAR (BYTE_POS_ADDR (this_pos_byte));
1568 TRANSLATE (buf_ch, trt, buf_ch);
1570 if (buf_ch != pat_ch)
1571 break;
1573 this_len--;
1576 if (this_len == 0)
1578 match_byte = pos_byte - this_pos_byte;
1579 pos = this_pos;
1580 pos_byte = this_pos_byte;
1581 break;
1584 DEC_BOTH (pos, pos_byte);
1587 n++;
1589 else if (lim < pos)
1590 while (n < 0)
1592 while (1)
1594 /* Try matching at position POS. */
1595 EMACS_INT this_pos = pos - len;
1596 EMACS_INT this_len = len;
1597 unsigned char *p = pat;
1599 if (this_pos < lim)
1600 goto stop;
1602 while (this_len > 0)
1604 int pat_ch = *p++;
1605 int buf_ch = FETCH_BYTE (this_pos);
1606 TRANSLATE (buf_ch, trt, buf_ch);
1608 if (buf_ch != pat_ch)
1609 break;
1610 this_len--;
1611 this_pos++;
1614 if (this_len == 0)
1616 match_byte = len;
1617 pos -= len;
1618 break;
1621 pos--;
1624 n++;
1627 stop:
1628 if (n == 0)
1630 if (forward)
1631 set_search_regs ((multibyte ? pos_byte : pos) - match_byte, match_byte);
1632 else
1633 set_search_regs (multibyte ? pos_byte : pos, match_byte);
1635 return pos;
1637 else if (n > 0)
1638 return -n;
1639 else
1640 return n;
1643 /* Do Boyer-Moore search N times for the string BASE_PAT,
1644 whose length is LEN/LEN_BYTE,
1645 from buffer position POS/POS_BYTE until LIM/LIM_BYTE.
1646 DIRECTION says which direction we search in.
1647 TRT and INVERSE_TRT are translation tables.
1648 Characters in PAT are already translated by TRT.
1650 This kind of search works if all the characters in BASE_PAT that
1651 have nontrivial translation are the same aside from the last byte.
1652 This makes it possible to translate just the last byte of a
1653 character, and do so after just a simple test of the context.
1654 CHAR_BASE is nonzero if there is such a non-ASCII character.
1656 If that criterion is not satisfied, do not call this function. */
1658 static EMACS_INT
1659 boyer_moore (EMACS_INT n, unsigned char *base_pat,
1660 EMACS_INT len, EMACS_INT len_byte,
1661 Lisp_Object trt, Lisp_Object inverse_trt,
1662 EMACS_INT pos, EMACS_INT pos_byte,
1663 EMACS_INT lim, EMACS_INT lim_byte, int char_base)
1665 int direction = ((n > 0) ? 1 : -1);
1666 register EMACS_INT dirlen;
1667 EMACS_INT limit;
1668 int stride_for_teases = 0;
1669 int BM_tab[0400];
1670 register unsigned char *cursor, *p_limit;
1671 register EMACS_INT i;
1672 register int j;
1673 unsigned char *pat, *pat_end;
1674 int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
1676 unsigned char simple_translate[0400];
1677 /* These are set to the preceding bytes of a byte to be translated
1678 if char_base is nonzero. As the maximum byte length of a
1679 multibyte character is 5, we have to check at most four previous
1680 bytes. */
1681 int translate_prev_byte1 = 0;
1682 int translate_prev_byte2 = 0;
1683 int translate_prev_byte3 = 0;
1684 int translate_prev_byte4 = 0;
1686 /* The general approach is that we are going to maintain that we know
1687 the first (closest to the present position, in whatever direction
1688 we're searching) character that could possibly be the last
1689 (furthest from present position) character of a valid match. We
1690 advance the state of our knowledge by looking at that character
1691 and seeing whether it indeed matches the last character of the
1692 pattern. If it does, we take a closer look. If it does not, we
1693 move our pointer (to putative last characters) as far as is
1694 logically possible. This amount of movement, which I call a
1695 stride, will be the length of the pattern if the actual character
1696 appears nowhere in the pattern, otherwise it will be the distance
1697 from the last occurrence of that character to the end of the
1698 pattern. If the amount is zero we have a possible match. */
1700 /* Here we make a "mickey mouse" BM table. The stride of the search
1701 is determined only by the last character of the putative match.
1702 If that character does not match, we will stride the proper
1703 distance to propose a match that superimposes it on the last
1704 instance of a character that matches it (per trt), or misses
1705 it entirely if there is none. */
1707 dirlen = len_byte * direction;
1709 /* Record position after the end of the pattern. */
1710 pat_end = base_pat + len_byte;
1711 /* BASE_PAT points to a character that we start scanning from.
1712 It is the first character in a forward search,
1713 the last character in a backward search. */
1714 if (direction < 0)
1715 base_pat = pat_end - 1;
1717 /* A character that does not appear in the pattern induces a
1718 stride equal to the pattern length. */
1719 for (i = 0; i < 0400; i++)
1720 BM_tab[i] = dirlen;
1722 /* We use this for translation, instead of TRT itself.
1723 We fill this in to handle the characters that actually
1724 occur in the pattern. Others don't matter anyway! */
1725 for (i = 0; i < 0400; i++)
1726 simple_translate[i] = i;
1728 if (char_base)
1730 /* Setup translate_prev_byte1/2/3/4 from CHAR_BASE. Only a
1731 byte following them are the target of translation. */
1732 unsigned char str[MAX_MULTIBYTE_LENGTH];
1733 int len = CHAR_STRING (char_base, str);
1735 translate_prev_byte1 = str[len - 2];
1736 if (len > 2)
1738 translate_prev_byte2 = str[len - 3];
1739 if (len > 3)
1741 translate_prev_byte3 = str[len - 4];
1742 if (len > 4)
1743 translate_prev_byte4 = str[len - 5];
1748 i = 0;
1749 while (i != dirlen)
1751 unsigned char *ptr = base_pat + i;
1752 i += direction;
1753 if (! NILP (trt))
1755 /* If the byte currently looking at is the last of a
1756 character to check case-equivalents, set CH to that
1757 character. An ASCII character and a non-ASCII character
1758 matching with CHAR_BASE are to be checked. */
1759 int ch = -1;
1761 if (ASCII_BYTE_P (*ptr) || ! multibyte)
1762 ch = *ptr;
1763 else if (char_base
1764 && ((pat_end - ptr) == 1 || CHAR_HEAD_P (ptr[1])))
1766 unsigned char *charstart = ptr - 1;
1768 while (! (CHAR_HEAD_P (*charstart)))
1769 charstart--;
1770 ch = STRING_CHAR (charstart);
1771 if (char_base != (ch & ~0x3F))
1772 ch = -1;
1775 if (ch >= 0200)
1776 j = (ch & 0x3F) | 0200;
1777 else
1778 j = *ptr;
1780 if (i == dirlen)
1781 stride_for_teases = BM_tab[j];
1783 BM_tab[j] = dirlen - i;
1784 /* A translation table is accompanied by its inverse -- see */
1785 /* comment following downcase_table for details */
1786 if (ch >= 0)
1788 int starting_ch = ch;
1789 int starting_j = j;
1791 while (1)
1793 TRANSLATE (ch, inverse_trt, ch);
1794 if (ch >= 0200)
1795 j = (ch & 0x3F) | 0200;
1796 else
1797 j = ch;
1799 /* For all the characters that map into CH,
1800 set up simple_translate to map the last byte
1801 into STARTING_J. */
1802 simple_translate[j] = starting_j;
1803 if (ch == starting_ch)
1804 break;
1805 BM_tab[j] = dirlen - i;
1809 else
1811 j = *ptr;
1813 if (i == dirlen)
1814 stride_for_teases = BM_tab[j];
1815 BM_tab[j] = dirlen - i;
1817 /* stride_for_teases tells how much to stride if we get a
1818 match on the far character but are subsequently
1819 disappointed, by recording what the stride would have been
1820 for that character if the last character had been
1821 different. */
1823 pos_byte += dirlen - ((direction > 0) ? direction : 0);
1824 /* loop invariant - POS_BYTE points at where last char (first
1825 char if reverse) of pattern would align in a possible match. */
1826 while (n != 0)
1828 EMACS_INT tail_end;
1829 unsigned char *tail_end_ptr;
1831 /* It's been reported that some (broken) compiler thinks that
1832 Boolean expressions in an arithmetic context are unsigned.
1833 Using an explicit ?1:0 prevents this. */
1834 if ((lim_byte - pos_byte - ((direction > 0) ? 1 : 0)) * direction
1835 < 0)
1836 return (n * (0 - direction));
1837 /* First we do the part we can by pointers (maybe nothing) */
1838 QUIT;
1839 pat = base_pat;
1840 limit = pos_byte - dirlen + direction;
1841 if (direction > 0)
1843 limit = BUFFER_CEILING_OF (limit);
1844 /* LIMIT is now the last (not beyond-last!) value POS_BYTE
1845 can take on without hitting edge of buffer or the gap. */
1846 limit = min (limit, pos_byte + 20000);
1847 limit = min (limit, lim_byte - 1);
1849 else
1851 limit = BUFFER_FLOOR_OF (limit);
1852 /* LIMIT is now the last (not beyond-last!) value POS_BYTE
1853 can take on without hitting edge of buffer or the gap. */
1854 limit = max (limit, pos_byte - 20000);
1855 limit = max (limit, lim_byte);
1857 tail_end = BUFFER_CEILING_OF (pos_byte) + 1;
1858 tail_end_ptr = BYTE_POS_ADDR (tail_end);
1860 if ((limit - pos_byte) * direction > 20)
1862 unsigned char *p2;
1864 p_limit = BYTE_POS_ADDR (limit);
1865 p2 = (cursor = BYTE_POS_ADDR (pos_byte));
1866 /* In this loop, pos + cursor - p2 is the surrogate for pos. */
1867 while (1) /* use one cursor setting as long as i can */
1869 if (direction > 0) /* worth duplicating */
1871 while (cursor <= p_limit)
1873 if (BM_tab[*cursor] == 0)
1874 goto hit;
1875 cursor += BM_tab[*cursor];
1878 else
1880 while (cursor >= p_limit)
1882 if (BM_tab[*cursor] == 0)
1883 goto hit;
1884 cursor += BM_tab[*cursor];
1887 /* If you are here, cursor is beyond the end of the
1888 searched region. You fail to match within the
1889 permitted region and would otherwise try a character
1890 beyond that region. */
1891 break;
1893 hit:
1894 i = dirlen - direction;
1895 if (! NILP (trt))
1897 while ((i -= direction) + direction != 0)
1899 int ch;
1900 cursor -= direction;
1901 /* Translate only the last byte of a character. */
1902 if (! multibyte
1903 || ((cursor == tail_end_ptr
1904 || CHAR_HEAD_P (cursor[1]))
1905 && (CHAR_HEAD_P (cursor[0])
1906 /* Check if this is the last byte of
1907 a translable character. */
1908 || (translate_prev_byte1 == cursor[-1]
1909 && (CHAR_HEAD_P (translate_prev_byte1)
1910 || (translate_prev_byte2 == cursor[-2]
1911 && (CHAR_HEAD_P (translate_prev_byte2)
1912 || (translate_prev_byte3 == cursor[-3]))))))))
1913 ch = simple_translate[*cursor];
1914 else
1915 ch = *cursor;
1916 if (pat[i] != ch)
1917 break;
1920 else
1922 while ((i -= direction) + direction != 0)
1924 cursor -= direction;
1925 if (pat[i] != *cursor)
1926 break;
1929 cursor += dirlen - i - direction; /* fix cursor */
1930 if (i + direction == 0)
1932 EMACS_INT position, start, end;
1934 cursor -= direction;
1936 position = pos_byte + cursor - p2 + ((direction > 0)
1937 ? 1 - len_byte : 0);
1938 set_search_regs (position, len_byte);
1940 if (NILP (Vinhibit_changing_match_data))
1942 start = search_regs.start[0];
1943 end = search_regs.end[0];
1945 else
1946 /* If Vinhibit_changing_match_data is non-nil,
1947 search_regs will not be changed. So let's
1948 compute start and end here. */
1950 start = BYTE_TO_CHAR (position);
1951 end = BYTE_TO_CHAR (position + len_byte);
1954 if ((n -= direction) != 0)
1955 cursor += dirlen; /* to resume search */
1956 else
1957 return direction > 0 ? end : start;
1959 else
1960 cursor += stride_for_teases; /* <sigh> we lose - */
1962 pos_byte += cursor - p2;
1964 else
1965 /* Now we'll pick up a clump that has to be done the hard
1966 way because it covers a discontinuity. */
1968 limit = ((direction > 0)
1969 ? BUFFER_CEILING_OF (pos_byte - dirlen + 1)
1970 : BUFFER_FLOOR_OF (pos_byte - dirlen - 1));
1971 limit = ((direction > 0)
1972 ? min (limit + len_byte, lim_byte - 1)
1973 : max (limit - len_byte, lim_byte));
1974 /* LIMIT is now the last value POS_BYTE can have
1975 and still be valid for a possible match. */
1976 while (1)
1978 /* This loop can be coded for space rather than
1979 speed because it will usually run only once.
1980 (the reach is at most len + 21, and typically
1981 does not exceed len). */
1982 while ((limit - pos_byte) * direction >= 0)
1984 int ch = FETCH_BYTE (pos_byte);
1985 if (BM_tab[ch] == 0)
1986 goto hit2;
1987 pos_byte += BM_tab[ch];
1989 break; /* ran off the end */
1991 hit2:
1992 /* Found what might be a match. */
1993 i = dirlen - direction;
1994 while ((i -= direction) + direction != 0)
1996 int ch;
1997 unsigned char *ptr;
1998 pos_byte -= direction;
1999 ptr = BYTE_POS_ADDR (pos_byte);
2000 /* Translate only the last byte of a character. */
2001 if (! multibyte
2002 || ((ptr == tail_end_ptr
2003 || CHAR_HEAD_P (ptr[1]))
2004 && (CHAR_HEAD_P (ptr[0])
2005 /* Check if this is the last byte of a
2006 translable character. */
2007 || (translate_prev_byte1 == ptr[-1]
2008 && (CHAR_HEAD_P (translate_prev_byte1)
2009 || (translate_prev_byte2 == ptr[-2]
2010 && (CHAR_HEAD_P (translate_prev_byte2)
2011 || translate_prev_byte3 == ptr[-3])))))))
2012 ch = simple_translate[*ptr];
2013 else
2014 ch = *ptr;
2015 if (pat[i] != ch)
2016 break;
2018 /* Above loop has moved POS_BYTE part or all the way
2019 back to the first pos (last pos if reverse).
2020 Set it once again at the last (first if reverse) char. */
2021 pos_byte += dirlen - i - direction;
2022 if (i + direction == 0)
2024 EMACS_INT position, start, end;
2025 pos_byte -= direction;
2027 position = pos_byte + ((direction > 0) ? 1 - len_byte : 0);
2028 set_search_regs (position, len_byte);
2030 if (NILP (Vinhibit_changing_match_data))
2032 start = search_regs.start[0];
2033 end = search_regs.end[0];
2035 else
2036 /* If Vinhibit_changing_match_data is non-nil,
2037 search_regs will not be changed. So let's
2038 compute start and end here. */
2040 start = BYTE_TO_CHAR (position);
2041 end = BYTE_TO_CHAR (position + len_byte);
2044 if ((n -= direction) != 0)
2045 pos_byte += dirlen; /* to resume search */
2046 else
2047 return direction > 0 ? end : start;
2049 else
2050 pos_byte += stride_for_teases;
2053 /* We have done one clump. Can we continue? */
2054 if ((lim_byte - pos_byte) * direction < 0)
2055 return ((0 - n) * direction);
2057 return BYTE_TO_CHAR (pos_byte);
2060 /* Record beginning BEG_BYTE and end BEG_BYTE + NBYTES
2061 for the overall match just found in the current buffer.
2062 Also clear out the match data for registers 1 and up. */
2064 static void
2065 set_search_regs (EMACS_INT beg_byte, EMACS_INT nbytes)
2067 int i;
2069 if (!NILP (Vinhibit_changing_match_data))
2070 return;
2072 /* Make sure we have registers in which to store
2073 the match position. */
2074 if (search_regs.num_regs == 0)
2076 search_regs.start = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
2077 search_regs.end = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
2078 search_regs.num_regs = 2;
2081 /* Clear out the other registers. */
2082 for (i = 1; i < search_regs.num_regs; i++)
2084 search_regs.start[i] = -1;
2085 search_regs.end[i] = -1;
2088 search_regs.start[0] = BYTE_TO_CHAR (beg_byte);
2089 search_regs.end[0] = BYTE_TO_CHAR (beg_byte + nbytes);
2090 XSETBUFFER (last_thing_searched, current_buffer);
2093 /* Given STRING, a string of words separated by word delimiters,
2094 compute a regexp that matches those exact words separated by
2095 arbitrary punctuation. If LAX is nonzero, the end of the string
2096 need not match a word boundary unless it ends in whitespace. */
2098 static Lisp_Object
2099 wordify (Lisp_Object string, int lax)
2101 register unsigned char *p, *o;
2102 register EMACS_INT i, i_byte, len, punct_count = 0, word_count = 0;
2103 Lisp_Object val;
2104 int prev_c = 0;
2105 EMACS_INT adjust;
2106 int whitespace_at_end;
2108 CHECK_STRING (string);
2109 p = SDATA (string);
2110 len = SCHARS (string);
2112 for (i = 0, i_byte = 0; i < len; )
2114 int c;
2116 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
2118 if (SYNTAX (c) != Sword)
2120 punct_count++;
2121 if (i > 0 && SYNTAX (prev_c) == Sword)
2122 word_count++;
2125 prev_c = c;
2128 if (SYNTAX (prev_c) == Sword)
2130 word_count++;
2131 whitespace_at_end = 0;
2133 else
2134 whitespace_at_end = 1;
2136 if (!word_count)
2137 return empty_unibyte_string;
2139 adjust = - punct_count + 5 * (word_count - 1)
2140 + ((lax && !whitespace_at_end) ? 2 : 4);
2141 if (STRING_MULTIBYTE (string))
2142 val = make_uninit_multibyte_string (len + adjust,
2143 SBYTES (string)
2144 + adjust);
2145 else
2146 val = make_uninit_string (len + adjust);
2148 o = SDATA (val);
2149 *o++ = '\\';
2150 *o++ = 'b';
2151 prev_c = 0;
2153 for (i = 0, i_byte = 0; i < len; )
2155 int c;
2156 EMACS_INT i_byte_orig = i_byte;
2158 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
2160 if (SYNTAX (c) == Sword)
2162 memcpy (o, SDATA (string) + i_byte_orig, i_byte - i_byte_orig);
2163 o += i_byte - i_byte_orig;
2165 else if (i > 0 && SYNTAX (prev_c) == Sword && --word_count)
2167 *o++ = '\\';
2168 *o++ = 'W';
2169 *o++ = '\\';
2170 *o++ = 'W';
2171 *o++ = '*';
2174 prev_c = c;
2177 if (!lax || whitespace_at_end)
2179 *o++ = '\\';
2180 *o++ = 'b';
2183 return val;
2186 DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
2187 "MSearch backward: ",
2188 doc: /* Search backward from point for STRING.
2189 Set point to the beginning of the occurrence found, and return point.
2190 An optional second argument bounds the search; it is a buffer position.
2191 The match found must not extend before that position.
2192 Optional third argument, if t, means if fail just return nil (no error).
2193 If not nil and not t, position at limit of search and return nil.
2194 Optional fourth argument is repeat count--search for successive occurrences.
2196 Search case-sensitivity is determined by the value of the variable
2197 `case-fold-search', which see.
2199 See also the functions `match-beginning', `match-end' and `replace-match'. */)
2200 (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2202 return search_command (string, bound, noerror, count, -1, 0, 0);
2205 DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "MSearch: ",
2206 doc: /* Search forward from point for STRING.
2207 Set point to the end of the occurrence found, and return point.
2208 An optional second argument bounds the search; it is a buffer position.
2209 The match found must not extend after that position. A value of nil is
2210 equivalent to (point-max).
2211 Optional third argument, if t, means if fail just return nil (no error).
2212 If not nil and not t, move to limit of search and return nil.
2213 Optional fourth argument is repeat count--search for successive occurrences.
2215 Search case-sensitivity is determined by the value of the variable
2216 `case-fold-search', which see.
2218 See also the functions `match-beginning', `match-end' and `replace-match'. */)
2219 (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2221 return search_command (string, bound, noerror, count, 1, 0, 0);
2224 DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
2225 "sWord search backward: ",
2226 doc: /* Search backward from point for STRING, ignoring differences in punctuation.
2227 Set point to the beginning of the occurrence found, and return point.
2228 An optional second argument bounds the search; it is a buffer position.
2229 The match found must not extend before that position.
2230 Optional third argument, if t, means if fail just return nil (no error).
2231 If not nil and not t, move to limit of search and return nil.
2232 Optional fourth argument is repeat count--search for successive occurrences. */)
2233 (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2235 return search_command (wordify (string, 0), bound, noerror, count, -1, 1, 0);
2238 DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
2239 "sWord search: ",
2240 doc: /* Search forward from point for STRING, ignoring differences in punctuation.
2241 Set point to the end of the occurrence found, and return point.
2242 An optional second argument bounds the search; it is a buffer position.
2243 The match found must not extend after that position.
2244 Optional third argument, if t, means if fail just return nil (no error).
2245 If not nil and not t, move to limit of search and return nil.
2246 Optional fourth argument is repeat count--search for successive occurrences. */)
2247 (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2249 return search_command (wordify (string, 0), bound, noerror, count, 1, 1, 0);
2252 DEFUN ("word-search-backward-lax", Fword_search_backward_lax, Sword_search_backward_lax, 1, 4,
2253 "sWord search backward: ",
2254 doc: /* Search backward from point for STRING, ignoring differences in punctuation.
2255 Set point to the beginning of the occurrence found, and return point.
2257 Unlike `word-search-backward', the end of STRING need not match a word
2258 boundary unless it ends in whitespace.
2260 An optional second argument bounds the search; it is a buffer position.
2261 The match found must not extend before that position.
2262 Optional third argument, if t, means if fail just return nil (no error).
2263 If not nil and not t, move to limit of search and return nil.
2264 Optional fourth argument is repeat count--search for successive occurrences. */)
2265 (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2267 return search_command (wordify (string, 1), bound, noerror, count, -1, 1, 0);
2270 DEFUN ("word-search-forward-lax", Fword_search_forward_lax, Sword_search_forward_lax, 1, 4,
2271 "sWord search: ",
2272 doc: /* Search forward from point for STRING, ignoring differences in punctuation.
2273 Set point to the end of the occurrence found, and return point.
2275 Unlike `word-search-forward', the end of STRING need not match a word
2276 boundary unless it ends in whitespace.
2278 An optional second argument bounds the search; it is a buffer position.
2279 The match found must not extend after that position.
2280 Optional third argument, if t, means if fail just return nil (no error).
2281 If not nil and not t, move to limit of search and return nil.
2282 Optional fourth argument is repeat count--search for successive occurrences. */)
2283 (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2285 return search_command (wordify (string, 1), bound, noerror, count, 1, 1, 0);
2288 DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
2289 "sRE search backward: ",
2290 doc: /* Search backward from point for match for regular expression REGEXP.
2291 Set point to the beginning of the match, and return point.
2292 The match found is the one starting last in the buffer
2293 and yet ending before the origin of the search.
2294 An optional second argument bounds the search; it is a buffer position.
2295 The match found must start at or after that position.
2296 Optional third argument, if t, means if fail just return nil (no error).
2297 If not nil and not t, move to limit of search and return nil.
2298 Optional fourth argument is repeat count--search for successive occurrences.
2299 See also the functions `match-beginning', `match-end', `match-string',
2300 and `replace-match'. */)
2301 (Lisp_Object regexp, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2303 return search_command (regexp, bound, noerror, count, -1, 1, 0);
2306 DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4,
2307 "sRE search: ",
2308 doc: /* Search forward from point for regular expression REGEXP.
2309 Set point to the end of the occurrence found, and return point.
2310 An optional second argument bounds the search; it is a buffer position.
2311 The match found must not extend after that position.
2312 Optional third argument, if t, means if fail just return nil (no error).
2313 If not nil and not t, move to limit of search and return nil.
2314 Optional fourth argument is repeat count--search for successive occurrences.
2315 See also the functions `match-beginning', `match-end', `match-string',
2316 and `replace-match'. */)
2317 (Lisp_Object regexp, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2319 return search_command (regexp, bound, noerror, count, 1, 1, 0);
2322 DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, 1, 4,
2323 "sPosix search backward: ",
2324 doc: /* Search backward from point for match for regular expression REGEXP.
2325 Find the longest match in accord with Posix regular expression rules.
2326 Set point to the beginning of the match, and return point.
2327 The match found is the one starting last in the buffer
2328 and yet ending before the origin of the search.
2329 An optional second argument bounds the search; it is a buffer position.
2330 The match found must start at or after that position.
2331 Optional third argument, if t, means if fail just return nil (no error).
2332 If not nil and not t, move to limit of search and return nil.
2333 Optional fourth argument is repeat count--search for successive occurrences.
2334 See also the functions `match-beginning', `match-end', `match-string',
2335 and `replace-match'. */)
2336 (Lisp_Object regexp, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2338 return search_command (regexp, bound, noerror, count, -1, 1, 1);
2341 DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, 1, 4,
2342 "sPosix search: ",
2343 doc: /* Search forward from point for regular expression REGEXP.
2344 Find the longest match in accord with Posix regular expression rules.
2345 Set point to the end of the occurrence found, and return point.
2346 An optional second argument bounds the search; it is a buffer position.
2347 The match found must not extend after that position.
2348 Optional third argument, if t, means if fail just return nil (no error).
2349 If not nil and not t, move to limit of search and return nil.
2350 Optional fourth argument is repeat count--search for successive occurrences.
2351 See also the functions `match-beginning', `match-end', `match-string',
2352 and `replace-match'. */)
2353 (Lisp_Object regexp, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2355 return search_command (regexp, bound, noerror, count, 1, 1, 1);
2358 DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0,
2359 doc: /* Replace text matched by last search with NEWTEXT.
2360 Leave point at the end of the replacement text.
2362 If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
2363 Otherwise maybe capitalize the whole text, or maybe just word initials,
2364 based on the replaced text.
2365 If the replaced text has only capital letters
2366 and has at least one multiletter word, convert NEWTEXT to all caps.
2367 Otherwise if all words are capitalized in the replaced text,
2368 capitalize each word in NEWTEXT.
2370 If third arg LITERAL is non-nil, insert NEWTEXT literally.
2371 Otherwise treat `\\' as special:
2372 `\\&' in NEWTEXT means substitute original matched text.
2373 `\\N' means substitute what matched the Nth `\\(...\\)'.
2374 If Nth parens didn't match, substitute nothing.
2375 `\\\\' means insert one `\\'.
2376 Case conversion does not apply to these substitutions.
2378 FIXEDCASE and LITERAL are optional arguments.
2380 The optional fourth argument STRING can be a string to modify.
2381 This is meaningful when the previous match was done against STRING,
2382 using `string-match'. When used this way, `replace-match'
2383 creates and returns a new string made by copying STRING and replacing
2384 the part of STRING that was matched.
2386 The optional fifth argument SUBEXP specifies a subexpression;
2387 it says to replace just that subexpression with NEWTEXT,
2388 rather than replacing the entire matched text.
2389 This is, in a vague sense, the inverse of using `\\N' in NEWTEXT;
2390 `\\N' copies subexp N into NEWTEXT, but using N as SUBEXP puts
2391 NEWTEXT in place of subexp N.
2392 This is useful only after a regular expression search or match,
2393 since only regular expressions have distinguished subexpressions. */)
2394 (Lisp_Object newtext, Lisp_Object fixedcase, Lisp_Object literal, Lisp_Object string, Lisp_Object subexp)
2396 enum { nochange, all_caps, cap_initial } case_action;
2397 register EMACS_INT pos, pos_byte;
2398 int some_multiletter_word;
2399 int some_lowercase;
2400 int some_uppercase;
2401 int some_nonuppercase_initial;
2402 register int c, prevc;
2403 int sub;
2404 EMACS_INT opoint, newpoint;
2406 CHECK_STRING (newtext);
2408 if (! NILP (string))
2409 CHECK_STRING (string);
2411 case_action = nochange; /* We tried an initialization */
2412 /* but some C compilers blew it */
2414 if (search_regs.num_regs <= 0)
2415 error ("`replace-match' called before any match found");
2417 if (NILP (subexp))
2418 sub = 0;
2419 else
2421 CHECK_NUMBER (subexp);
2422 sub = XINT (subexp);
2423 if (sub < 0 || sub >= search_regs.num_regs)
2424 args_out_of_range (subexp, make_number (search_regs.num_regs));
2427 if (NILP (string))
2429 if (search_regs.start[sub] < BEGV
2430 || search_regs.start[sub] > search_regs.end[sub]
2431 || search_regs.end[sub] > ZV)
2432 args_out_of_range (make_number (search_regs.start[sub]),
2433 make_number (search_regs.end[sub]));
2435 else
2437 if (search_regs.start[sub] < 0
2438 || search_regs.start[sub] > search_regs.end[sub]
2439 || search_regs.end[sub] > SCHARS (string))
2440 args_out_of_range (make_number (search_regs.start[sub]),
2441 make_number (search_regs.end[sub]));
2444 if (NILP (fixedcase))
2446 /* Decide how to casify by examining the matched text. */
2447 EMACS_INT last;
2449 pos = search_regs.start[sub];
2450 last = search_regs.end[sub];
2452 if (NILP (string))
2453 pos_byte = CHAR_TO_BYTE (pos);
2454 else
2455 pos_byte = string_char_to_byte (string, pos);
2457 prevc = '\n';
2458 case_action = all_caps;
2460 /* some_multiletter_word is set nonzero if any original word
2461 is more than one letter long. */
2462 some_multiletter_word = 0;
2463 some_lowercase = 0;
2464 some_nonuppercase_initial = 0;
2465 some_uppercase = 0;
2467 while (pos < last)
2469 if (NILP (string))
2471 c = FETCH_CHAR_AS_MULTIBYTE (pos_byte);
2472 INC_BOTH (pos, pos_byte);
2474 else
2475 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, pos, pos_byte);
2477 if (LOWERCASEP (c))
2479 /* Cannot be all caps if any original char is lower case */
2481 some_lowercase = 1;
2482 if (SYNTAX (prevc) != Sword)
2483 some_nonuppercase_initial = 1;
2484 else
2485 some_multiletter_word = 1;
2487 else if (UPPERCASEP (c))
2489 some_uppercase = 1;
2490 if (SYNTAX (prevc) != Sword)
2492 else
2493 some_multiletter_word = 1;
2495 else
2497 /* If the initial is a caseless word constituent,
2498 treat that like a lowercase initial. */
2499 if (SYNTAX (prevc) != Sword)
2500 some_nonuppercase_initial = 1;
2503 prevc = c;
2506 /* Convert to all caps if the old text is all caps
2507 and has at least one multiletter word. */
2508 if (! some_lowercase && some_multiletter_word)
2509 case_action = all_caps;
2510 /* Capitalize each word, if the old text has all capitalized words. */
2511 else if (!some_nonuppercase_initial && some_multiletter_word)
2512 case_action = cap_initial;
2513 else if (!some_nonuppercase_initial && some_uppercase)
2514 /* Should x -> yz, operating on X, give Yz or YZ?
2515 We'll assume the latter. */
2516 case_action = all_caps;
2517 else
2518 case_action = nochange;
2521 /* Do replacement in a string. */
2522 if (!NILP (string))
2524 Lisp_Object before, after;
2526 before = Fsubstring (string, make_number (0),
2527 make_number (search_regs.start[sub]));
2528 after = Fsubstring (string, make_number (search_regs.end[sub]), Qnil);
2530 /* Substitute parts of the match into NEWTEXT
2531 if desired. */
2532 if (NILP (literal))
2534 EMACS_INT lastpos = 0;
2535 EMACS_INT lastpos_byte = 0;
2536 /* We build up the substituted string in ACCUM. */
2537 Lisp_Object accum;
2538 Lisp_Object middle;
2539 int length = SBYTES (newtext);
2541 accum = Qnil;
2543 for (pos_byte = 0, pos = 0; pos_byte < length;)
2545 EMACS_INT substart = -1;
2546 EMACS_INT subend = 0;
2547 int delbackslash = 0;
2549 FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
2551 if (c == '\\')
2553 FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
2555 if (c == '&')
2557 substart = search_regs.start[sub];
2558 subend = search_regs.end[sub];
2560 else if (c >= '1' && c <= '9')
2562 if (search_regs.start[c - '0'] >= 0
2563 && c <= search_regs.num_regs + '0')
2565 substart = search_regs.start[c - '0'];
2566 subend = search_regs.end[c - '0'];
2568 else
2570 /* If that subexp did not match,
2571 replace \\N with nothing. */
2572 substart = 0;
2573 subend = 0;
2576 else if (c == '\\')
2577 delbackslash = 1;
2578 else
2579 error ("Invalid use of `\\' in replacement text");
2581 if (substart >= 0)
2583 if (pos - 2 != lastpos)
2584 middle = substring_both (newtext, lastpos,
2585 lastpos_byte,
2586 pos - 2, pos_byte - 2);
2587 else
2588 middle = Qnil;
2589 accum = concat3 (accum, middle,
2590 Fsubstring (string,
2591 make_number (substart),
2592 make_number (subend)));
2593 lastpos = pos;
2594 lastpos_byte = pos_byte;
2596 else if (delbackslash)
2598 middle = substring_both (newtext, lastpos,
2599 lastpos_byte,
2600 pos - 1, pos_byte - 1);
2602 accum = concat2 (accum, middle);
2603 lastpos = pos;
2604 lastpos_byte = pos_byte;
2608 if (pos != lastpos)
2609 middle = substring_both (newtext, lastpos,
2610 lastpos_byte,
2611 pos, pos_byte);
2612 else
2613 middle = Qnil;
2615 newtext = concat2 (accum, middle);
2618 /* Do case substitution in NEWTEXT if desired. */
2619 if (case_action == all_caps)
2620 newtext = Fupcase (newtext);
2621 else if (case_action == cap_initial)
2622 newtext = Fupcase_initials (newtext);
2624 return concat3 (before, newtext, after);
2627 /* Record point, then move (quietly) to the start of the match. */
2628 if (PT >= search_regs.end[sub])
2629 opoint = PT - ZV;
2630 else if (PT > search_regs.start[sub])
2631 opoint = search_regs.end[sub] - ZV;
2632 else
2633 opoint = PT;
2635 /* If we want non-literal replacement,
2636 perform substitution on the replacement string. */
2637 if (NILP (literal))
2639 EMACS_INT length = SBYTES (newtext);
2640 unsigned char *substed;
2641 EMACS_INT substed_alloc_size, substed_len;
2642 int buf_multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
2643 int str_multibyte = STRING_MULTIBYTE (newtext);
2644 Lisp_Object rev_tbl;
2645 int really_changed = 0;
2647 rev_tbl = Qnil;
2649 substed_alloc_size = length * 2 + 100;
2650 substed = (unsigned char *) xmalloc (substed_alloc_size + 1);
2651 substed_len = 0;
2653 /* Go thru NEWTEXT, producing the actual text to insert in
2654 SUBSTED while adjusting multibyteness to that of the current
2655 buffer. */
2657 for (pos_byte = 0, pos = 0; pos_byte < length;)
2659 unsigned char str[MAX_MULTIBYTE_LENGTH];
2660 const unsigned char *add_stuff = NULL;
2661 EMACS_INT add_len = 0;
2662 int idx = -1;
2664 if (str_multibyte)
2666 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext, pos, pos_byte);
2667 if (!buf_multibyte)
2668 c = multibyte_char_to_unibyte (c, rev_tbl);
2670 else
2672 /* Note that we don't have to increment POS. */
2673 c = SREF (newtext, pos_byte++);
2674 if (buf_multibyte)
2675 MAKE_CHAR_MULTIBYTE (c);
2678 /* Either set ADD_STUFF and ADD_LEN to the text to put in SUBSTED,
2679 or set IDX to a match index, which means put that part
2680 of the buffer text into SUBSTED. */
2682 if (c == '\\')
2684 really_changed = 1;
2686 if (str_multibyte)
2688 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext,
2689 pos, pos_byte);
2690 if (!buf_multibyte && !ASCII_CHAR_P (c))
2691 c = multibyte_char_to_unibyte (c, rev_tbl);
2693 else
2695 c = SREF (newtext, pos_byte++);
2696 if (buf_multibyte)
2697 MAKE_CHAR_MULTIBYTE (c);
2700 if (c == '&')
2701 idx = sub;
2702 else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0')
2704 if (search_regs.start[c - '0'] >= 1)
2705 idx = c - '0';
2707 else if (c == '\\')
2708 add_len = 1, add_stuff = (unsigned char *) "\\";
2709 else
2711 xfree (substed);
2712 error ("Invalid use of `\\' in replacement text");
2715 else
2717 add_len = CHAR_STRING (c, str);
2718 add_stuff = str;
2721 /* If we want to copy part of a previous match,
2722 set up ADD_STUFF and ADD_LEN to point to it. */
2723 if (idx >= 0)
2725 EMACS_INT begbyte = CHAR_TO_BYTE (search_regs.start[idx]);
2726 add_len = CHAR_TO_BYTE (search_regs.end[idx]) - begbyte;
2727 if (search_regs.start[idx] < GPT && GPT < search_regs.end[idx])
2728 move_gap (search_regs.start[idx]);
2729 add_stuff = BYTE_POS_ADDR (begbyte);
2732 /* Now the stuff we want to add to SUBSTED
2733 is invariably ADD_LEN bytes starting at ADD_STUFF. */
2735 /* Make sure SUBSTED is big enough. */
2736 if (substed_len + add_len >= substed_alloc_size)
2738 substed_alloc_size = substed_len + add_len + 500;
2739 substed = (unsigned char *) xrealloc (substed,
2740 substed_alloc_size + 1);
2743 /* Now add to the end of SUBSTED. */
2744 if (add_stuff)
2746 memcpy (substed + substed_len, add_stuff, add_len);
2747 substed_len += add_len;
2751 if (really_changed)
2753 if (buf_multibyte)
2755 EMACS_INT nchars =
2756 multibyte_chars_in_text (substed, substed_len);
2758 newtext = make_multibyte_string ((char *) substed, nchars,
2759 substed_len);
2761 else
2762 newtext = make_unibyte_string ((char *) substed, substed_len);
2764 xfree (substed);
2767 /* Replace the old text with the new in the cleanest possible way. */
2768 replace_range (search_regs.start[sub], search_regs.end[sub],
2769 newtext, 1, 0, 1);
2770 newpoint = search_regs.start[sub] + SCHARS (newtext);
2772 if (case_action == all_caps)
2773 Fupcase_region (make_number (search_regs.start[sub]),
2774 make_number (newpoint));
2775 else if (case_action == cap_initial)
2776 Fupcase_initials_region (make_number (search_regs.start[sub]),
2777 make_number (newpoint));
2779 /* Adjust search data for this change. */
2781 EMACS_INT oldend = search_regs.end[sub];
2782 EMACS_INT oldstart = search_regs.start[sub];
2783 EMACS_INT change = newpoint - search_regs.end[sub];
2784 int i;
2786 for (i = 0; i < search_regs.num_regs; i++)
2788 if (search_regs.start[i] >= oldend)
2789 search_regs.start[i] += change;
2790 else if (search_regs.start[i] > oldstart)
2791 search_regs.start[i] = oldstart;
2792 if (search_regs.end[i] >= oldend)
2793 search_regs.end[i] += change;
2794 else if (search_regs.end[i] > oldstart)
2795 search_regs.end[i] = oldstart;
2799 /* Put point back where it was in the text. */
2800 if (opoint <= 0)
2801 TEMP_SET_PT (opoint + ZV);
2802 else
2803 TEMP_SET_PT (opoint);
2805 /* Now move point "officially" to the start of the inserted replacement. */
2806 move_if_not_intangible (newpoint);
2808 return Qnil;
2811 static Lisp_Object
2812 match_limit (Lisp_Object num, int beginningp)
2814 register int n;
2816 CHECK_NUMBER (num);
2817 n = XINT (num);
2818 if (n < 0)
2819 args_out_of_range (num, make_number (0));
2820 if (search_regs.num_regs <= 0)
2821 error ("No match data, because no search succeeded");
2822 if (n >= search_regs.num_regs
2823 || search_regs.start[n] < 0)
2824 return Qnil;
2825 return (make_number ((beginningp) ? search_regs.start[n]
2826 : search_regs.end[n]));
2829 DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
2830 doc: /* Return position of start of text matched by last search.
2831 SUBEXP, a number, specifies which parenthesized expression in the last
2832 regexp.
2833 Value is nil if SUBEXPth pair didn't match, or there were less than
2834 SUBEXP pairs.
2835 Zero means the entire text matched by the whole regexp or whole string. */)
2836 (Lisp_Object subexp)
2838 return match_limit (subexp, 1);
2841 DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0,
2842 doc: /* Return position of end of text matched by last search.
2843 SUBEXP, a number, specifies which parenthesized expression in the last
2844 regexp.
2845 Value is nil if SUBEXPth pair didn't match, or there were less than
2846 SUBEXP pairs.
2847 Zero means the entire text matched by the whole regexp or whole string. */)
2848 (Lisp_Object subexp)
2850 return match_limit (subexp, 0);
2853 DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 3, 0,
2854 doc: /* Return a list containing all info on what the last search matched.
2855 Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.
2856 All the elements are markers or nil (nil if the Nth pair didn't match)
2857 if the last match was on a buffer; integers or nil if a string was matched.
2858 Use `set-match-data' to reinstate the data in this list.
2860 If INTEGERS (the optional first argument) is non-nil, always use
2861 integers \(rather than markers) to represent buffer positions. In
2862 this case, and if the last match was in a buffer, the buffer will get
2863 stored as one additional element at the end of the list.
2865 If REUSE is a list, reuse it as part of the value. If REUSE is long
2866 enough to hold all the values, and if INTEGERS is non-nil, no consing
2867 is done.
2869 If optional third arg RESEAT is non-nil, any previous markers on the
2870 REUSE list will be modified to point to nowhere.
2872 Return value is undefined if the last search failed. */)
2873 (Lisp_Object integers, Lisp_Object reuse, Lisp_Object reseat)
2875 Lisp_Object tail, prev;
2876 Lisp_Object *data;
2877 int i, len;
2879 if (!NILP (reseat))
2880 for (tail = reuse; CONSP (tail); tail = XCDR (tail))
2881 if (MARKERP (XCAR (tail)))
2883 unchain_marker (XMARKER (XCAR (tail)));
2884 XSETCAR (tail, Qnil);
2887 if (NILP (last_thing_searched))
2888 return Qnil;
2890 prev = Qnil;
2892 data = (Lisp_Object *) alloca ((2 * search_regs.num_regs + 1)
2893 * sizeof (Lisp_Object));
2895 len = 0;
2896 for (i = 0; i < search_regs.num_regs; i++)
2898 int start = search_regs.start[i];
2899 if (start >= 0)
2901 if (EQ (last_thing_searched, Qt)
2902 || ! NILP (integers))
2904 XSETFASTINT (data[2 * i], start);
2905 XSETFASTINT (data[2 * i + 1], search_regs.end[i]);
2907 else if (BUFFERP (last_thing_searched))
2909 data[2 * i] = Fmake_marker ();
2910 Fset_marker (data[2 * i],
2911 make_number (start),
2912 last_thing_searched);
2913 data[2 * i + 1] = Fmake_marker ();
2914 Fset_marker (data[2 * i + 1],
2915 make_number (search_regs.end[i]),
2916 last_thing_searched);
2918 else
2919 /* last_thing_searched must always be Qt, a buffer, or Qnil. */
2920 abort ();
2922 len = 2 * i + 2;
2924 else
2925 data[2 * i] = data[2 * i + 1] = Qnil;
2928 if (BUFFERP (last_thing_searched) && !NILP (integers))
2930 data[len] = last_thing_searched;
2931 len++;
2934 /* If REUSE is not usable, cons up the values and return them. */
2935 if (! CONSP (reuse))
2936 return Flist (len, data);
2938 /* If REUSE is a list, store as many value elements as will fit
2939 into the elements of REUSE. */
2940 for (i = 0, tail = reuse; CONSP (tail);
2941 i++, tail = XCDR (tail))
2943 if (i < len)
2944 XSETCAR (tail, data[i]);
2945 else
2946 XSETCAR (tail, Qnil);
2947 prev = tail;
2950 /* If we couldn't fit all value elements into REUSE,
2951 cons up the rest of them and add them to the end of REUSE. */
2952 if (i < len)
2953 XSETCDR (prev, Flist (len - i, data + i));
2955 return reuse;
2958 /* We used to have an internal use variant of `reseat' described as:
2960 If RESEAT is `evaporate', put the markers back on the free list
2961 immediately. No other references to the markers must exist in this
2962 case, so it is used only internally on the unwind stack and
2963 save-match-data from Lisp.
2965 But it was ill-conceived: those supposedly-internal markers get exposed via
2966 the undo-list, so freeing them here is unsafe. */
2968 DEFUN ("set-match-data", Fset_match_data, Sset_match_data, 1, 2, 0,
2969 doc: /* Set internal data on last search match from elements of LIST.
2970 LIST should have been created by calling `match-data' previously.
2972 If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */)
2973 (register Lisp_Object list, Lisp_Object reseat)
2975 register int i;
2976 register Lisp_Object marker;
2978 if (running_asynch_code)
2979 save_search_regs ();
2981 CHECK_LIST (list);
2983 /* Unless we find a marker with a buffer or an explicit buffer
2984 in LIST, assume that this match data came from a string. */
2985 last_thing_searched = Qt;
2987 /* Allocate registers if they don't already exist. */
2989 int length = XFASTINT (Flength (list)) / 2;
2991 if (length > search_regs.num_regs)
2993 if (search_regs.num_regs == 0)
2995 search_regs.start
2996 = (regoff_t *) xmalloc (length * sizeof (regoff_t));
2997 search_regs.end
2998 = (regoff_t *) xmalloc (length * sizeof (regoff_t));
3000 else
3002 search_regs.start
3003 = (regoff_t *) xrealloc (search_regs.start,
3004 length * sizeof (regoff_t));
3005 search_regs.end
3006 = (regoff_t *) xrealloc (search_regs.end,
3007 length * sizeof (regoff_t));
3010 for (i = search_regs.num_regs; i < length; i++)
3011 search_regs.start[i] = -1;
3013 search_regs.num_regs = length;
3016 for (i = 0; CONSP (list); i++)
3018 marker = XCAR (list);
3019 if (BUFFERP (marker))
3021 last_thing_searched = marker;
3022 break;
3024 if (i >= length)
3025 break;
3026 if (NILP (marker))
3028 search_regs.start[i] = -1;
3029 list = XCDR (list);
3031 else
3033 EMACS_INT from;
3034 Lisp_Object m;
3036 m = marker;
3037 if (MARKERP (marker))
3039 if (XMARKER (marker)->buffer == 0)
3040 XSETFASTINT (marker, 0);
3041 else
3042 XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer);
3045 CHECK_NUMBER_COERCE_MARKER (marker);
3046 from = XINT (marker);
3048 if (!NILP (reseat) && MARKERP (m))
3050 unchain_marker (XMARKER (m));
3051 XSETCAR (list, Qnil);
3054 if ((list = XCDR (list), !CONSP (list)))
3055 break;
3057 m = marker = XCAR (list);
3059 if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
3060 XSETFASTINT (marker, 0);
3062 CHECK_NUMBER_COERCE_MARKER (marker);
3063 search_regs.start[i] = from;
3064 search_regs.end[i] = XINT (marker);
3066 if (!NILP (reseat) && MARKERP (m))
3068 unchain_marker (XMARKER (m));
3069 XSETCAR (list, Qnil);
3072 list = XCDR (list);
3075 for (; i < search_regs.num_regs; i++)
3076 search_regs.start[i] = -1;
3079 return Qnil;
3082 /* If non-zero the match data have been saved in saved_search_regs
3083 during the execution of a sentinel or filter. */
3084 static int search_regs_saved;
3085 static struct re_registers saved_search_regs;
3086 static Lisp_Object saved_last_thing_searched;
3088 /* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
3089 if asynchronous code (filter or sentinel) is running. */
3090 static void
3091 save_search_regs (void)
3093 if (!search_regs_saved)
3095 saved_search_regs.num_regs = search_regs.num_regs;
3096 saved_search_regs.start = search_regs.start;
3097 saved_search_regs.end = search_regs.end;
3098 saved_last_thing_searched = last_thing_searched;
3099 last_thing_searched = Qnil;
3100 search_regs.num_regs = 0;
3101 search_regs.start = 0;
3102 search_regs.end = 0;
3104 search_regs_saved = 1;
3108 /* Called upon exit from filters and sentinels. */
3109 void
3110 restore_search_regs (void)
3112 if (search_regs_saved)
3114 if (search_regs.num_regs > 0)
3116 xfree (search_regs.start);
3117 xfree (search_regs.end);
3119 search_regs.num_regs = saved_search_regs.num_regs;
3120 search_regs.start = saved_search_regs.start;
3121 search_regs.end = saved_search_regs.end;
3122 last_thing_searched = saved_last_thing_searched;
3123 saved_last_thing_searched = Qnil;
3124 search_regs_saved = 0;
3128 static Lisp_Object
3129 unwind_set_match_data (Lisp_Object list)
3131 /* It is NOT ALWAYS safe to free (evaporate) the markers immediately. */
3132 return Fset_match_data (list, Qt);
3135 /* Called to unwind protect the match data. */
3136 void
3137 record_unwind_save_match_data (void)
3139 record_unwind_protect (unwind_set_match_data,
3140 Fmatch_data (Qnil, Qnil, Qnil));
3143 /* Quote a string to inactivate reg-expr chars */
3145 DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
3146 doc: /* Return a regexp string which matches exactly STRING and nothing else. */)
3147 (Lisp_Object string)
3149 register char *in, *out, *end;
3150 register char *temp;
3151 int backslashes_added = 0;
3153 CHECK_STRING (string);
3155 temp = (char *) alloca (SBYTES (string) * 2);
3157 /* Now copy the data into the new string, inserting escapes. */
3159 in = SSDATA (string);
3160 end = in + SBYTES (string);
3161 out = temp;
3163 for (; in != end; in++)
3165 if (*in == '['
3166 || *in == '*' || *in == '.' || *in == '\\'
3167 || *in == '?' || *in == '+'
3168 || *in == '^' || *in == '$')
3169 *out++ = '\\', backslashes_added++;
3170 *out++ = *in;
3173 return make_specified_string (temp,
3174 SCHARS (string) + backslashes_added,
3175 out - temp,
3176 STRING_MULTIBYTE (string));
3179 void
3180 syms_of_search (void)
3182 register int i;
3184 for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
3186 searchbufs[i].buf.allocated = 100;
3187 searchbufs[i].buf.buffer = (unsigned char *) xmalloc (100);
3188 searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
3189 searchbufs[i].regexp = Qnil;
3190 searchbufs[i].whitespace_regexp = Qnil;
3191 searchbufs[i].syntax_table = Qnil;
3192 staticpro (&searchbufs[i].regexp);
3193 staticpro (&searchbufs[i].whitespace_regexp);
3194 staticpro (&searchbufs[i].syntax_table);
3195 searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]);
3197 searchbuf_head = &searchbufs[0];
3199 Qsearch_failed = intern_c_string ("search-failed");
3200 staticpro (&Qsearch_failed);
3201 Qinvalid_regexp = intern_c_string ("invalid-regexp");
3202 staticpro (&Qinvalid_regexp);
3204 Fput (Qsearch_failed, Qerror_conditions,
3205 pure_cons (Qsearch_failed, pure_cons (Qerror, Qnil)));
3206 Fput (Qsearch_failed, Qerror_message,
3207 make_pure_c_string ("Search failed"));
3209 Fput (Qinvalid_regexp, Qerror_conditions,
3210 pure_cons (Qinvalid_regexp, pure_cons (Qerror, Qnil)));
3211 Fput (Qinvalid_regexp, Qerror_message,
3212 make_pure_c_string ("Invalid regexp"));
3214 last_thing_searched = Qnil;
3215 staticpro (&last_thing_searched);
3217 saved_last_thing_searched = Qnil;
3218 staticpro (&saved_last_thing_searched);
3220 DEFVAR_LISP ("search-spaces-regexp", Vsearch_spaces_regexp,
3221 doc: /* Regexp to substitute for bunches of spaces in regexp search.
3222 Some commands use this for user-specified regexps.
3223 Spaces that occur inside character classes or repetition operators
3224 or other such regexp constructs are not replaced with this.
3225 A value of nil (which is the normal value) means treat spaces literally. */);
3226 Vsearch_spaces_regexp = Qnil;
3228 DEFVAR_LISP ("inhibit-changing-match-data", Vinhibit_changing_match_data,
3229 doc: /* Internal use only.
3230 If non-nil, the primitive searching and matching functions
3231 such as `looking-at', `string-match', `re-search-forward', etc.,
3232 do not set the match data. The proper way to use this variable
3233 is to bind it with `let' around a small expression. */);
3234 Vinhibit_changing_match_data = Qnil;
3236 defsubr (&Slooking_at);
3237 defsubr (&Sposix_looking_at);
3238 defsubr (&Sstring_match);
3239 defsubr (&Sposix_string_match);
3240 defsubr (&Ssearch_forward);
3241 defsubr (&Ssearch_backward);
3242 defsubr (&Sword_search_forward);
3243 defsubr (&Sword_search_backward);
3244 defsubr (&Sword_search_forward_lax);
3245 defsubr (&Sword_search_backward_lax);
3246 defsubr (&Sre_search_forward);
3247 defsubr (&Sre_search_backward);
3248 defsubr (&Sposix_search_forward);
3249 defsubr (&Sposix_search_backward);
3250 defsubr (&Sreplace_match);
3251 defsubr (&Smatch_beginning);
3252 defsubr (&Smatch_end);
3253 defsubr (&Smatch_data);
3254 defsubr (&Sset_match_data);
3255 defsubr (&Sregexp_quote);