* subr.el (with-current-buffer): don't use backquotes to avoid
[emacs.git] / src / search.c
blobcbecadcdc007e91a4cd26c18749dbfb9c97aa1f6
1 /* String search routines for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 93, 94, 97, 1998 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 #include <config.h>
23 #ifdef STDC_HEADERS
24 #include <stdlib.h>
25 #endif
26 #include "lisp.h"
27 #include "syntax.h"
28 #include "category.h"
29 #include "buffer.h"
30 #include "charset.h"
31 #include "region-cache.h"
32 #include "commands.h"
33 #include "blockinput.h"
34 #include "intervals.h"
36 #include <sys/types.h>
37 #include "regex.h"
39 #define min(a, b) ((a) < (b) ? (a) : (b))
40 #define max(a, b) ((a) > (b) ? (a) : (b))
42 #define REGEXP_CACHE_SIZE 20
44 /* If the regexp is non-nil, then the buffer contains the compiled form
45 of that regexp, suitable for searching. */
46 struct regexp_cache
48 struct regexp_cache *next;
49 Lisp_Object regexp;
50 struct re_pattern_buffer buf;
51 char fastmap[0400];
52 /* Nonzero means regexp was compiled to do full POSIX backtracking. */
53 char posix;
56 /* The instances of that struct. */
57 struct regexp_cache searchbufs[REGEXP_CACHE_SIZE];
59 /* The head of the linked list; points to the most recently used buffer. */
60 struct regexp_cache *searchbuf_head;
63 /* Every call to re_match, etc., must pass &search_regs as the regs
64 argument unless you can show it is unnecessary (i.e., if re_match
65 is certainly going to be called again before region-around-match
66 can be called).
68 Since the registers are now dynamically allocated, we need to make
69 sure not to refer to the Nth register before checking that it has
70 been allocated by checking search_regs.num_regs.
72 The regex code keeps track of whether it has allocated the search
73 buffer using bits in the re_pattern_buffer. This means that whenever
74 you compile a new pattern, it completely forgets whether it has
75 allocated any registers, and will allocate new registers the next
76 time you call a searching or matching function. Therefore, we need
77 to call re_set_registers after compiling a new pattern or after
78 setting the match registers, so that the regex functions will be
79 able to free or re-allocate it properly. */
80 static struct re_registers search_regs;
82 /* The buffer in which the last search was performed, or
83 Qt if the last search was done in a string;
84 Qnil if no searching has been done yet. */
85 static Lisp_Object last_thing_searched;
87 /* error condition signaled when regexp compile_pattern fails */
89 Lisp_Object Qinvalid_regexp;
91 static void set_search_regs ();
92 static void save_search_regs ();
93 static int simple_search ();
94 static int boyer_moore ();
95 static int search_buffer ();
97 static void
98 matcher_overflow ()
100 error ("Stack overflow in regexp matcher");
103 #ifdef __STDC__
104 #define CONST const
105 #else
106 #define CONST
107 #endif
109 /* Compile a regexp and signal a Lisp error if anything goes wrong.
110 PATTERN is the pattern to compile.
111 CP is the place to put the result.
112 TRANSLATE is a translation table for ignoring case, or nil for none.
113 REGP is the structure that says where to store the "register"
114 values that will result from matching this pattern.
115 If it is 0, we should compile the pattern not to record any
116 subexpression bounds.
117 POSIX is nonzero if we want full backtracking (POSIX style)
118 for this pattern. 0 means backtrack only enough to get a valid match.
119 MULTIBYTE is nonzero if we want to handle multibyte characters in
120 PATTERN. 0 means all multibyte characters are recognized just as
121 sequences of binary data. */
123 static void
124 compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte)
125 struct regexp_cache *cp;
126 Lisp_Object pattern;
127 Lisp_Object translate;
128 struct re_registers *regp;
129 int posix;
130 int multibyte;
132 unsigned char *raw_pattern;
133 int raw_pattern_size;
134 char *val;
135 reg_syntax_t old;
137 /* MULTIBYTE says whether the text to be searched is multibyte.
138 We must convert PATTERN to match that, or we will not really
139 find things right. */
141 if (multibyte == STRING_MULTIBYTE (pattern))
143 raw_pattern = (unsigned char *) XSTRING (pattern)->data;
144 raw_pattern_size = STRING_BYTES (XSTRING (pattern));
146 else if (multibyte)
148 raw_pattern_size = count_size_as_multibyte (XSTRING (pattern)->data,
149 XSTRING (pattern)->size);
150 raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
151 copy_text (XSTRING (pattern)->data, raw_pattern,
152 XSTRING (pattern)->size, 0, 1);
154 else
156 /* Converting multibyte to single-byte.
158 ??? Perhaps this conversion should be done in a special way
159 by subtracting nonascii-insert-offset from each non-ASCII char,
160 so that only the multibyte chars which really correspond to
161 the chosen single-byte character set can possibly match. */
162 raw_pattern_size = XSTRING (pattern)->size;
163 raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
164 copy_text (XSTRING (pattern)->data, raw_pattern,
165 STRING_BYTES (XSTRING (pattern)), 1, 0);
168 cp->regexp = Qnil;
169 cp->buf.translate = (! NILP (translate) ? translate : make_number (0));
170 cp->posix = posix;
171 cp->buf.multibyte = multibyte;
172 BLOCK_INPUT;
173 old = re_set_syntax (RE_SYNTAX_EMACS | RE_CHAR_CLASSES
174 | (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
175 val = (char *) re_compile_pattern ((char *)raw_pattern,
176 raw_pattern_size, &cp->buf);
177 re_set_syntax (old);
178 UNBLOCK_INPUT;
179 if (val)
180 Fsignal (Qinvalid_regexp, Fcons (build_string (val), Qnil));
182 cp->regexp = Fcopy_sequence (pattern);
185 /* Shrink each compiled regexp buffer in the cache
186 to the size actually used right now.
187 This is called from garbage collection. */
189 void
190 shrink_regexp_cache ()
192 struct regexp_cache *cp, **cpp;
194 for (cp = searchbuf_head; cp != 0; cp = cp->next)
196 cp->buf.allocated = cp->buf.used;
197 cp->buf.buffer
198 = (unsigned char *) realloc (cp->buf.buffer, cp->buf.used);
202 /* Compile a regexp if necessary, but first check to see if there's one in
203 the cache.
204 PATTERN is the pattern to compile.
205 TRANSLATE is a translation table for ignoring case, or nil for none.
206 REGP is the structure that says where to store the "register"
207 values that will result from matching this pattern.
208 If it is 0, we should compile the pattern not to record any
209 subexpression bounds.
210 POSIX is nonzero if we want full backtracking (POSIX style)
211 for this pattern. 0 means backtrack only enough to get a valid match. */
213 struct re_pattern_buffer *
214 compile_pattern (pattern, regp, translate, posix, multibyte)
215 Lisp_Object pattern;
216 struct re_registers *regp;
217 Lisp_Object translate;
218 int posix, multibyte;
220 struct regexp_cache *cp, **cpp;
222 for (cpp = &searchbuf_head; ; cpp = &cp->next)
224 cp = *cpp;
225 if (XSTRING (cp->regexp)->size == XSTRING (pattern)->size
226 && !NILP (Fstring_equal (cp->regexp, pattern))
227 && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0)))
228 && cp->posix == posix
229 && cp->buf.multibyte == multibyte)
230 break;
232 /* If we're at the end of the cache, compile into the last cell. */
233 if (cp->next == 0)
235 compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte);
236 break;
240 /* When we get here, cp (aka *cpp) contains the compiled pattern,
241 either because we found it in the cache or because we just compiled it.
242 Move it to the front of the queue to mark it as most recently used. */
243 *cpp = cp->next;
244 cp->next = searchbuf_head;
245 searchbuf_head = cp;
247 /* Advise the searching functions about the space we have allocated
248 for register data. */
249 if (regp)
250 re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end);
252 return &cp->buf;
255 /* Error condition used for failing searches */
256 Lisp_Object Qsearch_failed;
258 Lisp_Object
259 signal_failure (arg)
260 Lisp_Object arg;
262 Fsignal (Qsearch_failed, Fcons (arg, Qnil));
263 return Qnil;
266 static Lisp_Object
267 looking_at_1 (string, posix)
268 Lisp_Object string;
269 int posix;
271 Lisp_Object val;
272 unsigned char *p1, *p2;
273 int s1, s2;
274 register int i;
275 struct re_pattern_buffer *bufp;
277 if (running_asynch_code)
278 save_search_regs ();
280 CHECK_STRING (string, 0);
281 bufp = compile_pattern (string, &search_regs,
282 (!NILP (current_buffer->case_fold_search)
283 ? DOWNCASE_TABLE : Qnil),
284 posix,
285 !NILP (current_buffer->enable_multibyte_characters));
287 immediate_quit = 1;
288 QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */
290 /* Get pointers and sizes of the two strings
291 that make up the visible portion of the buffer. */
293 p1 = BEGV_ADDR;
294 s1 = GPT_BYTE - BEGV_BYTE;
295 p2 = GAP_END_ADDR;
296 s2 = ZV_BYTE - GPT_BYTE;
297 if (s1 < 0)
299 p2 = p1;
300 s2 = ZV_BYTE - BEGV_BYTE;
301 s1 = 0;
303 if (s2 < 0)
305 s1 = ZV_BYTE - BEGV_BYTE;
306 s2 = 0;
309 re_match_object = Qnil;
311 i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
312 PT_BYTE - BEGV_BYTE, &search_regs,
313 ZV_BYTE - BEGV_BYTE);
314 if (i == -2)
315 matcher_overflow ();
317 val = (0 <= i ? Qt : Qnil);
318 if (i >= 0)
319 for (i = 0; i < search_regs.num_regs; i++)
320 if (search_regs.start[i] >= 0)
322 search_regs.start[i]
323 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
324 search_regs.end[i]
325 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
327 XSETBUFFER (last_thing_searched, current_buffer);
328 immediate_quit = 0;
329 return val;
332 DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0,
333 "Return t if text after point matches regular expression REGEXP.\n\
334 This function modifies the match data that `match-beginning',\n\
335 `match-end' and `match-data' access; save and restore the match\n\
336 data if you want to preserve them.")
337 (regexp)
338 Lisp_Object regexp;
340 return looking_at_1 (regexp, 0);
343 DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0,
344 "Return t if text after point matches regular expression REGEXP.\n\
345 Find the longest match, in accord with Posix regular expression rules.\n\
346 This function modifies the match data that `match-beginning',\n\
347 `match-end' and `match-data' access; save and restore the match\n\
348 data if you want to preserve them.")
349 (regexp)
350 Lisp_Object regexp;
352 return looking_at_1 (regexp, 1);
355 static Lisp_Object
356 string_match_1 (regexp, string, start, posix)
357 Lisp_Object regexp, string, start;
358 int posix;
360 int val;
361 struct re_pattern_buffer *bufp;
362 int pos, pos_byte;
363 int i;
365 if (running_asynch_code)
366 save_search_regs ();
368 CHECK_STRING (regexp, 0);
369 CHECK_STRING (string, 1);
371 if (NILP (start))
372 pos = 0, pos_byte = 0;
373 else
375 int len = XSTRING (string)->size;
377 CHECK_NUMBER (start, 2);
378 pos = XINT (start);
379 if (pos < 0 && -pos <= len)
380 pos = len + pos;
381 else if (0 > pos || pos > len)
382 args_out_of_range (string, start);
383 pos_byte = string_char_to_byte (string, pos);
386 bufp = compile_pattern (regexp, &search_regs,
387 (!NILP (current_buffer->case_fold_search)
388 ? DOWNCASE_TABLE : Qnil),
389 posix,
390 STRING_MULTIBYTE (string));
391 immediate_quit = 1;
392 re_match_object = string;
394 val = re_search (bufp, (char *) XSTRING (string)->data,
395 STRING_BYTES (XSTRING (string)), pos_byte,
396 STRING_BYTES (XSTRING (string)) - pos_byte,
397 &search_regs);
398 immediate_quit = 0;
399 last_thing_searched = Qt;
400 if (val == -2)
401 matcher_overflow ();
402 if (val < 0) return Qnil;
404 for (i = 0; i < search_regs.num_regs; i++)
405 if (search_regs.start[i] >= 0)
407 search_regs.start[i]
408 = string_byte_to_char (string, search_regs.start[i]);
409 search_regs.end[i]
410 = string_byte_to_char (string, search_regs.end[i]);
413 return make_number (string_byte_to_char (string, val));
416 DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0,
417 "Return index of start of first match for REGEXP in STRING, or nil.\n\
418 Case is ignored if `case-fold-search' is non-nil in the current buffer.\n\
419 If third arg START is non-nil, start search at that index in STRING.\n\
420 For index of first char beyond the match, do (match-end 0).\n\
421 `match-end' and `match-beginning' also give indices of substrings\n\
422 matched by parenthesis constructs in the pattern.")
423 (regexp, string, start)
424 Lisp_Object regexp, string, start;
426 return string_match_1 (regexp, string, start, 0);
429 DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0,
430 "Return index of start of first match for REGEXP in STRING, or nil.\n\
431 Find the longest match, in accord with Posix regular expression rules.\n\
432 Case is ignored if `case-fold-search' is non-nil in the current buffer.\n\
433 If third arg START is non-nil, start search at that index in STRING.\n\
434 For index of first char beyond the match, do (match-end 0).\n\
435 `match-end' and `match-beginning' also give indices of substrings\n\
436 matched by parenthesis constructs in the pattern.")
437 (regexp, string, start)
438 Lisp_Object regexp, string, start;
440 return string_match_1 (regexp, string, start, 1);
443 /* Match REGEXP against STRING, searching all of STRING,
444 and return the index of the match, or negative on failure.
445 This does not clobber the match data. */
448 fast_string_match (regexp, string)
449 Lisp_Object regexp, string;
451 int val;
452 struct re_pattern_buffer *bufp;
454 bufp = compile_pattern (regexp, 0, Qnil,
455 0, STRING_MULTIBYTE (string));
456 immediate_quit = 1;
457 re_match_object = string;
459 val = re_search (bufp, (char *) XSTRING (string)->data,
460 STRING_BYTES (XSTRING (string)), 0,
461 STRING_BYTES (XSTRING (string)), 0);
462 immediate_quit = 0;
463 return val;
466 /* Match REGEXP against STRING, searching all of STRING ignoring case,
467 and return the index of the match, or negative on failure.
468 This does not clobber the match data.
469 We assume that STRING contains single-byte characters. */
471 extern Lisp_Object Vascii_downcase_table;
474 fast_c_string_match_ignore_case (regexp, string)
475 Lisp_Object regexp;
476 char *string;
478 int val;
479 struct re_pattern_buffer *bufp;
480 int len = strlen (string);
482 regexp = string_make_unibyte (regexp);
483 re_match_object = Qt;
484 bufp = compile_pattern (regexp, 0,
485 Vascii_downcase_table, 0,
487 immediate_quit = 1;
488 val = re_search (bufp, string, len, 0, len, 0);
489 immediate_quit = 0;
490 return val;
493 /* The newline cache: remembering which sections of text have no newlines. */
495 /* If the user has requested newline caching, make sure it's on.
496 Otherwise, make sure it's off.
497 This is our cheezy way of associating an action with the change of
498 state of a buffer-local variable. */
499 static void
500 newline_cache_on_off (buf)
501 struct buffer *buf;
503 if (NILP (buf->cache_long_line_scans))
505 /* It should be off. */
506 if (buf->newline_cache)
508 free_region_cache (buf->newline_cache);
509 buf->newline_cache = 0;
512 else
514 /* It should be on. */
515 if (buf->newline_cache == 0)
516 buf->newline_cache = new_region_cache ();
521 /* Search for COUNT instances of the character TARGET between START and END.
523 If COUNT is positive, search forwards; END must be >= START.
524 If COUNT is negative, search backwards for the -COUNTth instance;
525 END must be <= START.
526 If COUNT is zero, do anything you please; run rogue, for all I care.
528 If END is zero, use BEGV or ZV instead, as appropriate for the
529 direction indicated by COUNT.
531 If we find COUNT instances, set *SHORTAGE to zero, and return the
532 position after the COUNTth match. Note that for reverse motion
533 this is not the same as the usual convention for Emacs motion commands.
535 If we don't find COUNT instances before reaching END, set *SHORTAGE
536 to the number of TARGETs left unfound, and return END.
538 If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do
539 except when inside redisplay. */
542 scan_buffer (target, start, end, count, shortage, allow_quit)
543 register int target;
544 int start, end;
545 int count;
546 int *shortage;
547 int allow_quit;
549 struct region_cache *newline_cache;
550 int direction;
552 if (count > 0)
554 direction = 1;
555 if (! end) end = ZV;
557 else
559 direction = -1;
560 if (! end) end = BEGV;
563 newline_cache_on_off (current_buffer);
564 newline_cache = current_buffer->newline_cache;
566 if (shortage != 0)
567 *shortage = 0;
569 immediate_quit = allow_quit;
571 if (count > 0)
572 while (start != end)
574 /* Our innermost scanning loop is very simple; it doesn't know
575 about gaps, buffer ends, or the newline cache. ceiling is
576 the position of the last character before the next such
577 obstacle --- the last character the dumb search loop should
578 examine. */
579 int ceiling_byte = CHAR_TO_BYTE (end) - 1;
580 int start_byte = CHAR_TO_BYTE (start);
581 int tem;
583 /* If we're looking for a newline, consult the newline cache
584 to see where we can avoid some scanning. */
585 if (target == '\n' && newline_cache)
587 int next_change;
588 immediate_quit = 0;
589 while (region_cache_forward
590 (current_buffer, newline_cache, start_byte, &next_change))
591 start_byte = next_change;
592 immediate_quit = allow_quit;
594 /* START should never be after END. */
595 if (start_byte > ceiling_byte)
596 start_byte = ceiling_byte;
598 /* Now the text after start is an unknown region, and
599 next_change is the position of the next known region. */
600 ceiling_byte = min (next_change - 1, ceiling_byte);
603 /* The dumb loop can only scan text stored in contiguous
604 bytes. BUFFER_CEILING_OF returns the last character
605 position that is contiguous, so the ceiling is the
606 position after that. */
607 tem = BUFFER_CEILING_OF (start_byte);
608 ceiling_byte = min (tem, ceiling_byte);
611 /* The termination address of the dumb loop. */
612 register unsigned char *ceiling_addr
613 = BYTE_POS_ADDR (ceiling_byte) + 1;
614 register unsigned char *cursor
615 = BYTE_POS_ADDR (start_byte);
616 unsigned char *base = cursor;
618 while (cursor < ceiling_addr)
620 unsigned char *scan_start = cursor;
622 /* The dumb loop. */
623 while (*cursor != target && ++cursor < ceiling_addr)
626 /* If we're looking for newlines, cache the fact that
627 the region from start to cursor is free of them. */
628 if (target == '\n' && newline_cache)
629 know_region_cache (current_buffer, newline_cache,
630 start_byte + scan_start - base,
631 start_byte + cursor - base);
633 /* Did we find the target character? */
634 if (cursor < ceiling_addr)
636 if (--count == 0)
638 immediate_quit = 0;
639 return BYTE_TO_CHAR (start_byte + cursor - base + 1);
641 cursor++;
645 start = BYTE_TO_CHAR (start_byte + cursor - base);
648 else
649 while (start > end)
651 /* The last character to check before the next obstacle. */
652 int ceiling_byte = CHAR_TO_BYTE (end);
653 int start_byte = CHAR_TO_BYTE (start);
654 int tem;
656 /* Consult the newline cache, if appropriate. */
657 if (target == '\n' && newline_cache)
659 int next_change;
660 immediate_quit = 0;
661 while (region_cache_backward
662 (current_buffer, newline_cache, start_byte, &next_change))
663 start_byte = next_change;
664 immediate_quit = allow_quit;
666 /* Start should never be at or before end. */
667 if (start_byte <= ceiling_byte)
668 start_byte = ceiling_byte + 1;
670 /* Now the text before start is an unknown region, and
671 next_change is the position of the next known region. */
672 ceiling_byte = max (next_change, ceiling_byte);
675 /* Stop scanning before the gap. */
676 tem = BUFFER_FLOOR_OF (start_byte - 1);
677 ceiling_byte = max (tem, ceiling_byte);
680 /* The termination address of the dumb loop. */
681 register unsigned char *ceiling_addr = BYTE_POS_ADDR (ceiling_byte);
682 register unsigned char *cursor = BYTE_POS_ADDR (start_byte - 1);
683 unsigned char *base = cursor;
685 while (cursor >= ceiling_addr)
687 unsigned char *scan_start = cursor;
689 while (*cursor != target && --cursor >= ceiling_addr)
692 /* If we're looking for newlines, cache the fact that
693 the region from after the cursor to start is free of them. */
694 if (target == '\n' && newline_cache)
695 know_region_cache (current_buffer, newline_cache,
696 start_byte + cursor - base,
697 start_byte + scan_start - base);
699 /* Did we find the target character? */
700 if (cursor >= ceiling_addr)
702 if (++count >= 0)
704 immediate_quit = 0;
705 return BYTE_TO_CHAR (start_byte + cursor - base);
707 cursor--;
711 start = BYTE_TO_CHAR (start_byte + cursor - base);
715 immediate_quit = 0;
716 if (shortage != 0)
717 *shortage = count * direction;
718 return start;
721 /* Search for COUNT instances of a line boundary, which means either a
722 newline or (if selective display enabled) a carriage return.
723 Start at START. If COUNT is negative, search backwards.
725 We report the resulting position by calling TEMP_SET_PT_BOTH.
727 If we find COUNT instances. we position after (always after,
728 even if scanning backwards) the COUNTth match, and return 0.
730 If we don't find COUNT instances before reaching the end of the
731 buffer (or the beginning, if scanning backwards), we return
732 the number of line boundaries left unfound, and position at
733 the limit we bumped up against.
735 If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do
736 except in special cases. */
739 scan_newline (start, start_byte, limit, limit_byte, count, allow_quit)
740 int start, start_byte;
741 int limit, limit_byte;
742 register int count;
743 int allow_quit;
745 int direction = ((count > 0) ? 1 : -1);
747 register unsigned char *cursor;
748 unsigned char *base;
750 register int ceiling;
751 register unsigned char *ceiling_addr;
753 int old_immediate_quit = immediate_quit;
755 /* If we are not in selective display mode,
756 check only for newlines. */
757 int selective_display = (!NILP (current_buffer->selective_display)
758 && !INTEGERP (current_buffer->selective_display));
760 /* The code that follows is like scan_buffer
761 but checks for either newline or carriage return. */
763 if (allow_quit)
764 immediate_quit++;
766 start_byte = CHAR_TO_BYTE (start);
768 if (count > 0)
770 while (start_byte < limit_byte)
772 ceiling = BUFFER_CEILING_OF (start_byte);
773 ceiling = min (limit_byte - 1, ceiling);
774 ceiling_addr = BYTE_POS_ADDR (ceiling) + 1;
775 base = (cursor = BYTE_POS_ADDR (start_byte));
776 while (1)
778 while (*cursor != '\n' && ++cursor != ceiling_addr)
781 if (cursor != ceiling_addr)
783 if (--count == 0)
785 immediate_quit = old_immediate_quit;
786 start_byte = start_byte + cursor - base + 1;
787 start = BYTE_TO_CHAR (start_byte);
788 TEMP_SET_PT_BOTH (start, start_byte);
789 return 0;
791 else
792 if (++cursor == ceiling_addr)
793 break;
795 else
796 break;
798 start_byte += cursor - base;
801 else
803 while (start_byte > limit_byte)
805 ceiling = BUFFER_FLOOR_OF (start_byte - 1);
806 ceiling = max (limit_byte, ceiling);
807 ceiling_addr = BYTE_POS_ADDR (ceiling) - 1;
808 base = (cursor = BYTE_POS_ADDR (start_byte - 1) + 1);
809 while (1)
811 while (--cursor != ceiling_addr && *cursor != '\n')
814 if (cursor != ceiling_addr)
816 if (++count == 0)
818 immediate_quit = old_immediate_quit;
819 /* Return the position AFTER the match we found. */
820 start_byte = start_byte + cursor - base + 1;
821 start = BYTE_TO_CHAR (start_byte);
822 TEMP_SET_PT_BOTH (start, start_byte);
823 return 0;
826 else
827 break;
829 /* Here we add 1 to compensate for the last decrement
830 of CURSOR, which took it past the valid range. */
831 start_byte += cursor - base + 1;
835 TEMP_SET_PT_BOTH (limit, limit_byte);
836 immediate_quit = old_immediate_quit;
838 return count * direction;
842 find_next_newline_no_quit (from, cnt)
843 register int from, cnt;
845 return scan_buffer ('\n', from, 0, cnt, (int *) 0, 0);
848 /* Like find_next_newline, but returns position before the newline,
849 not after, and only search up to TO. This isn't just
850 find_next_newline (...)-1, because you might hit TO. */
853 find_before_next_newline (from, to, cnt)
854 int from, to, cnt;
856 int shortage;
857 int pos = scan_buffer ('\n', from, to, cnt, &shortage, 1);
859 if (shortage == 0)
860 pos--;
862 return pos;
865 /* Subroutines of Lisp buffer search functions. */
867 static Lisp_Object
868 search_command (string, bound, noerror, count, direction, RE, posix)
869 Lisp_Object string, bound, noerror, count;
870 int direction;
871 int RE;
872 int posix;
874 register int np;
875 int lim, lim_byte;
876 int n = direction;
878 if (!NILP (count))
880 CHECK_NUMBER (count, 3);
881 n *= XINT (count);
884 CHECK_STRING (string, 0);
885 if (NILP (bound))
887 if (n > 0)
888 lim = ZV, lim_byte = ZV_BYTE;
889 else
890 lim = BEGV, lim_byte = BEGV_BYTE;
892 else
894 CHECK_NUMBER_COERCE_MARKER (bound, 1);
895 lim = XINT (bound);
896 if (n > 0 ? lim < PT : lim > PT)
897 error ("Invalid search bound (wrong side of point)");
898 if (lim > ZV)
899 lim = ZV, lim_byte = ZV_BYTE;
900 else if (lim < BEGV)
901 lim = BEGV, lim_byte = BEGV_BYTE;
902 else
903 lim_byte = CHAR_TO_BYTE (lim);
906 np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE,
907 (!NILP (current_buffer->case_fold_search)
908 ? current_buffer->case_canon_table
909 : Qnil),
910 (!NILP (current_buffer->case_fold_search)
911 ? current_buffer->case_eqv_table
912 : Qnil),
913 posix);
914 if (np <= 0)
916 if (NILP (noerror))
917 return signal_failure (string);
918 if (!EQ (noerror, Qt))
920 if (lim < BEGV || lim > ZV)
921 abort ();
922 SET_PT_BOTH (lim, lim_byte);
923 return Qnil;
924 #if 0 /* This would be clean, but maybe programs depend on
925 a value of nil here. */
926 np = lim;
927 #endif
929 else
930 return Qnil;
933 if (np < BEGV || np > ZV)
934 abort ();
936 SET_PT (np);
938 return make_number (np);
941 /* Return 1 if REGEXP it matches just one constant string. */
943 static int
944 trivial_regexp_p (regexp)
945 Lisp_Object regexp;
947 int len = STRING_BYTES (XSTRING (regexp));
948 unsigned char *s = XSTRING (regexp)->data;
949 unsigned char c;
950 while (--len >= 0)
952 switch (*s++)
954 case '.': case '*': case '+': case '?': case '[': case '^': case '$':
955 return 0;
956 case '\\':
957 if (--len < 0)
958 return 0;
959 switch (*s++)
961 case '|': case '(': case ')': case '`': case '\'': case 'b':
962 case 'B': case '<': case '>': case 'w': case 'W': case 's':
963 case 'S': case '=':
964 case 'c': case 'C': /* for categoryspec and notcategoryspec */
965 case '1': case '2': case '3': case '4': case '5':
966 case '6': case '7': case '8': case '9':
967 return 0;
971 return 1;
974 /* Search for the n'th occurrence of STRING in the current buffer,
975 starting at position POS and stopping at position LIM,
976 treating STRING as a literal string if RE is false or as
977 a regular expression if RE is true.
979 If N is positive, searching is forward and LIM must be greater than POS.
980 If N is negative, searching is backward and LIM must be less than POS.
982 Returns -x if x occurrences remain to be found (x > 0),
983 or else the position at the beginning of the Nth occurrence
984 (if searching backward) or the end (if searching forward).
986 POSIX is nonzero if we want full backtracking (POSIX style)
987 for this pattern. 0 means backtrack only enough to get a valid match. */
989 #define TRANSLATE(out, trt, d) \
990 do \
992 if (! NILP (trt)) \
994 Lisp_Object temp; \
995 temp = Faref (trt, make_number (d)); \
996 if (INTEGERP (temp)) \
997 out = XINT (temp); \
998 else \
999 out = d; \
1001 else \
1002 out = d; \
1004 while (0)
1006 static int
1007 search_buffer (string, pos, pos_byte, lim, lim_byte, n,
1008 RE, trt, inverse_trt, posix)
1009 Lisp_Object string;
1010 int pos;
1011 int pos_byte;
1012 int lim;
1013 int lim_byte;
1014 int n;
1015 int RE;
1016 Lisp_Object trt;
1017 Lisp_Object inverse_trt;
1018 int posix;
1020 int len = XSTRING (string)->size;
1021 int len_byte = STRING_BYTES (XSTRING (string));
1022 register int i;
1024 if (running_asynch_code)
1025 save_search_regs ();
1027 /* Searching 0 times means don't move. */
1028 /* Null string is found at starting position. */
1029 if (len == 0 || n == 0)
1031 set_search_regs (pos, 0);
1032 return pos;
1035 if (RE && !trivial_regexp_p (string))
1037 unsigned char *p1, *p2;
1038 int s1, s2;
1039 struct re_pattern_buffer *bufp;
1041 bufp = compile_pattern (string, &search_regs, trt, posix,
1042 !NILP (current_buffer->enable_multibyte_characters));
1044 immediate_quit = 1; /* Quit immediately if user types ^G,
1045 because letting this function finish
1046 can take too long. */
1047 QUIT; /* Do a pending quit right away,
1048 to avoid paradoxical behavior */
1049 /* Get pointers and sizes of the two strings
1050 that make up the visible portion of the buffer. */
1052 p1 = BEGV_ADDR;
1053 s1 = GPT_BYTE - BEGV_BYTE;
1054 p2 = GAP_END_ADDR;
1055 s2 = ZV_BYTE - GPT_BYTE;
1056 if (s1 < 0)
1058 p2 = p1;
1059 s2 = ZV_BYTE - BEGV_BYTE;
1060 s1 = 0;
1062 if (s2 < 0)
1064 s1 = ZV_BYTE - BEGV_BYTE;
1065 s2 = 0;
1067 re_match_object = Qnil;
1069 while (n < 0)
1071 int val;
1072 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
1073 pos_byte - BEGV_BYTE, lim_byte - pos_byte,
1074 &search_regs,
1075 /* Don't allow match past current point */
1076 pos_byte - BEGV_BYTE);
1077 if (val == -2)
1079 matcher_overflow ();
1081 if (val >= 0)
1083 pos_byte = search_regs.start[0] + BEGV_BYTE;
1084 for (i = 0; i < search_regs.num_regs; i++)
1085 if (search_regs.start[i] >= 0)
1087 search_regs.start[i]
1088 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
1089 search_regs.end[i]
1090 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
1092 XSETBUFFER (last_thing_searched, current_buffer);
1093 /* Set pos to the new position. */
1094 pos = search_regs.start[0];
1096 else
1098 immediate_quit = 0;
1099 return (n);
1101 n++;
1103 while (n > 0)
1105 int val;
1106 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
1107 pos_byte - BEGV_BYTE, lim_byte - pos_byte,
1108 &search_regs,
1109 lim_byte - BEGV_BYTE);
1110 if (val == -2)
1112 matcher_overflow ();
1114 if (val >= 0)
1116 pos_byte = search_regs.end[0] + BEGV_BYTE;
1117 for (i = 0; i < search_regs.num_regs; i++)
1118 if (search_regs.start[i] >= 0)
1120 search_regs.start[i]
1121 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
1122 search_regs.end[i]
1123 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
1125 XSETBUFFER (last_thing_searched, current_buffer);
1126 pos = search_regs.end[0];
1128 else
1130 immediate_quit = 0;
1131 return (0 - n);
1133 n--;
1135 immediate_quit = 0;
1136 return (pos);
1138 else /* non-RE case */
1140 unsigned char *raw_pattern, *pat;
1141 int raw_pattern_size;
1142 int raw_pattern_size_byte;
1143 unsigned char *patbuf;
1144 int multibyte = !NILP (current_buffer->enable_multibyte_characters);
1145 unsigned char *base_pat = XSTRING (string)->data;
1146 int charset_base = -1;
1147 int boyer_moore_ok = 1;
1149 /* MULTIBYTE says whether the text to be searched is multibyte.
1150 We must convert PATTERN to match that, or we will not really
1151 find things right. */
1153 if (multibyte == STRING_MULTIBYTE (string))
1155 raw_pattern = (unsigned char *) XSTRING (string)->data;
1156 raw_pattern_size = XSTRING (string)->size;
1157 raw_pattern_size_byte = STRING_BYTES (XSTRING (string));
1159 else if (multibyte)
1161 raw_pattern_size = XSTRING (string)->size;
1162 raw_pattern_size_byte
1163 = count_size_as_multibyte (XSTRING (string)->data,
1164 raw_pattern_size);
1165 raw_pattern = (unsigned char *) alloca (raw_pattern_size_byte + 1);
1166 copy_text (XSTRING (string)->data, raw_pattern,
1167 XSTRING (string)->size, 0, 1);
1169 else
1171 /* Converting multibyte to single-byte.
1173 ??? Perhaps this conversion should be done in a special way
1174 by subtracting nonascii-insert-offset from each non-ASCII char,
1175 so that only the multibyte chars which really correspond to
1176 the chosen single-byte character set can possibly match. */
1177 raw_pattern_size = XSTRING (string)->size;
1178 raw_pattern_size_byte = XSTRING (string)->size;
1179 raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
1180 copy_text (XSTRING (string)->data, raw_pattern,
1181 STRING_BYTES (XSTRING (string)), 1, 0);
1184 /* Copy and optionally translate the pattern. */
1185 len = raw_pattern_size;
1186 len_byte = raw_pattern_size_byte;
1187 patbuf = (unsigned char *) alloca (len_byte);
1188 pat = patbuf;
1189 base_pat = raw_pattern;
1190 if (multibyte)
1192 while (--len >= 0)
1194 unsigned char workbuf[4], *str;
1195 int c, translated, inverse;
1196 int in_charlen, charlen;
1198 /* If we got here and the RE flag is set, it's because we're
1199 dealing with a regexp known to be trivial, so the backslash
1200 just quotes the next character. */
1201 if (RE && *base_pat == '\\')
1203 len--;
1204 len_byte--;
1205 base_pat++;
1208 c = STRING_CHAR_AND_LENGTH (base_pat, len_byte, in_charlen);
1210 /* Translate the character, if requested. */
1211 TRANSLATE (translated, trt, c);
1212 /* If translation changed the byte-length, go back
1213 to the original character. */
1214 charlen = CHAR_STRING (translated, workbuf, str);
1215 if (in_charlen != charlen)
1217 translated = c;
1218 charlen = CHAR_STRING (c, workbuf, str);
1221 /* If we are searching for something strange,
1222 an invalid multibyte code, don't use boyer-moore. */
1223 if (! ASCII_BYTE_P (translated)
1224 && (charlen == 1 /* 8bit code */
1225 || charlen != in_charlen /* invalid multibyte code */
1227 boyer_moore_ok = 0;
1229 TRANSLATE (inverse, inverse_trt, c);
1231 /* Did this char actually get translated?
1232 Would any other char get translated into it? */
1233 if (translated != c || inverse != c)
1235 /* Keep track of which character set row
1236 contains the characters that need translation. */
1237 int charset_base_code = c & ~CHAR_FIELD3_MASK;
1238 if (charset_base == -1)
1239 charset_base = charset_base_code;
1240 else if (charset_base != charset_base_code)
1241 /* If two different rows appear, needing translation,
1242 then we cannot use boyer_moore search. */
1243 boyer_moore_ok = 0;
1244 /* ??? Handa: this must do boyer_moore_ok = 0
1245 if c is a composite character. */
1248 /* Store this character into the translated pattern. */
1249 bcopy (str, pat, charlen);
1250 pat += charlen;
1251 base_pat += in_charlen;
1252 len_byte -= in_charlen;
1255 else
1257 /* Unibyte buffer. */
1258 charset_base = 0;
1259 while (--len >= 0)
1261 int c, translated;
1263 /* If we got here and the RE flag is set, it's because we're
1264 dealing with a regexp known to be trivial, so the backslash
1265 just quotes the next character. */
1266 if (RE && *base_pat == '\\')
1268 len--;
1269 base_pat++;
1271 c = *base_pat++;
1272 TRANSLATE (translated, trt, c);
1273 *pat++ = translated;
1277 len_byte = pat - patbuf;
1278 len = raw_pattern_size;
1279 pat = base_pat = patbuf;
1281 if (boyer_moore_ok)
1282 return boyer_moore (n, pat, len, len_byte, trt, inverse_trt,
1283 pos, pos_byte, lim, lim_byte,
1284 charset_base);
1285 else
1286 return simple_search (n, pat, len, len_byte, trt,
1287 pos, pos_byte, lim, lim_byte);
1291 /* Do a simple string search N times for the string PAT,
1292 whose length is LEN/LEN_BYTE,
1293 from buffer position POS/POS_BYTE until LIM/LIM_BYTE.
1294 TRT is the translation table.
1296 Return the character position where the match is found.
1297 Otherwise, if M matches remained to be found, return -M.
1299 This kind of search works regardless of what is in PAT and
1300 regardless of what is in TRT. It is used in cases where
1301 boyer_moore cannot work. */
1303 static int
1304 simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte)
1305 int n;
1306 unsigned char *pat;
1307 int len, len_byte;
1308 Lisp_Object trt;
1309 int pos, pos_byte;
1310 int lim, lim_byte;
1312 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
1313 int forward = n > 0;
1315 if (lim > pos && multibyte)
1316 while (n > 0)
1318 while (1)
1320 /* Try matching at position POS. */
1321 int this_pos = pos;
1322 int this_pos_byte = pos_byte;
1323 int this_len = len;
1324 int this_len_byte = len_byte;
1325 unsigned char *p = pat;
1326 if (pos + len > lim)
1327 goto stop;
1329 while (this_len > 0)
1331 int charlen, buf_charlen;
1332 int pat_ch, buf_ch;
1334 pat_ch = STRING_CHAR_AND_LENGTH (p, this_len_byte, charlen);
1335 buf_ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (this_pos_byte),
1336 ZV_BYTE - this_pos_byte,
1337 buf_charlen);
1338 TRANSLATE (buf_ch, trt, buf_ch);
1340 if (buf_ch != pat_ch)
1341 break;
1343 this_len_byte -= charlen;
1344 this_len--;
1345 p += charlen;
1347 this_pos_byte += buf_charlen;
1348 this_pos++;
1351 if (this_len == 0)
1353 pos += len;
1354 pos_byte += len_byte;
1355 break;
1358 INC_BOTH (pos, pos_byte);
1361 n--;
1363 else if (lim > pos)
1364 while (n > 0)
1366 while (1)
1368 /* Try matching at position POS. */
1369 int this_pos = pos;
1370 int this_len = len;
1371 unsigned char *p = pat;
1373 if (pos + len > lim)
1374 goto stop;
1376 while (this_len > 0)
1378 int pat_ch = *p++;
1379 int buf_ch = FETCH_BYTE (this_pos);
1380 TRANSLATE (buf_ch, trt, buf_ch);
1382 if (buf_ch != pat_ch)
1383 break;
1385 this_len--;
1386 this_pos++;
1389 if (this_len == 0)
1391 pos += len;
1392 break;
1395 pos++;
1398 n--;
1400 /* Backwards search. */
1401 else if (lim < pos && multibyte)
1402 while (n < 0)
1404 while (1)
1406 /* Try matching at position POS. */
1407 int this_pos = pos - len;
1408 int this_pos_byte = pos_byte - len_byte;
1409 int this_len = len;
1410 int this_len_byte = len_byte;
1411 unsigned char *p = pat;
1413 if (pos - len < lim)
1414 goto stop;
1416 while (this_len > 0)
1418 int charlen, buf_charlen;
1419 int pat_ch, buf_ch;
1421 pat_ch = STRING_CHAR_AND_LENGTH (p, this_len_byte, charlen);
1422 buf_ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (this_pos_byte),
1423 ZV_BYTE - this_pos_byte,
1424 buf_charlen);
1425 TRANSLATE (buf_ch, trt, buf_ch);
1427 if (buf_ch != pat_ch)
1428 break;
1430 this_len_byte -= charlen;
1431 this_len--;
1432 p += charlen;
1433 this_pos_byte += buf_charlen;
1434 this_pos++;
1437 if (this_len == 0)
1439 pos -= len;
1440 pos_byte -= len_byte;
1441 break;
1444 DEC_BOTH (pos, pos_byte);
1447 n++;
1449 else if (lim < pos)
1450 while (n < 0)
1452 while (1)
1454 /* Try matching at position POS. */
1455 int this_pos = pos - len;
1456 int this_len = len;
1457 unsigned char *p = pat;
1459 if (pos - len < lim)
1460 goto stop;
1462 while (this_len > 0)
1464 int pat_ch = *p++;
1465 int buf_ch = FETCH_BYTE (this_pos);
1466 TRANSLATE (buf_ch, trt, buf_ch);
1468 if (buf_ch != pat_ch)
1469 break;
1470 this_len--;
1471 this_pos++;
1474 if (this_len == 0)
1476 pos -= len;
1477 break;
1480 pos--;
1483 n++;
1486 stop:
1487 if (n == 0)
1489 if (forward)
1490 set_search_regs ((multibyte ? pos_byte : pos) - len_byte, len_byte);
1491 else
1492 set_search_regs (multibyte ? pos_byte : pos, len_byte);
1494 return pos;
1496 else if (n > 0)
1497 return -n;
1498 else
1499 return n;
1502 /* Do Boyer-Moore search N times for the string PAT,
1503 whose length is LEN/LEN_BYTE,
1504 from buffer position POS/POS_BYTE until LIM/LIM_BYTE.
1505 DIRECTION says which direction we search in.
1506 TRT and INVERSE_TRT are translation tables.
1508 This kind of search works if all the characters in PAT that have
1509 nontrivial translation are the same aside from the last byte. This
1510 makes it possible to translate just the last byte of a character,
1511 and do so after just a simple test of the context.
1513 If that criterion is not satisfied, do not call this function. */
1515 static int
1516 boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt,
1517 pos, pos_byte, lim, lim_byte, charset_base)
1518 int n;
1519 unsigned char *base_pat;
1520 int len, len_byte;
1521 Lisp_Object trt;
1522 Lisp_Object inverse_trt;
1523 int pos, pos_byte;
1524 int lim, lim_byte;
1525 int charset_base;
1527 int direction = ((n > 0) ? 1 : -1);
1528 register int dirlen;
1529 int infinity, limit, k, stride_for_teases;
1530 register int *BM_tab;
1531 int *BM_tab_base;
1532 register unsigned char *cursor, *p_limit;
1533 register int i, j;
1534 unsigned char *pat, *pat_end;
1535 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
1537 unsigned char simple_translate[0400];
1538 int translate_prev_byte;
1539 int translate_anteprev_byte;
1541 #ifdef C_ALLOCA
1542 int BM_tab_space[0400];
1543 BM_tab = &BM_tab_space[0];
1544 #else
1545 BM_tab = (int *) alloca (0400 * sizeof (int));
1546 #endif
1547 /* The general approach is that we are going to maintain that we know */
1548 /* the first (closest to the present position, in whatever direction */
1549 /* we're searching) character that could possibly be the last */
1550 /* (furthest from present position) character of a valid match. We */
1551 /* advance the state of our knowledge by looking at that character */
1552 /* and seeing whether it indeed matches the last character of the */
1553 /* pattern. If it does, we take a closer look. If it does not, we */
1554 /* move our pointer (to putative last characters) as far as is */
1555 /* logically possible. This amount of movement, which I call a */
1556 /* stride, will be the length of the pattern if the actual character */
1557 /* appears nowhere in the pattern, otherwise it will be the distance */
1558 /* from the last occurrence of that character to the end of the */
1559 /* pattern. */
1560 /* As a coding trick, an enormous stride is coded into the table for */
1561 /* characters that match the last character. This allows use of only */
1562 /* a single test, a test for having gone past the end of the */
1563 /* permissible match region, to test for both possible matches (when */
1564 /* the stride goes past the end immediately) and failure to */
1565 /* match (where you get nudged past the end one stride at a time). */
1567 /* Here we make a "mickey mouse" BM table. The stride of the search */
1568 /* is determined only by the last character of the putative match. */
1569 /* If that character does not match, we will stride the proper */
1570 /* distance to propose a match that superimposes it on the last */
1571 /* instance of a character that matches it (per trt), or misses */
1572 /* it entirely if there is none. */
1574 dirlen = len_byte * direction;
1575 infinity = dirlen - (lim_byte + pos_byte + len_byte + len_byte) * direction;
1577 /* Record position after the end of the pattern. */
1578 pat_end = base_pat + len_byte;
1579 /* BASE_PAT points to a character that we start scanning from.
1580 It is the first character in a forward search,
1581 the last character in a backward search. */
1582 if (direction < 0)
1583 base_pat = pat_end - 1;
1585 BM_tab_base = BM_tab;
1586 BM_tab += 0400;
1587 j = dirlen; /* to get it in a register */
1588 /* A character that does not appear in the pattern induces a */
1589 /* stride equal to the pattern length. */
1590 while (BM_tab_base != BM_tab)
1592 *--BM_tab = j;
1593 *--BM_tab = j;
1594 *--BM_tab = j;
1595 *--BM_tab = j;
1598 /* We use this for translation, instead of TRT itself.
1599 We fill this in to handle the characters that actually
1600 occur in the pattern. Others don't matter anyway! */
1601 bzero (simple_translate, sizeof simple_translate);
1602 for (i = 0; i < 0400; i++)
1603 simple_translate[i] = i;
1605 i = 0;
1606 while (i != infinity)
1608 unsigned char *ptr = base_pat + i;
1609 i += direction;
1610 if (i == dirlen)
1611 i = infinity;
1612 if (! NILP (trt))
1614 int ch;
1615 int untranslated;
1616 int this_translated = 1;
1618 if (multibyte
1619 /* Is *PTR the last byte of a character? */
1620 && (pat_end - ptr == 1 || CHAR_HEAD_P (ptr[1])))
1622 unsigned char *charstart = ptr;
1623 while (! CHAR_HEAD_P (*charstart))
1624 charstart--;
1625 untranslated = STRING_CHAR (charstart, ptr - charstart + 1);
1626 if (charset_base == (untranslated & ~CHAR_FIELD3_MASK))
1628 TRANSLATE (ch, trt, untranslated);
1629 if (! CHAR_HEAD_P (*ptr))
1631 translate_prev_byte = ptr[-1];
1632 if (! CHAR_HEAD_P (translate_prev_byte))
1633 translate_anteprev_byte = ptr[-2];
1636 else
1638 this_translated = 0;
1639 ch = *ptr;
1642 else if (!multibyte)
1643 TRANSLATE (ch, trt, *ptr);
1644 else
1646 ch = *ptr;
1647 this_translated = 0;
1650 if (ch > 0400)
1651 j = ((unsigned char) ch) | 0200;
1652 else
1653 j = (unsigned char) ch;
1655 if (i == infinity)
1656 stride_for_teases = BM_tab[j];
1658 BM_tab[j] = dirlen - i;
1659 /* A translation table is accompanied by its inverse -- see */
1660 /* comment following downcase_table for details */
1661 if (this_translated)
1663 int starting_ch = ch;
1664 int starting_j = j;
1665 while (1)
1667 TRANSLATE (ch, inverse_trt, ch);
1668 if (ch > 0400)
1669 j = ((unsigned char) ch) | 0200;
1670 else
1671 j = (unsigned char) ch;
1673 /* For all the characters that map into CH,
1674 set up simple_translate to map the last byte
1675 into STARTING_J. */
1676 simple_translate[j] = starting_j;
1677 if (ch == starting_ch)
1678 break;
1679 BM_tab[j] = dirlen - i;
1683 else
1685 j = *ptr;
1687 if (i == infinity)
1688 stride_for_teases = BM_tab[j];
1689 BM_tab[j] = dirlen - i;
1691 /* stride_for_teases tells how much to stride if we get a */
1692 /* match on the far character but are subsequently */
1693 /* disappointed, by recording what the stride would have been */
1694 /* for that character if the last character had been */
1695 /* different. */
1697 infinity = dirlen - infinity;
1698 pos_byte += dirlen - ((direction > 0) ? direction : 0);
1699 /* loop invariant - POS_BYTE points at where last char (first
1700 char if reverse) of pattern would align in a possible match. */
1701 while (n != 0)
1703 int tail_end;
1704 unsigned char *tail_end_ptr;
1706 /* It's been reported that some (broken) compiler thinks that
1707 Boolean expressions in an arithmetic context are unsigned.
1708 Using an explicit ?1:0 prevents this. */
1709 if ((lim_byte - pos_byte - ((direction > 0) ? 1 : 0)) * direction
1710 < 0)
1711 return (n * (0 - direction));
1712 /* First we do the part we can by pointers (maybe nothing) */
1713 QUIT;
1714 pat = base_pat;
1715 limit = pos_byte - dirlen + direction;
1716 if (direction > 0)
1718 limit = BUFFER_CEILING_OF (limit);
1719 /* LIMIT is now the last (not beyond-last!) value POS_BYTE
1720 can take on without hitting edge of buffer or the gap. */
1721 limit = min (limit, pos_byte + 20000);
1722 limit = min (limit, lim_byte - 1);
1724 else
1726 limit = BUFFER_FLOOR_OF (limit);
1727 /* LIMIT is now the last (not beyond-last!) value POS_BYTE
1728 can take on without hitting edge of buffer or the gap. */
1729 limit = max (limit, pos_byte - 20000);
1730 limit = max (limit, lim_byte);
1732 tail_end = BUFFER_CEILING_OF (pos_byte) + 1;
1733 tail_end_ptr = BYTE_POS_ADDR (tail_end);
1735 if ((limit - pos_byte) * direction > 20)
1737 unsigned char *p2;
1739 p_limit = BYTE_POS_ADDR (limit);
1740 p2 = (cursor = BYTE_POS_ADDR (pos_byte));
1741 /* In this loop, pos + cursor - p2 is the surrogate for pos */
1742 while (1) /* use one cursor setting as long as i can */
1744 if (direction > 0) /* worth duplicating */
1746 /* Use signed comparison if appropriate
1747 to make cursor+infinity sure to be > p_limit.
1748 Assuming that the buffer lies in a range of addresses
1749 that are all "positive" (as ints) or all "negative",
1750 either kind of comparison will work as long
1751 as we don't step by infinity. So pick the kind
1752 that works when we do step by infinity. */
1753 if ((EMACS_INT) (p_limit + infinity) > (EMACS_INT) p_limit)
1754 while ((EMACS_INT) cursor <= (EMACS_INT) p_limit)
1755 cursor += BM_tab[*cursor];
1756 else
1757 while ((EMACS_UINT) cursor <= (EMACS_UINT) p_limit)
1758 cursor += BM_tab[*cursor];
1760 else
1762 if ((EMACS_INT) (p_limit + infinity) < (EMACS_INT) p_limit)
1763 while ((EMACS_INT) cursor >= (EMACS_INT) p_limit)
1764 cursor += BM_tab[*cursor];
1765 else
1766 while ((EMACS_UINT) cursor >= (EMACS_UINT) p_limit)
1767 cursor += BM_tab[*cursor];
1769 /* If you are here, cursor is beyond the end of the searched region. */
1770 /* This can happen if you match on the far character of the pattern, */
1771 /* because the "stride" of that character is infinity, a number able */
1772 /* to throw you well beyond the end of the search. It can also */
1773 /* happen if you fail to match within the permitted region and would */
1774 /* otherwise try a character beyond that region */
1775 if ((cursor - p_limit) * direction <= len_byte)
1776 break; /* a small overrun is genuine */
1777 cursor -= infinity; /* large overrun = hit */
1778 i = dirlen - direction;
1779 if (! NILP (trt))
1781 while ((i -= direction) + direction != 0)
1783 int ch;
1784 cursor -= direction;
1785 /* Translate only the last byte of a character. */
1786 if (! multibyte
1787 || ((cursor == tail_end_ptr
1788 || CHAR_HEAD_P (cursor[1]))
1789 && (CHAR_HEAD_P (cursor[0])
1790 || (translate_prev_byte == cursor[-1]
1791 && (CHAR_HEAD_P (translate_prev_byte)
1792 || translate_anteprev_byte == cursor[-2])))))
1793 ch = simple_translate[*cursor];
1794 else
1795 ch = *cursor;
1796 if (pat[i] != ch)
1797 break;
1800 else
1802 while ((i -= direction) + direction != 0)
1804 cursor -= direction;
1805 if (pat[i] != *cursor)
1806 break;
1809 cursor += dirlen - i - direction; /* fix cursor */
1810 if (i + direction == 0)
1812 int position;
1814 cursor -= direction;
1816 position = pos_byte + cursor - p2 + ((direction > 0)
1817 ? 1 - len_byte : 0);
1818 set_search_regs (position, len_byte);
1820 if ((n -= direction) != 0)
1821 cursor += dirlen; /* to resume search */
1822 else
1823 return ((direction > 0)
1824 ? search_regs.end[0] : search_regs.start[0]);
1826 else
1827 cursor += stride_for_teases; /* <sigh> we lose - */
1829 pos_byte += cursor - p2;
1831 else
1832 /* Now we'll pick up a clump that has to be done the hard */
1833 /* way because it covers a discontinuity */
1835 limit = ((direction > 0)
1836 ? BUFFER_CEILING_OF (pos_byte - dirlen + 1)
1837 : BUFFER_FLOOR_OF (pos_byte - dirlen - 1));
1838 limit = ((direction > 0)
1839 ? min (limit + len_byte, lim_byte - 1)
1840 : max (limit - len_byte, lim_byte));
1841 /* LIMIT is now the last value POS_BYTE can have
1842 and still be valid for a possible match. */
1843 while (1)
1845 /* This loop can be coded for space rather than */
1846 /* speed because it will usually run only once. */
1847 /* (the reach is at most len + 21, and typically */
1848 /* does not exceed len) */
1849 while ((limit - pos_byte) * direction >= 0)
1850 pos_byte += BM_tab[FETCH_BYTE (pos_byte)];
1851 /* now run the same tests to distinguish going off the */
1852 /* end, a match or a phony match. */
1853 if ((pos_byte - limit) * direction <= len_byte)
1854 break; /* ran off the end */
1855 /* Found what might be a match.
1856 Set POS_BYTE back to last (first if reverse) pos. */
1857 pos_byte -= infinity;
1858 i = dirlen - direction;
1859 while ((i -= direction) + direction != 0)
1861 int ch;
1862 unsigned char *ptr;
1863 pos_byte -= direction;
1864 ptr = BYTE_POS_ADDR (pos_byte);
1865 /* Translate only the last byte of a character. */
1866 if (! multibyte
1867 || ((ptr == tail_end_ptr
1868 || CHAR_HEAD_P (ptr[1]))
1869 && (CHAR_HEAD_P (ptr[0])
1870 || (translate_prev_byte == ptr[-1]
1871 && (CHAR_HEAD_P (translate_prev_byte)
1872 || translate_anteprev_byte == ptr[-2])))))
1873 ch = simple_translate[*ptr];
1874 else
1875 ch = *ptr;
1876 if (pat[i] != ch)
1877 break;
1879 /* Above loop has moved POS_BYTE part or all the way
1880 back to the first pos (last pos if reverse).
1881 Set it once again at the last (first if reverse) char. */
1882 pos_byte += dirlen - i- direction;
1883 if (i + direction == 0)
1885 int position;
1886 pos_byte -= direction;
1888 position = pos_byte + ((direction > 0) ? 1 - len_byte : 0);
1890 set_search_regs (position, len_byte);
1892 if ((n -= direction) != 0)
1893 pos_byte += dirlen; /* to resume search */
1894 else
1895 return ((direction > 0)
1896 ? search_regs.end[0] : search_regs.start[0]);
1898 else
1899 pos_byte += stride_for_teases;
1902 /* We have done one clump. Can we continue? */
1903 if ((lim_byte - pos_byte) * direction < 0)
1904 return ((0 - n) * direction);
1906 return BYTE_TO_CHAR (pos_byte);
1909 /* Record beginning BEG_BYTE and end BEG_BYTE + NBYTES
1910 for the overall match just found in the current buffer.
1911 Also clear out the match data for registers 1 and up. */
1913 static void
1914 set_search_regs (beg_byte, nbytes)
1915 int beg_byte, nbytes;
1917 int i;
1919 /* Make sure we have registers in which to store
1920 the match position. */
1921 if (search_regs.num_regs == 0)
1923 search_regs.start = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
1924 search_regs.end = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
1925 search_regs.num_regs = 2;
1928 /* Clear out the other registers. */
1929 for (i = 1; i < search_regs.num_regs; i++)
1931 search_regs.start[i] = -1;
1932 search_regs.end[i] = -1;
1935 search_regs.start[0] = BYTE_TO_CHAR (beg_byte);
1936 search_regs.end[0] = BYTE_TO_CHAR (beg_byte + nbytes);
1937 XSETBUFFER (last_thing_searched, current_buffer);
1940 /* Given a string of words separated by word delimiters,
1941 compute a regexp that matches those exact words
1942 separated by arbitrary punctuation. */
1944 static Lisp_Object
1945 wordify (string)
1946 Lisp_Object string;
1948 register unsigned char *p, *o;
1949 register int i, i_byte, len, punct_count = 0, word_count = 0;
1950 Lisp_Object val;
1951 int prev_c = 0;
1952 int adjust;
1954 CHECK_STRING (string, 0);
1955 p = XSTRING (string)->data;
1956 len = XSTRING (string)->size;
1958 for (i = 0, i_byte = 0; i < len; )
1960 int c;
1962 if (STRING_MULTIBYTE (string))
1963 FETCH_STRING_CHAR_ADVANCE (c, string, i, i_byte);
1964 else
1965 c = XSTRING (string)->data[i++];
1967 if (SYNTAX (c) != Sword)
1969 punct_count++;
1970 if (i > 0 && SYNTAX (prev_c) == Sword)
1971 word_count++;
1974 prev_c = c;
1977 if (SYNTAX (prev_c) == Sword)
1978 word_count++;
1979 if (!word_count)
1980 return build_string ("");
1982 adjust = - punct_count + 5 * (word_count - 1) + 4;
1983 if (STRING_MULTIBYTE (string))
1984 val = make_uninit_multibyte_string (len + adjust,
1985 STRING_BYTES (XSTRING (string))
1986 + adjust);
1987 else
1988 val = make_uninit_string (len + adjust);
1990 o = XSTRING (val)->data;
1991 *o++ = '\\';
1992 *o++ = 'b';
1993 prev_c = 0;
1995 for (i = 0, i_byte = 0; i < len; )
1997 int c;
1998 int i_byte_orig = i_byte;
2000 if (STRING_MULTIBYTE (string))
2001 FETCH_STRING_CHAR_ADVANCE (c, string, i, i_byte);
2002 else
2004 c = XSTRING (string)->data[i++];
2005 i_byte++;
2008 if (SYNTAX (c) == Sword)
2010 bcopy (&XSTRING (string)->data[i_byte_orig], o,
2011 i_byte - i_byte_orig);
2012 o += i_byte - i_byte_orig;
2014 else if (i > 0 && SYNTAX (prev_c) == Sword && --word_count)
2016 *o++ = '\\';
2017 *o++ = 'W';
2018 *o++ = '\\';
2019 *o++ = 'W';
2020 *o++ = '*';
2023 prev_c = c;
2026 *o++ = '\\';
2027 *o++ = 'b';
2029 return val;
2032 DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
2033 "MSearch backward: ",
2034 "Search backward from point for STRING.\n\
2035 Set point to the beginning of the occurrence found, and return point.\n\
2036 An optional second argument bounds the search; it is a buffer position.\n\
2037 The match found must not extend before that position.\n\
2038 Optional third argument, if t, means if fail just return nil (no error).\n\
2039 If not nil and not t, position at limit of search and return nil.\n\
2040 Optional fourth argument is repeat count--search for successive occurrences.\n\
2041 See also the functions `match-beginning', `match-end' and `replace-match'.")
2042 (string, bound, noerror, count)
2043 Lisp_Object string, bound, noerror, count;
2045 return search_command (string, bound, noerror, count, -1, 0, 0);
2048 DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "MSearch: ",
2049 "Search forward from point for STRING.\n\
2050 Set point to the end of the occurrence found, and return point.\n\
2051 An optional second argument bounds the search; it is a buffer position.\n\
2052 The match found must not extend after that position. nil is equivalent\n\
2053 to (point-max).\n\
2054 Optional third argument, if t, means if fail just return nil (no error).\n\
2055 If not nil and not t, move to limit of search and return nil.\n\
2056 Optional fourth argument is repeat count--search for successive occurrences.\n\
2057 See also the functions `match-beginning', `match-end' and `replace-match'.")
2058 (string, bound, noerror, count)
2059 Lisp_Object string, bound, noerror, count;
2061 return search_command (string, bound, noerror, count, 1, 0, 0);
2064 DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
2065 "sWord search backward: ",
2066 "Search backward from point for STRING, ignoring differences in punctuation.\n\
2067 Set point to the beginning of the occurrence found, and return point.\n\
2068 An optional second argument bounds the search; it is a buffer position.\n\
2069 The match found must not extend before that position.\n\
2070 Optional third argument, if t, means if fail just return nil (no error).\n\
2071 If not nil and not t, move to limit of search and return nil.\n\
2072 Optional fourth argument is repeat count--search for successive occurrences.")
2073 (string, bound, noerror, count)
2074 Lisp_Object string, bound, noerror, count;
2076 return search_command (wordify (string), bound, noerror, count, -1, 1, 0);
2079 DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
2080 "sWord search: ",
2081 "Search forward from point for STRING, ignoring differences in punctuation.\n\
2082 Set point to the end of the occurrence found, and return point.\n\
2083 An optional second argument bounds the search; it is a buffer position.\n\
2084 The match found must not extend after that position.\n\
2085 Optional third argument, if t, means if fail just return nil (no error).\n\
2086 If not nil and not t, move to limit of search and return nil.\n\
2087 Optional fourth argument is repeat count--search for successive occurrences.")
2088 (string, bound, noerror, count)
2089 Lisp_Object string, bound, noerror, count;
2091 return search_command (wordify (string), bound, noerror, count, 1, 1, 0);
2094 DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
2095 "sRE search backward: ",
2096 "Search backward from point for match for regular expression REGEXP.\n\
2097 Set point to the beginning of the match, and return point.\n\
2098 The match found is the one starting last in the buffer\n\
2099 and yet ending before the origin of the search.\n\
2100 An optional second argument bounds the search; it is a buffer position.\n\
2101 The match found must start at or after that position.\n\
2102 Optional third argument, if t, means if fail just return nil (no error).\n\
2103 If not nil and not t, move to limit of search and return nil.\n\
2104 Optional fourth argument is repeat count--search for successive occurrences.\n\
2105 See also the functions `match-beginning', `match-end' and `replace-match'.")
2106 (regexp, bound, noerror, count)
2107 Lisp_Object regexp, bound, noerror, count;
2109 return search_command (regexp, bound, noerror, count, -1, 1, 0);
2112 DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4,
2113 "sRE search: ",
2114 "Search forward from point for regular expression REGEXP.\n\
2115 Set point to the end of the occurrence found, and return point.\n\
2116 An optional second argument bounds the search; it is a buffer position.\n\
2117 The match found must not extend after that position.\n\
2118 Optional third argument, if t, means if fail just return nil (no error).\n\
2119 If not nil and not t, move to limit of search and return nil.\n\
2120 Optional fourth argument is repeat count--search for successive occurrences.\n\
2121 See also the functions `match-beginning', `match-end' and `replace-match'.")
2122 (regexp, bound, noerror, count)
2123 Lisp_Object regexp, bound, noerror, count;
2125 return search_command (regexp, bound, noerror, count, 1, 1, 0);
2128 DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, 1, 4,
2129 "sPosix search backward: ",
2130 "Search backward from point for match for regular expression REGEXP.\n\
2131 Find the longest match in accord with Posix regular expression rules.\n\
2132 Set point to the beginning of the match, and return point.\n\
2133 The match found is the one starting last in the buffer\n\
2134 and yet ending before the origin of the search.\n\
2135 An optional second argument bounds the search; it is a buffer position.\n\
2136 The match found must start at or after that position.\n\
2137 Optional third argument, if t, means if fail just return nil (no error).\n\
2138 If not nil and not t, move to limit of search and return nil.\n\
2139 Optional fourth argument is repeat count--search for successive occurrences.\n\
2140 See also the functions `match-beginning', `match-end' and `replace-match'.")
2141 (regexp, bound, noerror, count)
2142 Lisp_Object regexp, bound, noerror, count;
2144 return search_command (regexp, bound, noerror, count, -1, 1, 1);
2147 DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, 1, 4,
2148 "sPosix search: ",
2149 "Search forward from point for regular expression REGEXP.\n\
2150 Find the longest match in accord with Posix regular expression rules.\n\
2151 Set point to the end of the occurrence found, and return point.\n\
2152 An optional second argument bounds the search; it is a buffer position.\n\
2153 The match found must not extend after that position.\n\
2154 Optional third argument, if t, means if fail just return nil (no error).\n\
2155 If not nil and not t, move to limit of search and return nil.\n\
2156 Optional fourth argument is repeat count--search for successive occurrences.\n\
2157 See also the functions `match-beginning', `match-end' and `replace-match'.")
2158 (regexp, bound, noerror, count)
2159 Lisp_Object regexp, bound, noerror, count;
2161 return search_command (regexp, bound, noerror, count, 1, 1, 1);
2164 DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0,
2165 "Replace text matched by last search with NEWTEXT.\n\
2166 If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\
2167 Otherwise maybe capitalize the whole text, or maybe just word initials,\n\
2168 based on the replaced text.\n\
2169 If the replaced text has only capital letters\n\
2170 and has at least one multiletter word, convert NEWTEXT to all caps.\n\
2171 If the replaced text has at least one word starting with a capital letter,\n\
2172 then capitalize each word in NEWTEXT.\n\n\
2173 If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\
2174 Otherwise treat `\\' as special:\n\
2175 `\\&' in NEWTEXT means substitute original matched text.\n\
2176 `\\N' means substitute what matched the Nth `\\(...\\)'.\n\
2177 If Nth parens didn't match, substitute nothing.\n\
2178 `\\\\' means insert one `\\'.\n\
2179 FIXEDCASE and LITERAL are optional arguments.\n\
2180 Leaves point at end of replacement text.\n\
2182 The optional fourth argument STRING can be a string to modify.\n\
2183 In that case, this function creates and returns a new string\n\
2184 which is made by replacing the part of STRING that was matched.\n\
2186 The optional fifth argument SUBEXP specifies a subexpression of the match.\n\
2187 It says to replace just that subexpression instead of the whole match.\n\
2188 This is useful only after a regular expression search or match\n\
2189 since only regular expressions have distinguished subexpressions.")
2190 (newtext, fixedcase, literal, string, subexp)
2191 Lisp_Object newtext, fixedcase, literal, string, subexp;
2193 enum { nochange, all_caps, cap_initial } case_action;
2194 register int pos, pos_byte;
2195 int some_multiletter_word;
2196 int some_lowercase;
2197 int some_uppercase;
2198 int some_nonuppercase_initial;
2199 register int c, prevc;
2200 int inslen;
2201 int sub;
2202 int opoint, newpoint;
2204 CHECK_STRING (newtext, 0);
2206 if (! NILP (string))
2207 CHECK_STRING (string, 4);
2209 case_action = nochange; /* We tried an initialization */
2210 /* but some C compilers blew it */
2212 if (search_regs.num_regs <= 0)
2213 error ("replace-match called before any match found");
2215 if (NILP (subexp))
2216 sub = 0;
2217 else
2219 CHECK_NUMBER (subexp, 3);
2220 sub = XINT (subexp);
2221 if (sub < 0 || sub >= search_regs.num_regs)
2222 args_out_of_range (subexp, make_number (search_regs.num_regs));
2225 if (NILP (string))
2227 if (search_regs.start[sub] < BEGV
2228 || search_regs.start[sub] > search_regs.end[sub]
2229 || search_regs.end[sub] > ZV)
2230 args_out_of_range (make_number (search_regs.start[sub]),
2231 make_number (search_regs.end[sub]));
2233 else
2235 if (search_regs.start[sub] < 0
2236 || search_regs.start[sub] > search_regs.end[sub]
2237 || search_regs.end[sub] > XSTRING (string)->size)
2238 args_out_of_range (make_number (search_regs.start[sub]),
2239 make_number (search_regs.end[sub]));
2242 if (NILP (fixedcase))
2244 /* Decide how to casify by examining the matched text. */
2245 int last;
2247 pos = search_regs.start[sub];
2248 last = search_regs.end[sub];
2250 if (NILP (string))
2251 pos_byte = CHAR_TO_BYTE (pos);
2252 else
2253 pos_byte = string_char_to_byte (string, pos);
2255 prevc = '\n';
2256 case_action = all_caps;
2258 /* some_multiletter_word is set nonzero if any original word
2259 is more than one letter long. */
2260 some_multiletter_word = 0;
2261 some_lowercase = 0;
2262 some_nonuppercase_initial = 0;
2263 some_uppercase = 0;
2265 while (pos < last)
2267 if (NILP (string))
2269 c = FETCH_CHAR (pos_byte);
2270 INC_BOTH (pos, pos_byte);
2272 else
2273 FETCH_STRING_CHAR_ADVANCE (c, string, pos, pos_byte);
2275 if (LOWERCASEP (c))
2277 /* Cannot be all caps if any original char is lower case */
2279 some_lowercase = 1;
2280 if (SYNTAX (prevc) != Sword)
2281 some_nonuppercase_initial = 1;
2282 else
2283 some_multiletter_word = 1;
2285 else if (!NOCASEP (c))
2287 some_uppercase = 1;
2288 if (SYNTAX (prevc) != Sword)
2290 else
2291 some_multiletter_word = 1;
2293 else
2295 /* If the initial is a caseless word constituent,
2296 treat that like a lowercase initial. */
2297 if (SYNTAX (prevc) != Sword)
2298 some_nonuppercase_initial = 1;
2301 prevc = c;
2304 /* Convert to all caps if the old text is all caps
2305 and has at least one multiletter word. */
2306 if (! some_lowercase && some_multiletter_word)
2307 case_action = all_caps;
2308 /* Capitalize each word, if the old text has all capitalized words. */
2309 else if (!some_nonuppercase_initial && some_multiletter_word)
2310 case_action = cap_initial;
2311 else if (!some_nonuppercase_initial && some_uppercase)
2312 /* Should x -> yz, operating on X, give Yz or YZ?
2313 We'll assume the latter. */
2314 case_action = all_caps;
2315 else
2316 case_action = nochange;
2319 /* Do replacement in a string. */
2320 if (!NILP (string))
2322 Lisp_Object before, after;
2324 before = Fsubstring (string, make_number (0),
2325 make_number (search_regs.start[sub]));
2326 after = Fsubstring (string, make_number (search_regs.end[sub]), Qnil);
2328 /* Substitute parts of the match into NEWTEXT
2329 if desired. */
2330 if (NILP (literal))
2332 int lastpos = 0;
2333 int lastpos_byte = 0;
2334 /* We build up the substituted string in ACCUM. */
2335 Lisp_Object accum;
2336 Lisp_Object middle;
2337 int length = STRING_BYTES (XSTRING (newtext));
2339 accum = Qnil;
2341 for (pos_byte = 0, pos = 0; pos_byte < length;)
2343 int substart = -1;
2344 int subend;
2345 int delbackslash = 0;
2347 FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
2349 if (c == '\\')
2351 FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
2352 if (c == '&')
2354 substart = search_regs.start[sub];
2355 subend = search_regs.end[sub];
2357 else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0')
2359 if (search_regs.start[c - '0'] >= 0)
2361 substart = search_regs.start[c - '0'];
2362 subend = search_regs.end[c - '0'];
2365 else if (c == '\\')
2366 delbackslash = 1;
2367 else
2368 error ("Invalid use of `\\' in replacement text");
2370 if (substart >= 0)
2372 if (pos - 2 != lastpos)
2373 middle = substring_both (newtext, lastpos,
2374 lastpos_byte,
2375 pos - 2, pos_byte - 2);
2376 else
2377 middle = Qnil;
2378 accum = concat3 (accum, middle,
2379 Fsubstring (string,
2380 make_number (substart),
2381 make_number (subend)));
2382 lastpos = pos;
2383 lastpos_byte = pos_byte;
2385 else if (delbackslash)
2387 middle = substring_both (newtext, lastpos,
2388 lastpos_byte,
2389 pos - 1, pos_byte - 1);
2391 accum = concat2 (accum, middle);
2392 lastpos = pos;
2393 lastpos_byte = pos_byte;
2397 if (pos != lastpos)
2398 middle = substring_both (newtext, lastpos,
2399 lastpos_byte,
2400 pos, pos_byte);
2401 else
2402 middle = Qnil;
2404 newtext = concat2 (accum, middle);
2407 /* Do case substitution in NEWTEXT if desired. */
2408 if (case_action == all_caps)
2409 newtext = Fupcase (newtext);
2410 else if (case_action == cap_initial)
2411 newtext = Fupcase_initials (newtext);
2413 return concat3 (before, newtext, after);
2416 /* Record point, the move (quietly) to the start of the match. */
2417 if (PT >= search_regs.end[sub])
2418 opoint = PT - ZV;
2419 else if (PT > search_regs.start[sub])
2420 opoint = search_regs.end[sub] - ZV;
2421 else
2422 opoint = PT;
2424 TEMP_SET_PT (search_regs.start[sub]);
2426 /* We insert the replacement text before the old text, and then
2427 delete the original text. This means that markers at the
2428 beginning or end of the original will float to the corresponding
2429 position in the replacement. */
2430 if (!NILP (literal))
2431 Finsert_and_inherit (1, &newtext);
2432 else
2434 struct gcpro gcpro1;
2435 int length = STRING_BYTES (XSTRING (newtext));
2437 GCPRO1 (newtext);
2439 for (pos_byte = 0, pos = 0; pos_byte < length;)
2441 int offset = PT - search_regs.start[sub];
2443 FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
2445 if (c == '\\')
2447 FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
2448 if (c == '&')
2449 Finsert_buffer_substring
2450 (Fcurrent_buffer (),
2451 make_number (search_regs.start[sub] + offset),
2452 make_number (search_regs.end[sub] + offset));
2453 else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0')
2455 if (search_regs.start[c - '0'] >= 1)
2456 Finsert_buffer_substring
2457 (Fcurrent_buffer (),
2458 make_number (search_regs.start[c - '0'] + offset),
2459 make_number (search_regs.end[c - '0'] + offset));
2461 else if (c == '\\')
2462 insert_char (c);
2463 else
2464 error ("Invalid use of `\\' in replacement text");
2466 else
2467 insert_char (c);
2469 UNGCPRO;
2472 inslen = PT - (search_regs.start[sub]);
2473 del_range (search_regs.start[sub] + inslen, search_regs.end[sub] + inslen);
2475 if (case_action == all_caps)
2476 Fupcase_region (make_number (PT - inslen), make_number (PT));
2477 else if (case_action == cap_initial)
2478 Fupcase_initials_region (make_number (PT - inslen), make_number (PT));
2480 newpoint = PT;
2482 /* Put point back where it was in the text. */
2483 if (opoint <= 0)
2484 TEMP_SET_PT (opoint + ZV);
2485 else
2486 TEMP_SET_PT (opoint);
2488 /* Now move point "officially" to the start of the inserted replacement. */
2489 move_if_not_intangible (newpoint);
2491 return Qnil;
2494 static Lisp_Object
2495 match_limit (num, beginningp)
2496 Lisp_Object num;
2497 int beginningp;
2499 register int n;
2501 CHECK_NUMBER (num, 0);
2502 n = XINT (num);
2503 if (n < 0 || n >= search_regs.num_regs)
2504 args_out_of_range (num, make_number (search_regs.num_regs));
2505 if (search_regs.num_regs <= 0
2506 || search_regs.start[n] < 0)
2507 return Qnil;
2508 return (make_number ((beginningp) ? search_regs.start[n]
2509 : search_regs.end[n]));
2512 DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
2513 "Return position of start of text matched by last search.\n\
2514 SUBEXP, a number, specifies which parenthesized expression in the last\n\
2515 regexp.\n\
2516 Value is nil if SUBEXPth pair didn't match, or there were less than\n\
2517 SUBEXP pairs.\n\
2518 Zero means the entire text matched by the whole regexp or whole string.")
2519 (subexp)
2520 Lisp_Object subexp;
2522 return match_limit (subexp, 1);
2525 DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0,
2526 "Return position of end of text matched by last search.\n\
2527 SUBEXP, a number, specifies which parenthesized expression in the last\n\
2528 regexp.\n\
2529 Value is nil if SUBEXPth pair didn't match, or there were less than\n\
2530 SUBEXP pairs.\n\
2531 Zero means the entire text matched by the whole regexp or whole string.")
2532 (subexp)
2533 Lisp_Object subexp;
2535 return match_limit (subexp, 0);
2538 DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 2, 0,
2539 "Return a list containing all info on what the last search matched.\n\
2540 Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.\n\
2541 All the elements are markers or nil (nil if the Nth pair didn't match)\n\
2542 if the last match was on a buffer; integers or nil if a string was matched.\n\
2543 Use `store-match-data' to reinstate the data in this list.\n\
2545 If INTEGERS (the optional first argument) is non-nil, always use integers\n\
2546 \(rather than markers) to represent buffer positions.\n\
2547 If REUSE is a list, reuse it as part of the value. If REUSE is long enough\n\
2548 to hold all the values, and if INTEGERS is non-nil, no consing is done.")
2549 (integers, reuse)
2550 Lisp_Object integers, reuse;
2552 Lisp_Object tail, prev;
2553 Lisp_Object *data;
2554 int i, len;
2556 if (NILP (last_thing_searched))
2557 return Qnil;
2559 data = (Lisp_Object *) alloca ((2 * search_regs.num_regs)
2560 * sizeof (Lisp_Object));
2562 len = -1;
2563 for (i = 0; i < search_regs.num_regs; i++)
2565 int start = search_regs.start[i];
2566 if (start >= 0)
2568 if (EQ (last_thing_searched, Qt)
2569 || ! NILP (integers))
2571 XSETFASTINT (data[2 * i], start);
2572 XSETFASTINT (data[2 * i + 1], search_regs.end[i]);
2574 else if (BUFFERP (last_thing_searched))
2576 data[2 * i] = Fmake_marker ();
2577 Fset_marker (data[2 * i],
2578 make_number (start),
2579 last_thing_searched);
2580 data[2 * i + 1] = Fmake_marker ();
2581 Fset_marker (data[2 * i + 1],
2582 make_number (search_regs.end[i]),
2583 last_thing_searched);
2585 else
2586 /* last_thing_searched must always be Qt, a buffer, or Qnil. */
2587 abort ();
2589 len = i;
2591 else
2592 data[2 * i] = data [2 * i + 1] = Qnil;
2595 /* If REUSE is not usable, cons up the values and return them. */
2596 if (! CONSP (reuse))
2597 return Flist (2 * len + 2, data);
2599 /* If REUSE is a list, store as many value elements as will fit
2600 into the elements of REUSE. */
2601 for (i = 0, tail = reuse; CONSP (tail);
2602 i++, tail = XCDR (tail))
2604 if (i < 2 * len + 2)
2605 XCAR (tail) = data[i];
2606 else
2607 XCAR (tail) = Qnil;
2608 prev = tail;
2611 /* If we couldn't fit all value elements into REUSE,
2612 cons up the rest of them and add them to the end of REUSE. */
2613 if (i < 2 * len + 2)
2614 XCDR (prev) = Flist (2 * len + 2 - i, data + i);
2616 return reuse;
2620 DEFUN ("set-match-data", Fset_match_data, Sset_match_data, 1, 1, 0,
2621 "Set internal data on last search match from elements of LIST.\n\
2622 LIST should have been created by calling `match-data' previously.")
2623 (list)
2624 register Lisp_Object list;
2626 register int i;
2627 register Lisp_Object marker;
2629 if (running_asynch_code)
2630 save_search_regs ();
2632 if (!CONSP (list) && !NILP (list))
2633 list = wrong_type_argument (Qconsp, list);
2635 /* Unless we find a marker with a buffer in LIST, assume that this
2636 match data came from a string. */
2637 last_thing_searched = Qt;
2639 /* Allocate registers if they don't already exist. */
2641 int length = XFASTINT (Flength (list)) / 2;
2643 if (length > search_regs.num_regs)
2645 if (search_regs.num_regs == 0)
2647 search_regs.start
2648 = (regoff_t *) xmalloc (length * sizeof (regoff_t));
2649 search_regs.end
2650 = (regoff_t *) xmalloc (length * sizeof (regoff_t));
2652 else
2654 search_regs.start
2655 = (regoff_t *) xrealloc (search_regs.start,
2656 length * sizeof (regoff_t));
2657 search_regs.end
2658 = (regoff_t *) xrealloc (search_regs.end,
2659 length * sizeof (regoff_t));
2662 search_regs.num_regs = length;
2666 for (i = 0; i < search_regs.num_regs; i++)
2668 marker = Fcar (list);
2669 if (NILP (marker))
2671 search_regs.start[i] = -1;
2672 list = Fcdr (list);
2674 else
2676 if (MARKERP (marker))
2678 if (XMARKER (marker)->buffer == 0)
2679 XSETFASTINT (marker, 0);
2680 else
2681 XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer);
2684 CHECK_NUMBER_COERCE_MARKER (marker, 0);
2685 search_regs.start[i] = XINT (marker);
2686 list = Fcdr (list);
2688 marker = Fcar (list);
2689 if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
2690 XSETFASTINT (marker, 0);
2692 CHECK_NUMBER_COERCE_MARKER (marker, 0);
2693 search_regs.end[i] = XINT (marker);
2695 list = Fcdr (list);
2698 return Qnil;
2701 /* If non-zero the match data have been saved in saved_search_regs
2702 during the execution of a sentinel or filter. */
2703 static int search_regs_saved;
2704 static struct re_registers saved_search_regs;
2706 /* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
2707 if asynchronous code (filter or sentinel) is running. */
2708 static void
2709 save_search_regs ()
2711 if (!search_regs_saved)
2713 saved_search_regs.num_regs = search_regs.num_regs;
2714 saved_search_regs.start = search_regs.start;
2715 saved_search_regs.end = search_regs.end;
2716 search_regs.num_regs = 0;
2717 search_regs.start = 0;
2718 search_regs.end = 0;
2720 search_regs_saved = 1;
2724 /* Called upon exit from filters and sentinels. */
2725 void
2726 restore_match_data ()
2728 if (search_regs_saved)
2730 if (search_regs.num_regs > 0)
2732 xfree (search_regs.start);
2733 xfree (search_regs.end);
2735 search_regs.num_regs = saved_search_regs.num_regs;
2736 search_regs.start = saved_search_regs.start;
2737 search_regs.end = saved_search_regs.end;
2739 search_regs_saved = 0;
2743 /* Quote a string to inactivate reg-expr chars */
2745 DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
2746 "Return a regexp string which matches exactly STRING and nothing else.")
2747 (string)
2748 Lisp_Object string;
2750 register unsigned char *in, *out, *end;
2751 register unsigned char *temp;
2752 int backslashes_added = 0;
2754 CHECK_STRING (string, 0);
2756 temp = (unsigned char *) alloca (STRING_BYTES (XSTRING (string)) * 2);
2758 /* Now copy the data into the new string, inserting escapes. */
2760 in = XSTRING (string)->data;
2761 end = in + STRING_BYTES (XSTRING (string));
2762 out = temp;
2764 for (; in != end; in++)
2766 if (*in == '[' || *in == ']'
2767 || *in == '*' || *in == '.' || *in == '\\'
2768 || *in == '?' || *in == '+'
2769 || *in == '^' || *in == '$')
2770 *out++ = '\\', backslashes_added++;
2771 *out++ = *in;
2774 return make_specified_string (temp,
2775 XSTRING (string)->size + backslashes_added,
2776 out - temp,
2777 STRING_MULTIBYTE (string));
2780 void
2781 syms_of_search ()
2783 register int i;
2785 for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
2787 searchbufs[i].buf.allocated = 100;
2788 searchbufs[i].buf.buffer = (unsigned char *) malloc (100);
2789 searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
2790 searchbufs[i].regexp = Qnil;
2791 staticpro (&searchbufs[i].regexp);
2792 searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]);
2794 searchbuf_head = &searchbufs[0];
2796 Qsearch_failed = intern ("search-failed");
2797 staticpro (&Qsearch_failed);
2798 Qinvalid_regexp = intern ("invalid-regexp");
2799 staticpro (&Qinvalid_regexp);
2801 Fput (Qsearch_failed, Qerror_conditions,
2802 Fcons (Qsearch_failed, Fcons (Qerror, Qnil)));
2803 Fput (Qsearch_failed, Qerror_message,
2804 build_string ("Search failed"));
2806 Fput (Qinvalid_regexp, Qerror_conditions,
2807 Fcons (Qinvalid_regexp, Fcons (Qerror, Qnil)));
2808 Fput (Qinvalid_regexp, Qerror_message,
2809 build_string ("Invalid regexp"));
2811 last_thing_searched = Qnil;
2812 staticpro (&last_thing_searched);
2814 defsubr (&Slooking_at);
2815 defsubr (&Sposix_looking_at);
2816 defsubr (&Sstring_match);
2817 defsubr (&Sposix_string_match);
2818 defsubr (&Ssearch_forward);
2819 defsubr (&Ssearch_backward);
2820 defsubr (&Sword_search_forward);
2821 defsubr (&Sword_search_backward);
2822 defsubr (&Sre_search_forward);
2823 defsubr (&Sre_search_backward);
2824 defsubr (&Sposix_search_forward);
2825 defsubr (&Sposix_search_backward);
2826 defsubr (&Sreplace_match);
2827 defsubr (&Smatch_beginning);
2828 defsubr (&Smatch_end);
2829 defsubr (&Smatch_data);
2830 defsubr (&Sset_match_data);
2831 defsubr (&Sregexp_quote);