]> code.delx.au - gnu-emacs/blob - src/search.c
c9e27627cd173690aadbcf3fc869084267d35cee
[gnu-emacs] / src / search.c
1 /* String search routines for GNU Emacs.
2
3 Copyright (C) 1985-1987, 1993-1994, 1997-1999, 2001-2013 Free Software
4 Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21
22 #include <config.h>
23
24 #include "lisp.h"
25 #include "category.h"
26 #include "character.h"
27 #include "buffer.h"
28 #include "syntax.h"
29 #include "charset.h"
30 #include "region-cache.h"
31 #include "commands.h"
32 #include "blockinput.h"
33 #include "intervals.h"
34
35 #include <sys/types.h>
36 #include "regex.h"
37
38 #define REGEXP_CACHE_SIZE 20
39
40 /* If the regexp is non-nil, then the buffer contains the compiled form
41 of that regexp, suitable for searching. */
42 struct regexp_cache
43 {
44 struct regexp_cache *next;
45 Lisp_Object regexp, whitespace_regexp;
46 /* Syntax table for which the regexp applies. We need this because
47 of character classes. If this is t, then the compiled pattern is valid
48 for any syntax-table. */
49 Lisp_Object syntax_table;
50 struct re_pattern_buffer buf;
51 char fastmap[0400];
52 /* True means regexp was compiled to do full POSIX backtracking. */
53 bool posix;
54 };
55
56 /* The instances of that struct. */
57 static struct regexp_cache searchbufs[REGEXP_CACHE_SIZE];
58
59 /* The head of the linked list; points to the most recently used buffer. */
60 static struct regexp_cache *searchbuf_head;
61
62
63 /* Every call to re_match, etc., must pass &search_regs as the regs
64 argument unless you can show it is unnecessary (i.e., if re_match
65 is certainly going to be called again before region-around-match
66 can be called).
67
68 Since the registers are now dynamically allocated, we need to make
69 sure not to refer to the Nth register before checking that it has
70 been allocated by checking search_regs.num_regs.
71
72 The regex code keeps track of whether it has allocated the search
73 buffer using bits in the re_pattern_buffer. This means that whenever
74 you compile a new pattern, it completely forgets whether it has
75 allocated any registers, and will allocate new registers the next
76 time you call a searching or matching function. Therefore, we need
77 to call re_set_registers after compiling a new pattern or after
78 setting the match registers, so that the regex functions will be
79 able to free or re-allocate it properly. */
80 static struct re_registers search_regs;
81
82 /* The buffer in which the last search was performed, or
83 Qt if the last search was done in a string;
84 Qnil if no searching has been done yet. */
85 static Lisp_Object last_thing_searched;
86
87 /* Error condition signaled when regexp compile_pattern fails. */
88 static Lisp_Object Qinvalid_regexp;
89
90 /* Error condition used for failing searches. */
91 static Lisp_Object Qsearch_failed;
92
93 static void set_search_regs (ptrdiff_t, ptrdiff_t);
94 static void save_search_regs (void);
95 static EMACS_INT simple_search (EMACS_INT, unsigned char *, ptrdiff_t,
96 ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t,
97 ptrdiff_t, ptrdiff_t);
98 static EMACS_INT boyer_moore (EMACS_INT, unsigned char *, ptrdiff_t,
99 Lisp_Object, Lisp_Object, ptrdiff_t,
100 ptrdiff_t, int);
101 static EMACS_INT search_buffer (Lisp_Object, ptrdiff_t, ptrdiff_t,
102 ptrdiff_t, ptrdiff_t, EMACS_INT, int,
103 Lisp_Object, Lisp_Object, bool);
104
105 static _Noreturn void
106 matcher_overflow (void)
107 {
108 error ("Stack overflow in regexp matcher");
109 }
110
111 /* Compile a regexp and signal a Lisp error if anything goes wrong.
112 PATTERN is the pattern to compile.
113 CP is the place to put the result.
114 TRANSLATE is a translation table for ignoring case, or nil for none.
115 POSIX is true if we want full backtracking (POSIX style) for this pattern.
116 False means backtrack only enough to get a valid match.
117
118 The behavior also depends on Vsearch_spaces_regexp. */
119
120 static void
121 compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern,
122 Lisp_Object translate, bool posix)
123 {
124 char *val;
125 reg_syntax_t old;
126
127 cp->regexp = Qnil;
128 cp->buf.translate = (! NILP (translate) ? translate : make_number (0));
129 cp->posix = posix;
130 cp->buf.multibyte = STRING_MULTIBYTE (pattern);
131 cp->buf.charset_unibyte = charset_unibyte;
132 if (STRINGP (Vsearch_spaces_regexp))
133 cp->whitespace_regexp = Vsearch_spaces_regexp;
134 else
135 cp->whitespace_regexp = Qnil;
136
137 /* rms: I think BLOCK_INPUT is not needed here any more,
138 because regex.c defines malloc to call xmalloc.
139 Using BLOCK_INPUT here means the debugger won't run if an error occurs.
140 So let's turn it off. */
141 /* BLOCK_INPUT; */
142 old = re_set_syntax (RE_SYNTAX_EMACS
143 | (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
144
145 if (STRINGP (Vsearch_spaces_regexp))
146 re_set_whitespace_regexp (SSDATA (Vsearch_spaces_regexp));
147 else
148 re_set_whitespace_regexp (NULL);
149
150 val = (char *) re_compile_pattern (SSDATA (pattern),
151 SBYTES (pattern), &cp->buf);
152
153 /* If the compiled pattern hard codes some of the contents of the
154 syntax-table, it can only be reused with *this* syntax table. */
155 cp->syntax_table = cp->buf.used_syntax ? BVAR (current_buffer, syntax_table) : Qt;
156
157 re_set_whitespace_regexp (NULL);
158
159 re_set_syntax (old);
160 /* unblock_input (); */
161 if (val)
162 xsignal1 (Qinvalid_regexp, build_string (val));
163
164 cp->regexp = Fcopy_sequence (pattern);
165 }
166
167 /* Shrink each compiled regexp buffer in the cache
168 to the size actually used right now.
169 This is called from garbage collection. */
170
171 void
172 shrink_regexp_cache (void)
173 {
174 struct regexp_cache *cp;
175
176 for (cp = searchbuf_head; cp != 0; cp = cp->next)
177 {
178 cp->buf.allocated = cp->buf.used;
179 cp->buf.buffer = xrealloc (cp->buf.buffer, cp->buf.used);
180 }
181 }
182
183 /* Clear the regexp cache w.r.t. a particular syntax table,
184 because it was changed.
185 There is no danger of memory leak here because re_compile_pattern
186 automagically manages the memory in each re_pattern_buffer struct,
187 based on its `allocated' and `buffer' values. */
188 void
189 clear_regexp_cache (void)
190 {
191 int i;
192
193 for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
194 /* It's tempting to compare with the syntax-table we've actually changed,
195 but it's not sufficient because char-table inheritance means that
196 modifying one syntax-table can change others at the same time. */
197 if (!EQ (searchbufs[i].syntax_table, Qt))
198 searchbufs[i].regexp = Qnil;
199 }
200
201 /* Compile a regexp if necessary, but first check to see if there's one in
202 the cache.
203 PATTERN is the pattern to compile.
204 TRANSLATE is a translation table for ignoring case, or nil for none.
205 REGP is the structure that says where to store the "register"
206 values that will result from matching this pattern.
207 If it is 0, we should compile the pattern not to record any
208 subexpression bounds.
209 POSIX is true if we want full backtracking (POSIX style) for this pattern.
210 False means backtrack only enough to get a valid match. */
211
212 struct re_pattern_buffer *
213 compile_pattern (Lisp_Object pattern, struct re_registers *regp,
214 Lisp_Object translate, bool posix, bool multibyte)
215 {
216 struct regexp_cache *cp, **cpp;
217
218 for (cpp = &searchbuf_head; ; cpp = &cp->next)
219 {
220 cp = *cpp;
221 /* Entries are initialized to nil, and may be set to nil by
222 compile_pattern_1 if the pattern isn't valid. Don't apply
223 string accessors in those cases. However, compile_pattern_1
224 is only applied to the cache entry we pick here to reuse. So
225 nil should never appear before a non-nil entry. */
226 if (NILP (cp->regexp))
227 goto compile_it;
228 if (SCHARS (cp->regexp) == SCHARS (pattern)
229 && STRING_MULTIBYTE (cp->regexp) == STRING_MULTIBYTE (pattern)
230 && !NILP (Fstring_equal (cp->regexp, pattern))
231 && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0)))
232 && cp->posix == posix
233 && (EQ (cp->syntax_table, Qt)
234 || EQ (cp->syntax_table, BVAR (current_buffer, syntax_table)))
235 && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp))
236 && cp->buf.charset_unibyte == charset_unibyte)
237 break;
238
239 /* If we're at the end of the cache, compile into the nil cell
240 we found, or the last (least recently used) cell with a
241 string value. */
242 if (cp->next == 0)
243 {
244 compile_it:
245 compile_pattern_1 (cp, pattern, translate, posix);
246 break;
247 }
248 }
249
250 /* When we get here, cp (aka *cpp) contains the compiled pattern,
251 either because we found it in the cache or because we just compiled it.
252 Move it to the front of the queue to mark it as most recently used. */
253 *cpp = cp->next;
254 cp->next = searchbuf_head;
255 searchbuf_head = cp;
256
257 /* Advise the searching functions about the space we have allocated
258 for register data. */
259 if (regp)
260 re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end);
261
262 /* The compiled pattern can be used both for multibyte and unibyte
263 target. But, we have to tell which the pattern is used for. */
264 cp->buf.target_multibyte = multibyte;
265
266 return &cp->buf;
267 }
268
269 \f
270 static Lisp_Object
271 looking_at_1 (Lisp_Object string, bool posix)
272 {
273 Lisp_Object val;
274 unsigned char *p1, *p2;
275 ptrdiff_t s1, s2;
276 register ptrdiff_t i;
277 struct re_pattern_buffer *bufp;
278
279 if (running_asynch_code)
280 save_search_regs ();
281
282 /* This is so set_image_of_range_1 in regex.c can find the EQV table. */
283 set_char_table_extras (BVAR (current_buffer, case_canon_table), 2,
284 BVAR (current_buffer, case_eqv_table));
285
286 CHECK_STRING (string);
287 bufp = compile_pattern (string,
288 (NILP (Vinhibit_changing_match_data)
289 ? &search_regs : NULL),
290 (!NILP (BVAR (current_buffer, case_fold_search))
291 ? BVAR (current_buffer, case_canon_table) : Qnil),
292 posix,
293 !NILP (BVAR (current_buffer, enable_multibyte_characters)));
294
295 immediate_quit = 1;
296 QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */
297
298 /* Get pointers and sizes of the two strings
299 that make up the visible portion of the buffer. */
300
301 p1 = BEGV_ADDR;
302 s1 = GPT_BYTE - BEGV_BYTE;
303 p2 = GAP_END_ADDR;
304 s2 = ZV_BYTE - GPT_BYTE;
305 if (s1 < 0)
306 {
307 p2 = p1;
308 s2 = ZV_BYTE - BEGV_BYTE;
309 s1 = 0;
310 }
311 if (s2 < 0)
312 {
313 s1 = ZV_BYTE - BEGV_BYTE;
314 s2 = 0;
315 }
316
317 re_match_object = Qnil;
318
319 i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
320 PT_BYTE - BEGV_BYTE,
321 (NILP (Vinhibit_changing_match_data)
322 ? &search_regs : NULL),
323 ZV_BYTE - BEGV_BYTE);
324 immediate_quit = 0;
325
326 if (i == -2)
327 matcher_overflow ();
328
329 val = (i >= 0 ? Qt : Qnil);
330 if (NILP (Vinhibit_changing_match_data) && i >= 0)
331 {
332 for (i = 0; i < search_regs.num_regs; i++)
333 if (search_regs.start[i] >= 0)
334 {
335 search_regs.start[i]
336 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
337 search_regs.end[i]
338 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
339 }
340 /* Set last_thing_searched only when match data is changed. */
341 XSETBUFFER (last_thing_searched, current_buffer);
342 }
343
344 return val;
345 }
346
347 DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0,
348 doc: /* Return t if text after point matches regular expression REGEXP.
349 This function modifies the match data that `match-beginning',
350 `match-end' and `match-data' access; save and restore the match
351 data if you want to preserve them. */)
352 (Lisp_Object regexp)
353 {
354 return looking_at_1 (regexp, 0);
355 }
356
357 DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0,
358 doc: /* Return t if text after point matches regular expression REGEXP.
359 Find the longest match, in accord with Posix regular expression rules.
360 This function modifies the match data that `match-beginning',
361 `match-end' and `match-data' access; save and restore the match
362 data if you want to preserve them. */)
363 (Lisp_Object regexp)
364 {
365 return looking_at_1 (regexp, 1);
366 }
367 \f
368 static Lisp_Object
369 string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
370 bool posix)
371 {
372 ptrdiff_t val;
373 struct re_pattern_buffer *bufp;
374 EMACS_INT pos;
375 ptrdiff_t pos_byte, i;
376
377 if (running_asynch_code)
378 save_search_regs ();
379
380 CHECK_STRING (regexp);
381 CHECK_STRING (string);
382
383 if (NILP (start))
384 pos = 0, pos_byte = 0;
385 else
386 {
387 ptrdiff_t len = SCHARS (string);
388
389 CHECK_NUMBER (start);
390 pos = XINT (start);
391 if (pos < 0 && -pos <= len)
392 pos = len + pos;
393 else if (0 > pos || pos > len)
394 args_out_of_range (string, start);
395 pos_byte = string_char_to_byte (string, pos);
396 }
397
398 /* This is so set_image_of_range_1 in regex.c can find the EQV table. */
399 set_char_table_extras (BVAR (current_buffer, case_canon_table), 2,
400 BVAR (current_buffer, case_eqv_table));
401
402 bufp = compile_pattern (regexp,
403 (NILP (Vinhibit_changing_match_data)
404 ? &search_regs : NULL),
405 (!NILP (BVAR (current_buffer, case_fold_search))
406 ? BVAR (current_buffer, case_canon_table) : Qnil),
407 posix,
408 STRING_MULTIBYTE (string));
409 immediate_quit = 1;
410 re_match_object = string;
411
412 val = re_search (bufp, SSDATA (string),
413 SBYTES (string), pos_byte,
414 SBYTES (string) - pos_byte,
415 (NILP (Vinhibit_changing_match_data)
416 ? &search_regs : NULL));
417 immediate_quit = 0;
418
419 /* Set last_thing_searched only when match data is changed. */
420 if (NILP (Vinhibit_changing_match_data))
421 last_thing_searched = Qt;
422
423 if (val == -2)
424 matcher_overflow ();
425 if (val < 0) return Qnil;
426
427 if (NILP (Vinhibit_changing_match_data))
428 for (i = 0; i < search_regs.num_regs; i++)
429 if (search_regs.start[i] >= 0)
430 {
431 search_regs.start[i]
432 = string_byte_to_char (string, search_regs.start[i]);
433 search_regs.end[i]
434 = string_byte_to_char (string, search_regs.end[i]);
435 }
436
437 return make_number (string_byte_to_char (string, val));
438 }
439
440 DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0,
441 doc: /* Return index of start of first match for REGEXP in STRING, or nil.
442 Matching ignores case if `case-fold-search' is non-nil.
443 If third arg START is non-nil, start search at that index in STRING.
444 For index of first char beyond the match, do (match-end 0).
445 `match-end' and `match-beginning' also give indices of substrings
446 matched by parenthesis constructs in the pattern.
447
448 You can use the function `match-string' to extract the substrings
449 matched by the parenthesis constructions in REGEXP. */)
450 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start)
451 {
452 return string_match_1 (regexp, string, start, 0);
453 }
454
455 DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0,
456 doc: /* Return index of start of first match for REGEXP in STRING, or nil.
457 Find the longest match, in accord with Posix regular expression rules.
458 Case is ignored if `case-fold-search' is non-nil in the current buffer.
459 If third arg START is non-nil, start search at that index in STRING.
460 For index of first char beyond the match, do (match-end 0).
461 `match-end' and `match-beginning' also give indices of substrings
462 matched by parenthesis constructs in the pattern. */)
463 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start)
464 {
465 return string_match_1 (regexp, string, start, 1);
466 }
467
468 /* Match REGEXP against STRING, searching all of STRING,
469 and return the index of the match, or negative on failure.
470 This does not clobber the match data. */
471
472 ptrdiff_t
473 fast_string_match (Lisp_Object regexp, Lisp_Object string)
474 {
475 ptrdiff_t val;
476 struct re_pattern_buffer *bufp;
477
478 bufp = compile_pattern (regexp, 0, Qnil,
479 0, STRING_MULTIBYTE (string));
480 immediate_quit = 1;
481 re_match_object = string;
482
483 val = re_search (bufp, SSDATA (string),
484 SBYTES (string), 0,
485 SBYTES (string), 0);
486 immediate_quit = 0;
487 return val;
488 }
489
490 /* Match REGEXP against STRING, searching all of STRING ignoring case,
491 and return the index of the match, or negative on failure.
492 This does not clobber the match data.
493 We assume that STRING contains single-byte characters. */
494
495 ptrdiff_t
496 fast_c_string_match_ignore_case (Lisp_Object regexp,
497 const char *string, ptrdiff_t len)
498 {
499 ptrdiff_t val;
500 struct re_pattern_buffer *bufp;
501
502 regexp = string_make_unibyte (regexp);
503 re_match_object = Qt;
504 bufp = compile_pattern (regexp, 0,
505 Vascii_canon_table, 0,
506 0);
507 immediate_quit = 1;
508 val = re_search (bufp, string, len, 0, len, 0);
509 immediate_quit = 0;
510 return val;
511 }
512
513 /* Like fast_string_match but ignore case. */
514
515 ptrdiff_t
516 fast_string_match_ignore_case (Lisp_Object regexp, Lisp_Object string)
517 {
518 ptrdiff_t val;
519 struct re_pattern_buffer *bufp;
520
521 bufp = compile_pattern (regexp, 0, Vascii_canon_table,
522 0, STRING_MULTIBYTE (string));
523 immediate_quit = 1;
524 re_match_object = string;
525
526 val = re_search (bufp, SSDATA (string),
527 SBYTES (string), 0,
528 SBYTES (string), 0);
529 immediate_quit = 0;
530 return val;
531 }
532 \f
533 /* Match REGEXP against the characters after POS to LIMIT, and return
534 the number of matched characters. If STRING is non-nil, match
535 against the characters in it. In that case, POS and LIMIT are
536 indices into the string. This function doesn't modify the match
537 data. */
538
539 ptrdiff_t
540 fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte,
541 ptrdiff_t limit, ptrdiff_t limit_byte, Lisp_Object string)
542 {
543 bool multibyte;
544 struct re_pattern_buffer *buf;
545 unsigned char *p1, *p2;
546 ptrdiff_t s1, s2;
547 ptrdiff_t len;
548
549 if (STRINGP (string))
550 {
551 if (pos_byte < 0)
552 pos_byte = string_char_to_byte (string, pos);
553 if (limit_byte < 0)
554 limit_byte = string_char_to_byte (string, limit);
555 p1 = NULL;
556 s1 = 0;
557 p2 = SDATA (string);
558 s2 = SBYTES (string);
559 re_match_object = string;
560 multibyte = STRING_MULTIBYTE (string);
561 }
562 else
563 {
564 if (pos_byte < 0)
565 pos_byte = CHAR_TO_BYTE (pos);
566 if (limit_byte < 0)
567 limit_byte = CHAR_TO_BYTE (limit);
568 pos_byte -= BEGV_BYTE;
569 limit_byte -= BEGV_BYTE;
570 p1 = BEGV_ADDR;
571 s1 = GPT_BYTE - BEGV_BYTE;
572 p2 = GAP_END_ADDR;
573 s2 = ZV_BYTE - GPT_BYTE;
574 if (s1 < 0)
575 {
576 p2 = p1;
577 s2 = ZV_BYTE - BEGV_BYTE;
578 s1 = 0;
579 }
580 if (s2 < 0)
581 {
582 s1 = ZV_BYTE - BEGV_BYTE;
583 s2 = 0;
584 }
585 re_match_object = Qnil;
586 multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
587 }
588
589 buf = compile_pattern (regexp, 0, Qnil, 0, multibyte);
590 immediate_quit = 1;
591 len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2,
592 pos_byte, NULL, limit_byte);
593 immediate_quit = 0;
594
595 return len;
596 }
597
598 \f
599 /* The newline cache: remembering which sections of text have no newlines. */
600
601 /* If the user has requested the long scans caching, make sure it's on.
602 Otherwise, make sure it's off.
603 This is our cheezy way of associating an action with the change of
604 state of a buffer-local variable. */
605 static void
606 newline_cache_on_off (struct buffer *buf)
607 {
608 if (NILP (BVAR (buf, cache_long_scans)))
609 {
610 /* It should be off. */
611 if (buf->newline_cache)
612 {
613 free_region_cache (buf->newline_cache);
614 buf->newline_cache = 0;
615 }
616 }
617 else
618 {
619 /* It should be on. */
620 if (buf->newline_cache == 0)
621 buf->newline_cache = new_region_cache ();
622 }
623 }
624
625 \f
626 /* Search for COUNT newlines between START/START_BYTE and END/END_BYTE.
627
628 If COUNT is positive, search forwards; END must be >= START.
629 If COUNT is negative, search backwards for the -COUNTth instance;
630 END must be <= START.
631 If COUNT is zero, do anything you please; run rogue, for all I care.
632
633 If END is zero, use BEGV or ZV instead, as appropriate for the
634 direction indicated by COUNT.
635
636 If we find COUNT instances, set *SHORTAGE to zero, and return the
637 position past the COUNTth match. Note that for reverse motion
638 this is not the same as the usual convention for Emacs motion commands.
639
640 If we don't find COUNT instances before reaching END, set *SHORTAGE
641 to the number of newlines left unfound, and return END.
642
643 If BYTEPOS is not NULL, set *BYTEPOS to the byte position corresponding
644 to the returned character position.
645
646 If ALLOW_QUIT, set immediate_quit. That's good to do
647 except when inside redisplay. */
648
649 ptrdiff_t
650 find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
651 ptrdiff_t end_byte, ptrdiff_t count, ptrdiff_t *shortage,
652 ptrdiff_t *bytepos, bool allow_quit)
653 {
654 struct region_cache *newline_cache;
655 int direction;
656
657 if (count > 0)
658 {
659 direction = 1;
660 if (!end)
661 end = ZV, end_byte = ZV_BYTE;
662 }
663 else
664 {
665 direction = -1;
666 if (!end)
667 end = BEGV, end_byte = BEGV_BYTE;
668 }
669 if (end_byte == -1)
670 end_byte = CHAR_TO_BYTE (end);
671
672 newline_cache_on_off (current_buffer);
673 newline_cache = current_buffer->newline_cache;
674
675 if (shortage != 0)
676 *shortage = 0;
677
678 immediate_quit = allow_quit;
679
680 if (count > 0)
681 while (start != end)
682 {
683 /* Our innermost scanning loop is very simple; it doesn't know
684 about gaps, buffer ends, or the newline cache. ceiling is
685 the position of the last character before the next such
686 obstacle --- the last character the dumb search loop should
687 examine. */
688 ptrdiff_t tem, ceiling_byte = end_byte - 1;
689
690 /* If we're looking for a newline, consult the newline cache
691 to see where we can avoid some scanning. */
692 if (newline_cache)
693 {
694 ptrdiff_t next_change;
695 immediate_quit = 0;
696 while (region_cache_forward
697 (current_buffer, newline_cache, start, &next_change))
698 start = next_change;
699 immediate_quit = allow_quit;
700
701 start_byte = CHAR_TO_BYTE (start);
702
703 /* START should never be after END. */
704 if (start_byte > ceiling_byte)
705 start_byte = ceiling_byte;
706
707 /* Now the text after start is an unknown region, and
708 next_change is the position of the next known region. */
709 ceiling_byte = min (CHAR_TO_BYTE (next_change) - 1, ceiling_byte);
710 }
711 else if (start_byte == -1)
712 start_byte = CHAR_TO_BYTE (start);
713
714 /* The dumb loop can only scan text stored in contiguous
715 bytes. BUFFER_CEILING_OF returns the last character
716 position that is contiguous, so the ceiling is the
717 position after that. */
718 tem = BUFFER_CEILING_OF (start_byte);
719 ceiling_byte = min (tem, ceiling_byte);
720
721 {
722 /* The termination address of the dumb loop. */
723 unsigned char *lim_addr = BYTE_POS_ADDR (ceiling_byte) + 1;
724 ptrdiff_t lim_byte = ceiling_byte + 1;
725
726 /* Nonpositive offsets (relative to LIM_ADDR and LIM_BYTE)
727 of the base, the cursor, and the next line. */
728 ptrdiff_t base = start_byte - lim_byte;
729 ptrdiff_t cursor, next;
730
731 for (cursor = base; cursor < 0; cursor = next)
732 {
733 /* The dumb loop. */
734 unsigned char *nl = memchr (lim_addr + cursor, '\n', - cursor);
735 next = nl ? nl - lim_addr : 0;
736
737 /* If we're looking for newlines, cache the fact that
738 this line's region is free of them. */
739 if (newline_cache)
740 {
741 know_region_cache (current_buffer, newline_cache,
742 BYTE_TO_CHAR (lim_byte + cursor),
743 BYTE_TO_CHAR (lim_byte + next));
744 /* know_region_cache can relocate buffer text. */
745 lim_addr = BYTE_POS_ADDR (ceiling_byte) + 1;
746 }
747
748 if (! nl)
749 break;
750 next++;
751
752 if (--count == 0)
753 {
754 immediate_quit = 0;
755 if (bytepos)
756 *bytepos = lim_byte + next;
757 return BYTE_TO_CHAR (lim_byte + next);
758 }
759 }
760
761 start_byte = lim_byte;
762 start = BYTE_TO_CHAR (start_byte);
763 }
764 }
765 else
766 while (start > end)
767 {
768 /* The last character to check before the next obstacle. */
769 ptrdiff_t tem, ceiling_byte = end_byte;
770
771 /* Consult the newline cache, if appropriate. */
772 if (newline_cache)
773 {
774 ptrdiff_t next_change;
775 immediate_quit = 0;
776 while (region_cache_backward
777 (current_buffer, newline_cache, start, &next_change))
778 start = next_change;
779 immediate_quit = allow_quit;
780
781 start_byte = CHAR_TO_BYTE (start);
782
783 /* Start should never be at or before end. */
784 if (start_byte <= ceiling_byte)
785 start_byte = ceiling_byte + 1;
786
787 /* Now the text before start is an unknown region, and
788 next_change is the position of the next known region. */
789 ceiling_byte = max (CHAR_TO_BYTE (next_change), ceiling_byte);
790 }
791 else if (start_byte == -1)
792 start_byte = CHAR_TO_BYTE (start);
793
794 /* Stop scanning before the gap. */
795 tem = BUFFER_FLOOR_OF (start_byte - 1);
796 ceiling_byte = max (tem, ceiling_byte);
797
798 {
799 /* The termination address of the dumb loop. */
800 unsigned char *ceiling_addr = BYTE_POS_ADDR (ceiling_byte);
801
802 /* Offsets (relative to CEILING_ADDR and CEILING_BYTE) of
803 the base, the cursor, and the previous line. These
804 offsets are at least -1. */
805 ptrdiff_t base = start_byte - ceiling_byte;
806 ptrdiff_t cursor, prev;
807
808 for (cursor = base; 0 < cursor; cursor = prev)
809 {
810 unsigned char *nl = memrchr (ceiling_addr, '\n', cursor);
811 prev = nl ? nl - ceiling_addr : -1;
812
813 /* If we're looking for newlines, cache the fact that
814 this line's region is free of them. */
815 if (newline_cache)
816 {
817 know_region_cache (current_buffer, newline_cache,
818 BYTE_TO_CHAR (ceiling_byte + prev + 1),
819 BYTE_TO_CHAR (ceiling_byte + cursor));
820 /* know_region_cache can relocate buffer text. */
821 ceiling_addr = BYTE_POS_ADDR (ceiling_byte);
822 }
823
824 if (! nl)
825 break;
826
827 if (++count >= 0)
828 {
829 immediate_quit = 0;
830 if (bytepos)
831 *bytepos = ceiling_byte + prev + 1;
832 return BYTE_TO_CHAR (ceiling_byte + prev + 1);
833 }
834 }
835
836 start_byte = ceiling_byte;
837 start = BYTE_TO_CHAR (start_byte);
838 }
839 }
840
841 immediate_quit = 0;
842 if (shortage)
843 *shortage = count * direction;
844 if (bytepos)
845 {
846 *bytepos = start_byte == -1 ? CHAR_TO_BYTE (start) : start_byte;
847 eassert (*bytepos == CHAR_TO_BYTE (start));
848 }
849 return start;
850 }
851 \f
852 /* Search for COUNT instances of a line boundary.
853 Start at START. If COUNT is negative, search backwards.
854
855 We report the resulting position by calling TEMP_SET_PT_BOTH.
856
857 If we find COUNT instances. we position after (always after,
858 even if scanning backwards) the COUNTth match, and return 0.
859
860 If we don't find COUNT instances before reaching the end of the
861 buffer (or the beginning, if scanning backwards), we return
862 the number of line boundaries left unfound, and position at
863 the limit we bumped up against.
864
865 If ALLOW_QUIT, set immediate_quit. That's good to do
866 except in special cases. */
867
868 ptrdiff_t
869 scan_newline (ptrdiff_t start, ptrdiff_t start_byte,
870 ptrdiff_t limit, ptrdiff_t limit_byte,
871 ptrdiff_t count, bool allow_quit)
872 {
873 ptrdiff_t charpos, bytepos, shortage;
874
875 charpos = find_newline (start, start_byte, limit, limit_byte,
876 count, &shortage, &bytepos, allow_quit);
877 if (shortage)
878 TEMP_SET_PT_BOTH (limit, limit_byte);
879 else
880 TEMP_SET_PT_BOTH (charpos, bytepos);
881 return shortage;
882 }
883
884 /* Like find_newline, but doesn't allow QUITting and doesn't return
885 SHORTAGE. */
886 ptrdiff_t
887 find_newline_no_quit (ptrdiff_t from, ptrdiff_t frombyte,
888 ptrdiff_t cnt, ptrdiff_t *bytepos)
889 {
890 return find_newline (from, frombyte, 0, -1, cnt, NULL, bytepos, 0);
891 }
892
893 /* Like find_newline, but returns position before the newline, not
894 after, and only search up to TO.
895 This isn't just find_newline_no_quit (...)-1, because you might hit TO. */
896
897 ptrdiff_t
898 find_before_next_newline (ptrdiff_t from, ptrdiff_t to,
899 ptrdiff_t cnt, ptrdiff_t *bytepos)
900 {
901 ptrdiff_t shortage;
902 ptrdiff_t pos = find_newline (from, -1, to, -1, cnt, &shortage, bytepos, 1);
903
904 if (shortage == 0)
905 {
906 if (bytepos)
907 DEC_BOTH (pos, *bytepos);
908 else
909 pos--;
910 }
911 return pos;
912 }
913 \f
914 /* Subroutines of Lisp buffer search functions. */
915
916 static Lisp_Object
917 search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
918 Lisp_Object count, int direction, int RE, bool posix)
919 {
920 EMACS_INT np;
921 EMACS_INT lim;
922 ptrdiff_t lim_byte;
923 EMACS_INT n = direction;
924
925 if (!NILP (count))
926 {
927 CHECK_NUMBER (count);
928 n *= XINT (count);
929 }
930
931 CHECK_STRING (string);
932 if (NILP (bound))
933 {
934 if (n > 0)
935 lim = ZV, lim_byte = ZV_BYTE;
936 else
937 lim = BEGV, lim_byte = BEGV_BYTE;
938 }
939 else
940 {
941 CHECK_NUMBER_COERCE_MARKER (bound);
942 lim = XINT (bound);
943 if (n > 0 ? lim < PT : lim > PT)
944 error ("Invalid search bound (wrong side of point)");
945 if (lim > ZV)
946 lim = ZV, lim_byte = ZV_BYTE;
947 else if (lim < BEGV)
948 lim = BEGV, lim_byte = BEGV_BYTE;
949 else
950 lim_byte = CHAR_TO_BYTE (lim);
951 }
952
953 /* This is so set_image_of_range_1 in regex.c can find the EQV table. */
954 set_char_table_extras (BVAR (current_buffer, case_canon_table), 2,
955 BVAR (current_buffer, case_eqv_table));
956
957 np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE,
958 (!NILP (BVAR (current_buffer, case_fold_search))
959 ? BVAR (current_buffer, case_canon_table)
960 : Qnil),
961 (!NILP (BVAR (current_buffer, case_fold_search))
962 ? BVAR (current_buffer, case_eqv_table)
963 : Qnil),
964 posix);
965 if (np <= 0)
966 {
967 if (NILP (noerror))
968 xsignal1 (Qsearch_failed, string);
969
970 if (!EQ (noerror, Qt))
971 {
972 eassert (BEGV <= lim && lim <= ZV);
973 SET_PT_BOTH (lim, lim_byte);
974 return Qnil;
975 #if 0 /* This would be clean, but maybe programs depend on
976 a value of nil here. */
977 np = lim;
978 #endif
979 }
980 else
981 return Qnil;
982 }
983
984 eassert (BEGV <= np && np <= ZV);
985 SET_PT (np);
986
987 return make_number (np);
988 }
989 \f
990 /* Return true if REGEXP it matches just one constant string. */
991
992 static bool
993 trivial_regexp_p (Lisp_Object regexp)
994 {
995 ptrdiff_t len = SBYTES (regexp);
996 unsigned char *s = SDATA (regexp);
997 while (--len >= 0)
998 {
999 switch (*s++)
1000 {
1001 case '.': case '*': case '+': case '?': case '[': case '^': case '$':
1002 return 0;
1003 case '\\':
1004 if (--len < 0)
1005 return 0;
1006 switch (*s++)
1007 {
1008 case '|': case '(': case ')': case '`': case '\'': case 'b':
1009 case 'B': case '<': case '>': case 'w': case 'W': case 's':
1010 case 'S': case '=': case '{': case '}': case '_':
1011 case 'c': case 'C': /* for categoryspec and notcategoryspec */
1012 case '1': case '2': case '3': case '4': case '5':
1013 case '6': case '7': case '8': case '9':
1014 return 0;
1015 }
1016 }
1017 }
1018 return 1;
1019 }
1020
1021 /* Search for the n'th occurrence of STRING in the current buffer,
1022 starting at position POS and stopping at position LIM,
1023 treating STRING as a literal string if RE is false or as
1024 a regular expression if RE is true.
1025
1026 If N is positive, searching is forward and LIM must be greater than POS.
1027 If N is negative, searching is backward and LIM must be less than POS.
1028
1029 Returns -x if x occurrences remain to be found (x > 0),
1030 or else the position at the beginning of the Nth occurrence
1031 (if searching backward) or the end (if searching forward).
1032
1033 POSIX is nonzero if we want full backtracking (POSIX style)
1034 for this pattern. 0 means backtrack only enough to get a valid match. */
1035
1036 #define TRANSLATE(out, trt, d) \
1037 do \
1038 { \
1039 if (! NILP (trt)) \
1040 { \
1041 Lisp_Object temp; \
1042 temp = Faref (trt, make_number (d)); \
1043 if (INTEGERP (temp)) \
1044 out = XINT (temp); \
1045 else \
1046 out = d; \
1047 } \
1048 else \
1049 out = d; \
1050 } \
1051 while (0)
1052
1053 /* Only used in search_buffer, to record the end position of the match
1054 when searching regexps and SEARCH_REGS should not be changed
1055 (i.e. Vinhibit_changing_match_data is non-nil). */
1056 static struct re_registers search_regs_1;
1057
1058 static EMACS_INT
1059 search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1060 ptrdiff_t lim, ptrdiff_t lim_byte, EMACS_INT n,
1061 int RE, Lisp_Object trt, Lisp_Object inverse_trt, bool posix)
1062 {
1063 ptrdiff_t len = SCHARS (string);
1064 ptrdiff_t len_byte = SBYTES (string);
1065 register ptrdiff_t i;
1066
1067 if (running_asynch_code)
1068 save_search_regs ();
1069
1070 /* Searching 0 times means don't move. */
1071 /* Null string is found at starting position. */
1072 if (len == 0 || n == 0)
1073 {
1074 set_search_regs (pos_byte, 0);
1075 return pos;
1076 }
1077
1078 if (RE && !(trivial_regexp_p (string) && NILP (Vsearch_spaces_regexp)))
1079 {
1080 unsigned char *p1, *p2;
1081 ptrdiff_t s1, s2;
1082 struct re_pattern_buffer *bufp;
1083
1084 bufp = compile_pattern (string,
1085 (NILP (Vinhibit_changing_match_data)
1086 ? &search_regs : &search_regs_1),
1087 trt, posix,
1088 !NILP (BVAR (current_buffer, enable_multibyte_characters)));
1089
1090 immediate_quit = 1; /* Quit immediately if user types ^G,
1091 because letting this function finish
1092 can take too long. */
1093 QUIT; /* Do a pending quit right away,
1094 to avoid paradoxical behavior */
1095 /* Get pointers and sizes of the two strings
1096 that make up the visible portion of the buffer. */
1097
1098 p1 = BEGV_ADDR;
1099 s1 = GPT_BYTE - BEGV_BYTE;
1100 p2 = GAP_END_ADDR;
1101 s2 = ZV_BYTE - GPT_BYTE;
1102 if (s1 < 0)
1103 {
1104 p2 = p1;
1105 s2 = ZV_BYTE - BEGV_BYTE;
1106 s1 = 0;
1107 }
1108 if (s2 < 0)
1109 {
1110 s1 = ZV_BYTE - BEGV_BYTE;
1111 s2 = 0;
1112 }
1113 re_match_object = Qnil;
1114
1115 while (n < 0)
1116 {
1117 ptrdiff_t val;
1118
1119 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
1120 pos_byte - BEGV_BYTE, lim_byte - pos_byte,
1121 (NILP (Vinhibit_changing_match_data)
1122 ? &search_regs : &search_regs_1),
1123 /* Don't allow match past current point */
1124 pos_byte - BEGV_BYTE);
1125 if (val == -2)
1126 {
1127 matcher_overflow ();
1128 }
1129 if (val >= 0)
1130 {
1131 if (NILP (Vinhibit_changing_match_data))
1132 {
1133 pos_byte = search_regs.start[0] + BEGV_BYTE;
1134 for (i = 0; i < search_regs.num_regs; i++)
1135 if (search_regs.start[i] >= 0)
1136 {
1137 search_regs.start[i]
1138 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
1139 search_regs.end[i]
1140 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
1141 }
1142 XSETBUFFER (last_thing_searched, current_buffer);
1143 /* Set pos to the new position. */
1144 pos = search_regs.start[0];
1145 }
1146 else
1147 {
1148 pos_byte = search_regs_1.start[0] + BEGV_BYTE;
1149 /* Set pos to the new position. */
1150 pos = BYTE_TO_CHAR (search_regs_1.start[0] + BEGV_BYTE);
1151 }
1152 }
1153 else
1154 {
1155 immediate_quit = 0;
1156 return (n);
1157 }
1158 n++;
1159 }
1160 while (n > 0)
1161 {
1162 ptrdiff_t val;
1163
1164 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
1165 pos_byte - BEGV_BYTE, lim_byte - pos_byte,
1166 (NILP (Vinhibit_changing_match_data)
1167 ? &search_regs : &search_regs_1),
1168 lim_byte - BEGV_BYTE);
1169 if (val == -2)
1170 {
1171 matcher_overflow ();
1172 }
1173 if (val >= 0)
1174 {
1175 if (NILP (Vinhibit_changing_match_data))
1176 {
1177 pos_byte = search_regs.end[0] + BEGV_BYTE;
1178 for (i = 0; i < search_regs.num_regs; i++)
1179 if (search_regs.start[i] >= 0)
1180 {
1181 search_regs.start[i]
1182 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
1183 search_regs.end[i]
1184 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
1185 }
1186 XSETBUFFER (last_thing_searched, current_buffer);
1187 pos = search_regs.end[0];
1188 }
1189 else
1190 {
1191 pos_byte = search_regs_1.end[0] + BEGV_BYTE;
1192 pos = BYTE_TO_CHAR (search_regs_1.end[0] + BEGV_BYTE);
1193 }
1194 }
1195 else
1196 {
1197 immediate_quit = 0;
1198 return (0 - n);
1199 }
1200 n--;
1201 }
1202 immediate_quit = 0;
1203 return (pos);
1204 }
1205 else /* non-RE case */
1206 {
1207 unsigned char *raw_pattern, *pat;
1208 ptrdiff_t raw_pattern_size;
1209 ptrdiff_t raw_pattern_size_byte;
1210 unsigned char *patbuf;
1211 bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
1212 unsigned char *base_pat;
1213 /* Set to positive if we find a non-ASCII char that need
1214 translation. Otherwise set to zero later. */
1215 int char_base = -1;
1216 bool boyer_moore_ok = 1;
1217
1218 /* MULTIBYTE says whether the text to be searched is multibyte.
1219 We must convert PATTERN to match that, or we will not really
1220 find things right. */
1221
1222 if (multibyte == STRING_MULTIBYTE (string))
1223 {
1224 raw_pattern = SDATA (string);
1225 raw_pattern_size = SCHARS (string);
1226 raw_pattern_size_byte = SBYTES (string);
1227 }
1228 else if (multibyte)
1229 {
1230 raw_pattern_size = SCHARS (string);
1231 raw_pattern_size_byte
1232 = count_size_as_multibyte (SDATA (string),
1233 raw_pattern_size);
1234 raw_pattern = alloca (raw_pattern_size_byte + 1);
1235 copy_text (SDATA (string), raw_pattern,
1236 SCHARS (string), 0, 1);
1237 }
1238 else
1239 {
1240 /* Converting multibyte to single-byte.
1241
1242 ??? Perhaps this conversion should be done in a special way
1243 by subtracting nonascii-insert-offset from each non-ASCII char,
1244 so that only the multibyte chars which really correspond to
1245 the chosen single-byte character set can possibly match. */
1246 raw_pattern_size = SCHARS (string);
1247 raw_pattern_size_byte = SCHARS (string);
1248 raw_pattern = alloca (raw_pattern_size + 1);
1249 copy_text (SDATA (string), raw_pattern,
1250 SBYTES (string), 1, 0);
1251 }
1252
1253 /* Copy and optionally translate the pattern. */
1254 len = raw_pattern_size;
1255 len_byte = raw_pattern_size_byte;
1256 patbuf = alloca (len * MAX_MULTIBYTE_LENGTH);
1257 pat = patbuf;
1258 base_pat = raw_pattern;
1259 if (multibyte)
1260 {
1261 /* Fill patbuf by translated characters in STRING while
1262 checking if we can use boyer-moore search. If TRT is
1263 non-nil, we can use boyer-moore search only if TRT can be
1264 represented by the byte array of 256 elements. For that,
1265 all non-ASCII case-equivalents of all case-sensitive
1266 characters in STRING must belong to the same character
1267 group (two characters belong to the same group iff their
1268 multibyte forms are the same except for the last byte;
1269 i.e. every 64 characters form a group; U+0000..U+003F,
1270 U+0040..U+007F, U+0080..U+00BF, ...). */
1271
1272 while (--len >= 0)
1273 {
1274 unsigned char str_base[MAX_MULTIBYTE_LENGTH], *str;
1275 int c, translated, inverse;
1276 int in_charlen, charlen;
1277
1278 /* If we got here and the RE flag is set, it's because we're
1279 dealing with a regexp known to be trivial, so the backslash
1280 just quotes the next character. */
1281 if (RE && *base_pat == '\\')
1282 {
1283 len--;
1284 raw_pattern_size--;
1285 len_byte--;
1286 base_pat++;
1287 }
1288
1289 c = STRING_CHAR_AND_LENGTH (base_pat, in_charlen);
1290
1291 if (NILP (trt))
1292 {
1293 str = base_pat;
1294 charlen = in_charlen;
1295 }
1296 else
1297 {
1298 /* Translate the character. */
1299 TRANSLATE (translated, trt, c);
1300 charlen = CHAR_STRING (translated, str_base);
1301 str = str_base;
1302
1303 /* Check if C has any other case-equivalents. */
1304 TRANSLATE (inverse, inverse_trt, c);
1305 /* If so, check if we can use boyer-moore. */
1306 if (c != inverse && boyer_moore_ok)
1307 {
1308 /* Check if all equivalents belong to the same
1309 group of characters. Note that the check of C
1310 itself is done by the last iteration. */
1311 int this_char_base = -1;
1312
1313 while (boyer_moore_ok)
1314 {
1315 if (ASCII_BYTE_P (inverse))
1316 {
1317 if (this_char_base > 0)
1318 boyer_moore_ok = 0;
1319 else
1320 this_char_base = 0;
1321 }
1322 else if (CHAR_BYTE8_P (inverse))
1323 /* Boyer-moore search can't handle a
1324 translation of an eight-bit
1325 character. */
1326 boyer_moore_ok = 0;
1327 else if (this_char_base < 0)
1328 {
1329 this_char_base = inverse & ~0x3F;
1330 if (char_base < 0)
1331 char_base = this_char_base;
1332 else if (this_char_base != char_base)
1333 boyer_moore_ok = 0;
1334 }
1335 else if ((inverse & ~0x3F) != this_char_base)
1336 boyer_moore_ok = 0;
1337 if (c == inverse)
1338 break;
1339 TRANSLATE (inverse, inverse_trt, inverse);
1340 }
1341 }
1342 }
1343
1344 /* Store this character into the translated pattern. */
1345 memcpy (pat, str, charlen);
1346 pat += charlen;
1347 base_pat += in_charlen;
1348 len_byte -= in_charlen;
1349 }
1350
1351 /* If char_base is still negative we didn't find any translated
1352 non-ASCII characters. */
1353 if (char_base < 0)
1354 char_base = 0;
1355 }
1356 else
1357 {
1358 /* Unibyte buffer. */
1359 char_base = 0;
1360 while (--len >= 0)
1361 {
1362 int c, translated, inverse;
1363
1364 /* If we got here and the RE flag is set, it's because we're
1365 dealing with a regexp known to be trivial, so the backslash
1366 just quotes the next character. */
1367 if (RE && *base_pat == '\\')
1368 {
1369 len--;
1370 raw_pattern_size--;
1371 base_pat++;
1372 }
1373 c = *base_pat++;
1374 TRANSLATE (translated, trt, c);
1375 *pat++ = translated;
1376 /* Check that none of C's equivalents violates the
1377 assumptions of boyer_moore. */
1378 TRANSLATE (inverse, inverse_trt, c);
1379 while (1)
1380 {
1381 if (inverse >= 0200)
1382 {
1383 boyer_moore_ok = 0;
1384 break;
1385 }
1386 if (c == inverse)
1387 break;
1388 TRANSLATE (inverse, inverse_trt, inverse);
1389 }
1390 }
1391 }
1392
1393 len_byte = pat - patbuf;
1394 pat = base_pat = patbuf;
1395
1396 if (boyer_moore_ok)
1397 return boyer_moore (n, pat, len_byte, trt, inverse_trt,
1398 pos_byte, lim_byte,
1399 char_base);
1400 else
1401 return simple_search (n, pat, raw_pattern_size, len_byte, trt,
1402 pos, pos_byte, lim, lim_byte);
1403 }
1404 }
1405 \f
1406 /* Do a simple string search N times for the string PAT,
1407 whose length is LEN/LEN_BYTE,
1408 from buffer position POS/POS_BYTE until LIM/LIM_BYTE.
1409 TRT is the translation table.
1410
1411 Return the character position where the match is found.
1412 Otherwise, if M matches remained to be found, return -M.
1413
1414 This kind of search works regardless of what is in PAT and
1415 regardless of what is in TRT. It is used in cases where
1416 boyer_moore cannot work. */
1417
1418 static EMACS_INT
1419 simple_search (EMACS_INT n, unsigned char *pat,
1420 ptrdiff_t len, ptrdiff_t len_byte, Lisp_Object trt,
1421 ptrdiff_t pos, ptrdiff_t pos_byte,
1422 ptrdiff_t lim, ptrdiff_t lim_byte)
1423 {
1424 bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
1425 bool forward = n > 0;
1426 /* Number of buffer bytes matched. Note that this may be different
1427 from len_byte in a multibyte buffer. */
1428 ptrdiff_t match_byte = PTRDIFF_MIN;
1429
1430 if (lim > pos && multibyte)
1431 while (n > 0)
1432 {
1433 while (1)
1434 {
1435 /* Try matching at position POS. */
1436 ptrdiff_t this_pos = pos;
1437 ptrdiff_t this_pos_byte = pos_byte;
1438 ptrdiff_t this_len = len;
1439 unsigned char *p = pat;
1440 if (pos + len > lim || pos_byte + len_byte > lim_byte)
1441 goto stop;
1442
1443 while (this_len > 0)
1444 {
1445 int charlen, buf_charlen;
1446 int pat_ch, buf_ch;
1447
1448 pat_ch = STRING_CHAR_AND_LENGTH (p, charlen);
1449 buf_ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (this_pos_byte),
1450 buf_charlen);
1451 TRANSLATE (buf_ch, trt, buf_ch);
1452
1453 if (buf_ch != pat_ch)
1454 break;
1455
1456 this_len--;
1457 p += charlen;
1458
1459 this_pos_byte += buf_charlen;
1460 this_pos++;
1461 }
1462
1463 if (this_len == 0)
1464 {
1465 match_byte = this_pos_byte - pos_byte;
1466 pos += len;
1467 pos_byte += match_byte;
1468 break;
1469 }
1470
1471 INC_BOTH (pos, pos_byte);
1472 }
1473
1474 n--;
1475 }
1476 else if (lim > pos)
1477 while (n > 0)
1478 {
1479 while (1)
1480 {
1481 /* Try matching at position POS. */
1482 ptrdiff_t this_pos = pos;
1483 ptrdiff_t this_len = len;
1484 unsigned char *p = pat;
1485
1486 if (pos + len > lim)
1487 goto stop;
1488
1489 while (this_len > 0)
1490 {
1491 int pat_ch = *p++;
1492 int buf_ch = FETCH_BYTE (this_pos);
1493 TRANSLATE (buf_ch, trt, buf_ch);
1494
1495 if (buf_ch != pat_ch)
1496 break;
1497
1498 this_len--;
1499 this_pos++;
1500 }
1501
1502 if (this_len == 0)
1503 {
1504 match_byte = len;
1505 pos += len;
1506 break;
1507 }
1508
1509 pos++;
1510 }
1511
1512 n--;
1513 }
1514 /* Backwards search. */
1515 else if (lim < pos && multibyte)
1516 while (n < 0)
1517 {
1518 while (1)
1519 {
1520 /* Try matching at position POS. */
1521 ptrdiff_t this_pos = pos;
1522 ptrdiff_t this_pos_byte = pos_byte;
1523 ptrdiff_t this_len = len;
1524 const unsigned char *p = pat + len_byte;
1525
1526 if (this_pos - len < lim || (pos_byte - len_byte) < lim_byte)
1527 goto stop;
1528
1529 while (this_len > 0)
1530 {
1531 int pat_ch, buf_ch;
1532
1533 DEC_BOTH (this_pos, this_pos_byte);
1534 PREV_CHAR_BOUNDARY (p, pat);
1535 pat_ch = STRING_CHAR (p);
1536 buf_ch = STRING_CHAR (BYTE_POS_ADDR (this_pos_byte));
1537 TRANSLATE (buf_ch, trt, buf_ch);
1538
1539 if (buf_ch != pat_ch)
1540 break;
1541
1542 this_len--;
1543 }
1544
1545 if (this_len == 0)
1546 {
1547 match_byte = pos_byte - this_pos_byte;
1548 pos = this_pos;
1549 pos_byte = this_pos_byte;
1550 break;
1551 }
1552
1553 DEC_BOTH (pos, pos_byte);
1554 }
1555
1556 n++;
1557 }
1558 else if (lim < pos)
1559 while (n < 0)
1560 {
1561 while (1)
1562 {
1563 /* Try matching at position POS. */
1564 ptrdiff_t this_pos = pos - len;
1565 ptrdiff_t this_len = len;
1566 unsigned char *p = pat;
1567
1568 if (this_pos < lim)
1569 goto stop;
1570
1571 while (this_len > 0)
1572 {
1573 int pat_ch = *p++;
1574 int buf_ch = FETCH_BYTE (this_pos);
1575 TRANSLATE (buf_ch, trt, buf_ch);
1576
1577 if (buf_ch != pat_ch)
1578 break;
1579 this_len--;
1580 this_pos++;
1581 }
1582
1583 if (this_len == 0)
1584 {
1585 match_byte = len;
1586 pos -= len;
1587 break;
1588 }
1589
1590 pos--;
1591 }
1592
1593 n++;
1594 }
1595
1596 stop:
1597 if (n == 0)
1598 {
1599 eassert (match_byte != PTRDIFF_MIN);
1600 if (forward)
1601 set_search_regs ((multibyte ? pos_byte : pos) - match_byte, match_byte);
1602 else
1603 set_search_regs (multibyte ? pos_byte : pos, match_byte);
1604
1605 return pos;
1606 }
1607 else if (n > 0)
1608 return -n;
1609 else
1610 return n;
1611 }
1612 \f
1613 /* Do Boyer-Moore search N times for the string BASE_PAT,
1614 whose length is LEN_BYTE,
1615 from buffer position POS_BYTE until LIM_BYTE.
1616 DIRECTION says which direction we search in.
1617 TRT and INVERSE_TRT are translation tables.
1618 Characters in PAT are already translated by TRT.
1619
1620 This kind of search works if all the characters in BASE_PAT that
1621 have nontrivial translation are the same aside from the last byte.
1622 This makes it possible to translate just the last byte of a
1623 character, and do so after just a simple test of the context.
1624 CHAR_BASE is nonzero if there is such a non-ASCII character.
1625
1626 If that criterion is not satisfied, do not call this function. */
1627
1628 static EMACS_INT
1629 boyer_moore (EMACS_INT n, unsigned char *base_pat,
1630 ptrdiff_t len_byte,
1631 Lisp_Object trt, Lisp_Object inverse_trt,
1632 ptrdiff_t pos_byte, ptrdiff_t lim_byte,
1633 int char_base)
1634 {
1635 int direction = ((n > 0) ? 1 : -1);
1636 register ptrdiff_t dirlen;
1637 ptrdiff_t limit;
1638 int stride_for_teases = 0;
1639 int BM_tab[0400];
1640 register unsigned char *cursor, *p_limit;
1641 register ptrdiff_t i;
1642 register int j;
1643 unsigned char *pat, *pat_end;
1644 bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
1645
1646 unsigned char simple_translate[0400];
1647 /* These are set to the preceding bytes of a byte to be translated
1648 if char_base is nonzero. As the maximum byte length of a
1649 multibyte character is 5, we have to check at most four previous
1650 bytes. */
1651 int translate_prev_byte1 = 0;
1652 int translate_prev_byte2 = 0;
1653 int translate_prev_byte3 = 0;
1654
1655 /* The general approach is that we are going to maintain that we know
1656 the first (closest to the present position, in whatever direction
1657 we're searching) character that could possibly be the last
1658 (furthest from present position) character of a valid match. We
1659 advance the state of our knowledge by looking at that character
1660 and seeing whether it indeed matches the last character of the
1661 pattern. If it does, we take a closer look. If it does not, we
1662 move our pointer (to putative last characters) as far as is
1663 logically possible. This amount of movement, which I call a
1664 stride, will be the length of the pattern if the actual character
1665 appears nowhere in the pattern, otherwise it will be the distance
1666 from the last occurrence of that character to the end of the
1667 pattern. If the amount is zero we have a possible match. */
1668
1669 /* Here we make a "mickey mouse" BM table. The stride of the search
1670 is determined only by the last character of the putative match.
1671 If that character does not match, we will stride the proper
1672 distance to propose a match that superimposes it on the last
1673 instance of a character that matches it (per trt), or misses
1674 it entirely if there is none. */
1675
1676 dirlen = len_byte * direction;
1677
1678 /* Record position after the end of the pattern. */
1679 pat_end = base_pat + len_byte;
1680 /* BASE_PAT points to a character that we start scanning from.
1681 It is the first character in a forward search,
1682 the last character in a backward search. */
1683 if (direction < 0)
1684 base_pat = pat_end - 1;
1685
1686 /* A character that does not appear in the pattern induces a
1687 stride equal to the pattern length. */
1688 for (i = 0; i < 0400; i++)
1689 BM_tab[i] = dirlen;
1690
1691 /* We use this for translation, instead of TRT itself.
1692 We fill this in to handle the characters that actually
1693 occur in the pattern. Others don't matter anyway! */
1694 for (i = 0; i < 0400; i++)
1695 simple_translate[i] = i;
1696
1697 if (char_base)
1698 {
1699 /* Setup translate_prev_byte1/2/3/4 from CHAR_BASE. Only a
1700 byte following them are the target of translation. */
1701 unsigned char str[MAX_MULTIBYTE_LENGTH];
1702 int cblen = CHAR_STRING (char_base, str);
1703
1704 translate_prev_byte1 = str[cblen - 2];
1705 if (cblen > 2)
1706 {
1707 translate_prev_byte2 = str[cblen - 3];
1708 if (cblen > 3)
1709 translate_prev_byte3 = str[cblen - 4];
1710 }
1711 }
1712
1713 i = 0;
1714 while (i != dirlen)
1715 {
1716 unsigned char *ptr = base_pat + i;
1717 i += direction;
1718 if (! NILP (trt))
1719 {
1720 /* If the byte currently looking at is the last of a
1721 character to check case-equivalents, set CH to that
1722 character. An ASCII character and a non-ASCII character
1723 matching with CHAR_BASE are to be checked. */
1724 int ch = -1;
1725
1726 if (ASCII_BYTE_P (*ptr) || ! multibyte)
1727 ch = *ptr;
1728 else if (char_base
1729 && ((pat_end - ptr) == 1 || CHAR_HEAD_P (ptr[1])))
1730 {
1731 unsigned char *charstart = ptr - 1;
1732
1733 while (! (CHAR_HEAD_P (*charstart)))
1734 charstart--;
1735 ch = STRING_CHAR (charstart);
1736 if (char_base != (ch & ~0x3F))
1737 ch = -1;
1738 }
1739
1740 if (ch >= 0200 && multibyte)
1741 j = (ch & 0x3F) | 0200;
1742 else
1743 j = *ptr;
1744
1745 if (i == dirlen)
1746 stride_for_teases = BM_tab[j];
1747
1748 BM_tab[j] = dirlen - i;
1749 /* A translation table is accompanied by its inverse -- see
1750 comment following downcase_table for details. */
1751 if (ch >= 0)
1752 {
1753 int starting_ch = ch;
1754 int starting_j = j;
1755
1756 while (1)
1757 {
1758 TRANSLATE (ch, inverse_trt, ch);
1759 if (ch >= 0200 && multibyte)
1760 j = (ch & 0x3F) | 0200;
1761 else
1762 j = ch;
1763
1764 /* For all the characters that map into CH,
1765 set up simple_translate to map the last byte
1766 into STARTING_J. */
1767 simple_translate[j] = starting_j;
1768 if (ch == starting_ch)
1769 break;
1770 BM_tab[j] = dirlen - i;
1771 }
1772 }
1773 }
1774 else
1775 {
1776 j = *ptr;
1777
1778 if (i == dirlen)
1779 stride_for_teases = BM_tab[j];
1780 BM_tab[j] = dirlen - i;
1781 }
1782 /* stride_for_teases tells how much to stride if we get a
1783 match on the far character but are subsequently
1784 disappointed, by recording what the stride would have been
1785 for that character if the last character had been
1786 different. */
1787 }
1788 pos_byte += dirlen - ((direction > 0) ? direction : 0);
1789 /* loop invariant - POS_BYTE points at where last char (first
1790 char if reverse) of pattern would align in a possible match. */
1791 while (n != 0)
1792 {
1793 ptrdiff_t tail_end;
1794 unsigned char *tail_end_ptr;
1795
1796 /* It's been reported that some (broken) compiler thinks that
1797 Boolean expressions in an arithmetic context are unsigned.
1798 Using an explicit ?1:0 prevents this. */
1799 if ((lim_byte - pos_byte - ((direction > 0) ? 1 : 0)) * direction
1800 < 0)
1801 return (n * (0 - direction));
1802 /* First we do the part we can by pointers (maybe nothing) */
1803 QUIT;
1804 pat = base_pat;
1805 limit = pos_byte - dirlen + direction;
1806 if (direction > 0)
1807 {
1808 limit = BUFFER_CEILING_OF (limit);
1809 /* LIMIT is now the last (not beyond-last!) value POS_BYTE
1810 can take on without hitting edge of buffer or the gap. */
1811 limit = min (limit, pos_byte + 20000);
1812 limit = min (limit, lim_byte - 1);
1813 }
1814 else
1815 {
1816 limit = BUFFER_FLOOR_OF (limit);
1817 /* LIMIT is now the last (not beyond-last!) value POS_BYTE
1818 can take on without hitting edge of buffer or the gap. */
1819 limit = max (limit, pos_byte - 20000);
1820 limit = max (limit, lim_byte);
1821 }
1822 tail_end = BUFFER_CEILING_OF (pos_byte) + 1;
1823 tail_end_ptr = BYTE_POS_ADDR (tail_end);
1824
1825 if ((limit - pos_byte) * direction > 20)
1826 {
1827 unsigned char *p2;
1828
1829 p_limit = BYTE_POS_ADDR (limit);
1830 p2 = (cursor = BYTE_POS_ADDR (pos_byte));
1831 /* In this loop, pos + cursor - p2 is the surrogate for pos. */
1832 while (1) /* use one cursor setting as long as i can */
1833 {
1834 if (direction > 0) /* worth duplicating */
1835 {
1836 while (cursor <= p_limit)
1837 {
1838 if (BM_tab[*cursor] == 0)
1839 goto hit;
1840 cursor += BM_tab[*cursor];
1841 }
1842 }
1843 else
1844 {
1845 while (cursor >= p_limit)
1846 {
1847 if (BM_tab[*cursor] == 0)
1848 goto hit;
1849 cursor += BM_tab[*cursor];
1850 }
1851 }
1852 /* If you are here, cursor is beyond the end of the
1853 searched region. You fail to match within the
1854 permitted region and would otherwise try a character
1855 beyond that region. */
1856 break;
1857
1858 hit:
1859 i = dirlen - direction;
1860 if (! NILP (trt))
1861 {
1862 while ((i -= direction) + direction != 0)
1863 {
1864 int ch;
1865 cursor -= direction;
1866 /* Translate only the last byte of a character. */
1867 if (! multibyte
1868 || ((cursor == tail_end_ptr
1869 || CHAR_HEAD_P (cursor[1]))
1870 && (CHAR_HEAD_P (cursor[0])
1871 /* Check if this is the last byte of
1872 a translatable character. */
1873 || (translate_prev_byte1 == cursor[-1]
1874 && (CHAR_HEAD_P (translate_prev_byte1)
1875 || (translate_prev_byte2 == cursor[-2]
1876 && (CHAR_HEAD_P (translate_prev_byte2)
1877 || (translate_prev_byte3 == cursor[-3]))))))))
1878 ch = simple_translate[*cursor];
1879 else
1880 ch = *cursor;
1881 if (pat[i] != ch)
1882 break;
1883 }
1884 }
1885 else
1886 {
1887 while ((i -= direction) + direction != 0)
1888 {
1889 cursor -= direction;
1890 if (pat[i] != *cursor)
1891 break;
1892 }
1893 }
1894 cursor += dirlen - i - direction; /* fix cursor */
1895 if (i + direction == 0)
1896 {
1897 ptrdiff_t position, start, end;
1898
1899 cursor -= direction;
1900
1901 position = pos_byte + cursor - p2 + ((direction > 0)
1902 ? 1 - len_byte : 0);
1903 set_search_regs (position, len_byte);
1904
1905 if (NILP (Vinhibit_changing_match_data))
1906 {
1907 start = search_regs.start[0];
1908 end = search_regs.end[0];
1909 }
1910 else
1911 /* If Vinhibit_changing_match_data is non-nil,
1912 search_regs will not be changed. So let's
1913 compute start and end here. */
1914 {
1915 start = BYTE_TO_CHAR (position);
1916 end = BYTE_TO_CHAR (position + len_byte);
1917 }
1918
1919 if ((n -= direction) != 0)
1920 cursor += dirlen; /* to resume search */
1921 else
1922 return direction > 0 ? end : start;
1923 }
1924 else
1925 cursor += stride_for_teases; /* <sigh> we lose - */
1926 }
1927 pos_byte += cursor - p2;
1928 }
1929 else
1930 /* Now we'll pick up a clump that has to be done the hard
1931 way because it covers a discontinuity. */
1932 {
1933 limit = ((direction > 0)
1934 ? BUFFER_CEILING_OF (pos_byte - dirlen + 1)
1935 : BUFFER_FLOOR_OF (pos_byte - dirlen - 1));
1936 limit = ((direction > 0)
1937 ? min (limit + len_byte, lim_byte - 1)
1938 : max (limit - len_byte, lim_byte));
1939 /* LIMIT is now the last value POS_BYTE can have
1940 and still be valid for a possible match. */
1941 while (1)
1942 {
1943 /* This loop can be coded for space rather than
1944 speed because it will usually run only once.
1945 (the reach is at most len + 21, and typically
1946 does not exceed len). */
1947 while ((limit - pos_byte) * direction >= 0)
1948 {
1949 int ch = FETCH_BYTE (pos_byte);
1950 if (BM_tab[ch] == 0)
1951 goto hit2;
1952 pos_byte += BM_tab[ch];
1953 }
1954 break; /* ran off the end */
1955
1956 hit2:
1957 /* Found what might be a match. */
1958 i = dirlen - direction;
1959 while ((i -= direction) + direction != 0)
1960 {
1961 int ch;
1962 unsigned char *ptr;
1963 pos_byte -= direction;
1964 ptr = BYTE_POS_ADDR (pos_byte);
1965 /* Translate only the last byte of a character. */
1966 if (! multibyte
1967 || ((ptr == tail_end_ptr
1968 || CHAR_HEAD_P (ptr[1]))
1969 && (CHAR_HEAD_P (ptr[0])
1970 /* Check if this is the last byte of a
1971 translatable character. */
1972 || (translate_prev_byte1 == ptr[-1]
1973 && (CHAR_HEAD_P (translate_prev_byte1)
1974 || (translate_prev_byte2 == ptr[-2]
1975 && (CHAR_HEAD_P (translate_prev_byte2)
1976 || translate_prev_byte3 == ptr[-3])))))))
1977 ch = simple_translate[*ptr];
1978 else
1979 ch = *ptr;
1980 if (pat[i] != ch)
1981 break;
1982 }
1983 /* Above loop has moved POS_BYTE part or all the way
1984 back to the first pos (last pos if reverse).
1985 Set it once again at the last (first if reverse) char. */
1986 pos_byte += dirlen - i - direction;
1987 if (i + direction == 0)
1988 {
1989 ptrdiff_t position, start, end;
1990 pos_byte -= direction;
1991
1992 position = pos_byte + ((direction > 0) ? 1 - len_byte : 0);
1993 set_search_regs (position, len_byte);
1994
1995 if (NILP (Vinhibit_changing_match_data))
1996 {
1997 start = search_regs.start[0];
1998 end = search_regs.end[0];
1999 }
2000 else
2001 /* If Vinhibit_changing_match_data is non-nil,
2002 search_regs will not be changed. So let's
2003 compute start and end here. */
2004 {
2005 start = BYTE_TO_CHAR (position);
2006 end = BYTE_TO_CHAR (position + len_byte);
2007 }
2008
2009 if ((n -= direction) != 0)
2010 pos_byte += dirlen; /* to resume search */
2011 else
2012 return direction > 0 ? end : start;
2013 }
2014 else
2015 pos_byte += stride_for_teases;
2016 }
2017 }
2018 /* We have done one clump. Can we continue? */
2019 if ((lim_byte - pos_byte) * direction < 0)
2020 return ((0 - n) * direction);
2021 }
2022 return BYTE_TO_CHAR (pos_byte);
2023 }
2024
2025 /* Record beginning BEG_BYTE and end BEG_BYTE + NBYTES
2026 for the overall match just found in the current buffer.
2027 Also clear out the match data for registers 1 and up. */
2028
2029 static void
2030 set_search_regs (ptrdiff_t beg_byte, ptrdiff_t nbytes)
2031 {
2032 ptrdiff_t i;
2033
2034 if (!NILP (Vinhibit_changing_match_data))
2035 return;
2036
2037 /* Make sure we have registers in which to store
2038 the match position. */
2039 if (search_regs.num_regs == 0)
2040 {
2041 search_regs.start = xmalloc (2 * sizeof (regoff_t));
2042 search_regs.end = xmalloc (2 * sizeof (regoff_t));
2043 search_regs.num_regs = 2;
2044 }
2045
2046 /* Clear out the other registers. */
2047 for (i = 1; i < search_regs.num_regs; i++)
2048 {
2049 search_regs.start[i] = -1;
2050 search_regs.end[i] = -1;
2051 }
2052
2053 search_regs.start[0] = BYTE_TO_CHAR (beg_byte);
2054 search_regs.end[0] = BYTE_TO_CHAR (beg_byte + nbytes);
2055 XSETBUFFER (last_thing_searched, current_buffer);
2056 }
2057 \f
2058 DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
2059 "MSearch backward: ",
2060 doc: /* Search backward from point for STRING.
2061 Set point to the beginning of the occurrence found, and return point.
2062 An optional second argument bounds the search; it is a buffer position.
2063 The match found must not extend before that position.
2064 Optional third argument, if t, means if fail just return nil (no error).
2065 If not nil and not t, position at limit of search and return nil.
2066 Optional fourth argument COUNT, if non-nil, means to search for COUNT
2067 successive occurrences. If COUNT is negative, search forward,
2068 instead of backward, for -COUNT occurrences.
2069
2070 Search case-sensitivity is determined by the value of the variable
2071 `case-fold-search', which see.
2072
2073 See also the functions `match-beginning', `match-end' and `replace-match'. */)
2074 (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2075 {
2076 return search_command (string, bound, noerror, count, -1, 0, 0);
2077 }
2078
2079 DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "MSearch: ",
2080 doc: /* Search forward from point for STRING.
2081 Set point to the end of the occurrence found, and return point.
2082 An optional second argument bounds the search; it is a buffer position.
2083 The match found must not extend after that position. A value of nil is
2084 equivalent to (point-max).
2085 Optional third argument, if t, means if fail just return nil (no error).
2086 If not nil and not t, move to limit of search and return nil.
2087 Optional fourth argument COUNT, if non-nil, means to search for COUNT
2088 successive occurrences. If COUNT is negative, search backward,
2089 instead of forward, for -COUNT occurrences.
2090
2091 Search case-sensitivity is determined by the value of the variable
2092 `case-fold-search', which see.
2093
2094 See also the functions `match-beginning', `match-end' and `replace-match'. */)
2095 (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2096 {
2097 return search_command (string, bound, noerror, count, 1, 0, 0);
2098 }
2099
2100 DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
2101 "sRE search backward: ",
2102 doc: /* Search backward from point for match for regular expression REGEXP.
2103 Set point to the beginning of the match, and return point.
2104 The match found is the one starting last in the buffer
2105 and yet ending before the origin of the search.
2106 An optional second argument bounds the search; it is a buffer position.
2107 The match found must start at or after that position.
2108 Optional third argument, if t, means if fail just return nil (no error).
2109 If not nil and not t, move to limit of search and return nil.
2110 Optional fourth argument is repeat count--search for successive occurrences.
2111
2112 Search case-sensitivity is determined by the value of the variable
2113 `case-fold-search', which see.
2114
2115 See also the functions `match-beginning', `match-end', `match-string',
2116 and `replace-match'. */)
2117 (Lisp_Object regexp, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2118 {
2119 return search_command (regexp, bound, noerror, count, -1, 1, 0);
2120 }
2121
2122 DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4,
2123 "sRE search: ",
2124 doc: /* Search forward from point for regular expression REGEXP.
2125 Set point to the end of the occurrence found, and return point.
2126 An optional second argument bounds the search; it is a buffer position.
2127 The match found must not extend after that position.
2128 Optional third argument, if t, means if fail just return nil (no error).
2129 If not nil and not t, move to limit of search and return nil.
2130 Optional fourth argument is repeat count--search for successive occurrences.
2131
2132 Search case-sensitivity is determined by the value of the variable
2133 `case-fold-search', which see.
2134
2135 See also the functions `match-beginning', `match-end', `match-string',
2136 and `replace-match'. */)
2137 (Lisp_Object regexp, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2138 {
2139 return search_command (regexp, bound, noerror, count, 1, 1, 0);
2140 }
2141
2142 DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, 1, 4,
2143 "sPosix search backward: ",
2144 doc: /* Search backward from point for match for regular expression REGEXP.
2145 Find the longest match in accord with Posix regular expression rules.
2146 Set point to the beginning of the match, and return point.
2147 The match found is the one starting last in the buffer
2148 and yet ending before the origin of the search.
2149 An optional second argument bounds the search; it is a buffer position.
2150 The match found must start at or after that position.
2151 Optional third argument, if t, means if fail just return nil (no error).
2152 If not nil and not t, move to limit of search and return nil.
2153 Optional fourth argument is repeat count--search for successive occurrences.
2154
2155 Search case-sensitivity is determined by the value of the variable
2156 `case-fold-search', which see.
2157
2158 See also the functions `match-beginning', `match-end', `match-string',
2159 and `replace-match'. */)
2160 (Lisp_Object regexp, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2161 {
2162 return search_command (regexp, bound, noerror, count, -1, 1, 1);
2163 }
2164
2165 DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, 1, 4,
2166 "sPosix search: ",
2167 doc: /* Search forward from point for regular expression REGEXP.
2168 Find the longest match in accord with Posix regular expression rules.
2169 Set point to the end of the occurrence found, and return point.
2170 An optional second argument bounds the search; it is a buffer position.
2171 The match found must not extend after that position.
2172 Optional third argument, if t, means if fail just return nil (no error).
2173 If not nil and not t, move to limit of search and return nil.
2174 Optional fourth argument is repeat count--search for successive occurrences.
2175
2176 Search case-sensitivity is determined by the value of the variable
2177 `case-fold-search', which see.
2178
2179 See also the functions `match-beginning', `match-end', `match-string',
2180 and `replace-match'. */)
2181 (Lisp_Object regexp, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
2182 {
2183 return search_command (regexp, bound, noerror, count, 1, 1, 1);
2184 }
2185 \f
2186 DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0,
2187 doc: /* Replace text matched by last search with NEWTEXT.
2188 Leave point at the end of the replacement text.
2189
2190 If optional second arg FIXEDCASE is non-nil, do not alter the case of
2191 the replacement text. Otherwise, maybe capitalize the whole text, or
2192 maybe just word initials, based on the replaced text. If the replaced
2193 text has only capital letters and has at least one multiletter word,
2194 convert NEWTEXT to all caps. Otherwise if all words are capitalized
2195 in the replaced text, capitalize each word in NEWTEXT.
2196
2197 If optional third arg LITERAL is non-nil, insert NEWTEXT literally.
2198 Otherwise treat `\\' as special:
2199 `\\&' in NEWTEXT means substitute original matched text.
2200 `\\N' means substitute what matched the Nth `\\(...\\)'.
2201 If Nth parens didn't match, substitute nothing.
2202 `\\\\' means insert one `\\'.
2203 `\\?' is treated literally
2204 (for compatibility with `query-replace-regexp').
2205 Any other character following `\\' signals an error.
2206 Case conversion does not apply to these substitutions.
2207
2208 If optional fourth argument STRING is non-nil, it should be a string
2209 to act on; this should be the string on which the previous match was
2210 done via `string-match'. In this case, `replace-match' creates and
2211 returns a new string, made by copying STRING and replacing the part of
2212 STRING that was matched (the original STRING itself is not altered).
2213
2214 The optional fifth argument SUBEXP specifies a subexpression;
2215 it says to replace just that subexpression with NEWTEXT,
2216 rather than replacing the entire matched text.
2217 This is, in a vague sense, the inverse of using `\\N' in NEWTEXT;
2218 `\\N' copies subexp N into NEWTEXT, but using N as SUBEXP puts
2219 NEWTEXT in place of subexp N.
2220 This is useful only after a regular expression search or match,
2221 since only regular expressions have distinguished subexpressions. */)
2222 (Lisp_Object newtext, Lisp_Object fixedcase, Lisp_Object literal, Lisp_Object string, Lisp_Object subexp)
2223 {
2224 enum { nochange, all_caps, cap_initial } case_action;
2225 ptrdiff_t pos, pos_byte;
2226 bool some_multiletter_word;
2227 bool some_lowercase;
2228 bool some_uppercase;
2229 bool some_nonuppercase_initial;
2230 int c, prevc;
2231 ptrdiff_t sub;
2232 ptrdiff_t opoint, newpoint;
2233
2234 CHECK_STRING (newtext);
2235
2236 if (! NILP (string))
2237 CHECK_STRING (string);
2238
2239 case_action = nochange; /* We tried an initialization */
2240 /* but some C compilers blew it */
2241
2242 if (search_regs.num_regs <= 0)
2243 error ("`replace-match' called before any match found");
2244
2245 if (NILP (subexp))
2246 sub = 0;
2247 else
2248 {
2249 CHECK_NUMBER (subexp);
2250 if (! (0 <= XINT (subexp) && XINT (subexp) < search_regs.num_regs))
2251 args_out_of_range (subexp, make_number (search_regs.num_regs));
2252 sub = XINT (subexp);
2253 }
2254
2255 if (NILP (string))
2256 {
2257 if (search_regs.start[sub] < BEGV
2258 || search_regs.start[sub] > search_regs.end[sub]
2259 || search_regs.end[sub] > ZV)
2260 args_out_of_range (make_number (search_regs.start[sub]),
2261 make_number (search_regs.end[sub]));
2262 }
2263 else
2264 {
2265 if (search_regs.start[sub] < 0
2266 || search_regs.start[sub] > search_regs.end[sub]
2267 || search_regs.end[sub] > SCHARS (string))
2268 args_out_of_range (make_number (search_regs.start[sub]),
2269 make_number (search_regs.end[sub]));
2270 }
2271
2272 if (NILP (fixedcase))
2273 {
2274 /* Decide how to casify by examining the matched text. */
2275 ptrdiff_t last;
2276
2277 pos = search_regs.start[sub];
2278 last = search_regs.end[sub];
2279
2280 if (NILP (string))
2281 pos_byte = CHAR_TO_BYTE (pos);
2282 else
2283 pos_byte = string_char_to_byte (string, pos);
2284
2285 prevc = '\n';
2286 case_action = all_caps;
2287
2288 /* some_multiletter_word is set nonzero if any original word
2289 is more than one letter long. */
2290 some_multiletter_word = 0;
2291 some_lowercase = 0;
2292 some_nonuppercase_initial = 0;
2293 some_uppercase = 0;
2294
2295 while (pos < last)
2296 {
2297 if (NILP (string))
2298 {
2299 c = FETCH_CHAR_AS_MULTIBYTE (pos_byte);
2300 INC_BOTH (pos, pos_byte);
2301 }
2302 else
2303 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, pos, pos_byte);
2304
2305 if (lowercasep (c))
2306 {
2307 /* Cannot be all caps if any original char is lower case */
2308
2309 some_lowercase = 1;
2310 if (SYNTAX (prevc) != Sword)
2311 some_nonuppercase_initial = 1;
2312 else
2313 some_multiletter_word = 1;
2314 }
2315 else if (uppercasep (c))
2316 {
2317 some_uppercase = 1;
2318 if (SYNTAX (prevc) != Sword)
2319 ;
2320 else
2321 some_multiletter_word = 1;
2322 }
2323 else
2324 {
2325 /* If the initial is a caseless word constituent,
2326 treat that like a lowercase initial. */
2327 if (SYNTAX (prevc) != Sword)
2328 some_nonuppercase_initial = 1;
2329 }
2330
2331 prevc = c;
2332 }
2333
2334 /* Convert to all caps if the old text is all caps
2335 and has at least one multiletter word. */
2336 if (! some_lowercase && some_multiletter_word)
2337 case_action = all_caps;
2338 /* Capitalize each word, if the old text has all capitalized words. */
2339 else if (!some_nonuppercase_initial && some_multiletter_word)
2340 case_action = cap_initial;
2341 else if (!some_nonuppercase_initial && some_uppercase)
2342 /* Should x -> yz, operating on X, give Yz or YZ?
2343 We'll assume the latter. */
2344 case_action = all_caps;
2345 else
2346 case_action = nochange;
2347 }
2348
2349 /* Do replacement in a string. */
2350 if (!NILP (string))
2351 {
2352 Lisp_Object before, after;
2353
2354 before = Fsubstring (string, make_number (0),
2355 make_number (search_regs.start[sub]));
2356 after = Fsubstring (string, make_number (search_regs.end[sub]), Qnil);
2357
2358 /* Substitute parts of the match into NEWTEXT
2359 if desired. */
2360 if (NILP (literal))
2361 {
2362 ptrdiff_t lastpos = 0;
2363 ptrdiff_t lastpos_byte = 0;
2364 /* We build up the substituted string in ACCUM. */
2365 Lisp_Object accum;
2366 Lisp_Object middle;
2367 ptrdiff_t length = SBYTES (newtext);
2368
2369 accum = Qnil;
2370
2371 for (pos_byte = 0, pos = 0; pos_byte < length;)
2372 {
2373 ptrdiff_t substart = -1;
2374 ptrdiff_t subend = 0;
2375 bool delbackslash = 0;
2376
2377 FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
2378
2379 if (c == '\\')
2380 {
2381 FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
2382
2383 if (c == '&')
2384 {
2385 substart = search_regs.start[sub];
2386 subend = search_regs.end[sub];
2387 }
2388 else if (c >= '1' && c <= '9')
2389 {
2390 if (c - '0' < search_regs.num_regs
2391 && search_regs.start[c - '0'] >= 0)
2392 {
2393 substart = search_regs.start[c - '0'];
2394 subend = search_regs.end[c - '0'];
2395 }
2396 else
2397 {
2398 /* If that subexp did not match,
2399 replace \\N with nothing. */
2400 substart = 0;
2401 subend = 0;
2402 }
2403 }
2404 else if (c == '\\')
2405 delbackslash = 1;
2406 else if (c != '?')
2407 error ("Invalid use of `\\' in replacement text");
2408 }
2409 if (substart >= 0)
2410 {
2411 if (pos - 2 != lastpos)
2412 middle = substring_both (newtext, lastpos,
2413 lastpos_byte,
2414 pos - 2, pos_byte - 2);
2415 else
2416 middle = Qnil;
2417 accum = concat3 (accum, middle,
2418 Fsubstring (string,
2419 make_number (substart),
2420 make_number (subend)));
2421 lastpos = pos;
2422 lastpos_byte = pos_byte;
2423 }
2424 else if (delbackslash)
2425 {
2426 middle = substring_both (newtext, lastpos,
2427 lastpos_byte,
2428 pos - 1, pos_byte - 1);
2429
2430 accum = concat2 (accum, middle);
2431 lastpos = pos;
2432 lastpos_byte = pos_byte;
2433 }
2434 }
2435
2436 if (pos != lastpos)
2437 middle = substring_both (newtext, lastpos,
2438 lastpos_byte,
2439 pos, pos_byte);
2440 else
2441 middle = Qnil;
2442
2443 newtext = concat2 (accum, middle);
2444 }
2445
2446 /* Do case substitution in NEWTEXT if desired. */
2447 if (case_action == all_caps)
2448 newtext = Fupcase (newtext);
2449 else if (case_action == cap_initial)
2450 newtext = Fupcase_initials (newtext);
2451
2452 return concat3 (before, newtext, after);
2453 }
2454
2455 /* Record point, then move (quietly) to the start of the match. */
2456 if (PT >= search_regs.end[sub])
2457 opoint = PT - ZV;
2458 else if (PT > search_regs.start[sub])
2459 opoint = search_regs.end[sub] - ZV;
2460 else
2461 opoint = PT;
2462
2463 /* If we want non-literal replacement,
2464 perform substitution on the replacement string. */
2465 if (NILP (literal))
2466 {
2467 ptrdiff_t length = SBYTES (newtext);
2468 unsigned char *substed;
2469 ptrdiff_t substed_alloc_size, substed_len;
2470 bool buf_multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
2471 bool str_multibyte = STRING_MULTIBYTE (newtext);
2472 bool really_changed = 0;
2473
2474 substed_alloc_size = (length <= (STRING_BYTES_BOUND - 100) / 2
2475 ? length * 2 + 100
2476 : STRING_BYTES_BOUND);
2477 substed = xmalloc (substed_alloc_size);
2478 substed_len = 0;
2479
2480 /* Go thru NEWTEXT, producing the actual text to insert in
2481 SUBSTED while adjusting multibyteness to that of the current
2482 buffer. */
2483
2484 for (pos_byte = 0, pos = 0; pos_byte < length;)
2485 {
2486 unsigned char str[MAX_MULTIBYTE_LENGTH];
2487 const unsigned char *add_stuff = NULL;
2488 ptrdiff_t add_len = 0;
2489 ptrdiff_t idx = -1;
2490
2491 if (str_multibyte)
2492 {
2493 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext, pos, pos_byte);
2494 if (!buf_multibyte)
2495 c = multibyte_char_to_unibyte (c);
2496 }
2497 else
2498 {
2499 /* Note that we don't have to increment POS. */
2500 c = SREF (newtext, pos_byte++);
2501 if (buf_multibyte)
2502 MAKE_CHAR_MULTIBYTE (c);
2503 }
2504
2505 /* Either set ADD_STUFF and ADD_LEN to the text to put in SUBSTED,
2506 or set IDX to a match index, which means put that part
2507 of the buffer text into SUBSTED. */
2508
2509 if (c == '\\')
2510 {
2511 really_changed = 1;
2512
2513 if (str_multibyte)
2514 {
2515 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext,
2516 pos, pos_byte);
2517 if (!buf_multibyte && !ASCII_CHAR_P (c))
2518 c = multibyte_char_to_unibyte (c);
2519 }
2520 else
2521 {
2522 c = SREF (newtext, pos_byte++);
2523 if (buf_multibyte)
2524 MAKE_CHAR_MULTIBYTE (c);
2525 }
2526
2527 if (c == '&')
2528 idx = sub;
2529 else if (c >= '1' && c <= '9' && c - '0' < search_regs.num_regs)
2530 {
2531 if (search_regs.start[c - '0'] >= 1)
2532 idx = c - '0';
2533 }
2534 else if (c == '\\')
2535 add_len = 1, add_stuff = (unsigned char *) "\\";
2536 else
2537 {
2538 xfree (substed);
2539 error ("Invalid use of `\\' in replacement text");
2540 }
2541 }
2542 else
2543 {
2544 add_len = CHAR_STRING (c, str);
2545 add_stuff = str;
2546 }
2547
2548 /* If we want to copy part of a previous match,
2549 set up ADD_STUFF and ADD_LEN to point to it. */
2550 if (idx >= 0)
2551 {
2552 ptrdiff_t begbyte = CHAR_TO_BYTE (search_regs.start[idx]);
2553 add_len = CHAR_TO_BYTE (search_regs.end[idx]) - begbyte;
2554 if (search_regs.start[idx] < GPT && GPT < search_regs.end[idx])
2555 move_gap_both (search_regs.start[idx], begbyte);
2556 add_stuff = BYTE_POS_ADDR (begbyte);
2557 }
2558
2559 /* Now the stuff we want to add to SUBSTED
2560 is invariably ADD_LEN bytes starting at ADD_STUFF. */
2561
2562 /* Make sure SUBSTED is big enough. */
2563 if (substed_alloc_size - substed_len < add_len)
2564 substed =
2565 xpalloc (substed, &substed_alloc_size,
2566 add_len - (substed_alloc_size - substed_len),
2567 STRING_BYTES_BOUND, 1);
2568
2569 /* Now add to the end of SUBSTED. */
2570 if (add_stuff)
2571 {
2572 memcpy (substed + substed_len, add_stuff, add_len);
2573 substed_len += add_len;
2574 }
2575 }
2576
2577 if (really_changed)
2578 {
2579 if (buf_multibyte)
2580 {
2581 ptrdiff_t nchars =
2582 multibyte_chars_in_text (substed, substed_len);
2583
2584 newtext = make_multibyte_string ((char *) substed, nchars,
2585 substed_len);
2586 }
2587 else
2588 newtext = make_unibyte_string ((char *) substed, substed_len);
2589 }
2590 xfree (substed);
2591 }
2592
2593 /* Replace the old text with the new in the cleanest possible way. */
2594 replace_range (search_regs.start[sub], search_regs.end[sub],
2595 newtext, 1, 0, 1);
2596 newpoint = search_regs.start[sub] + SCHARS (newtext);
2597
2598 if (case_action == all_caps)
2599 Fupcase_region (make_number (search_regs.start[sub]),
2600 make_number (newpoint));
2601 else if (case_action == cap_initial)
2602 Fupcase_initials_region (make_number (search_regs.start[sub]),
2603 make_number (newpoint));
2604
2605 /* Adjust search data for this change. */
2606 {
2607 ptrdiff_t oldend = search_regs.end[sub];
2608 ptrdiff_t oldstart = search_regs.start[sub];
2609 ptrdiff_t change = newpoint - search_regs.end[sub];
2610 ptrdiff_t i;
2611
2612 for (i = 0; i < search_regs.num_regs; i++)
2613 {
2614 if (search_regs.start[i] >= oldend)
2615 search_regs.start[i] += change;
2616 else if (search_regs.start[i] > oldstart)
2617 search_regs.start[i] = oldstart;
2618 if (search_regs.end[i] >= oldend)
2619 search_regs.end[i] += change;
2620 else if (search_regs.end[i] > oldstart)
2621 search_regs.end[i] = oldstart;
2622 }
2623 }
2624
2625 /* Put point back where it was in the text. */
2626 if (opoint <= 0)
2627 TEMP_SET_PT (opoint + ZV);
2628 else
2629 TEMP_SET_PT (opoint);
2630
2631 /* Now move point "officially" to the start of the inserted replacement. */
2632 move_if_not_intangible (newpoint);
2633
2634 return Qnil;
2635 }
2636 \f
2637 static Lisp_Object
2638 match_limit (Lisp_Object num, bool beginningp)
2639 {
2640 EMACS_INT n;
2641
2642 CHECK_NUMBER (num);
2643 n = XINT (num);
2644 if (n < 0)
2645 args_out_of_range (num, make_number (0));
2646 if (search_regs.num_regs <= 0)
2647 error ("No match data, because no search succeeded");
2648 if (n >= search_regs.num_regs
2649 || search_regs.start[n] < 0)
2650 return Qnil;
2651 return (make_number ((beginningp) ? search_regs.start[n]
2652 : search_regs.end[n]));
2653 }
2654
2655 DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
2656 doc: /* Return position of start of text matched by last search.
2657 SUBEXP, a number, specifies which parenthesized expression in the last
2658 regexp.
2659 Value is nil if SUBEXPth pair didn't match, or there were less than
2660 SUBEXP pairs.
2661 Zero means the entire text matched by the whole regexp or whole string. */)
2662 (Lisp_Object subexp)
2663 {
2664 return match_limit (subexp, 1);
2665 }
2666
2667 DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0,
2668 doc: /* Return position of end of text matched by last search.
2669 SUBEXP, a number, specifies which parenthesized expression in the last
2670 regexp.
2671 Value is nil if SUBEXPth pair didn't match, or there were less than
2672 SUBEXP pairs.
2673 Zero means the entire text matched by the whole regexp or whole string. */)
2674 (Lisp_Object subexp)
2675 {
2676 return match_limit (subexp, 0);
2677 }
2678
2679 DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 3, 0,
2680 doc: /* Return a list containing all info on what the last search matched.
2681 Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.
2682 All the elements are markers or nil (nil if the Nth pair didn't match)
2683 if the last match was on a buffer; integers or nil if a string was matched.
2684 Use `set-match-data' to reinstate the data in this list.
2685
2686 If INTEGERS (the optional first argument) is non-nil, always use
2687 integers \(rather than markers) to represent buffer positions. In
2688 this case, and if the last match was in a buffer, the buffer will get
2689 stored as one additional element at the end of the list.
2690
2691 If REUSE is a list, reuse it as part of the value. If REUSE is long
2692 enough to hold all the values, and if INTEGERS is non-nil, no consing
2693 is done.
2694
2695 If optional third arg RESEAT is non-nil, any previous markers on the
2696 REUSE list will be modified to point to nowhere.
2697
2698 Return value is undefined if the last search failed. */)
2699 (Lisp_Object integers, Lisp_Object reuse, Lisp_Object reseat)
2700 {
2701 Lisp_Object tail, prev;
2702 Lisp_Object *data;
2703 ptrdiff_t i, len;
2704
2705 if (!NILP (reseat))
2706 for (tail = reuse; CONSP (tail); tail = XCDR (tail))
2707 if (MARKERP (XCAR (tail)))
2708 {
2709 unchain_marker (XMARKER (XCAR (tail)));
2710 XSETCAR (tail, Qnil);
2711 }
2712
2713 if (NILP (last_thing_searched))
2714 return Qnil;
2715
2716 prev = Qnil;
2717
2718 data = alloca ((2 * search_regs.num_regs + 1) * sizeof *data);
2719
2720 len = 0;
2721 for (i = 0; i < search_regs.num_regs; i++)
2722 {
2723 ptrdiff_t start = search_regs.start[i];
2724 if (start >= 0)
2725 {
2726 if (EQ (last_thing_searched, Qt)
2727 || ! NILP (integers))
2728 {
2729 XSETFASTINT (data[2 * i], start);
2730 XSETFASTINT (data[2 * i + 1], search_regs.end[i]);
2731 }
2732 else if (BUFFERP (last_thing_searched))
2733 {
2734 data[2 * i] = Fmake_marker ();
2735 Fset_marker (data[2 * i],
2736 make_number (start),
2737 last_thing_searched);
2738 data[2 * i + 1] = Fmake_marker ();
2739 Fset_marker (data[2 * i + 1],
2740 make_number (search_regs.end[i]),
2741 last_thing_searched);
2742 }
2743 else
2744 /* last_thing_searched must always be Qt, a buffer, or Qnil. */
2745 emacs_abort ();
2746
2747 len = 2 * i + 2;
2748 }
2749 else
2750 data[2 * i] = data[2 * i + 1] = Qnil;
2751 }
2752
2753 if (BUFFERP (last_thing_searched) && !NILP (integers))
2754 {
2755 data[len] = last_thing_searched;
2756 len++;
2757 }
2758
2759 /* If REUSE is not usable, cons up the values and return them. */
2760 if (! CONSP (reuse))
2761 return Flist (len, data);
2762
2763 /* If REUSE is a list, store as many value elements as will fit
2764 into the elements of REUSE. */
2765 for (i = 0, tail = reuse; CONSP (tail);
2766 i++, tail = XCDR (tail))
2767 {
2768 if (i < len)
2769 XSETCAR (tail, data[i]);
2770 else
2771 XSETCAR (tail, Qnil);
2772 prev = tail;
2773 }
2774
2775 /* If we couldn't fit all value elements into REUSE,
2776 cons up the rest of them and add them to the end of REUSE. */
2777 if (i < len)
2778 XSETCDR (prev, Flist (len - i, data + i));
2779
2780 return reuse;
2781 }
2782
2783 /* We used to have an internal use variant of `reseat' described as:
2784
2785 If RESEAT is `evaporate', put the markers back on the free list
2786 immediately. No other references to the markers must exist in this
2787 case, so it is used only internally on the unwind stack and
2788 save-match-data from Lisp.
2789
2790 But it was ill-conceived: those supposedly-internal markers get exposed via
2791 the undo-list, so freeing them here is unsafe. */
2792
2793 DEFUN ("set-match-data", Fset_match_data, Sset_match_data, 1, 2, 0,
2794 doc: /* Set internal data on last search match from elements of LIST.
2795 LIST should have been created by calling `match-data' previously.
2796
2797 If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */)
2798 (register Lisp_Object list, Lisp_Object reseat)
2799 {
2800 ptrdiff_t i;
2801 register Lisp_Object marker;
2802
2803 if (running_asynch_code)
2804 save_search_regs ();
2805
2806 CHECK_LIST (list);
2807
2808 /* Unless we find a marker with a buffer or an explicit buffer
2809 in LIST, assume that this match data came from a string. */
2810 last_thing_searched = Qt;
2811
2812 /* Allocate registers if they don't already exist. */
2813 {
2814 EMACS_INT length = XFASTINT (Flength (list)) / 2;
2815
2816 if (length > search_regs.num_regs)
2817 {
2818 ptrdiff_t num_regs = search_regs.num_regs;
2819 if (PTRDIFF_MAX < length)
2820 memory_full (SIZE_MAX);
2821 search_regs.start =
2822 xpalloc (search_regs.start, &num_regs, length - num_regs,
2823 min (PTRDIFF_MAX, UINT_MAX), sizeof (regoff_t));
2824 search_regs.end =
2825 xrealloc (search_regs.end, num_regs * sizeof (regoff_t));
2826
2827 for (i = search_regs.num_regs; i < num_regs; i++)
2828 search_regs.start[i] = -1;
2829
2830 search_regs.num_regs = num_regs;
2831 }
2832
2833 for (i = 0; CONSP (list); i++)
2834 {
2835 marker = XCAR (list);
2836 if (BUFFERP (marker))
2837 {
2838 last_thing_searched = marker;
2839 break;
2840 }
2841 if (i >= length)
2842 break;
2843 if (NILP (marker))
2844 {
2845 search_regs.start[i] = -1;
2846 list = XCDR (list);
2847 }
2848 else
2849 {
2850 Lisp_Object from;
2851 Lisp_Object m;
2852
2853 m = marker;
2854 if (MARKERP (marker))
2855 {
2856 if (XMARKER (marker)->buffer == 0)
2857 XSETFASTINT (marker, 0);
2858 else
2859 XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer);
2860 }
2861
2862 CHECK_NUMBER_COERCE_MARKER (marker);
2863 from = marker;
2864
2865 if (!NILP (reseat) && MARKERP (m))
2866 {
2867 unchain_marker (XMARKER (m));
2868 XSETCAR (list, Qnil);
2869 }
2870
2871 if ((list = XCDR (list), !CONSP (list)))
2872 break;
2873
2874 m = marker = XCAR (list);
2875
2876 if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
2877 XSETFASTINT (marker, 0);
2878
2879 CHECK_NUMBER_COERCE_MARKER (marker);
2880 if ((XINT (from) < 0
2881 ? TYPE_MINIMUM (regoff_t) <= XINT (from)
2882 : XINT (from) <= TYPE_MAXIMUM (regoff_t))
2883 && (XINT (marker) < 0
2884 ? TYPE_MINIMUM (regoff_t) <= XINT (marker)
2885 : XINT (marker) <= TYPE_MAXIMUM (regoff_t)))
2886 {
2887 search_regs.start[i] = XINT (from);
2888 search_regs.end[i] = XINT (marker);
2889 }
2890 else
2891 {
2892 search_regs.start[i] = -1;
2893 }
2894
2895 if (!NILP (reseat) && MARKERP (m))
2896 {
2897 unchain_marker (XMARKER (m));
2898 XSETCAR (list, Qnil);
2899 }
2900 }
2901 list = XCDR (list);
2902 }
2903
2904 for (; i < search_regs.num_regs; i++)
2905 search_regs.start[i] = -1;
2906 }
2907
2908 return Qnil;
2909 }
2910
2911 /* If true the match data have been saved in saved_search_regs
2912 during the execution of a sentinel or filter. */
2913 static bool search_regs_saved;
2914 static struct re_registers saved_search_regs;
2915 static Lisp_Object saved_last_thing_searched;
2916
2917 /* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
2918 if asynchronous code (filter or sentinel) is running. */
2919 static void
2920 save_search_regs (void)
2921 {
2922 if (!search_regs_saved)
2923 {
2924 saved_search_regs.num_regs = search_regs.num_regs;
2925 saved_search_regs.start = search_regs.start;
2926 saved_search_regs.end = search_regs.end;
2927 saved_last_thing_searched = last_thing_searched;
2928 last_thing_searched = Qnil;
2929 search_regs.num_regs = 0;
2930 search_regs.start = 0;
2931 search_regs.end = 0;
2932
2933 search_regs_saved = 1;
2934 }
2935 }
2936
2937 /* Called upon exit from filters and sentinels. */
2938 void
2939 restore_search_regs (void)
2940 {
2941 if (search_regs_saved)
2942 {
2943 if (search_regs.num_regs > 0)
2944 {
2945 xfree (search_regs.start);
2946 xfree (search_regs.end);
2947 }
2948 search_regs.num_regs = saved_search_regs.num_regs;
2949 search_regs.start = saved_search_regs.start;
2950 search_regs.end = saved_search_regs.end;
2951 last_thing_searched = saved_last_thing_searched;
2952 saved_last_thing_searched = Qnil;
2953 search_regs_saved = 0;
2954 }
2955 }
2956
2957 static void
2958 unwind_set_match_data (Lisp_Object list)
2959 {
2960 /* It is NOT ALWAYS safe to free (evaporate) the markers immediately. */
2961 Fset_match_data (list, Qt);
2962 }
2963
2964 /* Called to unwind protect the match data. */
2965 void
2966 record_unwind_save_match_data (void)
2967 {
2968 record_unwind_protect (unwind_set_match_data,
2969 Fmatch_data (Qnil, Qnil, Qnil));
2970 }
2971
2972 /* Quote a string to deactivate reg-expr chars */
2973
2974 DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
2975 doc: /* Return a regexp string which matches exactly STRING and nothing else. */)
2976 (Lisp_Object string)
2977 {
2978 char *in, *out, *end;
2979 char *temp;
2980 ptrdiff_t backslashes_added = 0;
2981
2982 CHECK_STRING (string);
2983
2984 temp = alloca (SBYTES (string) * 2);
2985
2986 /* Now copy the data into the new string, inserting escapes. */
2987
2988 in = SSDATA (string);
2989 end = in + SBYTES (string);
2990 out = temp;
2991
2992 for (; in != end; in++)
2993 {
2994 if (*in == '['
2995 || *in == '*' || *in == '.' || *in == '\\'
2996 || *in == '?' || *in == '+'
2997 || *in == '^' || *in == '$')
2998 *out++ = '\\', backslashes_added++;
2999 *out++ = *in;
3000 }
3001
3002 return make_specified_string (temp,
3003 SCHARS (string) + backslashes_added,
3004 out - temp,
3005 STRING_MULTIBYTE (string));
3006 }
3007 \f
3008 void
3009 syms_of_search (void)
3010 {
3011 register int i;
3012
3013 for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
3014 {
3015 searchbufs[i].buf.allocated = 100;
3016 searchbufs[i].buf.buffer = xmalloc (100);
3017 searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
3018 searchbufs[i].regexp = Qnil;
3019 searchbufs[i].whitespace_regexp = Qnil;
3020 searchbufs[i].syntax_table = Qnil;
3021 staticpro (&searchbufs[i].regexp);
3022 staticpro (&searchbufs[i].whitespace_regexp);
3023 staticpro (&searchbufs[i].syntax_table);
3024 searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]);
3025 }
3026 searchbuf_head = &searchbufs[0];
3027
3028 DEFSYM (Qsearch_failed, "search-failed");
3029 DEFSYM (Qinvalid_regexp, "invalid-regexp");
3030
3031 Fput (Qsearch_failed, Qerror_conditions,
3032 listn (CONSTYPE_PURE, 2, Qsearch_failed, Qerror));
3033 Fput (Qsearch_failed, Qerror_message,
3034 build_pure_c_string ("Search failed"));
3035
3036 Fput (Qinvalid_regexp, Qerror_conditions,
3037 listn (CONSTYPE_PURE, 2, Qinvalid_regexp, Qerror));
3038 Fput (Qinvalid_regexp, Qerror_message,
3039 build_pure_c_string ("Invalid regexp"));
3040
3041 last_thing_searched = Qnil;
3042 staticpro (&last_thing_searched);
3043
3044 saved_last_thing_searched = Qnil;
3045 staticpro (&saved_last_thing_searched);
3046
3047 DEFVAR_LISP ("search-spaces-regexp", Vsearch_spaces_regexp,
3048 doc: /* Regexp to substitute for bunches of spaces in regexp search.
3049 Some commands use this for user-specified regexps.
3050 Spaces that occur inside character classes or repetition operators
3051 or other such regexp constructs are not replaced with this.
3052 A value of nil (which is the normal value) means treat spaces literally. */);
3053 Vsearch_spaces_regexp = Qnil;
3054
3055 DEFVAR_LISP ("inhibit-changing-match-data", Vinhibit_changing_match_data,
3056 doc: /* Internal use only.
3057 If non-nil, the primitive searching and matching functions
3058 such as `looking-at', `string-match', `re-search-forward', etc.,
3059 do not set the match data. The proper way to use this variable
3060 is to bind it with `let' around a small expression. */);
3061 Vinhibit_changing_match_data = Qnil;
3062
3063 defsubr (&Slooking_at);
3064 defsubr (&Sposix_looking_at);
3065 defsubr (&Sstring_match);
3066 defsubr (&Sposix_string_match);
3067 defsubr (&Ssearch_forward);
3068 defsubr (&Ssearch_backward);
3069 defsubr (&Sre_search_forward);
3070 defsubr (&Sre_search_backward);
3071 defsubr (&Sposix_search_forward);
3072 defsubr (&Sposix_search_backward);
3073 defsubr (&Sreplace_match);
3074 defsubr (&Smatch_beginning);
3075 defsubr (&Smatch_end);
3076 defsubr (&Smatch_data);
3077 defsubr (&Sset_match_data);
3078 defsubr (&Sregexp_quote);
3079 }