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