(nntp-buggy-select): Delete usg-unix-v from list.
[bpt/emacs.git] / src / search.c
CommitLineData
ca1d1d23 1/* String search routines for GNU Emacs.
3a22ee35 2 Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc.
ca1d1d23
JB
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 1, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
18160b98 21#include <config.h>
ca1d1d23
JB
22#include "lisp.h"
23#include "syntax.h"
24#include "buffer.h"
9169c321 25#include "region-cache.h"
ca1d1d23 26#include "commands.h"
9ac0d9e0 27#include "blockinput.h"
4746118a 28
ca1d1d23
JB
29#include <sys/types.h>
30#include "regex.h"
31
487282dc 32#define REGEXP_CACHE_SIZE 5
ca1d1d23 33
487282dc
KH
34/* If the regexp is non-nil, then the buffer contains the compiled form
35 of that regexp, suitable for searching. */
36struct regexp_cache {
37 struct regexp_cache *next;
38 Lisp_Object regexp;
39 struct re_pattern_buffer buf;
40 char fastmap[0400];
b819a390
RS
41 /* Nonzero means regexp was compiled to do full POSIX backtracking. */
42 char posix;
487282dc 43};
ca1d1d23 44
487282dc
KH
45/* The instances of that struct. */
46struct regexp_cache searchbufs[REGEXP_CACHE_SIZE];
ca1d1d23 47
487282dc
KH
48/* The head of the linked list; points to the most recently used buffer. */
49struct regexp_cache *searchbuf_head;
ca1d1d23 50
ca1d1d23 51
4746118a
JB
52/* Every call to re_match, etc., must pass &search_regs as the regs
53 argument unless you can show it is unnecessary (i.e., if re_match
54 is certainly going to be called again before region-around-match
55 can be called).
56
57 Since the registers are now dynamically allocated, we need to make
58 sure not to refer to the Nth register before checking that it has
1113d9db
JB
59 been allocated by checking search_regs.num_regs.
60
61 The regex code keeps track of whether it has allocated the search
487282dc
KH
62 buffer using bits in the re_pattern_buffer. This means that whenever
63 you compile a new pattern, it completely forgets whether it has
1113d9db
JB
64 allocated any registers, and will allocate new registers the next
65 time you call a searching or matching function. Therefore, we need
66 to call re_set_registers after compiling a new pattern or after
67 setting the match registers, so that the regex functions will be
68 able to free or re-allocate it properly. */
ca1d1d23
JB
69static struct re_registers search_regs;
70
daa37602
JB
71/* The buffer in which the last search was performed, or
72 Qt if the last search was done in a string;
73 Qnil if no searching has been done yet. */
74static Lisp_Object last_thing_searched;
ca1d1d23
JB
75
76/* error condition signalled when regexp compile_pattern fails */
77
78Lisp_Object Qinvalid_regexp;
79
ca325161 80static void set_search_regs ();
044f81f1 81static void save_search_regs ();
ca325161 82
b819a390
RS
83static int search_buffer ();
84
ca1d1d23
JB
85static void
86matcher_overflow ()
87{
88 error ("Stack overflow in regexp matcher");
89}
90
91#ifdef __STDC__
92#define CONST const
93#else
94#define CONST
95#endif
96
b819a390
RS
97/* Compile a regexp and signal a Lisp error if anything goes wrong.
98 PATTERN is the pattern to compile.
99 CP is the place to put the result.
100 TRANSLATE is a translation table for ignoring case, or NULL for none.
101 REGP is the structure that says where to store the "register"
102 values that will result from matching this pattern.
103 If it is 0, we should compile the pattern not to record any
104 subexpression bounds.
105 POSIX is nonzero if we want full backtracking (POSIX style)
106 for this pattern. 0 means backtrack only enough to get a valid match. */
ca1d1d23 107
487282dc 108static void
b819a390 109compile_pattern_1 (cp, pattern, translate, regp, posix)
487282dc 110 struct regexp_cache *cp;
ca1d1d23 111 Lisp_Object pattern;
ca1d1d23 112 char *translate;
487282dc 113 struct re_registers *regp;
b819a390 114 int posix;
ca1d1d23
JB
115{
116 CONST char *val;
b819a390 117 reg_syntax_t old;
ca1d1d23 118
487282dc
KH
119 cp->regexp = Qnil;
120 cp->buf.translate = translate;
b819a390 121 cp->posix = posix;
9ac0d9e0 122 BLOCK_INPUT;
b819a390
RS
123 old = re_set_syntax (RE_SYNTAX_EMACS
124 | (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
b90d9e80 125 val = (CONST char *) re_compile_pattern ((char *) XSTRING (pattern)->data,
487282dc 126 XSTRING (pattern)->size, &cp->buf);
b819a390 127 re_set_syntax (old);
9ac0d9e0 128 UNBLOCK_INPUT;
ca1d1d23 129 if (val)
487282dc 130 Fsignal (Qinvalid_regexp, Fcons (build_string (val), Qnil));
1113d9db 131
487282dc 132 cp->regexp = Fcopy_sequence (pattern);
1113d9db
JB
133
134 /* Advise the searching functions about the space we have allocated
135 for register data. */
9ac0d9e0 136 BLOCK_INPUT;
ebb9e16f 137 if (regp)
487282dc 138 re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end);
9ac0d9e0 139 UNBLOCK_INPUT;
487282dc
KH
140}
141
142/* Compile a regexp if necessary, but first check to see if there's one in
b819a390
RS
143 the cache.
144 PATTERN is the pattern to compile.
145 TRANSLATE is a translation table for ignoring case, or NULL for none.
146 REGP is the structure that says where to store the "register"
147 values that will result from matching this pattern.
148 If it is 0, we should compile the pattern not to record any
149 subexpression bounds.
150 POSIX is nonzero if we want full backtracking (POSIX style)
151 for this pattern. 0 means backtrack only enough to get a valid match. */
487282dc
KH
152
153struct re_pattern_buffer *
b819a390 154compile_pattern (pattern, regp, translate, posix)
487282dc
KH
155 Lisp_Object pattern;
156 struct re_registers *regp;
157 char *translate;
b819a390 158 int posix;
487282dc
KH
159{
160 struct regexp_cache *cp, **cpp;
161
162 for (cpp = &searchbuf_head; ; cpp = &cp->next)
163 {
164 cp = *cpp;
165 if (!NILP (Fstring_equal (cp->regexp, pattern))
b819a390
RS
166 && cp->buf.translate == translate
167 && cp->posix == posix)
487282dc
KH
168 break;
169
170 /* If we're at the end of the cache, compile into the last cell. */
171 if (cp->next == 0)
172 {
b819a390 173 compile_pattern_1 (cp, pattern, translate, regp, posix);
487282dc
KH
174 break;
175 }
176 }
177
178 /* When we get here, cp (aka *cpp) contains the compiled pattern,
179 either because we found it in the cache or because we just compiled it.
180 Move it to the front of the queue to mark it as most recently used. */
181 *cpp = cp->next;
182 cp->next = searchbuf_head;
183 searchbuf_head = cp;
1113d9db 184
487282dc 185 return &cp->buf;
ca1d1d23
JB
186}
187
188/* Error condition used for failing searches */
189Lisp_Object Qsearch_failed;
190
191Lisp_Object
192signal_failure (arg)
193 Lisp_Object arg;
194{
195 Fsignal (Qsearch_failed, Fcons (arg, Qnil));
196 return Qnil;
197}
198\f
b819a390
RS
199static Lisp_Object
200looking_at_1 (string, posix)
ca1d1d23 201 Lisp_Object string;
b819a390 202 int posix;
ca1d1d23
JB
203{
204 Lisp_Object val;
205 unsigned char *p1, *p2;
206 int s1, s2;
207 register int i;
487282dc 208 struct re_pattern_buffer *bufp;
ca1d1d23 209
7074fde6
FP
210 if (running_asynch_code)
211 save_search_regs ();
212
ca1d1d23 213 CHECK_STRING (string, 0);
487282dc
KH
214 bufp = compile_pattern (string, &search_regs,
215 (!NILP (current_buffer->case_fold_search)
b819a390
RS
216 ? DOWNCASE_TABLE : 0),
217 posix);
ca1d1d23
JB
218
219 immediate_quit = 1;
220 QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */
221
222 /* Get pointers and sizes of the two strings
223 that make up the visible portion of the buffer. */
224
225 p1 = BEGV_ADDR;
226 s1 = GPT - BEGV;
227 p2 = GAP_END_ADDR;
228 s2 = ZV - GPT;
229 if (s1 < 0)
230 {
231 p2 = p1;
232 s2 = ZV - BEGV;
233 s1 = 0;
234 }
235 if (s2 < 0)
236 {
237 s1 = ZV - BEGV;
238 s2 = 0;
239 }
240
487282dc 241 i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
ca1d1d23
JB
242 point - BEGV, &search_regs,
243 ZV - BEGV);
244 if (i == -2)
245 matcher_overflow ();
246
247 val = (0 <= i ? Qt : Qnil);
4746118a 248 for (i = 0; i < search_regs.num_regs; i++)
ca1d1d23
JB
249 if (search_regs.start[i] >= 0)
250 {
251 search_regs.start[i] += BEGV;
252 search_regs.end[i] += BEGV;
253 }
a3668d92 254 XSETBUFFER (last_thing_searched, current_buffer);
ca1d1d23
JB
255 immediate_quit = 0;
256 return val;
257}
258
b819a390
RS
259DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0,
260 "Return t if text after point matches regular expression PAT.\n\
261This function modifies the match data that `match-beginning',\n\
262`match-end' and `match-data' access; save and restore the match\n\
263data if you want to preserve them.")
264 (string)
265 Lisp_Object string;
266{
267 return looking_at_1 (string, 0);
268}
269
270DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0,
271 "Return t if text after point matches regular expression PAT.\n\
272Find the longest match, in accord with Posix regular expression rules.\n\
273This function modifies the match data that `match-beginning',\n\
274`match-end' and `match-data' access; save and restore the match\n\
275data if you want to preserve them.")
276 (string)
277 Lisp_Object string;
278{
279 return looking_at_1 (string, 1);
280}
281\f
282static Lisp_Object
283string_match_1 (regexp, string, start, posix)
ca1d1d23 284 Lisp_Object regexp, string, start;
b819a390 285 int posix;
ca1d1d23
JB
286{
287 int val;
288 int s;
487282dc 289 struct re_pattern_buffer *bufp;
ca1d1d23 290
7074fde6
FP
291 if (running_asynch_code)
292 save_search_regs ();
293
ca1d1d23
JB
294 CHECK_STRING (regexp, 0);
295 CHECK_STRING (string, 1);
296
297 if (NILP (start))
298 s = 0;
299 else
300 {
301 int len = XSTRING (string)->size;
302
303 CHECK_NUMBER (start, 2);
304 s = XINT (start);
305 if (s < 0 && -s <= len)
26faf9f4 306 s = len + s;
ca1d1d23
JB
307 else if (0 > s || s > len)
308 args_out_of_range (string, start);
309 }
310
487282dc
KH
311 bufp = compile_pattern (regexp, &search_regs,
312 (!NILP (current_buffer->case_fold_search)
b819a390
RS
313 ? DOWNCASE_TABLE : 0),
314 0);
ca1d1d23 315 immediate_quit = 1;
487282dc 316 val = re_search (bufp, (char *) XSTRING (string)->data,
ca1d1d23
JB
317 XSTRING (string)->size, s, XSTRING (string)->size - s,
318 &search_regs);
319 immediate_quit = 0;
daa37602 320 last_thing_searched = Qt;
ca1d1d23
JB
321 if (val == -2)
322 matcher_overflow ();
323 if (val < 0) return Qnil;
324 return make_number (val);
325}
e59a8453 326
b819a390
RS
327DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0,
328 "Return index of start of first match for REGEXP in STRING, or nil.\n\
329If third arg START is non-nil, start search at that index in STRING.\n\
330For index of first char beyond the match, do (match-end 0).\n\
331`match-end' and `match-beginning' also give indices of substrings\n\
332matched by parenthesis constructs in the pattern.")
333 (regexp, string, start)
334 Lisp_Object regexp, string, start;
335{
336 return string_match_1 (regexp, string, start, 0);
337}
338
339DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0,
340 "Return index of start of first match for REGEXP in STRING, or nil.\n\
341Find the longest match, in accord with Posix regular expression rules.\n\
342If third arg START is non-nil, start search at that index in STRING.\n\
343For index of first char beyond the match, do (match-end 0).\n\
344`match-end' and `match-beginning' also give indices of substrings\n\
345matched by parenthesis constructs in the pattern.")
346 (regexp, string, start)
347 Lisp_Object regexp, string, start;
348{
349 return string_match_1 (regexp, string, start, 1);
350}
351
e59a8453
RS
352/* Match REGEXP against STRING, searching all of STRING,
353 and return the index of the match, or negative on failure.
354 This does not clobber the match data. */
355
356int
357fast_string_match (regexp, string)
358 Lisp_Object regexp, string;
359{
360 int val;
487282dc 361 struct re_pattern_buffer *bufp;
e59a8453 362
b819a390 363 bufp = compile_pattern (regexp, 0, 0, 0);
e59a8453 364 immediate_quit = 1;
487282dc 365 val = re_search (bufp, (char *) XSTRING (string)->data,
e59a8453
RS
366 XSTRING (string)->size, 0, XSTRING (string)->size,
367 0);
368 immediate_quit = 0;
369 return val;
370}
ca1d1d23 371\f
9169c321
JB
372/* max and min. */
373
374static int
375max (a, b)
376 int a, b;
377{
378 return ((a > b) ? a : b);
379}
380
381static int
382min (a, b)
383 int a, b;
384{
385 return ((a < b) ? a : b);
386}
387
388\f
389/* The newline cache: remembering which sections of text have no newlines. */
390
391/* If the user has requested newline caching, make sure it's on.
392 Otherwise, make sure it's off.
393 This is our cheezy way of associating an action with the change of
394 state of a buffer-local variable. */
395static void
396newline_cache_on_off (buf)
397 struct buffer *buf;
398{
399 if (NILP (buf->cache_long_line_scans))
400 {
401 /* It should be off. */
402 if (buf->newline_cache)
403 {
404 free_region_cache (buf->newline_cache);
405 buf->newline_cache = 0;
406 }
407 }
408 else
409 {
410 /* It should be on. */
411 if (buf->newline_cache == 0)
412 buf->newline_cache = new_region_cache ();
413 }
414}
415
416\f
417/* Search for COUNT instances of the character TARGET between START and END.
418
419 If COUNT is positive, search forwards; END must be >= START.
420 If COUNT is negative, search backwards for the -COUNTth instance;
421 END must be <= START.
422 If COUNT is zero, do anything you please; run rogue, for all I care.
423
424 If END is zero, use BEGV or ZV instead, as appropriate for the
425 direction indicated by COUNT.
ffd56f97
JB
426
427 If we find COUNT instances, set *SHORTAGE to zero, and return the
5bfe95c9
RS
428 position after the COUNTth match. Note that for reverse motion
429 this is not the same as the usual convention for Emacs motion commands.
ffd56f97 430
9169c321
JB
431 If we don't find COUNT instances before reaching END, set *SHORTAGE
432 to the number of TARGETs left unfound, and return END.
ffd56f97 433
087a5f81
RS
434 If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do
435 except when inside redisplay. */
436
9169c321
JB
437scan_buffer (target, start, end, count, shortage, allow_quit)
438 register int target;
439 int start, end;
440 int count;
441 int *shortage;
087a5f81 442 int allow_quit;
ca1d1d23 443{
9169c321
JB
444 struct region_cache *newline_cache;
445 int direction;
ffd56f97 446
9169c321
JB
447 if (count > 0)
448 {
449 direction = 1;
450 if (! end) end = ZV;
451 }
452 else
453 {
454 direction = -1;
455 if (! end) end = BEGV;
456 }
ffd56f97 457
9169c321
JB
458 newline_cache_on_off (current_buffer);
459 newline_cache = current_buffer->newline_cache;
ca1d1d23
JB
460
461 if (shortage != 0)
462 *shortage = 0;
463
087a5f81 464 immediate_quit = allow_quit;
ca1d1d23 465
ffd56f97 466 if (count > 0)
9169c321 467 while (start != end)
ca1d1d23 468 {
9169c321
JB
469 /* Our innermost scanning loop is very simple; it doesn't know
470 about gaps, buffer ends, or the newline cache. ceiling is
471 the position of the last character before the next such
472 obstacle --- the last character the dumb search loop should
473 examine. */
474 register int ceiling = end - 1;
475
476 /* If we're looking for a newline, consult the newline cache
477 to see where we can avoid some scanning. */
478 if (target == '\n' && newline_cache)
479 {
480 int next_change;
481 immediate_quit = 0;
482 while (region_cache_forward
483 (current_buffer, newline_cache, start, &next_change))
484 start = next_change;
cbe0db0d 485 immediate_quit = allow_quit;
9169c321
JB
486
487 /* start should never be after end. */
488 if (start >= end)
489 start = end - 1;
490
491 /* Now the text after start is an unknown region, and
492 next_change is the position of the next known region. */
493 ceiling = min (next_change - 1, ceiling);
494 }
495
496 /* The dumb loop can only scan text stored in contiguous
497 bytes. BUFFER_CEILING_OF returns the last character
498 position that is contiguous, so the ceiling is the
499 position after that. */
500 ceiling = min (BUFFER_CEILING_OF (start), ceiling);
501
502 {
503 /* The termination address of the dumb loop. */
504 register unsigned char *ceiling_addr = &FETCH_CHAR (ceiling) + 1;
505 register unsigned char *cursor = &FETCH_CHAR (start);
506 unsigned char *base = cursor;
507
508 while (cursor < ceiling_addr)
509 {
510 unsigned char *scan_start = cursor;
511
512 /* The dumb loop. */
513 while (*cursor != target && ++cursor < ceiling_addr)
514 ;
515
516 /* If we're looking for newlines, cache the fact that
517 the region from start to cursor is free of them. */
518 if (target == '\n' && newline_cache)
519 know_region_cache (current_buffer, newline_cache,
520 start + scan_start - base,
521 start + cursor - base);
522
523 /* Did we find the target character? */
524 if (cursor < ceiling_addr)
525 {
526 if (--count == 0)
527 {
528 immediate_quit = 0;
529 return (start + cursor - base + 1);
530 }
531 cursor++;
532 }
533 }
534
535 start += cursor - base;
536 }
ca1d1d23
JB
537 }
538 else
9169c321
JB
539 while (start > end)
540 {
541 /* The last character to check before the next obstacle. */
542 register int ceiling = end;
543
544 /* Consult the newline cache, if appropriate. */
545 if (target == '\n' && newline_cache)
546 {
547 int next_change;
548 immediate_quit = 0;
549 while (region_cache_backward
550 (current_buffer, newline_cache, start, &next_change))
551 start = next_change;
cbe0db0d 552 immediate_quit = allow_quit;
9169c321
JB
553
554 /* Start should never be at or before end. */
555 if (start <= end)
556 start = end + 1;
557
558 /* Now the text before start is an unknown region, and
559 next_change is the position of the next known region. */
560 ceiling = max (next_change, ceiling);
561 }
562
563 /* Stop scanning before the gap. */
564 ceiling = max (BUFFER_FLOOR_OF (start - 1), ceiling);
565
566 {
567 /* The termination address of the dumb loop. */
568 register unsigned char *ceiling_addr = &FETCH_CHAR (ceiling);
569 register unsigned char *cursor = &FETCH_CHAR (start - 1);
570 unsigned char *base = cursor;
571
572 while (cursor >= ceiling_addr)
573 {
574 unsigned char *scan_start = cursor;
575
576 while (*cursor != target && --cursor >= ceiling_addr)
577 ;
578
579 /* If we're looking for newlines, cache the fact that
580 the region from after the cursor to start is free of them. */
581 if (target == '\n' && newline_cache)
582 know_region_cache (current_buffer, newline_cache,
583 start + cursor - base,
584 start + scan_start - base);
585
586 /* Did we find the target character? */
587 if (cursor >= ceiling_addr)
588 {
589 if (++count >= 0)
590 {
591 immediate_quit = 0;
592 return (start + cursor - base);
593 }
594 cursor--;
595 }
596 }
597
598 start += cursor - base;
599 }
600 }
601
ca1d1d23
JB
602 immediate_quit = 0;
603 if (shortage != 0)
ffd56f97 604 *shortage = count * direction;
9169c321 605 return start;
ca1d1d23
JB
606}
607
63fa018d
RS
608int
609find_next_newline_no_quit (from, cnt)
610 register int from, cnt;
611{
9169c321 612 return scan_buffer ('\n', from, 0, cnt, (int *) 0, 0);
63fa018d
RS
613}
614
ca1d1d23
JB
615int
616find_next_newline (from, cnt)
617 register int from, cnt;
618{
9169c321
JB
619 return scan_buffer ('\n', from, 0, cnt, (int *) 0, 1);
620}
621
622
623/* Like find_next_newline, but returns position before the newline,
624 not after, and only search up to TO. This isn't just
625 find_next_newline (...)-1, because you might hit TO. */
626int
627find_before_next_newline (from, to, cnt)
cbe0db0d 628 int from, to, cnt;
9169c321
JB
629{
630 int shortage;
631 int pos = scan_buffer ('\n', from, to, cnt, &shortage, 1);
632
633 if (shortage == 0)
634 pos--;
635
636 return pos;
ca1d1d23
JB
637}
638\f
c1dc99a1
JB
639Lisp_Object skip_chars ();
640
ca1d1d23 641DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0,
3acb9a69
RS
642 "Move point forward, stopping before a char not in STRING, or at pos LIM.\n\
643STRING is like the inside of a `[...]' in a regular expression\n\
ca1d1d23
JB
644except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\
645Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
c1dc99a1
JB
646With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\
647Returns the distance traveled, either zero or positive.")
ca1d1d23
JB
648 (string, lim)
649 Lisp_Object string, lim;
650{
17431c60 651 return skip_chars (1, 0, string, lim);
ca1d1d23
JB
652}
653
654DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
3acb9a69 655 "Move point backward, stopping after a char not in STRING, or at pos LIM.\n\
c1dc99a1
JB
656See `skip-chars-forward' for details.\n\
657Returns the distance traveled, either zero or negative.")
ca1d1d23
JB
658 (string, lim)
659 Lisp_Object string, lim;
660{
17431c60
RS
661 return skip_chars (0, 0, string, lim);
662}
663
664DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0,
665 "Move point forward across chars in specified syntax classes.\n\
666SYNTAX is a string of syntax code characters.\n\
667Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\
668If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
669This function returns the distance traveled, either zero or positive.")
670 (syntax, lim)
671 Lisp_Object syntax, lim;
672{
673 return skip_chars (1, 1, syntax, lim);
674}
675
676DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0,
677 "Move point backward across chars in specified syntax classes.\n\
678SYNTAX is a string of syntax code characters.\n\
679Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\
680If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
681This function returns the distance traveled, either zero or negative.")
682 (syntax, lim)
683 Lisp_Object syntax, lim;
684{
685 return skip_chars (0, 1, syntax, lim);
ca1d1d23
JB
686}
687
c1dc99a1 688Lisp_Object
17431c60
RS
689skip_chars (forwardp, syntaxp, string, lim)
690 int forwardp, syntaxp;
ca1d1d23
JB
691 Lisp_Object string, lim;
692{
693 register unsigned char *p, *pend;
694 register unsigned char c;
695 unsigned char fastmap[0400];
696 int negate = 0;
697 register int i;
698
699 CHECK_STRING (string, 0);
700
701 if (NILP (lim))
a3668d92 702 XSETINT (lim, forwardp ? ZV : BEGV);
ca1d1d23
JB
703 else
704 CHECK_NUMBER_COERCE_MARKER (lim, 1);
705
ca1d1d23 706 /* In any case, don't allow scan outside bounds of buffer. */
c5241910
RS
707 /* jla turned this off, for no known reason.
708 bfox turned the ZV part on, and rms turned the
709 BEGV part back on. */
710 if (XINT (lim) > ZV)
c235cce7 711 XSETFASTINT (lim, ZV);
c5241910 712 if (XINT (lim) < BEGV)
c235cce7 713 XSETFASTINT (lim, BEGV);
ca1d1d23
JB
714
715 p = XSTRING (string)->data;
716 pend = p + XSTRING (string)->size;
717 bzero (fastmap, sizeof fastmap);
718
719 if (p != pend && *p == '^')
720 {
721 negate = 1; p++;
722 }
723
17431c60
RS
724 /* Find the characters specified and set their elements of fastmap.
725 If syntaxp, each character counts as itself.
726 Otherwise, handle backslashes and ranges specially */
ca1d1d23
JB
727
728 while (p != pend)
729 {
730 c = *p++;
17431c60
RS
731 if (syntaxp)
732 fastmap[c] = 1;
733 else
ca1d1d23 734 {
17431c60 735 if (c == '\\')
ca1d1d23 736 {
17431c60
RS
737 if (p == pend) break;
738 c = *p++;
739 }
740 if (p != pend && *p == '-')
741 {
742 p++;
743 if (p == pend) break;
744 while (c <= *p)
745 {
746 fastmap[c] = 1;
747 c++;
748 }
749 p++;
ca1d1d23 750 }
17431c60
RS
751 else
752 fastmap[c] = 1;
ca1d1d23 753 }
ca1d1d23
JB
754 }
755
9239c6c1
RS
756 if (syntaxp && fastmap['-'] != 0)
757 fastmap[' '] = 1;
758
ca1d1d23
JB
759 /* If ^ was the first character, complement the fastmap. */
760
761 if (negate)
762 for (i = 0; i < sizeof fastmap; i++)
763 fastmap[i] ^= 1;
764
c1dc99a1
JB
765 {
766 int start_point = point;
767
768 immediate_quit = 1;
17431c60 769 if (syntaxp)
c1dc99a1 770 {
17431c60
RS
771
772 if (forwardp)
773 {
774 while (point < XINT (lim)
775 && fastmap[(unsigned char) syntax_code_spec[(int) SYNTAX (FETCH_CHAR (point))]])
776 SET_PT (point + 1);
777 }
778 else
779 {
780 while (point > XINT (lim)
781 && fastmap[(unsigned char) syntax_code_spec[(int) SYNTAX (FETCH_CHAR (point - 1))]])
782 SET_PT (point - 1);
783 }
c1dc99a1
JB
784 }
785 else
786 {
17431c60
RS
787 if (forwardp)
788 {
789 while (point < XINT (lim) && fastmap[FETCH_CHAR (point)])
790 SET_PT (point + 1);
791 }
792 else
793 {
794 while (point > XINT (lim) && fastmap[FETCH_CHAR (point - 1)])
795 SET_PT (point - 1);
796 }
c1dc99a1
JB
797 }
798 immediate_quit = 0;
799
800 return make_number (point - start_point);
801 }
ca1d1d23
JB
802}
803\f
804/* Subroutines of Lisp buffer search functions. */
805
806static Lisp_Object
b819a390 807search_command (string, bound, noerror, count, direction, RE, posix)
ca1d1d23
JB
808 Lisp_Object string, bound, noerror, count;
809 int direction;
810 int RE;
b819a390 811 int posix;
ca1d1d23
JB
812{
813 register int np;
814 int lim;
815 int n = direction;
816
817 if (!NILP (count))
818 {
819 CHECK_NUMBER (count, 3);
820 n *= XINT (count);
821 }
822
823 CHECK_STRING (string, 0);
824 if (NILP (bound))
825 lim = n > 0 ? ZV : BEGV;
826 else
827 {
828 CHECK_NUMBER_COERCE_MARKER (bound, 1);
829 lim = XINT (bound);
830 if (n > 0 ? lim < point : lim > point)
831 error ("Invalid search bound (wrong side of point)");
832 if (lim > ZV)
833 lim = ZV;
834 if (lim < BEGV)
835 lim = BEGV;
836 }
837
838 np = search_buffer (string, point, lim, n, RE,
839 (!NILP (current_buffer->case_fold_search)
840 ? XSTRING (current_buffer->case_canon_table)->data : 0),
841 (!NILP (current_buffer->case_fold_search)
b819a390
RS
842 ? XSTRING (current_buffer->case_eqv_table)->data : 0),
843 posix);
ca1d1d23
JB
844 if (np <= 0)
845 {
846 if (NILP (noerror))
847 return signal_failure (string);
848 if (!EQ (noerror, Qt))
849 {
850 if (lim < BEGV || lim > ZV)
851 abort ();
a5f217b8
RS
852 SET_PT (lim);
853 return Qnil;
854#if 0 /* This would be clean, but maybe programs depend on
855 a value of nil here. */
481399bf 856 np = lim;
a5f217b8 857#endif
ca1d1d23 858 }
481399bf
RS
859 else
860 return Qnil;
ca1d1d23
JB
861 }
862
863 if (np < BEGV || np > ZV)
864 abort ();
865
866 SET_PT (np);
867
868 return make_number (np);
869}
870\f
b6d6a51c
KH
871static int
872trivial_regexp_p (regexp)
873 Lisp_Object regexp;
874{
875 int len = XSTRING (regexp)->size;
876 unsigned char *s = XSTRING (regexp)->data;
877 unsigned char c;
878 while (--len >= 0)
879 {
880 switch (*s++)
881 {
882 case '.': case '*': case '+': case '?': case '[': case '^': case '$':
883 return 0;
884 case '\\':
885 if (--len < 0)
886 return 0;
887 switch (*s++)
888 {
889 case '|': case '(': case ')': case '`': case '\'': case 'b':
890 case 'B': case '<': case '>': case 'w': case 'W': case 's':
891 case 'S': case '1': case '2': case '3': case '4': case '5':
892 case '6': case '7': case '8': case '9':
893 return 0;
894 }
895 }
896 }
897 return 1;
898}
899
ca325161 900/* Search for the n'th occurrence of STRING in the current buffer,
ca1d1d23 901 starting at position POS and stopping at position LIM,
b819a390 902 treating STRING as a literal string if RE is false or as
ca1d1d23
JB
903 a regular expression if RE is true.
904
905 If N is positive, searching is forward and LIM must be greater than POS.
906 If N is negative, searching is backward and LIM must be less than POS.
907
908 Returns -x if only N-x occurrences found (x > 0),
909 or else the position at the beginning of the Nth occurrence
b819a390
RS
910 (if searching backward) or the end (if searching forward).
911
912 POSIX is nonzero if we want full backtracking (POSIX style)
913 for this pattern. 0 means backtrack only enough to get a valid match. */
ca1d1d23 914
b819a390
RS
915static int
916search_buffer (string, pos, lim, n, RE, trt, inverse_trt, posix)
ca1d1d23
JB
917 Lisp_Object string;
918 int pos;
919 int lim;
920 int n;
921 int RE;
922 register unsigned char *trt;
923 register unsigned char *inverse_trt;
b819a390 924 int posix;
ca1d1d23
JB
925{
926 int len = XSTRING (string)->size;
927 unsigned char *base_pat = XSTRING (string)->data;
928 register int *BM_tab;
929 int *BM_tab_base;
930 register int direction = ((n > 0) ? 1 : -1);
931 register int dirlen;
932 int infinity, limit, k, stride_for_teases;
933 register unsigned char *pat, *cursor, *p_limit;
934 register int i, j;
935 unsigned char *p1, *p2;
936 int s1, s2;
937
7074fde6
FP
938 if (running_asynch_code)
939 save_search_regs ();
940
ca1d1d23 941 /* Null string is found at starting position. */
3f57a499 942 if (len == 0)
ca325161
RS
943 {
944 set_search_regs (pos, 0);
945 return pos;
946 }
3f57a499
RS
947
948 /* Searching 0 times means don't move. */
949 if (n == 0)
ca1d1d23
JB
950 return pos;
951
b6d6a51c 952 if (RE && !trivial_regexp_p (string))
ca1d1d23 953 {
487282dc
KH
954 struct re_pattern_buffer *bufp;
955
b819a390 956 bufp = compile_pattern (string, &search_regs, (char *) trt, posix);
ca1d1d23 957
ca1d1d23
JB
958 immediate_quit = 1; /* Quit immediately if user types ^G,
959 because letting this function finish
960 can take too long. */
961 QUIT; /* Do a pending quit right away,
962 to avoid paradoxical behavior */
963 /* Get pointers and sizes of the two strings
964 that make up the visible portion of the buffer. */
965
966 p1 = BEGV_ADDR;
967 s1 = GPT - BEGV;
968 p2 = GAP_END_ADDR;
969 s2 = ZV - GPT;
970 if (s1 < 0)
971 {
972 p2 = p1;
973 s2 = ZV - BEGV;
974 s1 = 0;
975 }
976 if (s2 < 0)
977 {
978 s1 = ZV - BEGV;
979 s2 = 0;
980 }
981 while (n < 0)
982 {
42db823b 983 int val;
487282dc 984 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
42db823b
RS
985 pos - BEGV, lim - pos, &search_regs,
986 /* Don't allow match past current point */
987 pos - BEGV);
ca1d1d23 988 if (val == -2)
b6d6a51c
KH
989 {
990 matcher_overflow ();
991 }
ca1d1d23
JB
992 if (val >= 0)
993 {
994 j = BEGV;
4746118a 995 for (i = 0; i < search_regs.num_regs; i++)
ca1d1d23
JB
996 if (search_regs.start[i] >= 0)
997 {
998 search_regs.start[i] += j;
999 search_regs.end[i] += j;
1000 }
a3668d92 1001 XSETBUFFER (last_thing_searched, current_buffer);
ca1d1d23
JB
1002 /* Set pos to the new position. */
1003 pos = search_regs.start[0];
1004 }
1005 else
1006 {
1007 immediate_quit = 0;
1008 return (n);
1009 }
1010 n++;
1011 }
1012 while (n > 0)
1013 {
42db823b 1014 int val;
487282dc 1015 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
42db823b
RS
1016 pos - BEGV, lim - pos, &search_regs,
1017 lim - BEGV);
ca1d1d23 1018 if (val == -2)
b6d6a51c
KH
1019 {
1020 matcher_overflow ();
1021 }
ca1d1d23
JB
1022 if (val >= 0)
1023 {
1024 j = BEGV;
4746118a 1025 for (i = 0; i < search_regs.num_regs; i++)
ca1d1d23
JB
1026 if (search_regs.start[i] >= 0)
1027 {
1028 search_regs.start[i] += j;
1029 search_regs.end[i] += j;
1030 }
a3668d92 1031 XSETBUFFER (last_thing_searched, current_buffer);
ca1d1d23
JB
1032 pos = search_regs.end[0];
1033 }
1034 else
1035 {
1036 immediate_quit = 0;
1037 return (0 - n);
1038 }
1039 n--;
1040 }
1041 immediate_quit = 0;
1042 return (pos);
1043 }
1044 else /* non-RE case */
1045 {
1046#ifdef C_ALLOCA
1047 int BM_tab_space[0400];
1048 BM_tab = &BM_tab_space[0];
1049#else
1050 BM_tab = (int *) alloca (0400 * sizeof (int));
1051#endif
b6d6a51c
KH
1052 {
1053 unsigned char *patbuf = (unsigned char *) alloca (len);
1054 pat = patbuf;
1055 while (--len >= 0)
1056 {
1057 /* If we got here and the RE flag is set, it's because we're
1058 dealing with a regexp known to be trivial, so the backslash
1059 just quotes the next character. */
1060 if (RE && *base_pat == '\\')
1061 {
1062 len--;
1063 base_pat++;
1064 }
1065 *pat++ = (trt ? trt[*base_pat++] : *base_pat++);
1066 }
1067 len = pat - patbuf;
1068 pat = base_pat = patbuf;
1069 }
ca1d1d23
JB
1070 /* The general approach is that we are going to maintain that we know */
1071 /* the first (closest to the present position, in whatever direction */
1072 /* we're searching) character that could possibly be the last */
1073 /* (furthest from present position) character of a valid match. We */
1074 /* advance the state of our knowledge by looking at that character */
1075 /* and seeing whether it indeed matches the last character of the */
1076 /* pattern. If it does, we take a closer look. If it does not, we */
1077 /* move our pointer (to putative last characters) as far as is */
1078 /* logically possible. This amount of movement, which I call a */
1079 /* stride, will be the length of the pattern if the actual character */
1080 /* appears nowhere in the pattern, otherwise it will be the distance */
1081 /* from the last occurrence of that character to the end of the */
1082 /* pattern. */
1083 /* As a coding trick, an enormous stride is coded into the table for */
1084 /* characters that match the last character. This allows use of only */
1085 /* a single test, a test for having gone past the end of the */
1086 /* permissible match region, to test for both possible matches (when */
1087 /* the stride goes past the end immediately) and failure to */
1088 /* match (where you get nudged past the end one stride at a time). */
1089
1090 /* Here we make a "mickey mouse" BM table. The stride of the search */
1091 /* is determined only by the last character of the putative match. */
1092 /* If that character does not match, we will stride the proper */
1093 /* distance to propose a match that superimposes it on the last */
1094 /* instance of a character that matches it (per trt), or misses */
1095 /* it entirely if there is none. */
1096
1097 dirlen = len * direction;
1098 infinity = dirlen - (lim + pos + len + len) * direction;
1099 if (direction < 0)
1100 pat = (base_pat += len - 1);
1101 BM_tab_base = BM_tab;
1102 BM_tab += 0400;
1103 j = dirlen; /* to get it in a register */
1104 /* A character that does not appear in the pattern induces a */
1105 /* stride equal to the pattern length. */
1106 while (BM_tab_base != BM_tab)
1107 {
1108 *--BM_tab = j;
1109 *--BM_tab = j;
1110 *--BM_tab = j;
1111 *--BM_tab = j;
1112 }
1113 i = 0;
1114 while (i != infinity)
1115 {
1116 j = pat[i]; i += direction;
1117 if (i == dirlen) i = infinity;
1118 if ((int) trt)
1119 {
1120 k = (j = trt[j]);
1121 if (i == infinity)
1122 stride_for_teases = BM_tab[j];
1123 BM_tab[j] = dirlen - i;
1124 /* A translation table is accompanied by its inverse -- see */
1125 /* comment following downcase_table for details */
1126 while ((j = inverse_trt[j]) != k)
1127 BM_tab[j] = dirlen - i;
1128 }
1129 else
1130 {
1131 if (i == infinity)
1132 stride_for_teases = BM_tab[j];
1133 BM_tab[j] = dirlen - i;
1134 }
1135 /* stride_for_teases tells how much to stride if we get a */
1136 /* match on the far character but are subsequently */
1137 /* disappointed, by recording what the stride would have been */
1138 /* for that character if the last character had been */
1139 /* different. */
1140 }
1141 infinity = dirlen - infinity;
1142 pos += dirlen - ((direction > 0) ? direction : 0);
1143 /* loop invariant - pos points at where last char (first char if reverse)
1144 of pattern would align in a possible match. */
1145 while (n != 0)
1146 {
b2c71fb4
KH
1147 /* It's been reported that some (broken) compiler thinks that
1148 Boolean expressions in an arithmetic context are unsigned.
1149 Using an explicit ?1:0 prevents this. */
1150 if ((lim - pos - ((direction > 0) ? 1 : 0)) * direction < 0)
ca1d1d23
JB
1151 return (n * (0 - direction));
1152 /* First we do the part we can by pointers (maybe nothing) */
1153 QUIT;
1154 pat = base_pat;
1155 limit = pos - dirlen + direction;
1156 limit = ((direction > 0)
1157 ? BUFFER_CEILING_OF (limit)
1158 : BUFFER_FLOOR_OF (limit));
1159 /* LIMIT is now the last (not beyond-last!) value
1160 POS can take on without hitting edge of buffer or the gap. */
1161 limit = ((direction > 0)
1162 ? min (lim - 1, min (limit, pos + 20000))
1163 : max (lim, max (limit, pos - 20000)));
1164 if ((limit - pos) * direction > 20)
1165 {
1166 p_limit = &FETCH_CHAR (limit);
1167 p2 = (cursor = &FETCH_CHAR (pos));
1168 /* In this loop, pos + cursor - p2 is the surrogate for pos */
1169 while (1) /* use one cursor setting as long as i can */
1170 {
1171 if (direction > 0) /* worth duplicating */
1172 {
1173 /* Use signed comparison if appropriate
1174 to make cursor+infinity sure to be > p_limit.
1175 Assuming that the buffer lies in a range of addresses
1176 that are all "positive" (as ints) or all "negative",
1177 either kind of comparison will work as long
1178 as we don't step by infinity. So pick the kind
1179 that works when we do step by infinity. */
1180 if ((int) (p_limit + infinity) > (int) p_limit)
1181 while ((int) cursor <= (int) p_limit)
1182 cursor += BM_tab[*cursor];
1183 else
1184 while ((unsigned int) cursor <= (unsigned int) p_limit)
1185 cursor += BM_tab[*cursor];
1186 }
1187 else
1188 {
1189 if ((int) (p_limit + infinity) < (int) p_limit)
1190 while ((int) cursor >= (int) p_limit)
1191 cursor += BM_tab[*cursor];
1192 else
1193 while ((unsigned int) cursor >= (unsigned int) p_limit)
1194 cursor += BM_tab[*cursor];
1195 }
1196/* If you are here, cursor is beyond the end of the searched region. */
1197 /* This can happen if you match on the far character of the pattern, */
1198 /* because the "stride" of that character is infinity, a number able */
1199 /* to throw you well beyond the end of the search. It can also */
1200 /* happen if you fail to match within the permitted region and would */
1201 /* otherwise try a character beyond that region */
1202 if ((cursor - p_limit) * direction <= len)
1203 break; /* a small overrun is genuine */
1204 cursor -= infinity; /* large overrun = hit */
1205 i = dirlen - direction;
1206 if ((int) trt)
1207 {
1208 while ((i -= direction) + direction != 0)
1209 if (pat[i] != trt[*(cursor -= direction)])
1210 break;
1211 }
1212 else
1213 {
1214 while ((i -= direction) + direction != 0)
1215 if (pat[i] != *(cursor -= direction))
1216 break;
1217 }
1218 cursor += dirlen - i - direction; /* fix cursor */
1219 if (i + direction == 0)
1220 {
1221 cursor -= direction;
1113d9db 1222
ca325161
RS
1223 set_search_regs (pos + cursor - p2 + ((direction > 0)
1224 ? 1 - len : 0),
1225 len);
1226
ca1d1d23
JB
1227 if ((n -= direction) != 0)
1228 cursor += dirlen; /* to resume search */
1229 else
1230 return ((direction > 0)
1231 ? search_regs.end[0] : search_regs.start[0]);
1232 }
1233 else
1234 cursor += stride_for_teases; /* <sigh> we lose - */
1235 }
1236 pos += cursor - p2;
1237 }
1238 else
1239 /* Now we'll pick up a clump that has to be done the hard */
1240 /* way because it covers a discontinuity */
1241 {
1242 limit = ((direction > 0)
1243 ? BUFFER_CEILING_OF (pos - dirlen + 1)
1244 : BUFFER_FLOOR_OF (pos - dirlen - 1));
1245 limit = ((direction > 0)
1246 ? min (limit + len, lim - 1)
1247 : max (limit - len, lim));
1248 /* LIMIT is now the last value POS can have
1249 and still be valid for a possible match. */
1250 while (1)
1251 {
1252 /* This loop can be coded for space rather than */
1253 /* speed because it will usually run only once. */
1254 /* (the reach is at most len + 21, and typically */
1255 /* does not exceed len) */
1256 while ((limit - pos) * direction >= 0)
1257 pos += BM_tab[FETCH_CHAR(pos)];
1258 /* now run the same tests to distinguish going off the */
eb8c3be9 1259 /* end, a match or a phony match. */
ca1d1d23
JB
1260 if ((pos - limit) * direction <= len)
1261 break; /* ran off the end */
1262 /* Found what might be a match.
1263 Set POS back to last (first if reverse) char pos. */
1264 pos -= infinity;
1265 i = dirlen - direction;
1266 while ((i -= direction) + direction != 0)
1267 {
1268 pos -= direction;
1269 if (pat[i] != (((int) trt)
1270 ? trt[FETCH_CHAR(pos)]
1271 : FETCH_CHAR (pos)))
1272 break;
1273 }
1274 /* Above loop has moved POS part or all the way
1275 back to the first char pos (last char pos if reverse).
1276 Set it once again at the last (first if reverse) char. */
1277 pos += dirlen - i- direction;
1278 if (i + direction == 0)
1279 {
1280 pos -= direction;
1113d9db 1281
ca325161
RS
1282 set_search_regs (pos + ((direction > 0) ? 1 - len : 0),
1283 len);
1284
ca1d1d23
JB
1285 if ((n -= direction) != 0)
1286 pos += dirlen; /* to resume search */
1287 else
1288 return ((direction > 0)
1289 ? search_regs.end[0] : search_regs.start[0]);
1290 }
1291 else
1292 pos += stride_for_teases;
1293 }
1294 }
1295 /* We have done one clump. Can we continue? */
1296 if ((lim - pos) * direction < 0)
1297 return ((0 - n) * direction);
1298 }
1299 return pos;
1300 }
1301}
ca325161
RS
1302
1303/* Record beginning BEG and end BEG + LEN
1304 for a match just found in the current buffer. */
1305
1306static void
1307set_search_regs (beg, len)
1308 int beg, len;
1309{
1310 /* Make sure we have registers in which to store
1311 the match position. */
1312 if (search_regs.num_regs == 0)
1313 {
1314 regoff_t *starts, *ends;
1315
1316 starts = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
1317 ends = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
487282dc 1318 search_regs.num_regs = 2;
ca325161
RS
1319 }
1320
1321 search_regs.start[0] = beg;
1322 search_regs.end[0] = beg + len;
a3668d92 1323 XSETBUFFER (last_thing_searched, current_buffer);
ca325161 1324}
ca1d1d23
JB
1325\f
1326/* Given a string of words separated by word delimiters,
1327 compute a regexp that matches those exact words
1328 separated by arbitrary punctuation. */
1329
1330static Lisp_Object
1331wordify (string)
1332 Lisp_Object string;
1333{
1334 register unsigned char *p, *o;
1335 register int i, len, punct_count = 0, word_count = 0;
1336 Lisp_Object val;
1337
1338 CHECK_STRING (string, 0);
1339 p = XSTRING (string)->data;
1340 len = XSTRING (string)->size;
1341
1342 for (i = 0; i < len; i++)
1343 if (SYNTAX (p[i]) != Sword)
1344 {
1345 punct_count++;
1346 if (i > 0 && SYNTAX (p[i-1]) == Sword) word_count++;
1347 }
1348 if (SYNTAX (p[len-1]) == Sword) word_count++;
1349 if (!word_count) return build_string ("");
1350
1351 val = make_string (p, len - punct_count + 5 * (word_count - 1) + 4);
1352
1353 o = XSTRING (val)->data;
1354 *o++ = '\\';
1355 *o++ = 'b';
1356
1357 for (i = 0; i < len; i++)
1358 if (SYNTAX (p[i]) == Sword)
1359 *o++ = p[i];
1360 else if (i > 0 && SYNTAX (p[i-1]) == Sword && --word_count)
1361 {
1362 *o++ = '\\';
1363 *o++ = 'W';
1364 *o++ = '\\';
1365 *o++ = 'W';
1366 *o++ = '*';
1367 }
1368
1369 *o++ = '\\';
1370 *o++ = 'b';
1371
1372 return val;
1373}
1374\f
1375DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
1376 "sSearch backward: ",
1377 "Search backward from point for STRING.\n\
1378Set point to the beginning of the occurrence found, and return point.\n\
1379An optional second argument bounds the search; it is a buffer position.\n\
1380The match found must not extend before that position.\n\
1381Optional third argument, if t, means if fail just return nil (no error).\n\
1382 If not nil and not t, position at limit of search and return nil.\n\
1383Optional fourth argument is repeat count--search for successive occurrences.\n\
1384See also the functions `match-beginning', `match-end' and `replace-match'.")
1385 (string, bound, noerror, count)
1386 Lisp_Object string, bound, noerror, count;
1387{
b819a390 1388 return search_command (string, bound, noerror, count, -1, 0, 0);
ca1d1d23
JB
1389}
1390
1391DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "sSearch: ",
1392 "Search forward from point for STRING.\n\
1393Set point to the end of the occurrence found, and return point.\n\
1394An optional second argument bounds the search; it is a buffer position.\n\
1395The match found must not extend after that position. nil is equivalent\n\
1396 to (point-max).\n\
1397Optional third argument, if t, means if fail just return nil (no error).\n\
1398 If not nil and not t, move to limit of search and return nil.\n\
1399Optional fourth argument is repeat count--search for successive occurrences.\n\
1400See also the functions `match-beginning', `match-end' and `replace-match'.")
1401 (string, bound, noerror, count)
1402 Lisp_Object string, bound, noerror, count;
1403{
b819a390 1404 return search_command (string, bound, noerror, count, 1, 0, 0);
ca1d1d23
JB
1405}
1406
1407DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
1408 "sWord search backward: ",
1409 "Search backward from point for STRING, ignoring differences in punctuation.\n\
1410Set point to the beginning of the occurrence found, and return point.\n\
1411An optional second argument bounds the search; it is a buffer position.\n\
1412The match found must not extend before that position.\n\
1413Optional third argument, if t, means if fail just return nil (no error).\n\
1414 If not nil and not t, move to limit of search and return nil.\n\
1415Optional fourth argument is repeat count--search for successive occurrences.")
1416 (string, bound, noerror, count)
1417 Lisp_Object string, bound, noerror, count;
1418{
b819a390 1419 return search_command (wordify (string), bound, noerror, count, -1, 1, 0);
ca1d1d23
JB
1420}
1421
1422DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
1423 "sWord search: ",
1424 "Search forward from point for STRING, ignoring differences in punctuation.\n\
1425Set point to the end of the occurrence found, and return point.\n\
1426An optional second argument bounds the search; it is a buffer position.\n\
1427The match found must not extend after that position.\n\
1428Optional third argument, if t, means if fail just return nil (no error).\n\
1429 If not nil and not t, move to limit of search and return nil.\n\
1430Optional fourth argument is repeat count--search for successive occurrences.")
1431 (string, bound, noerror, count)
1432 Lisp_Object string, bound, noerror, count;
1433{
b819a390 1434 return search_command (wordify (string), bound, noerror, count, 1, 1, 0);
ca1d1d23
JB
1435}
1436
1437DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
1438 "sRE search backward: ",
1439 "Search backward from point for match for regular expression REGEXP.\n\
1440Set point to the beginning of the match, and return point.\n\
1441The match found is the one starting last in the buffer\n\
19c0a730 1442and yet ending before the origin of the search.\n\
ca1d1d23
JB
1443An optional second argument bounds the search; it is a buffer position.\n\
1444The match found must start at or after that position.\n\
1445Optional third argument, if t, means if fail just return nil (no error).\n\
1446 If not nil and not t, move to limit of search and return nil.\n\
1447Optional fourth argument is repeat count--search for successive occurrences.\n\
1448See also the functions `match-beginning', `match-end' and `replace-match'.")
19c0a730
KH
1449 (regexp, bound, noerror, count)
1450 Lisp_Object regexp, bound, noerror, count;
ca1d1d23 1451{
b819a390 1452 return search_command (regexp, bound, noerror, count, -1, 1, 0);
ca1d1d23
JB
1453}
1454
1455DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4,
1456 "sRE search: ",
1457 "Search forward from point for regular expression REGEXP.\n\
1458Set point to the end of the occurrence found, and return point.\n\
1459An optional second argument bounds the search; it is a buffer position.\n\
1460The match found must not extend after that position.\n\
1461Optional third argument, if t, means if fail just return nil (no error).\n\
1462 If not nil and not t, move to limit of search and return nil.\n\
1463Optional fourth argument is repeat count--search for successive occurrences.\n\
1464See also the functions `match-beginning', `match-end' and `replace-match'.")
19c0a730
KH
1465 (regexp, bound, noerror, count)
1466 Lisp_Object regexp, bound, noerror, count;
ca1d1d23 1467{
b819a390
RS
1468 return search_command (regexp, bound, noerror, count, 1, 1, 0);
1469}
1470
1471DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, 1, 4,
1472 "sPosix search backward: ",
1473 "Search backward from point for match for regular expression REGEXP.\n\
1474Find the longest match in accord with Posix regular expression rules.\n\
1475Set point to the beginning of the match, and return point.\n\
1476The match found is the one starting last in the buffer\n\
1477and yet ending before the origin of the search.\n\
1478An optional second argument bounds the search; it is a buffer position.\n\
1479The match found must start at or after that position.\n\
1480Optional third argument, if t, means if fail just return nil (no error).\n\
1481 If not nil and not t, move to limit of search and return nil.\n\
1482Optional fourth argument is repeat count--search for successive occurrences.\n\
1483See also the functions `match-beginning', `match-end' and `replace-match'.")
1484 (regexp, bound, noerror, count)
1485 Lisp_Object regexp, bound, noerror, count;
1486{
1487 return search_command (regexp, bound, noerror, count, -1, 1, 1);
1488}
1489
1490DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, 1, 4,
1491 "sPosix search: ",
1492 "Search forward from point for regular expression REGEXP.\n\
1493Find the longest match in accord with Posix regular expression rules.\n\
1494Set point to the end of the occurrence found, and return point.\n\
1495An optional second argument bounds the search; it is a buffer position.\n\
1496The match found must not extend after that position.\n\
1497Optional third argument, if t, means if fail just return nil (no error).\n\
1498 If not nil and not t, move to limit of search and return nil.\n\
1499Optional fourth argument is repeat count--search for successive occurrences.\n\
1500See also the functions `match-beginning', `match-end' and `replace-match'.")
1501 (regexp, bound, noerror, count)
1502 Lisp_Object regexp, bound, noerror, count;
1503{
1504 return search_command (regexp, bound, noerror, count, 1, 1, 1);
ca1d1d23
JB
1505}
1506\f
080c45fd 1507DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 4, 0,
ca1d1d23
JB
1508 "Replace text matched by last search with NEWTEXT.\n\
1509If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\
5b9cf4b2
RS
1510Otherwise maybe capitalize the whole text, or maybe just word initials,\n\
1511based on the replaced text.\n\
1512If the replaced text has only capital letters\n\
1513and has at least one multiletter word, convert NEWTEXT to all caps.\n\
1514If the replaced text has at least one word starting with a capital letter,\n\
1515then capitalize each word in NEWTEXT.\n\n\
ca1d1d23
JB
1516If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\
1517Otherwise treat `\\' as special:\n\
1518 `\\&' in NEWTEXT means substitute original matched text.\n\
1519 `\\N' means substitute what matched the Nth `\\(...\\)'.\n\
1520 If Nth parens didn't match, substitute nothing.\n\
1521 `\\\\' means insert one `\\'.\n\
1113d9db 1522FIXEDCASE and LITERAL are optional arguments.\n\
080c45fd
RS
1523Leaves point at end of replacement text.\n\
1524\n\
1525The optional fourth argument STRING can be a string to modify.\n\
1526In that case, this function creates and returns a new string\n\
1527which is made by replacing the part of STRING that was matched.")
1528 (newtext, fixedcase, literal, string)
1529 Lisp_Object newtext, fixedcase, literal, string;
ca1d1d23
JB
1530{
1531 enum { nochange, all_caps, cap_initial } case_action;
1532 register int pos, last;
1533 int some_multiletter_word;
97832bd0 1534 int some_lowercase;
73dc8771 1535 int some_uppercase;
208767c3 1536 int some_nonuppercase_initial;
ca1d1d23
JB
1537 register int c, prevc;
1538 int inslen;
1539
16fdc568 1540 CHECK_STRING (newtext, 0);
ca1d1d23 1541
080c45fd
RS
1542 if (! NILP (string))
1543 CHECK_STRING (string, 4);
1544
ca1d1d23
JB
1545 case_action = nochange; /* We tried an initialization */
1546 /* but some C compilers blew it */
4746118a
JB
1547
1548 if (search_regs.num_regs <= 0)
1549 error ("replace-match called before any match found");
1550
080c45fd
RS
1551 if (NILP (string))
1552 {
1553 if (search_regs.start[0] < BEGV
1554 || search_regs.start[0] > search_regs.end[0]
1555 || search_regs.end[0] > ZV)
1556 args_out_of_range (make_number (search_regs.start[0]),
1557 make_number (search_regs.end[0]));
1558 }
1559 else
1560 {
1561 if (search_regs.start[0] < 0
1562 || search_regs.start[0] > search_regs.end[0]
1563 || search_regs.end[0] > XSTRING (string)->size)
1564 args_out_of_range (make_number (search_regs.start[0]),
1565 make_number (search_regs.end[0]));
1566 }
ca1d1d23
JB
1567
1568 if (NILP (fixedcase))
1569 {
1570 /* Decide how to casify by examining the matched text. */
1571
1572 last = search_regs.end[0];
1573 prevc = '\n';
1574 case_action = all_caps;
1575
1576 /* some_multiletter_word is set nonzero if any original word
1577 is more than one letter long. */
1578 some_multiletter_word = 0;
97832bd0 1579 some_lowercase = 0;
208767c3 1580 some_nonuppercase_initial = 0;
73dc8771 1581 some_uppercase = 0;
ca1d1d23
JB
1582
1583 for (pos = search_regs.start[0]; pos < last; pos++)
1584 {
080c45fd
RS
1585 if (NILP (string))
1586 c = FETCH_CHAR (pos);
1587 else
1588 c = XSTRING (string)->data[pos];
1589
ca1d1d23
JB
1590 if (LOWERCASEP (c))
1591 {
1592 /* Cannot be all caps if any original char is lower case */
1593
97832bd0 1594 some_lowercase = 1;
ca1d1d23 1595 if (SYNTAX (prevc) != Sword)
208767c3 1596 some_nonuppercase_initial = 1;
ca1d1d23
JB
1597 else
1598 some_multiletter_word = 1;
1599 }
1600 else if (!NOCASEP (c))
1601 {
73dc8771 1602 some_uppercase = 1;
97832bd0 1603 if (SYNTAX (prevc) != Sword)
c4d460ce 1604 ;
97832bd0 1605 else
ca1d1d23
JB
1606 some_multiletter_word = 1;
1607 }
208767c3
RS
1608 else
1609 {
1610 /* If the initial is a caseless word constituent,
1611 treat that like a lowercase initial. */
1612 if (SYNTAX (prevc) != Sword)
1613 some_nonuppercase_initial = 1;
1614 }
ca1d1d23
JB
1615
1616 prevc = c;
1617 }
1618
97832bd0
RS
1619 /* Convert to all caps if the old text is all caps
1620 and has at least one multiletter word. */
1621 if (! some_lowercase && some_multiletter_word)
1622 case_action = all_caps;
c4d460ce 1623 /* Capitalize each word, if the old text has all capitalized words. */
208767c3 1624 else if (!some_nonuppercase_initial && some_multiletter_word)
ca1d1d23 1625 case_action = cap_initial;
208767c3 1626 else if (!some_nonuppercase_initial && some_uppercase)
73dc8771
KH
1627 /* Should x -> yz, operating on X, give Yz or YZ?
1628 We'll assume the latter. */
1629 case_action = all_caps;
97832bd0
RS
1630 else
1631 case_action = nochange;
ca1d1d23
JB
1632 }
1633
080c45fd
RS
1634 /* Do replacement in a string. */
1635 if (!NILP (string))
1636 {
1637 Lisp_Object before, after;
1638
1639 before = Fsubstring (string, make_number (0),
1640 make_number (search_regs.start[0]));
1641 after = Fsubstring (string, make_number (search_regs.end[0]), Qnil);
1642
1643 /* Do case substitution into NEWTEXT if desired. */
1644 if (NILP (literal))
1645 {
1646 int lastpos = -1;
1647 /* We build up the substituted string in ACCUM. */
1648 Lisp_Object accum;
1649 Lisp_Object middle;
1650
1651 accum = Qnil;
1652
1653 for (pos = 0; pos < XSTRING (newtext)->size; pos++)
1654 {
1655 int substart = -1;
1656 int subend;
1657
1658 c = XSTRING (newtext)->data[pos];
1659 if (c == '\\')
1660 {
1661 c = XSTRING (newtext)->data[++pos];
1662 if (c == '&')
1663 {
1664 substart = search_regs.start[0];
1665 subend = search_regs.end[0];
1666 }
1667 else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0')
1668 {
1669 if (search_regs.start[c - '0'] >= 1)
1670 {
1671 substart = search_regs.start[c - '0'];
1672 subend = search_regs.end[c - '0'];
1673 }
1674 }
1675 }
1676 if (substart >= 0)
1677 {
1678 if (pos - 1 != lastpos + 1)
1679 middle = Fsubstring (newtext, lastpos + 1, pos - 1);
1680 else
1681 middle = Qnil;
1682 accum = concat3 (accum, middle,
1683 Fsubstring (string, make_number (substart),
1684 make_number (subend)));
1685 lastpos = pos;
1686 }
1687 }
1688
1689 if (pos != lastpos + 1)
1690 middle = Fsubstring (newtext, lastpos + 1, pos);
1691 else
1692 middle = Qnil;
1693
1694 newtext = concat2 (accum, middle);
1695 }
1696
1697 if (case_action == all_caps)
1698 newtext = Fupcase (newtext);
1699 else if (case_action == cap_initial)
1700 newtext = upcase_initials (newtext);
1701
1702 return concat3 (before, newtext, after);
1703 }
1704
9a76659d
JB
1705 /* We insert the replacement text before the old text, and then
1706 delete the original text. This means that markers at the
1707 beginning or end of the original will float to the corresponding
1708 position in the replacement. */
1709 SET_PT (search_regs.start[0]);
ca1d1d23 1710 if (!NILP (literal))
16fdc568 1711 Finsert_and_inherit (1, &newtext);
ca1d1d23
JB
1712 else
1713 {
1714 struct gcpro gcpro1;
16fdc568 1715 GCPRO1 (newtext);
ca1d1d23 1716
16fdc568 1717 for (pos = 0; pos < XSTRING (newtext)->size; pos++)
ca1d1d23 1718 {
9a76659d
JB
1719 int offset = point - search_regs.start[0];
1720
16fdc568 1721 c = XSTRING (newtext)->data[pos];
ca1d1d23
JB
1722 if (c == '\\')
1723 {
16fdc568 1724 c = XSTRING (newtext)->data[++pos];
ca1d1d23 1725 if (c == '&')
9a76659d
JB
1726 Finsert_buffer_substring
1727 (Fcurrent_buffer (),
1728 make_number (search_regs.start[0] + offset),
1729 make_number (search_regs.end[0] + offset));
78445046 1730 else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0')
ca1d1d23
JB
1731 {
1732 if (search_regs.start[c - '0'] >= 1)
9a76659d
JB
1733 Finsert_buffer_substring
1734 (Fcurrent_buffer (),
1735 make_number (search_regs.start[c - '0'] + offset),
1736 make_number (search_regs.end[c - '0'] + offset));
ca1d1d23
JB
1737 }
1738 else
1739 insert_char (c);
1740 }
1741 else
1742 insert_char (c);
1743 }
1744 UNGCPRO;
1745 }
1746
9a76659d
JB
1747 inslen = point - (search_regs.start[0]);
1748 del_range (search_regs.start[0] + inslen, search_regs.end[0] + inslen);
ca1d1d23
JB
1749
1750 if (case_action == all_caps)
1751 Fupcase_region (make_number (point - inslen), make_number (point));
1752 else if (case_action == cap_initial)
1753 upcase_initials_region (make_number (point - inslen), make_number (point));
1754 return Qnil;
1755}
1756\f
1757static Lisp_Object
1758match_limit (num, beginningp)
1759 Lisp_Object num;
1760 int beginningp;
1761{
1762 register int n;
1763
1764 CHECK_NUMBER (num, 0);
1765 n = XINT (num);
4746118a
JB
1766 if (n < 0 || n >= search_regs.num_regs)
1767 args_out_of_range (num, make_number (search_regs.num_regs));
1768 if (search_regs.num_regs <= 0
1769 || search_regs.start[n] < 0)
ca1d1d23
JB
1770 return Qnil;
1771 return (make_number ((beginningp) ? search_regs.start[n]
1772 : search_regs.end[n]));
1773}
1774
1775DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
1776 "Return position of start of text matched by last search.\n\
16fdc568
BF
1777NUM specifies which parenthesized expression in the last regexp.\n\
1778 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.\n\
ca1d1d23
JB
1779Zero means the entire text matched by the whole regexp or whole string.")
1780 (num)
1781 Lisp_Object num;
1782{
1783 return match_limit (num, 1);
1784}
1785
1786DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0,
1787 "Return position of end of text matched by last search.\n\
1788ARG, a number, specifies which parenthesized expression in the last regexp.\n\
1789 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
1790Zero means the entire text matched by the whole regexp or whole string.")
1791 (num)
1792 Lisp_Object num;
1793{
1794 return match_limit (num, 0);
1795}
1796
1797DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 0, 0,
1798 "Return a list containing all info on what the last search matched.\n\
1799Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.\n\
1800All the elements are markers or nil (nil if the Nth pair didn't match)\n\
1801if the last match was on a buffer; integers or nil if a string was matched.\n\
1802Use `store-match-data' to reinstate the data in this list.")
1803 ()
1804{
4746118a 1805 Lisp_Object *data;
ca1d1d23
JB
1806 int i, len;
1807
daa37602
JB
1808 if (NILP (last_thing_searched))
1809 error ("match-data called before any match found");
1810
4746118a
JB
1811 data = (Lisp_Object *) alloca ((2 * search_regs.num_regs)
1812 * sizeof (Lisp_Object));
1813
ca1d1d23 1814 len = -1;
4746118a 1815 for (i = 0; i < search_regs.num_regs; i++)
ca1d1d23
JB
1816 {
1817 int start = search_regs.start[i];
1818 if (start >= 0)
1819 {
daa37602 1820 if (EQ (last_thing_searched, Qt))
ca1d1d23 1821 {
c235cce7
KH
1822 XSETFASTINT (data[2 * i], start);
1823 XSETFASTINT (data[2 * i + 1], search_regs.end[i]);
ca1d1d23 1824 }
0ed62dc7 1825 else if (BUFFERP (last_thing_searched))
ca1d1d23
JB
1826 {
1827 data[2 * i] = Fmake_marker ();
daa37602
JB
1828 Fset_marker (data[2 * i],
1829 make_number (start),
1830 last_thing_searched);
ca1d1d23
JB
1831 data[2 * i + 1] = Fmake_marker ();
1832 Fset_marker (data[2 * i + 1],
daa37602
JB
1833 make_number (search_regs.end[i]),
1834 last_thing_searched);
ca1d1d23 1835 }
daa37602
JB
1836 else
1837 /* last_thing_searched must always be Qt, a buffer, or Qnil. */
1838 abort ();
1839
ca1d1d23
JB
1840 len = i;
1841 }
1842 else
1843 data[2 * i] = data [2 * i + 1] = Qnil;
1844 }
1845 return Flist (2 * len + 2, data);
1846}
1847
1848
1849DEFUN ("store-match-data", Fstore_match_data, Sstore_match_data, 1, 1, 0,
1850 "Set internal data on last search match from elements of LIST.\n\
1851LIST should have been created by calling `match-data' previously.")
1852 (list)
1853 register Lisp_Object list;
1854{
1855 register int i;
1856 register Lisp_Object marker;
1857
7074fde6
FP
1858 if (running_asynch_code)
1859 save_search_regs ();
1860
ca1d1d23 1861 if (!CONSP (list) && !NILP (list))
b37902c8 1862 list = wrong_type_argument (Qconsp, list);
ca1d1d23 1863
daa37602
JB
1864 /* Unless we find a marker with a buffer in LIST, assume that this
1865 match data came from a string. */
1866 last_thing_searched = Qt;
1867
4746118a
JB
1868 /* Allocate registers if they don't already exist. */
1869 {
d084e942 1870 int length = XFASTINT (Flength (list)) / 2;
4746118a
JB
1871
1872 if (length > search_regs.num_regs)
1873 {
1113d9db
JB
1874 if (search_regs.num_regs == 0)
1875 {
1876 search_regs.start
1877 = (regoff_t *) xmalloc (length * sizeof (regoff_t));
1878 search_regs.end
1879 = (regoff_t *) xmalloc (length * sizeof (regoff_t));
1880 }
4746118a 1881 else
1113d9db
JB
1882 {
1883 search_regs.start
1884 = (regoff_t *) xrealloc (search_regs.start,
1885 length * sizeof (regoff_t));
1886 search_regs.end
1887 = (regoff_t *) xrealloc (search_regs.end,
1888 length * sizeof (regoff_t));
1889 }
4746118a 1890
487282dc 1891 search_regs.num_regs = length;
4746118a
JB
1892 }
1893 }
1894
1895 for (i = 0; i < search_regs.num_regs; i++)
ca1d1d23
JB
1896 {
1897 marker = Fcar (list);
1898 if (NILP (marker))
1899 {
1900 search_regs.start[i] = -1;
1901 list = Fcdr (list);
1902 }
1903 else
1904 {
0ed62dc7 1905 if (MARKERP (marker))
daa37602
JB
1906 {
1907 if (XMARKER (marker)->buffer == 0)
c235cce7 1908 XSETFASTINT (marker, 0);
daa37602 1909 else
a3668d92 1910 XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer);
daa37602 1911 }
ca1d1d23
JB
1912
1913 CHECK_NUMBER_COERCE_MARKER (marker, 0);
1914 search_regs.start[i] = XINT (marker);
1915 list = Fcdr (list);
1916
1917 marker = Fcar (list);
0ed62dc7 1918 if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
c235cce7 1919 XSETFASTINT (marker, 0);
ca1d1d23
JB
1920
1921 CHECK_NUMBER_COERCE_MARKER (marker, 0);
1922 search_regs.end[i] = XINT (marker);
1923 }
1924 list = Fcdr (list);
1925 }
1926
1927 return Qnil;
1928}
1929
7074fde6
FP
1930/* If non-zero the match data have been saved in saved_search_regs
1931 during the execution of a sentinel or filter. */
1932static int search_regs_saved = 0;
1933static struct re_registers saved_search_regs;
1934
1935/* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
1936 if asynchronous code (filter or sentinel) is running. */
1937static void
1938save_search_regs ()
1939{
1940 if (!search_regs_saved)
1941 {
1942 saved_search_regs.num_regs = search_regs.num_regs;
1943 saved_search_regs.start = search_regs.start;
1944 saved_search_regs.end = search_regs.end;
1945 search_regs.num_regs = 0;
1946
1947 search_regs_saved = 1;
1948 }
1949}
1950
1951/* Called upon exit from filters and sentinels. */
1952void
1953restore_match_data ()
1954{
1955 if (search_regs_saved)
1956 {
1957 if (search_regs.num_regs > 0)
1958 {
1959 xfree (search_regs.start);
1960 xfree (search_regs.end);
1961 }
1962 search_regs.num_regs = saved_search_regs.num_regs;
1963 search_regs.start = saved_search_regs.start;
1964 search_regs.end = saved_search_regs.end;
1965
1966 search_regs_saved = 0;
1967 }
1968}
1969
ca1d1d23
JB
1970/* Quote a string to inactivate reg-expr chars */
1971
1972DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
1973 "Return a regexp string which matches exactly STRING and nothing else.")
1974 (str)
1975 Lisp_Object str;
1976{
1977 register unsigned char *in, *out, *end;
1978 register unsigned char *temp;
1979
1980 CHECK_STRING (str, 0);
1981
1982 temp = (unsigned char *) alloca (XSTRING (str)->size * 2);
1983
1984 /* Now copy the data into the new string, inserting escapes. */
1985
1986 in = XSTRING (str)->data;
1987 end = in + XSTRING (str)->size;
1988 out = temp;
1989
1990 for (; in != end; in++)
1991 {
1992 if (*in == '[' || *in == ']'
1993 || *in == '*' || *in == '.' || *in == '\\'
1994 || *in == '?' || *in == '+'
1995 || *in == '^' || *in == '$')
1996 *out++ = '\\';
1997 *out++ = *in;
1998 }
1999
2000 return make_string (temp, out - temp);
2001}
2002\f
2003syms_of_search ()
2004{
2005 register int i;
2006
487282dc
KH
2007 for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
2008 {
2009 searchbufs[i].buf.allocated = 100;
2010 searchbufs[i].buf.buffer = (unsigned char *) malloc (100);
2011 searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
2012 searchbufs[i].regexp = Qnil;
2013 staticpro (&searchbufs[i].regexp);
2014 searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]);
2015 }
2016 searchbuf_head = &searchbufs[0];
ca1d1d23
JB
2017
2018 Qsearch_failed = intern ("search-failed");
2019 staticpro (&Qsearch_failed);
2020 Qinvalid_regexp = intern ("invalid-regexp");
2021 staticpro (&Qinvalid_regexp);
2022
2023 Fput (Qsearch_failed, Qerror_conditions,
2024 Fcons (Qsearch_failed, Fcons (Qerror, Qnil)));
2025 Fput (Qsearch_failed, Qerror_message,
2026 build_string ("Search failed"));
2027
2028 Fput (Qinvalid_regexp, Qerror_conditions,
2029 Fcons (Qinvalid_regexp, Fcons (Qerror, Qnil)));
2030 Fput (Qinvalid_regexp, Qerror_message,
2031 build_string ("Invalid regexp"));
2032
daa37602
JB
2033 last_thing_searched = Qnil;
2034 staticpro (&last_thing_searched);
2035
ca1d1d23 2036 defsubr (&Slooking_at);
b819a390
RS
2037 defsubr (&Sposix_looking_at);
2038 defsubr (&Sstring_match);
2039 defsubr (&Sposix_string_match);
ca1d1d23
JB
2040 defsubr (&Sskip_chars_forward);
2041 defsubr (&Sskip_chars_backward);
17431c60
RS
2042 defsubr (&Sskip_syntax_forward);
2043 defsubr (&Sskip_syntax_backward);
ca1d1d23
JB
2044 defsubr (&Ssearch_forward);
2045 defsubr (&Ssearch_backward);
2046 defsubr (&Sword_search_forward);
2047 defsubr (&Sword_search_backward);
2048 defsubr (&Sre_search_forward);
2049 defsubr (&Sre_search_backward);
b819a390
RS
2050 defsubr (&Sposix_search_forward);
2051 defsubr (&Sposix_search_backward);
ca1d1d23
JB
2052 defsubr (&Sreplace_match);
2053 defsubr (&Smatch_beginning);
2054 defsubr (&Smatch_end);
2055 defsubr (&Smatch_data);
2056 defsubr (&Sstore_match_data);
2057 defsubr (&Sregexp_quote);
2058}