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