1 /* String search routines for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1992 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. */
27 #include <sys/types.h>
30 #define max(a, b) ((a) > (b) ? (a) : (b))
31 #define min(a, b) ((a) < (b) ? (a) : (b))
33 /* We compile regexps into this buffer and then use it for searching. */
35 struct re_pattern_buffer searchbuf
;
37 char search_fastmap
[0400];
39 /* Last regexp we compiled */
41 Lisp_Object last_regexp
;
43 /* Every call to re_match, etc., must pass &search_regs as the regs
44 argument unless you can show it is unnecessary (i.e., if re_match
45 is certainly going to be called again before region-around-match
48 Since the registers are now dynamically allocated, we need to make
49 sure not to refer to the Nth register before checking that it has
50 been allocated by checking search_regs.num_regs.
52 The regex code keeps track of whether it has allocated the search
53 buffer using bits in searchbuf. This means that whenever you
54 compile a new pattern, it completely forgets whether it has
55 allocated any registers, and will allocate new registers the next
56 time you call a searching or matching function. Therefore, we need
57 to call re_set_registers after compiling a new pattern or after
58 setting the match registers, so that the regex functions will be
59 able to free or re-allocate it properly. */
60 static struct re_registers search_regs
;
62 /* The buffer in which the last search was performed, or
63 Qt if the last search was done in a string;
64 Qnil if no searching has been done yet. */
65 static Lisp_Object last_thing_searched
;
67 /* error condition signalled when regexp compile_pattern fails */
69 Lisp_Object Qinvalid_regexp
;
74 error ("Stack overflow in regexp matcher");
83 /* Compile a regexp and signal a Lisp error if anything goes wrong. */
85 compile_pattern (pattern
, bufp
, regp
, translate
)
87 struct re_pattern_buffer
*bufp
;
88 struct re_registers
*regp
;
94 if (EQ (pattern
, last_regexp
)
95 && translate
== bufp
->translate
)
99 bufp
->translate
= translate
;
100 val
= re_compile_pattern ((char *) XSTRING (pattern
)->data
,
101 XSTRING (pattern
)->size
,
105 dummy
= build_string (val
);
107 Fsignal (Qinvalid_regexp
, Fcons (dummy
, Qnil
));
110 last_regexp
= pattern
;
112 /* Advise the searching functions about the space we have allocated
113 for register data. */
114 re_set_registers (bufp
, regp
, regp
->num_regs
, regp
->start
, regp
->end
);
119 /* Error condition used for failing searches */
120 Lisp_Object Qsearch_failed
;
126 Fsignal (Qsearch_failed
, Fcons (arg
, Qnil
));
130 DEFUN ("looking-at", Flooking_at
, Slooking_at
, 1, 1, 0,
131 "Return t if text after point matches regular expression PAT.\n\
132 This function modifies the match data that `match-beginning',\n\
133 `match-end' and `match-data' access; save and restore the match\n\
134 data if you want to preserve them.")
139 unsigned char *p1
, *p2
;
143 CHECK_STRING (string
, 0);
144 compile_pattern (string
, &searchbuf
, &search_regs
,
145 !NILP (current_buffer
->case_fold_search
) ? DOWNCASE_TABLE
: 0);
148 QUIT
; /* Do a pending quit right away, to avoid paradoxical behavior */
150 /* Get pointers and sizes of the two strings
151 that make up the visible portion of the buffer. */
169 i
= re_match_2 (&searchbuf
, (char *) p1
, s1
, (char *) p2
, s2
,
170 point
- BEGV
, &search_regs
,
175 val
= (0 <= i
? Qt
: Qnil
);
176 for (i
= 0; i
< search_regs
.num_regs
; i
++)
177 if (search_regs
.start
[i
] >= 0)
179 search_regs
.start
[i
] += BEGV
;
180 search_regs
.end
[i
] += BEGV
;
182 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
187 DEFUN ("string-match", Fstring_match
, Sstring_match
, 2, 3, 0,
188 "Return index of start of first match for REGEXP in STRING, or nil.\n\
189 If third arg START is non-nil, start search at that index in STRING.\n\
190 For index of first char beyond the match, do (match-end 0).\n\
191 `match-end' and `match-beginning' also give indices of substrings\n\
192 matched by parenthesis constructs in the pattern.")
193 (regexp
, string
, start
)
194 Lisp_Object regexp
, string
, start
;
199 CHECK_STRING (regexp
, 0);
200 CHECK_STRING (string
, 1);
206 int len
= XSTRING (string
)->size
;
208 CHECK_NUMBER (start
, 2);
210 if (s
< 0 && -s
<= len
)
212 else if (0 > s
|| s
> len
)
213 args_out_of_range (string
, start
);
216 compile_pattern (regexp
, &searchbuf
, &search_regs
,
217 !NILP (current_buffer
->case_fold_search
) ? DOWNCASE_TABLE
: 0);
219 val
= re_search (&searchbuf
, (char *) XSTRING (string
)->data
,
220 XSTRING (string
)->size
, s
, XSTRING (string
)->size
- s
,
223 last_thing_searched
= Qt
;
226 if (val
< 0) return Qnil
;
227 return make_number (val
);
230 /* Search for COUNT instances of the character TARGET, starting at START.
231 If COUNT is negative, search backwards.
233 If we find COUNT instances, set *SHORTAGE to zero, and return the
234 position of the COUNTth character.
236 If we don't find COUNT instances before reaching the end of the
237 buffer (or the beginning, if scanning backwards), set *SHORTAGE to
238 the number of TARGETs left unfound, and return the end of the
239 buffer we bumped up against. */
241 scan_buffer (target
, start
, count
, shortage
)
242 int *shortage
, start
;
243 register int count
, target
;
245 int limit
= ((count
> 0) ? ZV
- 1 : BEGV
);
246 int direction
= ((count
> 0) ? 1 : -1);
248 register unsigned char *cursor
;
251 register int ceiling
;
252 register unsigned char *ceiling_addr
;
260 while (start
!= limit
+ 1)
262 ceiling
= BUFFER_CEILING_OF (start
);
263 ceiling
= min (limit
, ceiling
);
264 ceiling_addr
= &FETCH_CHAR (ceiling
) + 1;
265 base
= (cursor
= &FETCH_CHAR (start
));
268 while (*cursor
!= target
&& ++cursor
!= ceiling_addr
)
270 if (cursor
!= ceiling_addr
)
275 return (start
+ cursor
- base
+ 1);
278 if (++cursor
== ceiling_addr
)
284 start
+= cursor
- base
;
288 start
--; /* first character we scan */
289 while (start
> limit
- 1)
290 { /* we WILL scan under start */
291 ceiling
= BUFFER_FLOOR_OF (start
);
292 ceiling
= max (limit
, ceiling
);
293 ceiling_addr
= &FETCH_CHAR (ceiling
) - 1;
294 base
= (cursor
= &FETCH_CHAR (start
));
298 while (--cursor
!= ceiling_addr
&& *cursor
!= target
)
300 if (cursor
!= ceiling_addr
)
305 return (start
+ cursor
- base
+ 1);
311 start
+= cursor
- base
;
316 *shortage
= count
* direction
;
317 return (start
+ ((direction
== 1 ? 0 : 1)));
321 find_next_newline (from
, cnt
)
322 register int from
, cnt
;
324 return (scan_buffer ('\n', from
, cnt
, (int *) 0));
327 DEFUN ("skip-chars-forward", Fskip_chars_forward
, Sskip_chars_forward
, 1, 2, 0,
328 "Move point forward, stopping before a char not in CHARS, or at position LIM.\n\
329 CHARS is like the inside of a `[...]' in a regular expression\n\
330 except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\
331 Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
332 With arg \"^a-zA-Z\", skips nonletters stopping before first letter.")
334 Lisp_Object string
, lim
;
336 skip_chars (1, string
, lim
);
340 DEFUN ("skip-chars-backward", Fskip_chars_backward
, Sskip_chars_backward
, 1, 2, 0,
341 "Move point backward, stopping after a char not in CHARS, or at position LIM.\n\
342 See `skip-chars-forward' for details.")
344 Lisp_Object string
, lim
;
346 skip_chars (0, string
, lim
);
350 skip_chars (forwardp
, string
, lim
)
352 Lisp_Object string
, lim
;
354 register unsigned char *p
, *pend
;
355 register unsigned char c
;
356 unsigned char fastmap
[0400];
360 CHECK_STRING (string
, 0);
363 XSET (lim
, Lisp_Int
, forwardp
? ZV
: BEGV
);
365 CHECK_NUMBER_COERCE_MARKER (lim
, 1);
367 #if 0 /* This breaks some things... jla. */
368 /* In any case, don't allow scan outside bounds of buffer. */
369 if (XFASTINT (lim
) > ZV
)
371 if (XFASTINT (lim
) < BEGV
)
372 XFASTINT (lim
) = BEGV
;
375 p
= XSTRING (string
)->data
;
376 pend
= p
+ XSTRING (string
)->size
;
377 bzero (fastmap
, sizeof fastmap
);
379 if (p
!= pend
&& *p
== '^')
384 /* Find the characters specified and set their elements of fastmap. */
391 if (p
== pend
) break;
394 if (p
!= pend
&& *p
== '-')
397 if (p
== pend
) break;
409 /* If ^ was the first character, complement the fastmap. */
412 for (i
= 0; i
< sizeof fastmap
; i
++)
418 while (point
< XINT (lim
) && fastmap
[FETCH_CHAR (point
)])
423 while (point
> XINT (lim
) && fastmap
[FETCH_CHAR (point
- 1)])
429 /* Subroutines of Lisp buffer search functions. */
432 search_command (string
, bound
, noerror
, count
, direction
, RE
)
433 Lisp_Object string
, bound
, noerror
, count
;
443 CHECK_NUMBER (count
, 3);
447 CHECK_STRING (string
, 0);
449 lim
= n
> 0 ? ZV
: BEGV
;
452 CHECK_NUMBER_COERCE_MARKER (bound
, 1);
454 if (n
> 0 ? lim
< point
: lim
> point
)
455 error ("Invalid search bound (wrong side of point)");
462 np
= search_buffer (string
, point
, lim
, n
, RE
,
463 (!NILP (current_buffer
->case_fold_search
)
464 ? XSTRING (current_buffer
->case_canon_table
)->data
: 0),
465 (!NILP (current_buffer
->case_fold_search
)
466 ? XSTRING (current_buffer
->case_eqv_table
)->data
: 0));
470 return signal_failure (string
);
471 if (!EQ (noerror
, Qt
))
473 if (lim
< BEGV
|| lim
> ZV
)
480 if (np
< BEGV
|| np
> ZV
)
485 return make_number (np
);
488 /* search for the n'th occurrence of STRING in the current buffer,
489 starting at position POS and stopping at position LIM,
490 treating PAT as a literal string if RE is false or as
491 a regular expression if RE is true.
493 If N is positive, searching is forward and LIM must be greater than POS.
494 If N is negative, searching is backward and LIM must be less than POS.
496 Returns -x if only N-x occurrences found (x > 0),
497 or else the position at the beginning of the Nth occurrence
498 (if searching backward) or the end (if searching forward). */
500 search_buffer (string
, pos
, lim
, n
, RE
, trt
, inverse_trt
)
506 register unsigned char *trt
;
507 register unsigned char *inverse_trt
;
509 int len
= XSTRING (string
)->size
;
510 unsigned char *base_pat
= XSTRING (string
)->data
;
511 register int *BM_tab
;
513 register int direction
= ((n
> 0) ? 1 : -1);
515 int infinity
, limit
, k
, stride_for_teases
;
516 register unsigned char *pat
, *cursor
, *p_limit
;
518 unsigned char *p1
, *p2
;
521 /* Null string is found at starting position. */
526 compile_pattern (string
, &searchbuf
, &search_regs
, (char *) trt
);
528 if (RE
/* Here we detect whether the */
529 /* generality of an RE search is */
531 /* first item is "exact match" */
532 && *(searchbuf
.buffer
) == (char) RE_EXACTN_VALUE
533 && searchbuf
.buffer
[1] + 2 == searchbuf
.used
) /*first is ONLY item */
535 RE
= 0; /* can do straight (non RE) search */
536 pat
= (base_pat
= (unsigned char *) searchbuf
.buffer
+ 2);
537 /* trt already applied */
538 len
= searchbuf
.used
- 2;
542 pat
= (unsigned char *) alloca (len
);
544 for (i
= len
; i
--;) /* Copy the pattern; apply trt */
545 *pat
++ = (((int) trt
) ? trt
[*base_pat
++] : *base_pat
++);
546 pat
-= len
; base_pat
= pat
;
551 immediate_quit
= 1; /* Quit immediately if user types ^G,
552 because letting this function finish
553 can take too long. */
554 QUIT
; /* Do a pending quit right away,
555 to avoid paradoxical behavior */
556 /* Get pointers and sizes of the two strings
557 that make up the visible portion of the buffer. */
576 int val
= re_search_2 (&searchbuf
, (char *) p1
, s1
, (char *) p2
, s2
,
577 pos
- BEGV
, lim
- pos
, &search_regs
,
578 /* Don't allow match past current point */
585 for (i
= 0; i
< search_regs
.num_regs
; i
++)
586 if (search_regs
.start
[i
] >= 0)
588 search_regs
.start
[i
] += j
;
589 search_regs
.end
[i
] += j
;
591 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
592 /* Set pos to the new position. */
593 pos
= search_regs
.start
[0];
604 int val
= re_search_2 (&searchbuf
, (char *) p1
, s1
, (char *) p2
, s2
,
605 pos
- BEGV
, lim
- pos
, &search_regs
,
612 for (i
= 0; i
< search_regs
.num_regs
; i
++)
613 if (search_regs
.start
[i
] >= 0)
615 search_regs
.start
[i
] += j
;
616 search_regs
.end
[i
] += j
;
618 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
619 pos
= search_regs
.end
[0];
631 else /* non-RE case */
634 int BM_tab_space
[0400];
635 BM_tab
= &BM_tab_space
[0];
637 BM_tab
= (int *) alloca (0400 * sizeof (int));
639 /* The general approach is that we are going to maintain that we know */
640 /* the first (closest to the present position, in whatever direction */
641 /* we're searching) character that could possibly be the last */
642 /* (furthest from present position) character of a valid match. We */
643 /* advance the state of our knowledge by looking at that character */
644 /* and seeing whether it indeed matches the last character of the */
645 /* pattern. If it does, we take a closer look. If it does not, we */
646 /* move our pointer (to putative last characters) as far as is */
647 /* logically possible. This amount of movement, which I call a */
648 /* stride, will be the length of the pattern if the actual character */
649 /* appears nowhere in the pattern, otherwise it will be the distance */
650 /* from the last occurrence of that character to the end of the */
652 /* As a coding trick, an enormous stride is coded into the table for */
653 /* characters that match the last character. This allows use of only */
654 /* a single test, a test for having gone past the end of the */
655 /* permissible match region, to test for both possible matches (when */
656 /* the stride goes past the end immediately) and failure to */
657 /* match (where you get nudged past the end one stride at a time). */
659 /* Here we make a "mickey mouse" BM table. The stride of the search */
660 /* is determined only by the last character of the putative match. */
661 /* If that character does not match, we will stride the proper */
662 /* distance to propose a match that superimposes it on the last */
663 /* instance of a character that matches it (per trt), or misses */
664 /* it entirely if there is none. */
666 dirlen
= len
* direction
;
667 infinity
= dirlen
- (lim
+ pos
+ len
+ len
) * direction
;
669 pat
= (base_pat
+= len
- 1);
670 BM_tab_base
= BM_tab
;
672 j
= dirlen
; /* to get it in a register */
673 /* A character that does not appear in the pattern induces a */
674 /* stride equal to the pattern length. */
675 while (BM_tab_base
!= BM_tab
)
683 while (i
!= infinity
)
685 j
= pat
[i
]; i
+= direction
;
686 if (i
== dirlen
) i
= infinity
;
691 stride_for_teases
= BM_tab
[j
];
692 BM_tab
[j
] = dirlen
- i
;
693 /* A translation table is accompanied by its inverse -- see */
694 /* comment following downcase_table for details */
695 while ((j
= inverse_trt
[j
]) != k
)
696 BM_tab
[j
] = dirlen
- i
;
701 stride_for_teases
= BM_tab
[j
];
702 BM_tab
[j
] = dirlen
- i
;
704 /* stride_for_teases tells how much to stride if we get a */
705 /* match on the far character but are subsequently */
706 /* disappointed, by recording what the stride would have been */
707 /* for that character if the last character had been */
710 infinity
= dirlen
- infinity
;
711 pos
+= dirlen
- ((direction
> 0) ? direction
: 0);
712 /* loop invariant - pos points at where last char (first char if reverse)
713 of pattern would align in a possible match. */
716 if ((lim
- pos
- (direction
> 0)) * direction
< 0)
717 return (n
* (0 - direction
));
718 /* First we do the part we can by pointers (maybe nothing) */
721 limit
= pos
- dirlen
+ direction
;
722 limit
= ((direction
> 0)
723 ? BUFFER_CEILING_OF (limit
)
724 : BUFFER_FLOOR_OF (limit
));
725 /* LIMIT is now the last (not beyond-last!) value
726 POS can take on without hitting edge of buffer or the gap. */
727 limit
= ((direction
> 0)
728 ? min (lim
- 1, min (limit
, pos
+ 20000))
729 : max (lim
, max (limit
, pos
- 20000)));
730 if ((limit
- pos
) * direction
> 20)
732 p_limit
= &FETCH_CHAR (limit
);
733 p2
= (cursor
= &FETCH_CHAR (pos
));
734 /* In this loop, pos + cursor - p2 is the surrogate for pos */
735 while (1) /* use one cursor setting as long as i can */
737 if (direction
> 0) /* worth duplicating */
739 /* Use signed comparison if appropriate
740 to make cursor+infinity sure to be > p_limit.
741 Assuming that the buffer lies in a range of addresses
742 that are all "positive" (as ints) or all "negative",
743 either kind of comparison will work as long
744 as we don't step by infinity. So pick the kind
745 that works when we do step by infinity. */
746 if ((int) (p_limit
+ infinity
) > (int) p_limit
)
747 while ((int) cursor
<= (int) p_limit
)
748 cursor
+= BM_tab
[*cursor
];
750 while ((unsigned int) cursor
<= (unsigned int) p_limit
)
751 cursor
+= BM_tab
[*cursor
];
755 if ((int) (p_limit
+ infinity
) < (int) p_limit
)
756 while ((int) cursor
>= (int) p_limit
)
757 cursor
+= BM_tab
[*cursor
];
759 while ((unsigned int) cursor
>= (unsigned int) p_limit
)
760 cursor
+= BM_tab
[*cursor
];
762 /* If you are here, cursor is beyond the end of the searched region. */
763 /* This can happen if you match on the far character of the pattern, */
764 /* because the "stride" of that character is infinity, a number able */
765 /* to throw you well beyond the end of the search. It can also */
766 /* happen if you fail to match within the permitted region and would */
767 /* otherwise try a character beyond that region */
768 if ((cursor
- p_limit
) * direction
<= len
)
769 break; /* a small overrun is genuine */
770 cursor
-= infinity
; /* large overrun = hit */
771 i
= dirlen
- direction
;
774 while ((i
-= direction
) + direction
!= 0)
775 if (pat
[i
] != trt
[*(cursor
-= direction
)])
780 while ((i
-= direction
) + direction
!= 0)
781 if (pat
[i
] != *(cursor
-= direction
))
784 cursor
+= dirlen
- i
- direction
; /* fix cursor */
785 if (i
+ direction
== 0)
789 /* Make sure we have registers in which to store
790 the match position. */
791 if (search_regs
.num_regs
== 0)
793 regoff_t
*starts
, *ends
;
796 (regoff_t
*) xmalloc (2 * sizeof (regoff_t
));
798 (regoff_t
*) xmalloc (2 * sizeof (regoff_t
));
799 re_set_registers (&searchbuf
,
805 = pos
+ cursor
- p2
+ ((direction
> 0)
807 search_regs
.end
[0] = len
+ search_regs
.start
[0];
808 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
809 if ((n
-= direction
) != 0)
810 cursor
+= dirlen
; /* to resume search */
812 return ((direction
> 0)
813 ? search_regs
.end
[0] : search_regs
.start
[0]);
816 cursor
+= stride_for_teases
; /* <sigh> we lose - */
821 /* Now we'll pick up a clump that has to be done the hard */
822 /* way because it covers a discontinuity */
824 limit
= ((direction
> 0)
825 ? BUFFER_CEILING_OF (pos
- dirlen
+ 1)
826 : BUFFER_FLOOR_OF (pos
- dirlen
- 1));
827 limit
= ((direction
> 0)
828 ? min (limit
+ len
, lim
- 1)
829 : max (limit
- len
, lim
));
830 /* LIMIT is now the last value POS can have
831 and still be valid for a possible match. */
834 /* This loop can be coded for space rather than */
835 /* speed because it will usually run only once. */
836 /* (the reach is at most len + 21, and typically */
837 /* does not exceed len) */
838 while ((limit
- pos
) * direction
>= 0)
839 pos
+= BM_tab
[FETCH_CHAR(pos
)];
840 /* now run the same tests to distinguish going off the */
841 /* end, a match or a phoney match. */
842 if ((pos
- limit
) * direction
<= len
)
843 break; /* ran off the end */
844 /* Found what might be a match.
845 Set POS back to last (first if reverse) char pos. */
847 i
= dirlen
- direction
;
848 while ((i
-= direction
) + direction
!= 0)
851 if (pat
[i
] != (((int) trt
)
852 ? trt
[FETCH_CHAR(pos
)]
856 /* Above loop has moved POS part or all the way
857 back to the first char pos (last char pos if reverse).
858 Set it once again at the last (first if reverse) char. */
859 pos
+= dirlen
- i
- direction
;
860 if (i
+ direction
== 0)
864 /* Make sure we have registers in which to store
865 the match position. */
866 if (search_regs
.num_regs
== 0)
868 regoff_t
*starts
, *ends
;
871 (regoff_t
*) xmalloc (2 * sizeof (regoff_t
));
873 (regoff_t
*) xmalloc (2 * sizeof (regoff_t
));
874 re_set_registers (&searchbuf
,
880 = pos
+ ((direction
> 0) ? 1 - len
: 0);
881 search_regs
.end
[0] = len
+ search_regs
.start
[0];
882 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
883 if ((n
-= direction
) != 0)
884 pos
+= dirlen
; /* to resume search */
886 return ((direction
> 0)
887 ? search_regs
.end
[0] : search_regs
.start
[0]);
890 pos
+= stride_for_teases
;
893 /* We have done one clump. Can we continue? */
894 if ((lim
- pos
) * direction
< 0)
895 return ((0 - n
) * direction
);
901 /* Given a string of words separated by word delimiters,
902 compute a regexp that matches those exact words
903 separated by arbitrary punctuation. */
909 register unsigned char *p
, *o
;
910 register int i
, len
, punct_count
= 0, word_count
= 0;
913 CHECK_STRING (string
, 0);
914 p
= XSTRING (string
)->data
;
915 len
= XSTRING (string
)->size
;
917 for (i
= 0; i
< len
; i
++)
918 if (SYNTAX (p
[i
]) != Sword
)
921 if (i
> 0 && SYNTAX (p
[i
-1]) == Sword
) word_count
++;
923 if (SYNTAX (p
[len
-1]) == Sword
) word_count
++;
924 if (!word_count
) return build_string ("");
926 val
= make_string (p
, len
- punct_count
+ 5 * (word_count
- 1) + 4);
928 o
= XSTRING (val
)->data
;
932 for (i
= 0; i
< len
; i
++)
933 if (SYNTAX (p
[i
]) == Sword
)
935 else if (i
> 0 && SYNTAX (p
[i
-1]) == Sword
&& --word_count
)
950 DEFUN ("search-backward", Fsearch_backward
, Ssearch_backward
, 1, 4,
951 "sSearch backward: ",
952 "Search backward from point for STRING.\n\
953 Set point to the beginning of the occurrence found, and return point.\n\
954 An optional second argument bounds the search; it is a buffer position.\n\
955 The match found must not extend before that position.\n\
956 Optional third argument, if t, means if fail just return nil (no error).\n\
957 If not nil and not t, position at limit of search and return nil.\n\
958 Optional fourth argument is repeat count--search for successive occurrences.\n\
959 See also the functions `match-beginning', `match-end' and `replace-match'.")
960 (string
, bound
, noerror
, count
)
961 Lisp_Object string
, bound
, noerror
, count
;
963 return search_command (string
, bound
, noerror
, count
, -1, 0);
966 DEFUN ("search-forward", Fsearch_forward
, Ssearch_forward
, 1, 4, "sSearch: ",
967 "Search forward from point for STRING.\n\
968 Set point to the end of the occurrence found, and return point.\n\
969 An optional second argument bounds the search; it is a buffer position.\n\
970 The match found must not extend after that position. nil is equivalent\n\
972 Optional third argument, if t, means if fail just return nil (no error).\n\
973 If not nil and not t, move to limit of search and return nil.\n\
974 Optional fourth argument is repeat count--search for successive occurrences.\n\
975 See also the functions `match-beginning', `match-end' and `replace-match'.")
976 (string
, bound
, noerror
, count
)
977 Lisp_Object string
, bound
, noerror
, count
;
979 return search_command (string
, bound
, noerror
, count
, 1, 0);
982 DEFUN ("word-search-backward", Fword_search_backward
, Sword_search_backward
, 1, 4,
983 "sWord search backward: ",
984 "Search backward from point for STRING, ignoring differences in punctuation.\n\
985 Set point to the beginning of the occurrence found, and return point.\n\
986 An optional second argument bounds the search; it is a buffer position.\n\
987 The match found must not extend before that position.\n\
988 Optional third argument, if t, means if fail just return nil (no error).\n\
989 If not nil and not t, move to limit of search and return nil.\n\
990 Optional fourth argument is repeat count--search for successive occurrences.")
991 (string
, bound
, noerror
, count
)
992 Lisp_Object string
, bound
, noerror
, count
;
994 return search_command (wordify (string
), bound
, noerror
, count
, -1, 1);
997 DEFUN ("word-search-forward", Fword_search_forward
, Sword_search_forward
, 1, 4,
999 "Search forward from point for STRING, ignoring differences in punctuation.\n\
1000 Set point to the end of the occurrence found, and return point.\n\
1001 An optional second argument bounds the search; it is a buffer position.\n\
1002 The match found must not extend after that position.\n\
1003 Optional third argument, if t, means if fail just return nil (no error).\n\
1004 If not nil and not t, move to limit of search and return nil.\n\
1005 Optional fourth argument is repeat count--search for successive occurrences.")
1006 (string
, bound
, noerror
, count
)
1007 Lisp_Object string
, bound
, noerror
, count
;
1009 return search_command (wordify (string
), bound
, noerror
, count
, 1, 1);
1012 DEFUN ("re-search-backward", Fre_search_backward
, Sre_search_backward
, 1, 4,
1013 "sRE search backward: ",
1014 "Search backward from point for match for regular expression REGEXP.\n\
1015 Set point to the beginning of the match, and return point.\n\
1016 The match found is the one starting last in the buffer\n\
1017 and yet ending before the place the origin of the search.\n\
1018 An optional second argument bounds the search; it is a buffer position.\n\
1019 The match found must start at or after that position.\n\
1020 Optional third argument, if t, means if fail just return nil (no error).\n\
1021 If not nil and not t, move to limit of search and return nil.\n\
1022 Optional fourth argument is repeat count--search for successive occurrences.\n\
1023 See also the functions `match-beginning', `match-end' and `replace-match'.")
1024 (string
, bound
, noerror
, count
)
1025 Lisp_Object string
, bound
, noerror
, count
;
1027 return search_command (string
, bound
, noerror
, count
, -1, 1);
1030 DEFUN ("re-search-forward", Fre_search_forward
, Sre_search_forward
, 1, 4,
1032 "Search forward from point for regular expression REGEXP.\n\
1033 Set point to the end of the occurrence found, and return point.\n\
1034 An optional second argument bounds the search; it is a buffer position.\n\
1035 The match found must not extend after that position.\n\
1036 Optional third argument, if t, means if fail just return nil (no error).\n\
1037 If not nil and not t, move to limit of search and return nil.\n\
1038 Optional fourth argument is repeat count--search for successive occurrences.\n\
1039 See also the functions `match-beginning', `match-end' and `replace-match'.")
1040 (string
, bound
, noerror
, count
)
1041 Lisp_Object string
, bound
, noerror
, count
;
1043 return search_command (string
, bound
, noerror
, count
, 1, 1);
1046 DEFUN ("replace-match", Freplace_match
, Sreplace_match
, 1, 3, 0,
1047 "Replace text matched by last search with NEWTEXT.\n\
1048 If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\
1049 Otherwise convert to all caps or cap initials, like replaced text.\n\
1050 If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\
1051 Otherwise treat `\\' as special:\n\
1052 `\\&' in NEWTEXT means substitute original matched text.\n\
1053 `\\N' means substitute what matched the Nth `\\(...\\)'.\n\
1054 If Nth parens didn't match, substitute nothing.\n\
1055 `\\\\' means insert one `\\'.\n\
1056 FIXEDCASE and LITERAL are optional arguments.\n\
1057 Leaves point at end of replacement text.")
1058 (string
, fixedcase
, literal
)
1059 Lisp_Object string
, fixedcase
, literal
;
1061 enum { nochange
, all_caps
, cap_initial
} case_action
;
1062 register int pos
, last
;
1063 int some_multiletter_word
;
1064 int some_letter
= 0;
1065 register int c
, prevc
;
1068 CHECK_STRING (string
, 0);
1070 case_action
= nochange
; /* We tried an initialization */
1071 /* but some C compilers blew it */
1073 if (search_regs
.num_regs
<= 0)
1074 error ("replace-match called before any match found");
1076 if (search_regs
.start
[0] < BEGV
1077 || search_regs
.start
[0] > search_regs
.end
[0]
1078 || search_regs
.end
[0] > ZV
)
1079 args_out_of_range(make_number (search_regs
.start
[0]),
1080 make_number (search_regs
.end
[0]));
1082 if (NILP (fixedcase
))
1084 /* Decide how to casify by examining the matched text. */
1086 last
= search_regs
.end
[0];
1088 case_action
= all_caps
;
1090 /* some_multiletter_word is set nonzero if any original word
1091 is more than one letter long. */
1092 some_multiletter_word
= 0;
1094 for (pos
= search_regs
.start
[0]; pos
< last
; pos
++)
1096 c
= FETCH_CHAR (pos
);
1099 /* Cannot be all caps if any original char is lower case */
1101 case_action
= cap_initial
;
1102 if (SYNTAX (prevc
) != Sword
)
1104 /* Cannot even be cap initials
1105 if some original initial is lower case */
1106 case_action
= nochange
;
1110 some_multiletter_word
= 1;
1112 else if (!NOCASEP (c
))
1115 if (!some_multiletter_word
&& SYNTAX (prevc
) == Sword
)
1116 some_multiletter_word
= 1;
1122 /* Do not make new text all caps
1123 if the original text contained only single letter words. */
1124 if (case_action
== all_caps
&& !some_multiletter_word
)
1125 case_action
= cap_initial
;
1127 if (!some_letter
) case_action
= nochange
;
1130 SET_PT (search_regs
.end
[0]);
1131 if (!NILP (literal
))
1132 Finsert (1, &string
);
1135 struct gcpro gcpro1
;
1138 for (pos
= 0; pos
< XSTRING (string
)->size
; pos
++)
1140 c
= XSTRING (string
)->data
[pos
];
1143 c
= XSTRING (string
)->data
[++pos
];
1145 Finsert_buffer_substring (Fcurrent_buffer (),
1146 make_number (search_regs
.start
[0]),
1147 make_number (search_regs
.end
[0]));
1148 else if (c
>= '1' && c
<= search_regs
.num_regs
+ '0')
1150 if (search_regs
.start
[c
- '0'] >= 1)
1151 Finsert_buffer_substring (Fcurrent_buffer (),
1152 make_number (search_regs
.start
[c
- '0']),
1153 make_number (search_regs
.end
[c
- '0']));
1164 inslen
= point
- (search_regs
.end
[0]);
1165 del_range (search_regs
.start
[0], search_regs
.end
[0]);
1167 if (case_action
== all_caps
)
1168 Fupcase_region (make_number (point
- inslen
), make_number (point
));
1169 else if (case_action
== cap_initial
)
1170 upcase_initials_region (make_number (point
- inslen
), make_number (point
));
1175 match_limit (num
, beginningp
)
1181 CHECK_NUMBER (num
, 0);
1183 if (n
< 0 || n
>= search_regs
.num_regs
)
1184 args_out_of_range (num
, make_number (search_regs
.num_regs
));
1185 if (search_regs
.num_regs
<= 0
1186 || search_regs
.start
[n
] < 0)
1188 return (make_number ((beginningp
) ? search_regs
.start
[n
]
1189 : search_regs
.end
[n
]));
1192 DEFUN ("match-beginning", Fmatch_beginning
, Smatch_beginning
, 1, 1, 0,
1193 "Return position of start of text matched by last search.\n\
1194 ARG, a number, specifies which parenthesized expression in the last regexp.\n\
1195 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
1196 Zero means the entire text matched by the whole regexp or whole string.")
1200 return match_limit (num
, 1);
1203 DEFUN ("match-end", Fmatch_end
, Smatch_end
, 1, 1, 0,
1204 "Return position of end of text matched by last search.\n\
1205 ARG, a number, specifies which parenthesized expression in the last regexp.\n\
1206 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
1207 Zero means the entire text matched by the whole regexp or whole string.")
1211 return match_limit (num
, 0);
1214 DEFUN ("match-data", Fmatch_data
, Smatch_data
, 0, 0, 0,
1215 "Return a list containing all info on what the last search matched.\n\
1216 Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.\n\
1217 All the elements are markers or nil (nil if the Nth pair didn't match)\n\
1218 if the last match was on a buffer; integers or nil if a string was matched.\n\
1219 Use `store-match-data' to reinstate the data in this list.")
1225 if (NILP (last_thing_searched
))
1226 error ("match-data called before any match found");
1228 data
= (Lisp_Object
*) alloca ((2 * search_regs
.num_regs
)
1229 * sizeof (Lisp_Object
));
1232 for (i
= 0; i
< search_regs
.num_regs
; i
++)
1234 int start
= search_regs
.start
[i
];
1237 if (EQ (last_thing_searched
, Qt
))
1239 XFASTINT (data
[2 * i
]) = start
;
1240 XFASTINT (data
[2 * i
+ 1]) = search_regs
.end
[i
];
1242 else if (XTYPE (last_thing_searched
) == Lisp_Buffer
)
1244 data
[2 * i
] = Fmake_marker ();
1245 Fset_marker (data
[2 * i
],
1246 make_number (start
),
1247 last_thing_searched
);
1248 data
[2 * i
+ 1] = Fmake_marker ();
1249 Fset_marker (data
[2 * i
+ 1],
1250 make_number (search_regs
.end
[i
]),
1251 last_thing_searched
);
1254 /* last_thing_searched must always be Qt, a buffer, or Qnil. */
1260 data
[2 * i
] = data
[2 * i
+ 1] = Qnil
;
1262 return Flist (2 * len
+ 2, data
);
1266 DEFUN ("store-match-data", Fstore_match_data
, Sstore_match_data
, 1, 1, 0,
1267 "Set internal data on last search match from elements of LIST.\n\
1268 LIST should have been created by calling `match-data' previously.")
1270 register Lisp_Object list
;
1273 register Lisp_Object marker
;
1275 if (!CONSP (list
) && !NILP (list
))
1276 list
= wrong_type_argument (Qconsp
, list
, 0);
1278 /* Unless we find a marker with a buffer in LIST, assume that this
1279 match data came from a string. */
1280 last_thing_searched
= Qt
;
1282 /* Allocate registers if they don't already exist. */
1284 int length
= Flength (list
) / 2;
1286 if (length
> search_regs
.num_regs
)
1288 if (search_regs
.num_regs
== 0)
1291 = (regoff_t
*) xmalloc (length
* sizeof (regoff_t
));
1293 = (regoff_t
*) xmalloc (length
* sizeof (regoff_t
));
1298 = (regoff_t
*) xrealloc (search_regs
.start
,
1299 length
* sizeof (regoff_t
));
1301 = (regoff_t
*) xrealloc (search_regs
.end
,
1302 length
* sizeof (regoff_t
));
1305 re_set_registers (&searchbuf
, &search_regs
, length
,
1306 search_regs
.start
, search_regs
.end
);
1310 for (i
= 0; i
< search_regs
.num_regs
; i
++)
1312 marker
= Fcar (list
);
1315 search_regs
.start
[i
] = -1;
1320 if (XTYPE (marker
) == Lisp_Marker
)
1322 if (XMARKER (marker
)->buffer
== 0)
1323 XFASTINT (marker
) = 0;
1325 XSET (last_thing_searched
, Lisp_Buffer
,
1326 XMARKER (marker
)->buffer
);
1329 CHECK_NUMBER_COERCE_MARKER (marker
, 0);
1330 search_regs
.start
[i
] = XINT (marker
);
1333 marker
= Fcar (list
);
1334 if (XTYPE (marker
) == Lisp_Marker
1335 && XMARKER (marker
)->buffer
== 0)
1336 XFASTINT (marker
) = 0;
1338 CHECK_NUMBER_COERCE_MARKER (marker
, 0);
1339 search_regs
.end
[i
] = XINT (marker
);
1347 /* Quote a string to inactivate reg-expr chars */
1349 DEFUN ("regexp-quote", Fregexp_quote
, Sregexp_quote
, 1, 1, 0,
1350 "Return a regexp string which matches exactly STRING and nothing else.")
1354 register unsigned char *in
, *out
, *end
;
1355 register unsigned char *temp
;
1357 CHECK_STRING (str
, 0);
1359 temp
= (unsigned char *) alloca (XSTRING (str
)->size
* 2);
1361 /* Now copy the data into the new string, inserting escapes. */
1363 in
= XSTRING (str
)->data
;
1364 end
= in
+ XSTRING (str
)->size
;
1367 for (; in
!= end
; in
++)
1369 if (*in
== '[' || *in
== ']'
1370 || *in
== '*' || *in
== '.' || *in
== '\\'
1371 || *in
== '?' || *in
== '+'
1372 || *in
== '^' || *in
== '$')
1377 return make_string (temp
, out
- temp
);
1384 searchbuf
.allocated
= 100;
1385 searchbuf
.buffer
= (unsigned char *) malloc (searchbuf
.allocated
);
1386 searchbuf
.fastmap
= search_fastmap
;
1388 Qsearch_failed
= intern ("search-failed");
1389 staticpro (&Qsearch_failed
);
1390 Qinvalid_regexp
= intern ("invalid-regexp");
1391 staticpro (&Qinvalid_regexp
);
1393 Fput (Qsearch_failed
, Qerror_conditions
,
1394 Fcons (Qsearch_failed
, Fcons (Qerror
, Qnil
)));
1395 Fput (Qsearch_failed
, Qerror_message
,
1396 build_string ("Search failed"));
1398 Fput (Qinvalid_regexp
, Qerror_conditions
,
1399 Fcons (Qinvalid_regexp
, Fcons (Qerror
, Qnil
)));
1400 Fput (Qinvalid_regexp
, Qerror_message
,
1401 build_string ("Invalid regexp"));
1404 staticpro (&last_regexp
);
1406 last_thing_searched
= Qnil
;
1407 staticpro (&last_thing_searched
);
1409 defsubr (&Sstring_match
);
1410 defsubr (&Slooking_at
);
1411 defsubr (&Sskip_chars_forward
);
1412 defsubr (&Sskip_chars_backward
);
1413 defsubr (&Ssearch_forward
);
1414 defsubr (&Ssearch_backward
);
1415 defsubr (&Sword_search_forward
);
1416 defsubr (&Sword_search_backward
);
1417 defsubr (&Sre_search_forward
);
1418 defsubr (&Sre_search_backward
);
1419 defsubr (&Sreplace_match
);
1420 defsubr (&Smatch_beginning
);
1421 defsubr (&Smatch_end
);
1422 defsubr (&Smatch_data
);
1423 defsubr (&Sstore_match_data
);
1424 defsubr (&Sregexp_quote
);