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. */
115 re_set_registers (bufp
, regp
, regp
->num_regs
, regp
->start
, regp
->end
);
120 /* Error condition used for failing searches */
121 Lisp_Object Qsearch_failed
;
127 Fsignal (Qsearch_failed
, Fcons (arg
, Qnil
));
131 DEFUN ("looking-at", Flooking_at
, Slooking_at
, 1, 1, 0,
132 "Return t if text after point matches regular expression PAT.\n\
133 This function modifies the match data that `match-beginning',\n\
134 `match-end' and `match-data' access; save and restore the match\n\
135 data if you want to preserve them.")
140 unsigned char *p1
, *p2
;
144 CHECK_STRING (string
, 0);
145 compile_pattern (string
, &searchbuf
, &search_regs
,
146 !NILP (current_buffer
->case_fold_search
) ? DOWNCASE_TABLE
: 0);
149 QUIT
; /* Do a pending quit right away, to avoid paradoxical behavior */
151 /* Get pointers and sizes of the two strings
152 that make up the visible portion of the buffer. */
170 i
= re_match_2 (&searchbuf
, (char *) p1
, s1
, (char *) p2
, s2
,
171 point
- BEGV
, &search_regs
,
176 val
= (0 <= i
? Qt
: Qnil
);
177 for (i
= 0; i
< search_regs
.num_regs
; i
++)
178 if (search_regs
.start
[i
] >= 0)
180 search_regs
.start
[i
] += BEGV
;
181 search_regs
.end
[i
] += BEGV
;
183 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
188 DEFUN ("string-match", Fstring_match
, Sstring_match
, 2, 3, 0,
189 "Return index of start of first match for REGEXP in STRING, or nil.\n\
190 If third arg START is non-nil, start search at that index in STRING.\n\
191 For index of first char beyond the match, do (match-end 0).\n\
192 `match-end' and `match-beginning' also give indices of substrings\n\
193 matched by parenthesis constructs in the pattern.")
194 (regexp
, string
, start
)
195 Lisp_Object regexp
, string
, start
;
200 CHECK_STRING (regexp
, 0);
201 CHECK_STRING (string
, 1);
207 int len
= XSTRING (string
)->size
;
209 CHECK_NUMBER (start
, 2);
211 if (s
< 0 && -s
<= len
)
213 else if (0 > s
|| s
> len
)
214 args_out_of_range (string
, start
);
217 compile_pattern (regexp
, &searchbuf
, &search_regs
,
218 !NILP (current_buffer
->case_fold_search
) ? DOWNCASE_TABLE
: 0);
220 val
= re_search (&searchbuf
, (char *) XSTRING (string
)->data
,
221 XSTRING (string
)->size
, s
, XSTRING (string
)->size
- s
,
224 last_thing_searched
= Qt
;
227 if (val
< 0) return Qnil
;
228 return make_number (val
);
231 /* Search for COUNT instances of the character TARGET, starting at START.
232 If COUNT is negative, search backwards.
234 If we find COUNT instances, set *SHORTAGE to zero, and return the
235 position of the COUNTth character.
237 If we don't find COUNT instances before reaching the end of the
238 buffer (or the beginning, if scanning backwards), set *SHORTAGE to
239 the number of TARGETs left unfound, and return the end of the
240 buffer we bumped up against. */
242 scan_buffer (target
, start
, count
, shortage
)
243 int *shortage
, start
;
244 register int count
, target
;
246 int limit
= ((count
> 0) ? ZV
- 1 : BEGV
);
247 int direction
= ((count
> 0) ? 1 : -1);
249 register unsigned char *cursor
;
252 register int ceiling
;
253 register unsigned char *ceiling_addr
;
261 while (start
!= limit
+ 1)
263 ceiling
= BUFFER_CEILING_OF (start
);
264 ceiling
= min (limit
, ceiling
);
265 ceiling_addr
= &FETCH_CHAR (ceiling
) + 1;
266 base
= (cursor
= &FETCH_CHAR (start
));
269 while (*cursor
!= target
&& ++cursor
!= ceiling_addr
)
271 if (cursor
!= ceiling_addr
)
276 return (start
+ cursor
- base
+ 1);
279 if (++cursor
== ceiling_addr
)
285 start
+= cursor
- base
;
289 start
--; /* first character we scan */
290 while (start
> limit
- 1)
291 { /* we WILL scan under start */
292 ceiling
= BUFFER_FLOOR_OF (start
);
293 ceiling
= max (limit
, ceiling
);
294 ceiling_addr
= &FETCH_CHAR (ceiling
) - 1;
295 base
= (cursor
= &FETCH_CHAR (start
));
299 while (--cursor
!= ceiling_addr
&& *cursor
!= target
)
301 if (cursor
!= ceiling_addr
)
306 return (start
+ cursor
- base
+ 1);
312 start
+= cursor
- base
;
317 *shortage
= count
* direction
;
318 return (start
+ ((direction
== 1 ? 0 : 1)));
322 find_next_newline (from
, cnt
)
323 register int from
, cnt
;
325 return (scan_buffer ('\n', from
, cnt
, (int *) 0));
328 DEFUN ("skip-chars-forward", Fskip_chars_forward
, Sskip_chars_forward
, 1, 2, 0,
329 "Move point forward, stopping before a char not in CHARS, or at position LIM.\n\
330 CHARS is like the inside of a `[...]' in a regular expression\n\
331 except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\
332 Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
333 With arg \"^a-zA-Z\", skips nonletters stopping before first letter.")
335 Lisp_Object string
, lim
;
337 skip_chars (1, string
, lim
);
341 DEFUN ("skip-chars-backward", Fskip_chars_backward
, Sskip_chars_backward
, 1, 2, 0,
342 "Move point backward, stopping after a char not in CHARS, or at position LIM.\n\
343 See `skip-chars-forward' for details.")
345 Lisp_Object string
, lim
;
347 skip_chars (0, string
, lim
);
351 skip_chars (forwardp
, string
, lim
)
353 Lisp_Object string
, lim
;
355 register unsigned char *p
, *pend
;
356 register unsigned char c
;
357 unsigned char fastmap
[0400];
361 CHECK_STRING (string
, 0);
364 XSET (lim
, Lisp_Int
, forwardp
? ZV
: BEGV
);
366 CHECK_NUMBER_COERCE_MARKER (lim
, 1);
368 #if 0 /* This breaks some things... jla. */
369 /* In any case, don't allow scan outside bounds of buffer. */
370 if (XFASTINT (lim
) > ZV
)
372 if (XFASTINT (lim
) < BEGV
)
373 XFASTINT (lim
) = BEGV
;
376 p
= XSTRING (string
)->data
;
377 pend
= p
+ XSTRING (string
)->size
;
378 bzero (fastmap
, sizeof fastmap
);
380 if (p
!= pend
&& *p
== '^')
385 /* Find the characters specified and set their elements of fastmap. */
392 if (p
== pend
) break;
395 if (p
!= pend
&& *p
== '-')
398 if (p
== pend
) break;
410 /* If ^ was the first character, complement the fastmap. */
413 for (i
= 0; i
< sizeof fastmap
; i
++)
419 while (point
< XINT (lim
) && fastmap
[FETCH_CHAR (point
)])
424 while (point
> XINT (lim
) && fastmap
[FETCH_CHAR (point
- 1)])
430 /* Subroutines of Lisp buffer search functions. */
433 search_command (string
, bound
, noerror
, count
, direction
, RE
)
434 Lisp_Object string
, bound
, noerror
, count
;
444 CHECK_NUMBER (count
, 3);
448 CHECK_STRING (string
, 0);
450 lim
= n
> 0 ? ZV
: BEGV
;
453 CHECK_NUMBER_COERCE_MARKER (bound
, 1);
455 if (n
> 0 ? lim
< point
: lim
> point
)
456 error ("Invalid search bound (wrong side of point)");
463 np
= search_buffer (string
, point
, lim
, n
, RE
,
464 (!NILP (current_buffer
->case_fold_search
)
465 ? XSTRING (current_buffer
->case_canon_table
)->data
: 0),
466 (!NILP (current_buffer
->case_fold_search
)
467 ? XSTRING (current_buffer
->case_eqv_table
)->data
: 0));
471 return signal_failure (string
);
472 if (!EQ (noerror
, Qt
))
474 if (lim
< BEGV
|| lim
> ZV
)
481 if (np
< BEGV
|| np
> ZV
)
486 return make_number (np
);
489 /* search for the n'th occurrence of STRING in the current buffer,
490 starting at position POS and stopping at position LIM,
491 treating PAT as a literal string if RE is false or as
492 a regular expression if RE is true.
494 If N is positive, searching is forward and LIM must be greater than POS.
495 If N is negative, searching is backward and LIM must be less than POS.
497 Returns -x if only N-x occurrences found (x > 0),
498 or else the position at the beginning of the Nth occurrence
499 (if searching backward) or the end (if searching forward). */
501 search_buffer (string
, pos
, lim
, n
, RE
, trt
, inverse_trt
)
507 register unsigned char *trt
;
508 register unsigned char *inverse_trt
;
510 int len
= XSTRING (string
)->size
;
511 unsigned char *base_pat
= XSTRING (string
)->data
;
512 register int *BM_tab
;
514 register int direction
= ((n
> 0) ? 1 : -1);
516 int infinity
, limit
, k
, stride_for_teases
;
517 register unsigned char *pat
, *cursor
, *p_limit
;
519 unsigned char *p1
, *p2
;
522 /* Null string is found at starting position. */
527 compile_pattern (string
, &searchbuf
, &search_regs
, (char *) trt
);
529 if (RE
/* Here we detect whether the */
530 /* generality of an RE search is */
532 /* first item is "exact match" */
533 && *(searchbuf
.buffer
) == (char) RE_EXACTN_VALUE
534 && searchbuf
.buffer
[1] + 2 == searchbuf
.used
) /*first is ONLY item */
536 RE
= 0; /* can do straight (non RE) search */
537 pat
= (base_pat
= (unsigned char *) searchbuf
.buffer
+ 2);
538 /* trt already applied */
539 len
= searchbuf
.used
- 2;
543 pat
= (unsigned char *) alloca (len
);
545 for (i
= len
; i
--;) /* Copy the pattern; apply trt */
546 *pat
++ = (((int) trt
) ? trt
[*base_pat
++] : *base_pat
++);
547 pat
-= len
; base_pat
= pat
;
552 immediate_quit
= 1; /* Quit immediately if user types ^G,
553 because letting this function finish
554 can take too long. */
555 QUIT
; /* Do a pending quit right away,
556 to avoid paradoxical behavior */
557 /* Get pointers and sizes of the two strings
558 that make up the visible portion of the buffer. */
577 int val
= re_search_2 (&searchbuf
, (char *) p1
, s1
, (char *) p2
, s2
,
578 pos
- BEGV
, lim
- pos
, &search_regs
,
579 /* Don't allow match past current point */
586 for (i
= 0; i
< search_regs
.num_regs
; i
++)
587 if (search_regs
.start
[i
] >= 0)
589 search_regs
.start
[i
] += j
;
590 search_regs
.end
[i
] += j
;
592 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
593 /* Set pos to the new position. */
594 pos
= search_regs
.start
[0];
605 int val
= re_search_2 (&searchbuf
, (char *) p1
, s1
, (char *) p2
, s2
,
606 pos
- BEGV
, lim
- pos
, &search_regs
,
613 for (i
= 0; i
< search_regs
.num_regs
; i
++)
614 if (search_regs
.start
[i
] >= 0)
616 search_regs
.start
[i
] += j
;
617 search_regs
.end
[i
] += j
;
619 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
620 pos
= search_regs
.end
[0];
632 else /* non-RE case */
635 int BM_tab_space
[0400];
636 BM_tab
= &BM_tab_space
[0];
638 BM_tab
= (int *) alloca (0400 * sizeof (int));
640 /* The general approach is that we are going to maintain that we know */
641 /* the first (closest to the present position, in whatever direction */
642 /* we're searching) character that could possibly be the last */
643 /* (furthest from present position) character of a valid match. We */
644 /* advance the state of our knowledge by looking at that character */
645 /* and seeing whether it indeed matches the last character of the */
646 /* pattern. If it does, we take a closer look. If it does not, we */
647 /* move our pointer (to putative last characters) as far as is */
648 /* logically possible. This amount of movement, which I call a */
649 /* stride, will be the length of the pattern if the actual character */
650 /* appears nowhere in the pattern, otherwise it will be the distance */
651 /* from the last occurrence of that character to the end of the */
653 /* As a coding trick, an enormous stride is coded into the table for */
654 /* characters that match the last character. This allows use of only */
655 /* a single test, a test for having gone past the end of the */
656 /* permissible match region, to test for both possible matches (when */
657 /* the stride goes past the end immediately) and failure to */
658 /* match (where you get nudged past the end one stride at a time). */
660 /* Here we make a "mickey mouse" BM table. The stride of the search */
661 /* is determined only by the last character of the putative match. */
662 /* If that character does not match, we will stride the proper */
663 /* distance to propose a match that superimposes it on the last */
664 /* instance of a character that matches it (per trt), or misses */
665 /* it entirely if there is none. */
667 dirlen
= len
* direction
;
668 infinity
= dirlen
- (lim
+ pos
+ len
+ len
) * direction
;
670 pat
= (base_pat
+= len
- 1);
671 BM_tab_base
= BM_tab
;
673 j
= dirlen
; /* to get it in a register */
674 /* A character that does not appear in the pattern induces a */
675 /* stride equal to the pattern length. */
676 while (BM_tab_base
!= BM_tab
)
684 while (i
!= infinity
)
686 j
= pat
[i
]; i
+= direction
;
687 if (i
== dirlen
) i
= infinity
;
692 stride_for_teases
= BM_tab
[j
];
693 BM_tab
[j
] = dirlen
- i
;
694 /* A translation table is accompanied by its inverse -- see */
695 /* comment following downcase_table for details */
696 while ((j
= inverse_trt
[j
]) != k
)
697 BM_tab
[j
] = dirlen
- i
;
702 stride_for_teases
= BM_tab
[j
];
703 BM_tab
[j
] = dirlen
- i
;
705 /* stride_for_teases tells how much to stride if we get a */
706 /* match on the far character but are subsequently */
707 /* disappointed, by recording what the stride would have been */
708 /* for that character if the last character had been */
711 infinity
= dirlen
- infinity
;
712 pos
+= dirlen
- ((direction
> 0) ? direction
: 0);
713 /* loop invariant - pos points at where last char (first char if reverse)
714 of pattern would align in a possible match. */
717 if ((lim
- pos
- (direction
> 0)) * direction
< 0)
718 return (n
* (0 - direction
));
719 /* First we do the part we can by pointers (maybe nothing) */
722 limit
= pos
- dirlen
+ direction
;
723 limit
= ((direction
> 0)
724 ? BUFFER_CEILING_OF (limit
)
725 : BUFFER_FLOOR_OF (limit
));
726 /* LIMIT is now the last (not beyond-last!) value
727 POS can take on without hitting edge of buffer or the gap. */
728 limit
= ((direction
> 0)
729 ? min (lim
- 1, min (limit
, pos
+ 20000))
730 : max (lim
, max (limit
, pos
- 20000)));
731 if ((limit
- pos
) * direction
> 20)
733 p_limit
= &FETCH_CHAR (limit
);
734 p2
= (cursor
= &FETCH_CHAR (pos
));
735 /* In this loop, pos + cursor - p2 is the surrogate for pos */
736 while (1) /* use one cursor setting as long as i can */
738 if (direction
> 0) /* worth duplicating */
740 /* Use signed comparison if appropriate
741 to make cursor+infinity sure to be > p_limit.
742 Assuming that the buffer lies in a range of addresses
743 that are all "positive" (as ints) or all "negative",
744 either kind of comparison will work as long
745 as we don't step by infinity. So pick the kind
746 that works when we do step by infinity. */
747 if ((int) (p_limit
+ infinity
) > (int) p_limit
)
748 while ((int) cursor
<= (int) p_limit
)
749 cursor
+= BM_tab
[*cursor
];
751 while ((unsigned int) cursor
<= (unsigned int) p_limit
)
752 cursor
+= BM_tab
[*cursor
];
756 if ((int) (p_limit
+ infinity
) < (int) p_limit
)
757 while ((int) cursor
>= (int) p_limit
)
758 cursor
+= BM_tab
[*cursor
];
760 while ((unsigned int) cursor
>= (unsigned int) p_limit
)
761 cursor
+= BM_tab
[*cursor
];
763 /* If you are here, cursor is beyond the end of the searched region. */
764 /* This can happen if you match on the far character of the pattern, */
765 /* because the "stride" of that character is infinity, a number able */
766 /* to throw you well beyond the end of the search. It can also */
767 /* happen if you fail to match within the permitted region and would */
768 /* otherwise try a character beyond that region */
769 if ((cursor
- p_limit
) * direction
<= len
)
770 break; /* a small overrun is genuine */
771 cursor
-= infinity
; /* large overrun = hit */
772 i
= dirlen
- direction
;
775 while ((i
-= direction
) + direction
!= 0)
776 if (pat
[i
] != trt
[*(cursor
-= direction
)])
781 while ((i
-= direction
) + direction
!= 0)
782 if (pat
[i
] != *(cursor
-= direction
))
785 cursor
+= dirlen
- i
- direction
; /* fix cursor */
786 if (i
+ direction
== 0)
790 /* Make sure we have registers in which to store
791 the match position. */
792 if (search_regs
.num_regs
== 0)
794 regoff_t
*starts
, *ends
;
797 (regoff_t
*) xmalloc (2 * sizeof (regoff_t
));
799 (regoff_t
*) xmalloc (2 * sizeof (regoff_t
));
800 re_set_registers (&searchbuf
,
806 = pos
+ cursor
- p2
+ ((direction
> 0)
808 search_regs
.end
[0] = len
+ search_regs
.start
[0];
809 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
810 if ((n
-= direction
) != 0)
811 cursor
+= dirlen
; /* to resume search */
813 return ((direction
> 0)
814 ? search_regs
.end
[0] : search_regs
.start
[0]);
817 cursor
+= stride_for_teases
; /* <sigh> we lose - */
822 /* Now we'll pick up a clump that has to be done the hard */
823 /* way because it covers a discontinuity */
825 limit
= ((direction
> 0)
826 ? BUFFER_CEILING_OF (pos
- dirlen
+ 1)
827 : BUFFER_FLOOR_OF (pos
- dirlen
- 1));
828 limit
= ((direction
> 0)
829 ? min (limit
+ len
, lim
- 1)
830 : max (limit
- len
, lim
));
831 /* LIMIT is now the last value POS can have
832 and still be valid for a possible match. */
835 /* This loop can be coded for space rather than */
836 /* speed because it will usually run only once. */
837 /* (the reach is at most len + 21, and typically */
838 /* does not exceed len) */
839 while ((limit
- pos
) * direction
>= 0)
840 pos
+= BM_tab
[FETCH_CHAR(pos
)];
841 /* now run the same tests to distinguish going off the */
842 /* end, a match or a phoney match. */
843 if ((pos
- limit
) * direction
<= len
)
844 break; /* ran off the end */
845 /* Found what might be a match.
846 Set POS back to last (first if reverse) char pos. */
848 i
= dirlen
- direction
;
849 while ((i
-= direction
) + direction
!= 0)
852 if (pat
[i
] != (((int) trt
)
853 ? trt
[FETCH_CHAR(pos
)]
857 /* Above loop has moved POS part or all the way
858 back to the first char pos (last char pos if reverse).
859 Set it once again at the last (first if reverse) char. */
860 pos
+= dirlen
- i
- direction
;
861 if (i
+ direction
== 0)
865 /* Make sure we have registers in which to store
866 the match position. */
867 if (search_regs
.num_regs
== 0)
869 regoff_t
*starts
, *ends
;
872 (regoff_t
*) xmalloc (2 * sizeof (regoff_t
));
874 (regoff_t
*) xmalloc (2 * sizeof (regoff_t
));
875 re_set_registers (&searchbuf
,
881 = pos
+ ((direction
> 0) ? 1 - len
: 0);
882 search_regs
.end
[0] = len
+ search_regs
.start
[0];
883 XSET (last_thing_searched
, Lisp_Buffer
, current_buffer
);
884 if ((n
-= direction
) != 0)
885 pos
+= dirlen
; /* to resume search */
887 return ((direction
> 0)
888 ? search_regs
.end
[0] : search_regs
.start
[0]);
891 pos
+= stride_for_teases
;
894 /* We have done one clump. Can we continue? */
895 if ((lim
- pos
) * direction
< 0)
896 return ((0 - n
) * direction
);
902 /* Given a string of words separated by word delimiters,
903 compute a regexp that matches those exact words
904 separated by arbitrary punctuation. */
910 register unsigned char *p
, *o
;
911 register int i
, len
, punct_count
= 0, word_count
= 0;
914 CHECK_STRING (string
, 0);
915 p
= XSTRING (string
)->data
;
916 len
= XSTRING (string
)->size
;
918 for (i
= 0; i
< len
; i
++)
919 if (SYNTAX (p
[i
]) != Sword
)
922 if (i
> 0 && SYNTAX (p
[i
-1]) == Sword
) word_count
++;
924 if (SYNTAX (p
[len
-1]) == Sword
) word_count
++;
925 if (!word_count
) return build_string ("");
927 val
= make_string (p
, len
- punct_count
+ 5 * (word_count
- 1) + 4);
929 o
= XSTRING (val
)->data
;
933 for (i
= 0; i
< len
; i
++)
934 if (SYNTAX (p
[i
]) == Sword
)
936 else if (i
> 0 && SYNTAX (p
[i
-1]) == Sword
&& --word_count
)
951 DEFUN ("search-backward", Fsearch_backward
, Ssearch_backward
, 1, 4,
952 "sSearch backward: ",
953 "Search backward from point for STRING.\n\
954 Set point to the beginning of the occurrence found, and return point.\n\
955 An optional second argument bounds the search; it is a buffer position.\n\
956 The match found must not extend before that position.\n\
957 Optional third argument, if t, means if fail just return nil (no error).\n\
958 If not nil and not t, position at limit of search and return nil.\n\
959 Optional fourth argument is repeat count--search for successive occurrences.\n\
960 See also the functions `match-beginning', `match-end' and `replace-match'.")
961 (string
, bound
, noerror
, count
)
962 Lisp_Object string
, bound
, noerror
, count
;
964 return search_command (string
, bound
, noerror
, count
, -1, 0);
967 DEFUN ("search-forward", Fsearch_forward
, Ssearch_forward
, 1, 4, "sSearch: ",
968 "Search forward from point for STRING.\n\
969 Set point to the end of the occurrence found, and return point.\n\
970 An optional second argument bounds the search; it is a buffer position.\n\
971 The match found must not extend after that position. nil is equivalent\n\
973 Optional third argument, if t, means if fail just return nil (no error).\n\
974 If not nil and not t, move to limit of search and return nil.\n\
975 Optional fourth argument is repeat count--search for successive occurrences.\n\
976 See also the functions `match-beginning', `match-end' and `replace-match'.")
977 (string
, bound
, noerror
, count
)
978 Lisp_Object string
, bound
, noerror
, count
;
980 return search_command (string
, bound
, noerror
, count
, 1, 0);
983 DEFUN ("word-search-backward", Fword_search_backward
, Sword_search_backward
, 1, 4,
984 "sWord search backward: ",
985 "Search backward from point for STRING, ignoring differences in punctuation.\n\
986 Set point to the beginning of the occurrence found, and return point.\n\
987 An optional second argument bounds the search; it is a buffer position.\n\
988 The match found must not extend before that position.\n\
989 Optional third argument, if t, means if fail just return nil (no error).\n\
990 If not nil and not t, move to limit of search and return nil.\n\
991 Optional fourth argument is repeat count--search for successive occurrences.")
992 (string
, bound
, noerror
, count
)
993 Lisp_Object string
, bound
, noerror
, count
;
995 return search_command (wordify (string
), bound
, noerror
, count
, -1, 1);
998 DEFUN ("word-search-forward", Fword_search_forward
, Sword_search_forward
, 1, 4,
1000 "Search forward from point for STRING, ignoring differences in punctuation.\n\
1001 Set point to the end of the occurrence found, and return point.\n\
1002 An optional second argument bounds the search; it is a buffer position.\n\
1003 The match found must not extend after that position.\n\
1004 Optional third argument, if t, means if fail just return nil (no error).\n\
1005 If not nil and not t, move to limit of search and return nil.\n\
1006 Optional fourth argument is repeat count--search for successive occurrences.")
1007 (string
, bound
, noerror
, count
)
1008 Lisp_Object string
, bound
, noerror
, count
;
1010 return search_command (wordify (string
), bound
, noerror
, count
, 1, 1);
1013 DEFUN ("re-search-backward", Fre_search_backward
, Sre_search_backward
, 1, 4,
1014 "sRE search backward: ",
1015 "Search backward from point for match for regular expression REGEXP.\n\
1016 Set point to the beginning of the match, and return point.\n\
1017 The match found is the one starting last in the buffer\n\
1018 and yet ending before the place the origin of the search.\n\
1019 An optional second argument bounds the search; it is a buffer position.\n\
1020 The match found must start at or after that position.\n\
1021 Optional third argument, if t, means if fail just return nil (no error).\n\
1022 If not nil and not t, move to limit of search and return nil.\n\
1023 Optional fourth argument is repeat count--search for successive occurrences.\n\
1024 See also the functions `match-beginning', `match-end' and `replace-match'.")
1025 (string
, bound
, noerror
, count
)
1026 Lisp_Object string
, bound
, noerror
, count
;
1028 return search_command (string
, bound
, noerror
, count
, -1, 1);
1031 DEFUN ("re-search-forward", Fre_search_forward
, Sre_search_forward
, 1, 4,
1033 "Search forward from point for regular expression REGEXP.\n\
1034 Set point to the end of the occurrence found, and return point.\n\
1035 An optional second argument bounds the search; it is a buffer position.\n\
1036 The match found must not extend after that position.\n\
1037 Optional third argument, if t, means if fail just return nil (no error).\n\
1038 If not nil and not t, move to limit of search and return nil.\n\
1039 Optional fourth argument is repeat count--search for successive occurrences.\n\
1040 See also the functions `match-beginning', `match-end' and `replace-match'.")
1041 (string
, bound
, noerror
, count
)
1042 Lisp_Object string
, bound
, noerror
, count
;
1044 return search_command (string
, bound
, noerror
, count
, 1, 1);
1047 DEFUN ("replace-match", Freplace_match
, Sreplace_match
, 1, 3, 0,
1048 "Replace text matched by last search with NEWTEXT.\n\
1049 If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\
1050 Otherwise convert to all caps or cap initials, like replaced text.\n\
1051 If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\
1052 Otherwise treat `\\' as special:\n\
1053 `\\&' in NEWTEXT means substitute original matched text.\n\
1054 `\\N' means substitute what matched the Nth `\\(...\\)'.\n\
1055 If Nth parens didn't match, substitute nothing.\n\
1056 `\\\\' means insert one `\\'.\n\
1057 FIXEDCASE and LITERAL are optional arguments.\n\
1058 Leaves point at end of replacement text.")
1059 (string
, fixedcase
, literal
)
1060 Lisp_Object string
, fixedcase
, literal
;
1062 enum { nochange
, all_caps
, cap_initial
} case_action
;
1063 register int pos
, last
;
1064 int some_multiletter_word
;
1065 int some_letter
= 0;
1066 register int c
, prevc
;
1069 CHECK_STRING (string
, 0);
1071 case_action
= nochange
; /* We tried an initialization */
1072 /* but some C compilers blew it */
1074 if (search_regs
.num_regs
<= 0)
1075 error ("replace-match called before any match found");
1077 if (search_regs
.start
[0] < BEGV
1078 || search_regs
.start
[0] > search_regs
.end
[0]
1079 || search_regs
.end
[0] > ZV
)
1080 args_out_of_range(make_number (search_regs
.start
[0]),
1081 make_number (search_regs
.end
[0]));
1083 if (NILP (fixedcase
))
1085 /* Decide how to casify by examining the matched text. */
1087 last
= search_regs
.end
[0];
1089 case_action
= all_caps
;
1091 /* some_multiletter_word is set nonzero if any original word
1092 is more than one letter long. */
1093 some_multiletter_word
= 0;
1095 for (pos
= search_regs
.start
[0]; pos
< last
; pos
++)
1097 c
= FETCH_CHAR (pos
);
1100 /* Cannot be all caps if any original char is lower case */
1102 case_action
= cap_initial
;
1103 if (SYNTAX (prevc
) != Sword
)
1105 /* Cannot even be cap initials
1106 if some original initial is lower case */
1107 case_action
= nochange
;
1111 some_multiletter_word
= 1;
1113 else if (!NOCASEP (c
))
1116 if (!some_multiletter_word
&& SYNTAX (prevc
) == Sword
)
1117 some_multiletter_word
= 1;
1123 /* Do not make new text all caps
1124 if the original text contained only single letter words. */
1125 if (case_action
== all_caps
&& !some_multiletter_word
)
1126 case_action
= cap_initial
;
1128 if (!some_letter
) case_action
= nochange
;
1131 SET_PT (search_regs
.end
[0]);
1132 if (!NILP (literal
))
1133 Finsert (1, &string
);
1136 struct gcpro gcpro1
;
1139 for (pos
= 0; pos
< XSTRING (string
)->size
; pos
++)
1141 c
= XSTRING (string
)->data
[pos
];
1144 c
= XSTRING (string
)->data
[++pos
];
1146 Finsert_buffer_substring (Fcurrent_buffer (),
1147 make_number (search_regs
.start
[0]),
1148 make_number (search_regs
.end
[0]));
1149 else if (c
>= '1' && c
<= search_regs
.num_regs
+ '0')
1151 if (search_regs
.start
[c
- '0'] >= 1)
1152 Finsert_buffer_substring (Fcurrent_buffer (),
1153 make_number (search_regs
.start
[c
- '0']),
1154 make_number (search_regs
.end
[c
- '0']));
1165 inslen
= point
- (search_regs
.end
[0]);
1166 del_range (search_regs
.start
[0], search_regs
.end
[0]);
1168 if (case_action
== all_caps
)
1169 Fupcase_region (make_number (point
- inslen
), make_number (point
));
1170 else if (case_action
== cap_initial
)
1171 upcase_initials_region (make_number (point
- inslen
), make_number (point
));
1176 match_limit (num
, beginningp
)
1182 CHECK_NUMBER (num
, 0);
1184 if (n
< 0 || n
>= search_regs
.num_regs
)
1185 args_out_of_range (num
, make_number (search_regs
.num_regs
));
1186 if (search_regs
.num_regs
<= 0
1187 || search_regs
.start
[n
] < 0)
1189 return (make_number ((beginningp
) ? search_regs
.start
[n
]
1190 : search_regs
.end
[n
]));
1193 DEFUN ("match-beginning", Fmatch_beginning
, Smatch_beginning
, 1, 1, 0,
1194 "Return position of start of text matched by last search.\n\
1195 ARG, a number, specifies which parenthesized expression in the last regexp.\n\
1196 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
1197 Zero means the entire text matched by the whole regexp or whole string.")
1201 return match_limit (num
, 1);
1204 DEFUN ("match-end", Fmatch_end
, Smatch_end
, 1, 1, 0,
1205 "Return position of end of text matched by last search.\n\
1206 ARG, a number, specifies which parenthesized expression in the last regexp.\n\
1207 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
1208 Zero means the entire text matched by the whole regexp or whole string.")
1212 return match_limit (num
, 0);
1215 DEFUN ("match-data", Fmatch_data
, Smatch_data
, 0, 0, 0,
1216 "Return a list containing all info on what the last search matched.\n\
1217 Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.\n\
1218 All the elements are markers or nil (nil if the Nth pair didn't match)\n\
1219 if the last match was on a buffer; integers or nil if a string was matched.\n\
1220 Use `store-match-data' to reinstate the data in this list.")
1226 if (NILP (last_thing_searched
))
1227 error ("match-data called before any match found");
1229 data
= (Lisp_Object
*) alloca ((2 * search_regs
.num_regs
)
1230 * sizeof (Lisp_Object
));
1233 for (i
= 0; i
< search_regs
.num_regs
; i
++)
1235 int start
= search_regs
.start
[i
];
1238 if (EQ (last_thing_searched
, Qt
))
1240 XFASTINT (data
[2 * i
]) = start
;
1241 XFASTINT (data
[2 * i
+ 1]) = search_regs
.end
[i
];
1243 else if (XTYPE (last_thing_searched
) == Lisp_Buffer
)
1245 data
[2 * i
] = Fmake_marker ();
1246 Fset_marker (data
[2 * i
],
1247 make_number (start
),
1248 last_thing_searched
);
1249 data
[2 * i
+ 1] = Fmake_marker ();
1250 Fset_marker (data
[2 * i
+ 1],
1251 make_number (search_regs
.end
[i
]),
1252 last_thing_searched
);
1255 /* last_thing_searched must always be Qt, a buffer, or Qnil. */
1261 data
[2 * i
] = data
[2 * i
+ 1] = Qnil
;
1263 return Flist (2 * len
+ 2, data
);
1267 DEFUN ("store-match-data", Fstore_match_data
, Sstore_match_data
, 1, 1, 0,
1268 "Set internal data on last search match from elements of LIST.\n\
1269 LIST should have been created by calling `match-data' previously.")
1271 register Lisp_Object list
;
1274 register Lisp_Object marker
;
1276 if (!CONSP (list
) && !NILP (list
))
1277 list
= wrong_type_argument (Qconsp
, list
, 0);
1279 /* Unless we find a marker with a buffer in LIST, assume that this
1280 match data came from a string. */
1281 last_thing_searched
= Qt
;
1283 /* Allocate registers if they don't already exist. */
1285 int length
= Flength (list
) / 2;
1287 if (length
> search_regs
.num_regs
)
1289 if (search_regs
.num_regs
== 0)
1292 = (regoff_t
*) xmalloc (length
* sizeof (regoff_t
));
1294 = (regoff_t
*) xmalloc (length
* sizeof (regoff_t
));
1299 = (regoff_t
*) xrealloc (search_regs
.start
,
1300 length
* sizeof (regoff_t
));
1302 = (regoff_t
*) xrealloc (search_regs
.end
,
1303 length
* sizeof (regoff_t
));
1306 re_set_registers (&searchbuf
, &search_regs
, length
,
1307 search_regs
.start
, search_regs
.end
);
1311 for (i
= 0; i
< search_regs
.num_regs
; i
++)
1313 marker
= Fcar (list
);
1316 search_regs
.start
[i
] = -1;
1321 if (XTYPE (marker
) == Lisp_Marker
)
1323 if (XMARKER (marker
)->buffer
== 0)
1324 XFASTINT (marker
) = 0;
1326 XSET (last_thing_searched
, Lisp_Buffer
,
1327 XMARKER (marker
)->buffer
);
1330 CHECK_NUMBER_COERCE_MARKER (marker
, 0);
1331 search_regs
.start
[i
] = XINT (marker
);
1334 marker
= Fcar (list
);
1335 if (XTYPE (marker
) == Lisp_Marker
1336 && XMARKER (marker
)->buffer
== 0)
1337 XFASTINT (marker
) = 0;
1339 CHECK_NUMBER_COERCE_MARKER (marker
, 0);
1340 search_regs
.end
[i
] = XINT (marker
);
1348 /* Quote a string to inactivate reg-expr chars */
1350 DEFUN ("regexp-quote", Fregexp_quote
, Sregexp_quote
, 1, 1, 0,
1351 "Return a regexp string which matches exactly STRING and nothing else.")
1355 register unsigned char *in
, *out
, *end
;
1356 register unsigned char *temp
;
1358 CHECK_STRING (str
, 0);
1360 temp
= (unsigned char *) alloca (XSTRING (str
)->size
* 2);
1362 /* Now copy the data into the new string, inserting escapes. */
1364 in
= XSTRING (str
)->data
;
1365 end
= in
+ XSTRING (str
)->size
;
1368 for (; in
!= end
; in
++)
1370 if (*in
== '[' || *in
== ']'
1371 || *in
== '*' || *in
== '.' || *in
== '\\'
1372 || *in
== '?' || *in
== '+'
1373 || *in
== '^' || *in
== '$')
1378 return make_string (temp
, out
- temp
);
1385 searchbuf
.allocated
= 100;
1386 searchbuf
.buffer
= (unsigned char *) malloc (searchbuf
.allocated
);
1387 searchbuf
.fastmap
= search_fastmap
;
1389 Qsearch_failed
= intern ("search-failed");
1390 staticpro (&Qsearch_failed
);
1391 Qinvalid_regexp
= intern ("invalid-regexp");
1392 staticpro (&Qinvalid_regexp
);
1394 Fput (Qsearch_failed
, Qerror_conditions
,
1395 Fcons (Qsearch_failed
, Fcons (Qerror
, Qnil
)));
1396 Fput (Qsearch_failed
, Qerror_message
,
1397 build_string ("Search failed"));
1399 Fput (Qinvalid_regexp
, Qerror_conditions
,
1400 Fcons (Qinvalid_regexp
, Fcons (Qerror
, Qnil
)));
1401 Fput (Qinvalid_regexp
, Qerror_message
,
1402 build_string ("Invalid regexp"));
1405 staticpro (&last_regexp
);
1407 last_thing_searched
= Qnil
;
1408 staticpro (&last_thing_searched
);
1410 defsubr (&Sstring_match
);
1411 defsubr (&Slooking_at
);
1412 defsubr (&Sskip_chars_forward
);
1413 defsubr (&Sskip_chars_backward
);
1414 defsubr (&Ssearch_forward
);
1415 defsubr (&Ssearch_backward
);
1416 defsubr (&Sword_search_forward
);
1417 defsubr (&Sword_search_backward
);
1418 defsubr (&Sre_search_forward
);
1419 defsubr (&Sre_search_backward
);
1420 defsubr (&Sreplace_match
);
1421 defsubr (&Smatch_beginning
);
1422 defsubr (&Smatch_end
);
1423 defsubr (&Smatch_data
);
1424 defsubr (&Sstore_match_data
);
1425 defsubr (&Sregexp_quote
);