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