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