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