1 /* String search routines for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1993 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 1, 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
26 #include "blockinput.h"
28 #include <sys/types.h>
31 #define max(a, b) ((a) > (b) ? (a) : (b))
32 #define min(a, b) ((a) < (b) ? (a) : (b))
34 /* We compile regexps into this buffer and then use it for searching. */
36 struct re_pattern_buffer searchbuf
;
38 char search_fastmap
[0400];
40 /* Last regexp we compiled */
42 Lisp_Object last_regexp
;
44 /* Every call to re_match, etc., must pass &search_regs as the regs
45 argument unless you can show it is unnecessary (i.e., if re_match
46 is certainly going to be called again before region-around-match
49 Since the registers are now dynamically allocated, we need to make
50 sure not to refer to the Nth register before checking that it has
51 been allocated by checking search_regs.num_regs.
53 The regex code keeps track of whether it has allocated the search
54 buffer using bits in searchbuf. This means that whenever you
55 compile a new pattern, it completely forgets whether it has
56 allocated any registers, and will allocate new registers the next
57 time you call a searching or matching function. Therefore, we need
58 to call re_set_registers after compiling a new pattern or after
59 setting the match registers, so that the regex functions will be
60 able to free or re-allocate it properly. */
61 static struct re_registers search_regs
;
63 /* The buffer in which the last search was performed, or
64 Qt if the last search was done in a string;
65 Qnil if no searching has been done yet. */
66 static Lisp_Object last_thing_searched
;
68 /* error condition signalled when regexp compile_pattern fails */
70 Lisp_Object Qinvalid_regexp
;
75 error ("Stack overflow in regexp matcher");
84 /* Compile a regexp and signal a Lisp error if anything goes wrong. */
86 compile_pattern (pattern
, bufp
, regp
, translate
)
88 struct re_pattern_buffer
*bufp
;
89 struct re_registers
*regp
;
95 if (EQ (pattern
, last_regexp
)
96 && translate
== bufp
->translate
)
100 bufp
->translate
= translate
;
102 val
= re_compile_pattern ((char *) XSTRING (pattern
)->data
,
103 XSTRING (pattern
)->size
,
108 dummy
= build_string (val
);
110 Fsignal (Qinvalid_regexp
, Fcons (dummy
, Qnil
));
113 last_regexp
= pattern
;
115 /* Advise the searching functions about the space we have allocated
116 for register data. */
119 re_set_registers (bufp
, regp
, regp
->num_regs
, regp
->start
, regp
->end
);
125 /* Error condition used for failing searches */
126 Lisp_Object Qsearch_failed
;
132 Fsignal (Qsearch_failed
, Fcons (arg
, Qnil
));
136 DEFUN ("looking-at", Flooking_at
, Slooking_at
, 1, 1, 0,
137 "Return t if text after point matches regular expression PAT.\n\
138 This function modifies the match data that `match-beginning',\n\
139 `match-end' and `match-data' access; save and restore the match\n\
140 data if you want to preserve them.")
145 unsigned char *p1
, *p2
;
149 CHECK_STRING (string
, 0);
150 compile_pattern (string
, &searchbuf
, &search_regs
,
151 !NILP (current_buffer
->case_fold_search
) ? DOWNCASE_TABLE
: 0);
154 QUIT
; /* Do a pending quit right away, to avoid paradoxical behavior */
156 /* Get pointers and sizes of the two strings
157 that make up the visible portion of the buffer. */
175 i
= re_match_2 (&searchbuf
, (char *) p1
, s1
, (char *) p2
, s2
,
176 point
- BEGV
, &search_regs
,
181 val
= (0 <= i
? Qt
: Qnil
);
182 for (i
= 0; i
< search_regs
.num_regs
; i
++)
183 if (search_regs
.start
[i
] >= 0)
185 search_regs
.start
[i
] += BEGV
;
186 search_regs
.end
[i
] += BEGV
;
188 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
193 DEFUN ("string-match", Fstring_match
, Sstring_match
, 2, 3, 0,
194 "Return index of start of first match for REGEXP in STRING, or nil.\n\
195 If third arg START is non-nil, start search at that index in STRING.\n\
196 For index of first char beyond the match, do (match-end 0).\n\
197 `match-end' and `match-beginning' also give indices of substrings\n\
198 matched by parenthesis constructs in the pattern.")
199 (regexp
, string
, start
)
200 Lisp_Object regexp
, string
, start
;
205 CHECK_STRING (regexp
, 0);
206 CHECK_STRING (string
, 1);
212 int len
= XSTRING (string
)->size
;
214 CHECK_NUMBER (start
, 2);
216 if (s
< 0 && -s
<= len
)
218 else if (0 > s
|| s
> len
)
219 args_out_of_range (string
, start
);
222 compile_pattern (regexp
, &searchbuf
, &search_regs
,
223 !NILP (current_buffer
->case_fold_search
) ? DOWNCASE_TABLE
: 0);
225 val
= re_search (&searchbuf
, (char *) XSTRING (string
)->data
,
226 XSTRING (string
)->size
, s
, XSTRING (string
)->size
- s
,
229 last_thing_searched
= Qt
;
232 if (val
< 0) return Qnil
;
233 return make_number (val
);
236 /* Match REGEXP against STRING, searching all of STRING,
237 and return the index of the match, or negative on failure.
238 This does not clobber the match data. */
241 fast_string_match (regexp
, string
)
242 Lisp_Object regexp
, string
;
246 compile_pattern (regexp
, &searchbuf
, 0, 0);
248 val
= re_search (&searchbuf
, (char *) XSTRING (string
)->data
,
249 XSTRING (string
)->size
, 0, XSTRING (string
)->size
,
255 /* Search for COUNT instances of the character TARGET, starting at START.
256 If COUNT is negative, search backwards.
258 If we find COUNT instances, set *SHORTAGE to zero, and return the
259 position after the COUNTth match. Note that for reverse motion
260 this is not the same as the usual convention for Emacs motion commands.
262 If we don't find COUNT instances before reaching the end of the
263 buffer (or the beginning, if scanning backwards), set *SHORTAGE to
264 the number of TARGETs left unfound, and return the end of the
265 buffer we bumped up against. */
267 scan_buffer (target
, start
, count
, shortage
)
268 int *shortage
, start
;
269 register int count
, target
;
271 int limit
= ((count
> 0) ? ZV
- 1 : BEGV
);
272 int direction
= ((count
> 0) ? 1 : -1);
274 register unsigned char *cursor
;
277 register int ceiling
;
278 register unsigned char *ceiling_addr
;
286 while (start
!= limit
+ 1)
288 ceiling
= BUFFER_CEILING_OF (start
);
289 ceiling
= min (limit
, ceiling
);
290 ceiling_addr
= &FETCH_CHAR (ceiling
) + 1;
291 base
= (cursor
= &FETCH_CHAR (start
));
294 while (*cursor
!= target
&& ++cursor
!= ceiling_addr
)
296 if (cursor
!= ceiling_addr
)
301 return (start
+ cursor
- base
+ 1);
304 if (++cursor
== ceiling_addr
)
310 start
+= cursor
- base
;
314 start
--; /* first character we scan */
315 while (start
> limit
- 1)
316 { /* we WILL scan under start */
317 ceiling
= BUFFER_FLOOR_OF (start
);
318 ceiling
= max (limit
, ceiling
);
319 ceiling_addr
= &FETCH_CHAR (ceiling
) - 1;
320 base
= (cursor
= &FETCH_CHAR (start
));
324 while (--cursor
!= ceiling_addr
&& *cursor
!= target
)
326 if (cursor
!= ceiling_addr
)
331 return (start
+ cursor
- base
+ 1);
337 start
+= cursor
- base
;
342 *shortage
= count
* direction
;
343 return (start
+ ((direction
== 1 ? 0 : 1)));
347 find_next_newline (from
, cnt
)
348 register int from
, cnt
;
350 return (scan_buffer ('\n', from
, cnt
, (int *) 0));
353 Lisp_Object
skip_chars ();
355 DEFUN ("skip-chars-forward", Fskip_chars_forward
, Sskip_chars_forward
, 1, 2, 0,
356 "Move point forward, stopping before a char not in CHARS, or at position LIM.\n\
357 CHARS is like the inside of a `[...]' in a regular expression\n\
358 except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\
359 Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
360 With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\
361 Returns the distance traveled, either zero or positive.")
363 Lisp_Object string
, lim
;
365 return skip_chars (1, 0, string
, lim
);
368 DEFUN ("skip-chars-backward", Fskip_chars_backward
, Sskip_chars_backward
, 1, 2, 0,
369 "Move point backward, stopping after a char not in CHARS, or at position LIM.\n\
370 See `skip-chars-forward' for details.\n\
371 Returns the distance traveled, either zero or negative.")
373 Lisp_Object string
, lim
;
375 return skip_chars (0, 0, string
, lim
);
378 DEFUN ("skip-syntax-forward", Fskip_syntax_forward
, Sskip_syntax_forward
, 1, 2, 0,
379 "Move point forward across chars in specified syntax classes.\n\
380 SYNTAX is a string of syntax code characters.\n\
381 Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\
382 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
383 This function returns the distance traveled, either zero or positive.")
385 Lisp_Object syntax
, lim
;
387 return skip_chars (1, 1, syntax
, lim
);
390 DEFUN ("skip-syntax-backward", Fskip_syntax_backward
, Sskip_syntax_backward
, 1, 2, 0,
391 "Move point backward across chars in specified syntax classes.\n\
392 SYNTAX is a string of syntax code characters.\n\
393 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\
394 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
395 This function returns the distance traveled, either zero or negative.")
397 Lisp_Object syntax
, lim
;
399 return skip_chars (0, 1, syntax
, lim
);
403 skip_chars (forwardp
, syntaxp
, string
, lim
)
404 int forwardp
, syntaxp
;
405 Lisp_Object string
, lim
;
407 register unsigned char *p
, *pend
;
408 register unsigned char c
;
409 unsigned char fastmap
[0400];
413 CHECK_STRING (string
, 0);
416 XSET (lim
, Lisp_Int
, forwardp
? ZV
: BEGV
);
418 CHECK_NUMBER_COERCE_MARKER (lim
, 1);
420 #if 0 /* This breaks some things... jla. */
421 /* In any case, don't allow scan outside bounds of buffer. */
422 if (XFASTINT (lim
) > ZV
)
424 if (XFASTINT (lim
) < BEGV
)
425 XFASTINT (lim
) = BEGV
;
428 p
= XSTRING (string
)->data
;
429 pend
= p
+ XSTRING (string
)->size
;
430 bzero (fastmap
, sizeof fastmap
);
432 if (p
!= pend
&& *p
== '^')
437 /* Find the characters specified and set their elements of fastmap.
438 If syntaxp, each character counts as itself.
439 Otherwise, handle backslashes and ranges specially */
450 if (p
== pend
) break;
453 if (p
!= pend
&& *p
== '-')
456 if (p
== pend
) break;
469 /* If ^ was the first character, complement the fastmap. */
472 for (i
= 0; i
< sizeof fastmap
; i
++)
476 int start_point
= point
;
484 while (point
< XINT (lim
)
485 && fastmap
[(unsigned char) syntax_code_spec
[(int) SYNTAX (FETCH_CHAR (point
))]])
490 while (point
> XINT (lim
)
491 && fastmap
[(unsigned char) syntax_code_spec
[(int) SYNTAX (FETCH_CHAR (point
- 1))]])
499 while (point
< XINT (lim
) && fastmap
[FETCH_CHAR (point
)])
504 while (point
> XINT (lim
) && fastmap
[FETCH_CHAR (point
- 1)])
510 return make_number (point
- start_point
);
514 /* Subroutines of Lisp buffer search functions. */
517 search_command (string
, bound
, noerror
, count
, direction
, RE
)
518 Lisp_Object string
, bound
, noerror
, count
;
528 CHECK_NUMBER (count
, 3);
532 CHECK_STRING (string
, 0);
534 lim
= n
> 0 ? ZV
: BEGV
;
537 CHECK_NUMBER_COERCE_MARKER (bound
, 1);
539 if (n
> 0 ? lim
< point
: lim
> point
)
540 error ("Invalid search bound (wrong side of point)");
547 np
= search_buffer (string
, point
, lim
, n
, RE
,
548 (!NILP (current_buffer
->case_fold_search
)
549 ? XSTRING (current_buffer
->case_canon_table
)->data
: 0),
550 (!NILP (current_buffer
->case_fold_search
)
551 ? XSTRING (current_buffer
->case_eqv_table
)->data
: 0));
555 return signal_failure (string
);
556 if (!EQ (noerror
, Qt
))
558 if (lim
< BEGV
|| lim
> ZV
)
562 #if 0 /* This would be clean, but maybe programs depend on
563 a value of nil here. */
571 if (np
< BEGV
|| np
> ZV
)
576 return make_number (np
);
579 /* search for the n'th occurrence of STRING in the current buffer,
580 starting at position POS and stopping at position LIM,
581 treating PAT as a literal string if RE is false or as
582 a regular expression if RE is true.
584 If N is positive, searching is forward and LIM must be greater than POS.
585 If N is negative, searching is backward and LIM must be less than POS.
587 Returns -x if only N-x occurrences found (x > 0),
588 or else the position at the beginning of the Nth occurrence
589 (if searching backward) or the end (if searching forward). */
591 search_buffer (string
, pos
, lim
, n
, RE
, trt
, inverse_trt
)
597 register unsigned char *trt
;
598 register unsigned char *inverse_trt
;
600 int len
= XSTRING (string
)->size
;
601 unsigned char *base_pat
= XSTRING (string
)->data
;
602 register int *BM_tab
;
604 register int direction
= ((n
> 0) ? 1 : -1);
606 int infinity
, limit
, k
, stride_for_teases
;
607 register unsigned char *pat
, *cursor
, *p_limit
;
609 unsigned char *p1
, *p2
;
612 /* Null string is found at starting position. */
617 compile_pattern (string
, &searchbuf
, &search_regs
, (char *) trt
);
619 if (RE
/* Here we detect whether the */
620 /* generality of an RE search is */
622 /* first item is "exact match" */
623 && *(searchbuf
.buffer
) == (char) RE_EXACTN_VALUE
624 && searchbuf
.buffer
[1] + 2 == searchbuf
.used
) /*first is ONLY item */
626 RE
= 0; /* can do straight (non RE) search */
627 pat
= (base_pat
= (unsigned char *) searchbuf
.buffer
+ 2);
628 /* trt already applied */
629 len
= searchbuf
.used
- 2;
633 pat
= (unsigned char *) alloca (len
);
635 for (i
= len
; i
--;) /* Copy the pattern; apply trt */
636 *pat
++ = (((int) trt
) ? trt
[*base_pat
++] : *base_pat
++);
637 pat
-= len
; base_pat
= pat
;
642 immediate_quit
= 1; /* Quit immediately if user types ^G,
643 because letting this function finish
644 can take too long. */
645 QUIT
; /* Do a pending quit right away,
646 to avoid paradoxical behavior */
647 /* Get pointers and sizes of the two strings
648 that make up the visible portion of the buffer. */
668 val
= re_search_2 (&searchbuf
, (char *) p1
, s1
, (char *) p2
, s2
,
669 pos
- BEGV
, lim
- pos
, &search_regs
,
670 /* Don't allow match past current point */
677 for (i
= 0; i
< search_regs
.num_regs
; i
++)
678 if (search_regs
.start
[i
] >= 0)
680 search_regs
.start
[i
] += j
;
681 search_regs
.end
[i
] += j
;
683 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
684 /* Set pos to the new position. */
685 pos
= search_regs
.start
[0];
697 val
= re_search_2 (&searchbuf
, (char *) p1
, s1
, (char *) p2
, s2
,
698 pos
- BEGV
, lim
- pos
, &search_regs
,
705 for (i
= 0; i
< search_regs
.num_regs
; i
++)
706 if (search_regs
.start
[i
] >= 0)
708 search_regs
.start
[i
] += j
;
709 search_regs
.end
[i
] += j
;
711 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
712 pos
= search_regs
.end
[0];
724 else /* non-RE case */
727 int BM_tab_space
[0400];
728 BM_tab
= &BM_tab_space
[0];
730 BM_tab
= (int *) alloca (0400 * sizeof (int));
732 /* The general approach is that we are going to maintain that we know */
733 /* the first (closest to the present position, in whatever direction */
734 /* we're searching) character that could possibly be the last */
735 /* (furthest from present position) character of a valid match. We */
736 /* advance the state of our knowledge by looking at that character */
737 /* and seeing whether it indeed matches the last character of the */
738 /* pattern. If it does, we take a closer look. If it does not, we */
739 /* move our pointer (to putative last characters) as far as is */
740 /* logically possible. This amount of movement, which I call a */
741 /* stride, will be the length of the pattern if the actual character */
742 /* appears nowhere in the pattern, otherwise it will be the distance */
743 /* from the last occurrence of that character to the end of the */
745 /* As a coding trick, an enormous stride is coded into the table for */
746 /* characters that match the last character. This allows use of only */
747 /* a single test, a test for having gone past the end of the */
748 /* permissible match region, to test for both possible matches (when */
749 /* the stride goes past the end immediately) and failure to */
750 /* match (where you get nudged past the end one stride at a time). */
752 /* Here we make a "mickey mouse" BM table. The stride of the search */
753 /* is determined only by the last character of the putative match. */
754 /* If that character does not match, we will stride the proper */
755 /* distance to propose a match that superimposes it on the last */
756 /* instance of a character that matches it (per trt), or misses */
757 /* it entirely if there is none. */
759 dirlen
= len
* direction
;
760 infinity
= dirlen
- (lim
+ pos
+ len
+ len
) * direction
;
762 pat
= (base_pat
+= len
- 1);
763 BM_tab_base
= BM_tab
;
765 j
= dirlen
; /* to get it in a register */
766 /* A character that does not appear in the pattern induces a */
767 /* stride equal to the pattern length. */
768 while (BM_tab_base
!= BM_tab
)
776 while (i
!= infinity
)
778 j
= pat
[i
]; i
+= direction
;
779 if (i
== dirlen
) i
= infinity
;
784 stride_for_teases
= BM_tab
[j
];
785 BM_tab
[j
] = dirlen
- i
;
786 /* A translation table is accompanied by its inverse -- see */
787 /* comment following downcase_table for details */
788 while ((j
= inverse_trt
[j
]) != k
)
789 BM_tab
[j
] = dirlen
- i
;
794 stride_for_teases
= BM_tab
[j
];
795 BM_tab
[j
] = dirlen
- i
;
797 /* stride_for_teases tells how much to stride if we get a */
798 /* match on the far character but are subsequently */
799 /* disappointed, by recording what the stride would have been */
800 /* for that character if the last character had been */
803 infinity
= dirlen
- infinity
;
804 pos
+= dirlen
- ((direction
> 0) ? direction
: 0);
805 /* loop invariant - pos points at where last char (first char if reverse)
806 of pattern would align in a possible match. */
809 if ((lim
- pos
- (direction
> 0)) * direction
< 0)
810 return (n
* (0 - direction
));
811 /* First we do the part we can by pointers (maybe nothing) */
814 limit
= pos
- dirlen
+ direction
;
815 limit
= ((direction
> 0)
816 ? BUFFER_CEILING_OF (limit
)
817 : BUFFER_FLOOR_OF (limit
));
818 /* LIMIT is now the last (not beyond-last!) value
819 POS can take on without hitting edge of buffer or the gap. */
820 limit
= ((direction
> 0)
821 ? min (lim
- 1, min (limit
, pos
+ 20000))
822 : max (lim
, max (limit
, pos
- 20000)));
823 if ((limit
- pos
) * direction
> 20)
825 p_limit
= &FETCH_CHAR (limit
);
826 p2
= (cursor
= &FETCH_CHAR (pos
));
827 /* In this loop, pos + cursor - p2 is the surrogate for pos */
828 while (1) /* use one cursor setting as long as i can */
830 if (direction
> 0) /* worth duplicating */
832 /* Use signed comparison if appropriate
833 to make cursor+infinity sure to be > p_limit.
834 Assuming that the buffer lies in a range of addresses
835 that are all "positive" (as ints) or all "negative",
836 either kind of comparison will work as long
837 as we don't step by infinity. So pick the kind
838 that works when we do step by infinity. */
839 if ((int) (p_limit
+ infinity
) > (int) p_limit
)
840 while ((int) cursor
<= (int) p_limit
)
841 cursor
+= BM_tab
[*cursor
];
843 while ((unsigned int) cursor
<= (unsigned int) p_limit
)
844 cursor
+= BM_tab
[*cursor
];
848 if ((int) (p_limit
+ infinity
) < (int) p_limit
)
849 while ((int) cursor
>= (int) p_limit
)
850 cursor
+= BM_tab
[*cursor
];
852 while ((unsigned int) cursor
>= (unsigned int) p_limit
)
853 cursor
+= BM_tab
[*cursor
];
855 /* If you are here, cursor is beyond the end of the searched region. */
856 /* This can happen if you match on the far character of the pattern, */
857 /* because the "stride" of that character is infinity, a number able */
858 /* to throw you well beyond the end of the search. It can also */
859 /* happen if you fail to match within the permitted region and would */
860 /* otherwise try a character beyond that region */
861 if ((cursor
- p_limit
) * direction
<= len
)
862 break; /* a small overrun is genuine */
863 cursor
-= infinity
; /* large overrun = hit */
864 i
= dirlen
- direction
;
867 while ((i
-= direction
) + direction
!= 0)
868 if (pat
[i
] != trt
[*(cursor
-= direction
)])
873 while ((i
-= direction
) + direction
!= 0)
874 if (pat
[i
] != *(cursor
-= direction
))
877 cursor
+= dirlen
- i
- direction
; /* fix cursor */
878 if (i
+ direction
== 0)
882 /* Make sure we have registers in which to store
883 the match position. */
884 if (search_regs
.num_regs
== 0)
886 regoff_t
*starts
, *ends
;
889 (regoff_t
*) xmalloc (2 * sizeof (regoff_t
));
891 (regoff_t
*) xmalloc (2 * sizeof (regoff_t
));
893 re_set_registers (&searchbuf
,
900 = pos
+ cursor
- p2
+ ((direction
> 0)
902 search_regs
.end
[0] = len
+ search_regs
.start
[0];
903 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
904 if ((n
-= direction
) != 0)
905 cursor
+= dirlen
; /* to resume search */
907 return ((direction
> 0)
908 ? search_regs
.end
[0] : search_regs
.start
[0]);
911 cursor
+= stride_for_teases
; /* <sigh> we lose - */
916 /* Now we'll pick up a clump that has to be done the hard */
917 /* way because it covers a discontinuity */
919 limit
= ((direction
> 0)
920 ? BUFFER_CEILING_OF (pos
- dirlen
+ 1)
921 : BUFFER_FLOOR_OF (pos
- dirlen
- 1));
922 limit
= ((direction
> 0)
923 ? min (limit
+ len
, lim
- 1)
924 : max (limit
- len
, lim
));
925 /* LIMIT is now the last value POS can have
926 and still be valid for a possible match. */
929 /* This loop can be coded for space rather than */
930 /* speed because it will usually run only once. */
931 /* (the reach is at most len + 21, and typically */
932 /* does not exceed len) */
933 while ((limit
- pos
) * direction
>= 0)
934 pos
+= BM_tab
[FETCH_CHAR(pos
)];
935 /* now run the same tests to distinguish going off the */
936 /* end, a match or a phony match. */
937 if ((pos
- limit
) * direction
<= len
)
938 break; /* ran off the end */
939 /* Found what might be a match.
940 Set POS back to last (first if reverse) char pos. */
942 i
= dirlen
- direction
;
943 while ((i
-= direction
) + direction
!= 0)
946 if (pat
[i
] != (((int) trt
)
947 ? trt
[FETCH_CHAR(pos
)]
951 /* Above loop has moved POS part or all the way
952 back to the first char pos (last char pos if reverse).
953 Set it once again at the last (first if reverse) char. */
954 pos
+= dirlen
- i
- direction
;
955 if (i
+ direction
== 0)
959 /* Make sure we have registers in which to store
960 the match position. */
961 if (search_regs
.num_regs
== 0)
963 regoff_t
*starts
, *ends
;
966 (regoff_t
*) xmalloc (2 * sizeof (regoff_t
));
968 (regoff_t
*) xmalloc (2 * sizeof (regoff_t
));
970 re_set_registers (&searchbuf
,
977 = pos
+ ((direction
> 0) ? 1 - len
: 0);
978 search_regs
.end
[0] = len
+ search_regs
.start
[0];
979 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
980 if ((n
-= direction
) != 0)
981 pos
+= dirlen
; /* to resume search */
983 return ((direction
> 0)
984 ? search_regs
.end
[0] : search_regs
.start
[0]);
987 pos
+= stride_for_teases
;
990 /* We have done one clump. Can we continue? */
991 if ((lim
- pos
) * direction
< 0)
992 return ((0 - n
) * direction
);
998 /* Given a string of words separated by word delimiters,
999 compute a regexp that matches those exact words
1000 separated by arbitrary punctuation. */
1006 register unsigned char *p
, *o
;
1007 register int i
, len
, punct_count
= 0, word_count
= 0;
1010 CHECK_STRING (string
, 0);
1011 p
= XSTRING (string
)->data
;
1012 len
= XSTRING (string
)->size
;
1014 for (i
= 0; i
< len
; i
++)
1015 if (SYNTAX (p
[i
]) != Sword
)
1018 if (i
> 0 && SYNTAX (p
[i
-1]) == Sword
) word_count
++;
1020 if (SYNTAX (p
[len
-1]) == Sword
) word_count
++;
1021 if (!word_count
) return build_string ("");
1023 val
= make_string (p
, len
- punct_count
+ 5 * (word_count
- 1) + 4);
1025 o
= XSTRING (val
)->data
;
1029 for (i
= 0; i
< len
; i
++)
1030 if (SYNTAX (p
[i
]) == Sword
)
1032 else if (i
> 0 && SYNTAX (p
[i
-1]) == Sword
&& --word_count
)
1047 DEFUN ("search-backward", Fsearch_backward
, Ssearch_backward
, 1, 4,
1048 "sSearch backward: ",
1049 "Search backward from point for STRING.\n\
1050 Set point to the beginning of the occurrence found, and return point.\n\
1051 An optional second argument bounds the search; it is a buffer position.\n\
1052 The match found must not extend before that position.\n\
1053 Optional third argument, if t, means if fail just return nil (no error).\n\
1054 If not nil and not t, position at limit of search and return nil.\n\
1055 Optional fourth argument is repeat count--search for successive occurrences.\n\
1056 See also the functions `match-beginning', `match-end' and `replace-match'.")
1057 (string
, bound
, noerror
, count
)
1058 Lisp_Object string
, bound
, noerror
, count
;
1060 return search_command (string
, bound
, noerror
, count
, -1, 0);
1063 DEFUN ("search-forward", Fsearch_forward
, Ssearch_forward
, 1, 4, "sSearch: ",
1064 "Search forward from point for STRING.\n\
1065 Set point to the end of the occurrence found, and return point.\n\
1066 An optional second argument bounds the search; it is a buffer position.\n\
1067 The match found must not extend after that position. nil is equivalent\n\
1069 Optional third argument, if t, means if fail just return nil (no error).\n\
1070 If not nil and not t, move to limit of search and return nil.\n\
1071 Optional fourth argument is repeat count--search for successive occurrences.\n\
1072 See also the functions `match-beginning', `match-end' and `replace-match'.")
1073 (string
, bound
, noerror
, count
)
1074 Lisp_Object string
, bound
, noerror
, count
;
1076 return search_command (string
, bound
, noerror
, count
, 1, 0);
1079 DEFUN ("word-search-backward", Fword_search_backward
, Sword_search_backward
, 1, 4,
1080 "sWord search backward: ",
1081 "Search backward from point for STRING, ignoring differences in punctuation.\n\
1082 Set point to the beginning of the occurrence found, and return point.\n\
1083 An optional second argument bounds the search; it is a buffer position.\n\
1084 The match found must not extend before that position.\n\
1085 Optional third argument, if t, means if fail just return nil (no error).\n\
1086 If not nil and not t, move to limit of search and return nil.\n\
1087 Optional fourth argument is repeat count--search for successive occurrences.")
1088 (string
, bound
, noerror
, count
)
1089 Lisp_Object string
, bound
, noerror
, count
;
1091 return search_command (wordify (string
), bound
, noerror
, count
, -1, 1);
1094 DEFUN ("word-search-forward", Fword_search_forward
, Sword_search_forward
, 1, 4,
1096 "Search forward from point for STRING, ignoring differences in punctuation.\n\
1097 Set point to the end of the occurrence found, and return point.\n\
1098 An optional second argument bounds the search; it is a buffer position.\n\
1099 The match found must not extend after that position.\n\
1100 Optional third argument, if t, means if fail just return nil (no error).\n\
1101 If not nil and not t, move to limit of search and return nil.\n\
1102 Optional fourth argument is repeat count--search for successive occurrences.")
1103 (string
, bound
, noerror
, count
)
1104 Lisp_Object string
, bound
, noerror
, count
;
1106 return search_command (wordify (string
), bound
, noerror
, count
, 1, 1);
1109 DEFUN ("re-search-backward", Fre_search_backward
, Sre_search_backward
, 1, 4,
1110 "sRE search backward: ",
1111 "Search backward from point for match for regular expression REGEXP.\n\
1112 Set point to the beginning of the match, and return point.\n\
1113 The match found is the one starting last in the buffer\n\
1114 and yet ending before the place the origin of the search.\n\
1115 An optional second argument bounds the search; it is a buffer position.\n\
1116 The match found must start at or after that position.\n\
1117 Optional third argument, if t, means if fail just return nil (no error).\n\
1118 If not nil and not t, move to limit of search and return nil.\n\
1119 Optional fourth argument is repeat count--search for successive occurrences.\n\
1120 See also the functions `match-beginning', `match-end' and `replace-match'.")
1121 (string
, bound
, noerror
, count
)
1122 Lisp_Object string
, bound
, noerror
, count
;
1124 return search_command (string
, bound
, noerror
, count
, -1, 1);
1127 DEFUN ("re-search-forward", Fre_search_forward
, Sre_search_forward
, 1, 4,
1129 "Search forward from point for regular expression REGEXP.\n\
1130 Set point to the end of the occurrence found, and return point.\n\
1131 An optional second argument bounds the search; it is a buffer position.\n\
1132 The match found must not extend after that position.\n\
1133 Optional third argument, if t, means if fail just return nil (no error).\n\
1134 If not nil and not t, move to limit of search and return nil.\n\
1135 Optional fourth argument is repeat count--search for successive occurrences.\n\
1136 See also the functions `match-beginning', `match-end' and `replace-match'.")
1137 (string
, bound
, noerror
, count
)
1138 Lisp_Object string
, bound
, noerror
, count
;
1140 return search_command (string
, bound
, noerror
, count
, 1, 1);
1143 DEFUN ("replace-match", Freplace_match
, Sreplace_match
, 1, 3, 0,
1144 "Replace text matched by last search with NEWTEXT.\n\
1145 If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\
1146 Otherwise convert to all caps or cap initials, like replaced text.\n\
1147 If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\
1148 Otherwise treat `\\' as special:\n\
1149 `\\&' in NEWTEXT means substitute original matched text.\n\
1150 `\\N' means substitute what matched the Nth `\\(...\\)'.\n\
1151 If Nth parens didn't match, substitute nothing.\n\
1152 `\\\\' means insert one `\\'.\n\
1153 FIXEDCASE and LITERAL are optional arguments.\n\
1154 Leaves point at end of replacement text.")
1155 (string
, fixedcase
, literal
)
1156 Lisp_Object string
, fixedcase
, literal
;
1158 enum { nochange
, all_caps
, cap_initial
} case_action
;
1159 register int pos
, last
;
1160 int some_multiletter_word
;
1162 int some_uppercase_initial
;
1163 register int c
, prevc
;
1166 CHECK_STRING (string
, 0);
1168 case_action
= nochange
; /* We tried an initialization */
1169 /* but some C compilers blew it */
1171 if (search_regs
.num_regs
<= 0)
1172 error ("replace-match called before any match found");
1174 if (search_regs
.start
[0] < BEGV
1175 || search_regs
.start
[0] > search_regs
.end
[0]
1176 || search_regs
.end
[0] > ZV
)
1177 args_out_of_range (make_number (search_regs
.start
[0]),
1178 make_number (search_regs
.end
[0]));
1180 if (NILP (fixedcase
))
1182 /* Decide how to casify by examining the matched text. */
1184 last
= search_regs
.end
[0];
1186 case_action
= all_caps
;
1188 /* some_multiletter_word is set nonzero if any original word
1189 is more than one letter long. */
1190 some_multiletter_word
= 0;
1192 some_uppercase_initial
= 0;
1194 for (pos
= search_regs
.start
[0]; pos
< last
; pos
++)
1196 c
= FETCH_CHAR (pos
);
1199 /* Cannot be all caps if any original char is lower case */
1202 if (SYNTAX (prevc
) != Sword
)
1205 some_multiletter_word
= 1;
1207 else if (!NOCASEP (c
))
1209 if (SYNTAX (prevc
) != Sword
)
1210 some_uppercase_initial
= 1;
1212 some_multiletter_word
= 1;
1218 /* Convert to all caps if the old text is all caps
1219 and has at least one multiletter word. */
1220 if (! some_lowercase
&& some_multiletter_word
)
1221 case_action
= all_caps
;
1222 /* Capitalize each word, if the old text has a capitalized word. */
1223 else if (some_uppercase_initial
)
1224 case_action
= cap_initial
;
1226 case_action
= nochange
;
1229 /* We insert the replacement text before the old text, and then
1230 delete the original text. This means that markers at the
1231 beginning or end of the original will float to the corresponding
1232 position in the replacement. */
1233 SET_PT (search_regs
.start
[0]);
1234 if (!NILP (literal
))
1235 Finsert (1, &string
);
1238 struct gcpro gcpro1
;
1241 for (pos
= 0; pos
< XSTRING (string
)->size
; pos
++)
1243 int offset
= point
- search_regs
.start
[0];
1245 c
= XSTRING (string
)->data
[pos
];
1248 c
= XSTRING (string
)->data
[++pos
];
1250 Finsert_buffer_substring
1251 (Fcurrent_buffer (),
1252 make_number (search_regs
.start
[0] + offset
),
1253 make_number (search_regs
.end
[0] + offset
));
1254 else if (c
>= '1' && c
<= search_regs
.num_regs
+ '0')
1256 if (search_regs
.start
[c
- '0'] >= 1)
1257 Finsert_buffer_substring
1258 (Fcurrent_buffer (),
1259 make_number (search_regs
.start
[c
- '0'] + offset
),
1260 make_number (search_regs
.end
[c
- '0'] + offset
));
1271 inslen
= point
- (search_regs
.start
[0]);
1272 del_range (search_regs
.start
[0] + inslen
, search_regs
.end
[0] + inslen
);
1274 if (case_action
== all_caps
)
1275 Fupcase_region (make_number (point
- inslen
), make_number (point
));
1276 else if (case_action
== cap_initial
)
1277 upcase_initials_region (make_number (point
- inslen
), make_number (point
));
1282 match_limit (num
, beginningp
)
1288 CHECK_NUMBER (num
, 0);
1290 if (n
< 0 || n
>= search_regs
.num_regs
)
1291 args_out_of_range (num
, make_number (search_regs
.num_regs
));
1292 if (search_regs
.num_regs
<= 0
1293 || search_regs
.start
[n
] < 0)
1295 return (make_number ((beginningp
) ? search_regs
.start
[n
]
1296 : search_regs
.end
[n
]));
1299 DEFUN ("match-beginning", Fmatch_beginning
, Smatch_beginning
, 1, 1, 0,
1300 "Return position of start of text matched by last search.\n\
1301 ARG, a number, specifies which parenthesized expression in the last regexp.\n\
1302 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
1303 Zero means the entire text matched by the whole regexp or whole string.")
1307 return match_limit (num
, 1);
1310 DEFUN ("match-end", Fmatch_end
, Smatch_end
, 1, 1, 0,
1311 "Return position of end of text matched by last search.\n\
1312 ARG, a number, specifies which parenthesized expression in the last regexp.\n\
1313 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
1314 Zero means the entire text matched by the whole regexp or whole string.")
1318 return match_limit (num
, 0);
1321 DEFUN ("match-data", Fmatch_data
, Smatch_data
, 0, 0, 0,
1322 "Return a list containing all info on what the last search matched.\n\
1323 Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.\n\
1324 All the elements are markers or nil (nil if the Nth pair didn't match)\n\
1325 if the last match was on a buffer; integers or nil if a string was matched.\n\
1326 Use `store-match-data' to reinstate the data in this list.")
1332 if (NILP (last_thing_searched
))
1333 error ("match-data called before any match found");
1335 data
= (Lisp_Object
*) alloca ((2 * search_regs
.num_regs
)
1336 * sizeof (Lisp_Object
));
1339 for (i
= 0; i
< search_regs
.num_regs
; i
++)
1341 int start
= search_regs
.start
[i
];
1344 if (EQ (last_thing_searched
, Qt
))
1346 XFASTINT (data
[2 * i
]) = start
;
1347 XFASTINT (data
[2 * i
+ 1]) = search_regs
.end
[i
];
1349 else if (XTYPE (last_thing_searched
) == Lisp_Buffer
)
1351 data
[2 * i
] = Fmake_marker ();
1352 Fset_marker (data
[2 * i
],
1353 make_number (start
),
1354 last_thing_searched
);
1355 data
[2 * i
+ 1] = Fmake_marker ();
1356 Fset_marker (data
[2 * i
+ 1],
1357 make_number (search_regs
.end
[i
]),
1358 last_thing_searched
);
1361 /* last_thing_searched must always be Qt, a buffer, or Qnil. */
1367 data
[2 * i
] = data
[2 * i
+ 1] = Qnil
;
1369 return Flist (2 * len
+ 2, data
);
1373 DEFUN ("store-match-data", Fstore_match_data
, Sstore_match_data
, 1, 1, 0,
1374 "Set internal data on last search match from elements of LIST.\n\
1375 LIST should have been created by calling `match-data' previously.")
1377 register Lisp_Object list
;
1380 register Lisp_Object marker
;
1382 if (!CONSP (list
) && !NILP (list
))
1383 list
= wrong_type_argument (Qconsp
, list
);
1385 /* Unless we find a marker with a buffer in LIST, assume that this
1386 match data came from a string. */
1387 last_thing_searched
= Qt
;
1389 /* Allocate registers if they don't already exist. */
1391 int length
= XFASTINT (Flength (list
)) / 2;
1393 if (length
> search_regs
.num_regs
)
1395 if (search_regs
.num_regs
== 0)
1398 = (regoff_t
*) xmalloc (length
* sizeof (regoff_t
));
1400 = (regoff_t
*) xmalloc (length
* sizeof (regoff_t
));
1405 = (regoff_t
*) xrealloc (search_regs
.start
,
1406 length
* sizeof (regoff_t
));
1408 = (regoff_t
*) xrealloc (search_regs
.end
,
1409 length
* sizeof (regoff_t
));
1413 re_set_registers (&searchbuf
, &search_regs
, length
,
1414 search_regs
.start
, search_regs
.end
);
1419 for (i
= 0; i
< search_regs
.num_regs
; i
++)
1421 marker
= Fcar (list
);
1424 search_regs
.start
[i
] = -1;
1429 if (XTYPE (marker
) == Lisp_Marker
)
1431 if (XMARKER (marker
)->buffer
== 0)
1432 XFASTINT (marker
) = 0;
1434 XSET (last_thing_searched
, Lisp_Buffer
,
1435 XMARKER (marker
)->buffer
);
1438 CHECK_NUMBER_COERCE_MARKER (marker
, 0);
1439 search_regs
.start
[i
] = XINT (marker
);
1442 marker
= Fcar (list
);
1443 if (XTYPE (marker
) == Lisp_Marker
1444 && XMARKER (marker
)->buffer
== 0)
1445 XFASTINT (marker
) = 0;
1447 CHECK_NUMBER_COERCE_MARKER (marker
, 0);
1448 search_regs
.end
[i
] = XINT (marker
);
1456 /* Quote a string to inactivate reg-expr chars */
1458 DEFUN ("regexp-quote", Fregexp_quote
, Sregexp_quote
, 1, 1, 0,
1459 "Return a regexp string which matches exactly STRING and nothing else.")
1463 register unsigned char *in
, *out
, *end
;
1464 register unsigned char *temp
;
1466 CHECK_STRING (str
, 0);
1468 temp
= (unsigned char *) alloca (XSTRING (str
)->size
* 2);
1470 /* Now copy the data into the new string, inserting escapes. */
1472 in
= XSTRING (str
)->data
;
1473 end
= in
+ XSTRING (str
)->size
;
1476 for (; in
!= end
; in
++)
1478 if (*in
== '[' || *in
== ']'
1479 || *in
== '*' || *in
== '.' || *in
== '\\'
1480 || *in
== '?' || *in
== '+'
1481 || *in
== '^' || *in
== '$')
1486 return make_string (temp
, out
- temp
);
1493 searchbuf
.allocated
= 100;
1494 searchbuf
.buffer
= (unsigned char *) malloc (searchbuf
.allocated
);
1495 searchbuf
.fastmap
= search_fastmap
;
1497 Qsearch_failed
= intern ("search-failed");
1498 staticpro (&Qsearch_failed
);
1499 Qinvalid_regexp
= intern ("invalid-regexp");
1500 staticpro (&Qinvalid_regexp
);
1502 Fput (Qsearch_failed
, Qerror_conditions
,
1503 Fcons (Qsearch_failed
, Fcons (Qerror
, Qnil
)));
1504 Fput (Qsearch_failed
, Qerror_message
,
1505 build_string ("Search failed"));
1507 Fput (Qinvalid_regexp
, Qerror_conditions
,
1508 Fcons (Qinvalid_regexp
, Fcons (Qerror
, Qnil
)));
1509 Fput (Qinvalid_regexp
, Qerror_message
,
1510 build_string ("Invalid regexp"));
1513 staticpro (&last_regexp
);
1515 last_thing_searched
= Qnil
;
1516 staticpro (&last_thing_searched
);
1518 defsubr (&Sstring_match
);
1519 defsubr (&Slooking_at
);
1520 defsubr (&Sskip_chars_forward
);
1521 defsubr (&Sskip_chars_backward
);
1522 defsubr (&Sskip_syntax_forward
);
1523 defsubr (&Sskip_syntax_backward
);
1524 defsubr (&Ssearch_forward
);
1525 defsubr (&Ssearch_backward
);
1526 defsubr (&Sword_search_forward
);
1527 defsubr (&Sword_search_backward
);
1528 defsubr (&Sre_search_forward
);
1529 defsubr (&Sre_search_backward
);
1530 defsubr (&Sreplace_match
);
1531 defsubr (&Smatch_beginning
);
1532 defsubr (&Smatch_end
);
1533 defsubr (&Smatch_data
);
1534 defsubr (&Sstore_match_data
);
1535 defsubr (&Sregexp_quote
);