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)
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. */
31 #include "region-cache.h"
33 #include "blockinput.h"
34 #include "intervals.h"
36 #include <sys/types.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. */
48 struct regexp_cache
*next
;
50 struct re_pattern_buffer buf
;
52 /* Nonzero means regexp was compiled to do full POSIX backtracking. */
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
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 ();
100 error ("Stack overflow in regexp matcher");
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. */
124 compile_pattern_1 (cp
, pattern
, translate
, regp
, posix
, multibyte
)
125 struct regexp_cache
*cp
;
127 Lisp_Object translate
;
128 struct re_registers
*regp
;
132 unsigned char *raw_pattern
;
133 int raw_pattern_size
;
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
));
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);
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);
169 cp
->buf
.translate
= (! NILP (translate
) ? translate
: make_number (0));
171 cp
->buf
.multibyte
= multibyte
;
173 old
= re_set_syntax (RE_SYNTAX_EMACS
174 | (posix
? 0 : RE_NO_POSIX_BACKTRACKING
));
175 val
= (char *) re_compile_pattern ((char *)raw_pattern
,
176 raw_pattern_size
, &cp
->buf
);
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. */
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
;
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
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
)
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
)
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
)
232 /* If we're at the end of the cache, compile into the last cell. */
235 compile_pattern_1 (cp
, pattern
, translate
, regp
, posix
, multibyte
);
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. */
244 cp
->next
= searchbuf_head
;
247 /* Advise the searching functions about the space we have allocated
248 for register data. */
250 re_set_registers (&cp
->buf
, regp
, regp
->num_regs
, regp
->start
, regp
->end
);
255 /* Error condition used for failing searches */
256 Lisp_Object Qsearch_failed
;
262 Fsignal (Qsearch_failed
, Fcons (arg
, Qnil
));
267 looking_at_1 (string
, posix
)
272 unsigned char *p1
, *p2
;
275 struct re_pattern_buffer
*bufp
;
277 if (running_asynch_code
)
280 CHECK_STRING (string
, 0);
281 bufp
= compile_pattern (string
, &search_regs
,
282 (!NILP (current_buffer
->case_fold_search
)
283 ? DOWNCASE_TABLE
: Qnil
),
285 !NILP (current_buffer
->enable_multibyte_characters
));
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. */
294 s1
= GPT_BYTE
- BEGV_BYTE
;
296 s2
= ZV_BYTE
- GPT_BYTE
;
300 s2
= ZV_BYTE
- BEGV_BYTE
;
305 s1
= ZV_BYTE
- BEGV_BYTE
;
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
);
317 val
= (0 <= i
? Qt
: Qnil
);
319 for (i
= 0; i
< search_regs
.num_regs
; i
++)
320 if (search_regs
.start
[i
] >= 0)
323 = BYTE_TO_CHAR (search_regs
.start
[i
] + BEGV_BYTE
);
325 = BYTE_TO_CHAR (search_regs
.end
[i
] + BEGV_BYTE
);
327 XSETBUFFER (last_thing_searched
, current_buffer
);
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.")
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.")
352 return looking_at_1 (regexp
, 1);
356 string_match_1 (regexp
, string
, start
, posix
)
357 Lisp_Object regexp
, string
, start
;
361 struct re_pattern_buffer
*bufp
;
365 if (running_asynch_code
)
368 CHECK_STRING (regexp
, 0);
369 CHECK_STRING (string
, 1);
372 pos
= 0, pos_byte
= 0;
375 int len
= XSTRING (string
)->size
;
377 CHECK_NUMBER (start
, 2);
379 if (pos
< 0 && -pos
<= len
)
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
),
390 STRING_MULTIBYTE (string
));
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
,
399 last_thing_searched
= Qt
;
402 if (val
< 0) return Qnil
;
404 for (i
= 0; i
< search_regs
.num_regs
; i
++)
405 if (search_regs
.start
[i
] >= 0)
408 = string_byte_to_char (string
, search_regs
.start
[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
;
452 struct re_pattern_buffer
*bufp
;
454 bufp
= compile_pattern (regexp
, 0, Qnil
,
455 0, STRING_MULTIBYTE (string
));
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);
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
)
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,
488 val
= re_search (bufp
, string
, len
, 0, len
, 0);
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. */
500 newline_cache_on_off (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;
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
)
549 struct region_cache
*newline_cache
;
560 if (! end
) end
= BEGV
;
563 newline_cache_on_off (current_buffer
);
564 newline_cache
= current_buffer
->newline_cache
;
569 immediate_quit
= allow_quit
;
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
579 int ceiling_byte
= CHAR_TO_BYTE (end
) - 1;
580 int start_byte
= CHAR_TO_BYTE (start
);
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
)
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
;
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
)
639 return BYTE_TO_CHAR (start_byte
+ cursor
- base
+ 1);
645 start
= BYTE_TO_CHAR (start_byte
+ cursor
- base
);
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
);
656 /* Consult the newline cache, if appropriate. */
657 if (target
== '\n' && newline_cache
)
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
)
705 return BYTE_TO_CHAR (start_byte
+ cursor
- base
);
711 start
= BYTE_TO_CHAR (start_byte
+ cursor
- base
);
717 *shortage
= count
* direction
;
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
;
745 int direction
= ((count
> 0) ? 1 : -1);
747 register unsigned char *cursor
;
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. */
766 start_byte
= CHAR_TO_BYTE (start
);
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
));
778 while (*cursor
!= '\n' && ++cursor
!= ceiling_addr
)
781 if (cursor
!= ceiling_addr
)
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
);
792 if (++cursor
== ceiling_addr
)
798 start_byte
+= cursor
- base
;
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);
811 while (--cursor
!= ceiling_addr
&& *cursor
!= '\n')
814 if (cursor
!= ceiling_addr
)
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
);
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
)
857 int pos
= scan_buffer ('\n', from
, to
, cnt
, &shortage
, 1);
865 /* Subroutines of Lisp buffer search functions. */
868 search_command (string
, bound
, noerror
, count
, direction
, RE
, posix
)
869 Lisp_Object string
, bound
, noerror
, count
;
880 CHECK_NUMBER (count
, 3);
884 CHECK_STRING (string
, 0);
888 lim
= ZV
, lim_byte
= ZV_BYTE
;
890 lim
= BEGV
, lim_byte
= BEGV_BYTE
;
894 CHECK_NUMBER_COERCE_MARKER (bound
, 1);
896 if (n
> 0 ? lim
< PT
: lim
> PT
)
897 error ("Invalid search bound (wrong side of point)");
899 lim
= ZV
, lim_byte
= ZV_BYTE
;
901 lim
= BEGV
, lim_byte
= BEGV_BYTE
;
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
910 (!NILP (current_buffer
->case_fold_search
)
911 ? current_buffer
->case_eqv_table
917 return signal_failure (string
);
918 if (!EQ (noerror
, Qt
))
920 if (lim
< BEGV
|| lim
> ZV
)
922 SET_PT_BOTH (lim
, lim_byte
);
924 #if 0 /* This would be clean, but maybe programs depend on
925 a value of nil here. */
933 if (np
< BEGV
|| np
> ZV
)
938 return make_number (np
);
941 /* Return 1 if REGEXP it matches just one constant string. */
944 trivial_regexp_p (regexp
)
947 int len
= STRING_BYTES (XSTRING (regexp
));
948 unsigned char *s
= XSTRING (regexp
)->data
;
954 case '.': case '*': case '+': case '?': case '[': case '^': case '$':
961 case '|': case '(': case ')': case '`': case '\'': case 'b':
962 case 'B': case '<': case '>': case 'w': case 'W': case 's':
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':
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) \
995 temp = Faref (trt, make_number (d)); \
996 if (INTEGERP (temp)) \
1007 search_buffer (string
, pos
, pos_byte
, lim
, lim_byte
, n
,
1008 RE
, trt
, inverse_trt
, posix
)
1017 Lisp_Object inverse_trt
;
1020 int len
= XSTRING (string
)->size
;
1021 int len_byte
= STRING_BYTES (XSTRING (string
));
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);
1035 if (RE
&& !trivial_regexp_p (string
))
1037 unsigned char *p1
, *p2
;
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. */
1053 s1
= GPT_BYTE
- BEGV_BYTE
;
1055 s2
= ZV_BYTE
- GPT_BYTE
;
1059 s2
= ZV_BYTE
- BEGV_BYTE
;
1064 s1
= ZV_BYTE
- BEGV_BYTE
;
1067 re_match_object
= Qnil
;
1072 val
= re_search_2 (bufp
, (char *) p1
, s1
, (char *) p2
, s2
,
1073 pos_byte
- BEGV_BYTE
, lim_byte
- pos_byte
,
1075 /* Don't allow match past current point */
1076 pos_byte
- BEGV_BYTE
);
1079 matcher_overflow ();
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
);
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];
1106 val
= re_search_2 (bufp
, (char *) p1
, s1
, (char *) p2
, s2
,
1107 pos_byte
- BEGV_BYTE
, lim_byte
- pos_byte
,
1109 lim_byte
- BEGV_BYTE
);
1112 matcher_overflow ();
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
);
1123 = BYTE_TO_CHAR (search_regs
.end
[i
] + BEGV_BYTE
);
1125 XSETBUFFER (last_thing_searched
, current_buffer
);
1126 pos
= search_regs
.end
[0];
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
));
1161 raw_pattern_size
= XSTRING (string
)->size
;
1162 raw_pattern_size_byte
1163 = count_size_as_multibyte (XSTRING (string
)->data
,
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);
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
);
1189 base_pat
= raw_pattern
;
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
== '\\')
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
)
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 */
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. */
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
);
1251 base_pat
+= in_charlen
;
1252 len_byte
-= in_charlen
;
1257 /* Unibyte buffer. */
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
== '\\')
1272 TRANSLATE (translated
, trt
, c
);
1273 *pat
++ = translated
;
1277 len_byte
= pat
- patbuf
;
1278 len
= raw_pattern_size
;
1279 pat
= base_pat
= patbuf
;
1282 return boyer_moore (n
, pat
, len
, len_byte
, trt
, inverse_trt
,
1283 pos
, pos_byte
, lim
, lim_byte
,
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. */
1304 simple_search (n
, pat
, len
, len_byte
, trt
, pos
, pos_byte
, lim
, lim_byte
)
1312 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
1313 int forward
= n
> 0;
1315 if (lim
> pos
&& multibyte
)
1320 /* Try matching at position POS. */
1322 int this_pos_byte
= pos_byte
;
1324 int this_len_byte
= len_byte
;
1325 unsigned char *p
= pat
;
1326 if (pos
+ len
> lim
)
1329 while (this_len
> 0)
1331 int charlen
, buf_charlen
;
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
,
1338 TRANSLATE (buf_ch
, trt
, buf_ch
);
1340 if (buf_ch
!= pat_ch
)
1343 this_len_byte
-= charlen
;
1347 this_pos_byte
+= buf_charlen
;
1354 pos_byte
+= len_byte
;
1358 INC_BOTH (pos
, pos_byte
);
1368 /* Try matching at position POS. */
1371 unsigned char *p
= pat
;
1373 if (pos
+ len
> lim
)
1376 while (this_len
> 0)
1379 int buf_ch
= FETCH_BYTE (this_pos
);
1380 TRANSLATE (buf_ch
, trt
, buf_ch
);
1382 if (buf_ch
!= pat_ch
)
1400 /* Backwards search. */
1401 else if (lim
< pos
&& multibyte
)
1406 /* Try matching at position POS. */
1407 int this_pos
= pos
- len
;
1408 int this_pos_byte
= pos_byte
- len_byte
;
1410 int this_len_byte
= len_byte
;
1411 unsigned char *p
= pat
;
1413 if (pos
- len
< lim
)
1416 while (this_len
> 0)
1418 int charlen
, buf_charlen
;
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
,
1425 TRANSLATE (buf_ch
, trt
, buf_ch
);
1427 if (buf_ch
!= pat_ch
)
1430 this_len_byte
-= charlen
;
1433 this_pos_byte
+= buf_charlen
;
1440 pos_byte
-= len_byte
;
1444 DEC_BOTH (pos
, pos_byte
);
1454 /* Try matching at position POS. */
1455 int this_pos
= pos
- len
;
1457 unsigned char *p
= pat
;
1459 if (pos
- len
< lim
)
1462 while (this_len
> 0)
1465 int buf_ch
= FETCH_BYTE (this_pos
);
1466 TRANSLATE (buf_ch
, trt
, buf_ch
);
1468 if (buf_ch
!= pat_ch
)
1490 set_search_regs ((multibyte
? pos_byte
: pos
) - len_byte
, len_byte
);
1492 set_search_regs (multibyte
? pos_byte
: pos
, len_byte
);
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. */
1516 boyer_moore (n
, base_pat
, len
, len_byte
, trt
, inverse_trt
,
1517 pos
, pos_byte
, lim
, lim_byte
, charset_base
)
1519 unsigned char *base_pat
;
1522 Lisp_Object inverse_trt
;
1527 int direction
= ((n
> 0) ? 1 : -1);
1528 register int dirlen
;
1529 int infinity
, limit
, k
, stride_for_teases
;
1530 register int *BM_tab
;
1532 register unsigned char *cursor
, *p_limit
;
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
;
1542 int BM_tab_space
[0400];
1543 BM_tab
= &BM_tab_space
[0];
1545 BM_tab
= (int *) alloca (0400 * sizeof (int));
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 */
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. */
1583 base_pat
= pat_end
- 1;
1585 BM_tab_base
= BM_tab
;
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
)
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
;
1606 while (i
!= infinity
)
1608 unsigned char *ptr
= base_pat
+ i
;
1616 int this_translated
= 1;
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
))
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];
1638 this_translated
= 0;
1642 else if (!multibyte
)
1643 TRANSLATE (ch
, trt
, *ptr
);
1647 this_translated
= 0;
1651 j
= ((unsigned char) ch
) | 0200;
1653 j
= (unsigned char) ch
;
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
;
1667 TRANSLATE (ch
, inverse_trt
, ch
);
1669 j
= ((unsigned char) ch
) | 0200;
1671 j
= (unsigned char) ch
;
1673 /* For all the characters that map into CH,
1674 set up simple_translate to map the last byte
1676 simple_translate
[j
] = starting_j
;
1677 if (ch
== starting_ch
)
1679 BM_tab
[j
] = dirlen
- i
;
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 */
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. */
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
1711 return (n
* (0 - direction
));
1712 /* First we do the part we can by pointers (maybe nothing) */
1715 limit
= pos_byte
- dirlen
+ direction
;
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);
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)
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
];
1757 while ((EMACS_UINT
) cursor
<= (EMACS_UINT
) p_limit
)
1758 cursor
+= BM_tab
[*cursor
];
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
];
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
;
1781 while ((i
-= direction
) + direction
!= 0)
1784 cursor
-= direction
;
1785 /* Translate only the last byte of a character. */
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
];
1802 while ((i
-= direction
) + direction
!= 0)
1804 cursor
-= direction
;
1805 if (pat
[i
] != *cursor
)
1809 cursor
+= dirlen
- i
- direction
; /* fix cursor */
1810 if (i
+ direction
== 0)
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 */
1823 return ((direction
> 0)
1824 ? search_regs
.end
[0] : search_regs
.start
[0]);
1827 cursor
+= stride_for_teases
; /* <sigh> we lose - */
1829 pos_byte
+= cursor
- p2
;
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. */
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)
1863 pos_byte
-= direction
;
1864 ptr
= BYTE_POS_ADDR (pos_byte
);
1865 /* Translate only the last byte of a character. */
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
];
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)
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 */
1895 return ((direction
> 0)
1896 ? search_regs
.end
[0] : search_regs
.start
[0]);
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. */
1914 set_search_regs (beg_byte
, nbytes
)
1915 int beg_byte
, nbytes
;
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. */
1948 register unsigned char *p
, *o
;
1949 register int i
, i_byte
, len
, punct_count
= 0, word_count
= 0;
1954 CHECK_STRING (string
, 0);
1955 p
= XSTRING (string
)->data
;
1956 len
= XSTRING (string
)->size
;
1958 for (i
= 0, i_byte
= 0; i
< len
; )
1962 if (STRING_MULTIBYTE (string
))
1963 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
1965 c
= XSTRING (string
)->data
[i
++];
1967 if (SYNTAX (c
) != Sword
)
1970 if (i
> 0 && SYNTAX (prev_c
) == Sword
)
1977 if (SYNTAX (prev_c
) == Sword
)
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
))
1988 val
= make_uninit_string (len
+ adjust
);
1990 o
= XSTRING (val
)->data
;
1995 for (i
= 0, i_byte
= 0; i
< len
; )
1998 int i_byte_orig
= i_byte
;
2000 if (STRING_MULTIBYTE (string
))
2001 FETCH_STRING_CHAR_ADVANCE (c
, string
, i
, i_byte
);
2004 c
= XSTRING (string
)->data
[i
++];
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
)
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\
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,
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,
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,
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
;
2198 int some_nonuppercase_initial
;
2199 register int c
, prevc
;
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");
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
));
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
]));
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. */
2247 pos
= search_regs
.start
[sub
];
2248 last
= search_regs
.end
[sub
];
2251 pos_byte
= CHAR_TO_BYTE (pos
);
2253 pos_byte
= string_char_to_byte (string
, pos
);
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;
2262 some_nonuppercase_initial
= 0;
2269 c
= FETCH_CHAR (pos_byte
);
2270 INC_BOTH (pos
, pos_byte
);
2273 FETCH_STRING_CHAR_ADVANCE (c
, string
, pos
, pos_byte
);
2277 /* Cannot be all caps if any original char is lower case */
2280 if (SYNTAX (prevc
) != Sword
)
2281 some_nonuppercase_initial
= 1;
2283 some_multiletter_word
= 1;
2285 else if (!NOCASEP (c
))
2288 if (SYNTAX (prevc
) != Sword
)
2291 some_multiletter_word
= 1;
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;
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
;
2316 case_action
= nochange
;
2319 /* Do replacement in a 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
2333 int lastpos_byte
= 0;
2334 /* We build up the substituted string in ACCUM. */
2337 int length
= STRING_BYTES (XSTRING (newtext
));
2341 for (pos_byte
= 0, pos
= 0; pos_byte
< length
;)
2345 int delbackslash
= 0;
2347 FETCH_STRING_CHAR_ADVANCE (c
, newtext
, pos
, pos_byte
);
2351 FETCH_STRING_CHAR_ADVANCE (c
, newtext
, pos
, pos_byte
);
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'];
2368 error ("Invalid use of `\\' in replacement text");
2372 if (pos
- 2 != lastpos
)
2373 middle
= substring_both (newtext
, lastpos
,
2375 pos
- 2, pos_byte
- 2);
2378 accum
= concat3 (accum
, middle
,
2380 make_number (substart
),
2381 make_number (subend
)));
2383 lastpos_byte
= pos_byte
;
2385 else if (delbackslash
)
2387 middle
= substring_both (newtext
, lastpos
,
2389 pos
- 1, pos_byte
- 1);
2391 accum
= concat2 (accum
, middle
);
2393 lastpos_byte
= pos_byte
;
2398 middle
= substring_both (newtext
, lastpos
,
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
])
2419 else if (PT
> search_regs
.start
[sub
])
2420 opoint
= search_regs
.end
[sub
] - ZV
;
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
);
2434 struct gcpro gcpro1
;
2435 int length
= STRING_BYTES (XSTRING (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
);
2447 FETCH_STRING_CHAR_ADVANCE (c
, newtext
, pos
, pos_byte
);
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
));
2464 error ("Invalid use of `\\' in replacement text");
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
));
2482 /* Put point back where it was in the text. */
2484 TEMP_SET_PT (opoint
+ ZV
);
2486 TEMP_SET_PT (opoint
);
2488 /* Now move point "officially" to the start of the inserted replacement. */
2489 move_if_not_intangible (newpoint
);
2495 match_limit (num
, beginningp
)
2501 CHECK_NUMBER (num
, 0);
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)
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\
2516 Value is nil if SUBEXPth pair didn't match, or there were less than\n\
2518 Zero means the entire text matched by the whole regexp or whole string.")
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\
2529 Value is nil if SUBEXPth pair didn't match, or there were less than\n\
2531 Zero means the entire text matched by the whole regexp or whole string.")
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.")
2550 Lisp_Object integers
, reuse
;
2552 Lisp_Object tail
, prev
;
2556 if (NILP (last_thing_searched
))
2559 data
= (Lisp_Object
*) alloca ((2 * search_regs
.num_regs
)
2560 * sizeof (Lisp_Object
));
2563 for (i
= 0; i
< search_regs
.num_regs
; i
++)
2565 int start
= search_regs
.start
[i
];
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
);
2586 /* last_thing_searched must always be Qt, a buffer, or Qnil. */
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
= XCONS (tail
)->cdr
)
2604 if (i
< 2 * len
+ 2)
2605 XCONS (tail
)->car
= data
[i
];
2607 XCONS (tail
)->car
= Qnil
;
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 XCONS (prev
)->cdr
= Flist (2 * len
+ 2 - i
, data
+ i
);
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.")
2624 register Lisp_Object list
;
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)
2648 = (regoff_t
*) xmalloc (length
* sizeof (regoff_t
));
2650 = (regoff_t
*) xmalloc (length
* sizeof (regoff_t
));
2655 = (regoff_t
*) xrealloc (search_regs
.start
,
2656 length
* sizeof (regoff_t
));
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
);
2671 search_regs
.start
[i
] = -1;
2676 if (MARKERP (marker
))
2678 if (XMARKER (marker
)->buffer
== 0)
2679 XSETFASTINT (marker
, 0);
2681 XSETBUFFER (last_thing_searched
, XMARKER (marker
)->buffer
);
2684 CHECK_NUMBER_COERCE_MARKER (marker
, 0);
2685 search_regs
.start
[i
] = XINT (marker
);
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
);
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. */
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. */
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.")
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
));
2764 for (; in
!= end
; in
++)
2766 if (*in
== '[' || *in
== ']'
2767 || *in
== '*' || *in
== '.' || *in
== '\\'
2768 || *in
== '?' || *in
== '+'
2769 || *in
== '^' || *in
== '$')
2770 *out
++ = '\\', backslashes_added
++;
2774 return make_specified_string (temp
,
2775 XSTRING (string
)->size
+ backslashes_added
,
2777 STRING_MULTIBYTE (string
));
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
);