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