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