/* String search routines for GNU Emacs.
- Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "syntax.h"
#include "buffer.h"
#include "commands.h"
+#include "blockinput.h"
#include <sys/types.h>
#include "regex.h"
Since the registers are now dynamically allocated, we need to make
sure not to refer to the Nth register before checking that it has
- been allocated. */
-
+ been allocated by checking search_regs.num_regs.
+
+ The regex code keeps track of whether it has allocated the search
+ buffer using bits in searchbuf. This means that whenever you
+ compile a new pattern, it completely forgets whether it has
+ allocated any registers, and will allocate new registers the next
+ time you call a searching or matching function. Therefore, we need
+ to call re_set_registers after compiling a new pattern or after
+ setting the match registers, so that the regex functions will be
+ able to free or re-allocate it properly. */
static struct re_registers search_regs;
-/* Nonzero if search_regs are indices in a string; 0 if in a buffer. */
-
-static int search_regs_from_string;
+/* The buffer in which the last search was performed, or
+ Qt if the last search was done in a string;
+ Qnil if no searching has been done yet. */
+static Lisp_Object last_thing_searched;
/* error condition signalled when regexp compile_pattern fails */
/* Compile a regexp and signal a Lisp error if anything goes wrong. */
-compile_pattern (pattern, bufp, translate)
+compile_pattern (pattern, bufp, regp, translate)
Lisp_Object pattern;
struct re_pattern_buffer *bufp;
+ struct re_registers *regp;
char *translate;
{
CONST char *val;
if (EQ (pattern, last_regexp)
&& translate == bufp->translate)
return;
+
last_regexp = Qnil;
bufp->translate = translate;
+ BLOCK_INPUT;
val = re_compile_pattern ((char *) XSTRING (pattern)->data,
XSTRING (pattern)->size,
bufp);
+ UNBLOCK_INPUT;
if (val)
{
dummy = build_string (val);
while (1)
Fsignal (Qinvalid_regexp, Fcons (dummy, Qnil));
}
+
last_regexp = pattern;
+
+ /* Advise the searching functions about the space we have allocated
+ for register data. */
+ BLOCK_INPUT;
+ if (regp)
+ re_set_registers (bufp, regp, regp->num_regs, regp->start, regp->end);
+ UNBLOCK_INPUT;
+
return;
}
register int i;
CHECK_STRING (string, 0);
- compile_pattern (string, &searchbuf,
+ compile_pattern (string, &searchbuf, &search_regs,
!NILP (current_buffer->case_fold_search) ? DOWNCASE_TABLE : 0);
immediate_quit = 1;
search_regs.start[i] += BEGV;
search_regs.end[i] += BEGV;
}
- search_regs_from_string = 0;
+ XSET (last_thing_searched, Lisp_Buffer, current_buffer);
immediate_quit = 0;
return val;
}
args_out_of_range (string, start);
}
- compile_pattern (regexp, &searchbuf,
+ compile_pattern (regexp, &searchbuf, &search_regs,
!NILP (current_buffer->case_fold_search) ? DOWNCASE_TABLE : 0);
immediate_quit = 1;
val = re_search (&searchbuf, (char *) XSTRING (string)->data,
XSTRING (string)->size, s, XSTRING (string)->size - s,
&search_regs);
immediate_quit = 0;
- search_regs_from_string = 1;
+ last_thing_searched = Qt;
if (val == -2)
matcher_overflow ();
if (val < 0) return Qnil;
return make_number (val);
}
+
+/* Match REGEXP against STRING, searching all of STRING,
+ and return the index of the match, or negative on failure.
+ This does not clobber the match data. */
+
+int
+fast_string_match (regexp, string)
+ Lisp_Object regexp, string;
+{
+ int val;
+
+ compile_pattern (regexp, &searchbuf, 0, 0);
+ immediate_quit = 1;
+ val = re_search (&searchbuf, (char *) XSTRING (string)->data,
+ XSTRING (string)->size, 0, XSTRING (string)->size,
+ 0);
+ immediate_quit = 0;
+ return val;
+}
\f
/* Search for COUNT instances of the character TARGET, starting at START.
If COUNT is negative, search backwards.
If we find COUNT instances, set *SHORTAGE to zero, and return the
- position of the COUNTth character.
+ position after the COUNTth match. Note that for reverse motion
+ this is not the same as the usual convention for Emacs motion commands.
If we don't find COUNT instances before reaching the end of the
buffer (or the beginning, if scanning backwards), set *SHORTAGE to
return (scan_buffer ('\n', from, cnt, (int *) 0));
}
\f
+Lisp_Object skip_chars ();
+
DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0,
"Move point forward, stopping before a char not in CHARS, or at position LIM.\n\
CHARS is like the inside of a `[...]' in a regular expression\n\
except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\
Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
-With arg \"^a-zA-Z\", skips nonletters stopping before first letter.")
+With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\
+Returns the distance traveled, either zero or positive.")
(string, lim)
Lisp_Object string, lim;
{
- skip_chars (1, string, lim);
- return Qnil;
+ return skip_chars (1, 0, string, lim);
}
DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
"Move point backward, stopping after a char not in CHARS, or at position LIM.\n\
-See `skip-chars-forward' for details.")
+See `skip-chars-forward' for details.\n\
+Returns the distance traveled, either zero or negative.")
(string, lim)
Lisp_Object string, lim;
{
- skip_chars (0, string, lim);
- return Qnil;
+ return skip_chars (0, 0, string, lim);
+}
+
+DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0,
+ "Move point forward across chars in specified syntax classes.\n\
+SYNTAX is a string of syntax code characters.\n\
+Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\
+If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
+This function returns the distance traveled, either zero or positive.")
+ (syntax, lim)
+ Lisp_Object syntax, lim;
+{
+ return skip_chars (1, 1, syntax, lim);
+}
+
+DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0,
+ "Move point backward across chars in specified syntax classes.\n\
+SYNTAX is a string of syntax code characters.\n\
+Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\
+If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\
+This function returns the distance traveled, either zero or negative.")
+ (syntax, lim)
+ Lisp_Object syntax, lim;
+{
+ return skip_chars (0, 1, syntax, lim);
}
-skip_chars (forwardp, string, lim)
- int forwardp;
+Lisp_Object
+skip_chars (forwardp, syntaxp, string, lim)
+ int forwardp, syntaxp;
Lisp_Object string, lim;
{
register unsigned char *p, *pend;
negate = 1; p++;
}
- /* Find the characters specified and set their elements of fastmap. */
+ /* Find the characters specified and set their elements of fastmap.
+ If syntaxp, each character counts as itself.
+ Otherwise, handle backslashes and ranges specially */
while (p != pend)
{
c = *p++;
- if (c == '\\')
- {
- if (p == pend) break;
- c = *p++;
- }
- if (p != pend && *p == '-')
+ if (syntaxp)
+ fastmap[c] = 1;
+ else
{
- p++;
- if (p == pend) break;
- while (c <= *p)
+ if (c == '\\')
+ {
+ if (p == pend) break;
+ c = *p++;
+ }
+ if (p != pend && *p == '-')
{
- fastmap[c] = 1;
- c++;
+ p++;
+ if (p == pend) break;
+ while (c <= *p)
+ {
+ fastmap[c] = 1;
+ c++;
+ }
+ p++;
}
- p++;
+ else
+ fastmap[c] = 1;
}
- else
- fastmap[c] = 1;
}
/* If ^ was the first character, complement the fastmap. */
for (i = 0; i < sizeof fastmap; i++)
fastmap[i] ^= 1;
- immediate_quit = 1;
- if (forwardp)
- {
- while (point < XINT (lim) && fastmap[FETCH_CHAR (point)])
- SET_PT (point + 1);
- }
- else
- {
- while (point > XINT (lim) && fastmap[FETCH_CHAR (point - 1)])
- SET_PT (point - 1);
- }
- immediate_quit = 0;
+ {
+ int start_point = point;
+
+ immediate_quit = 1;
+ if (syntaxp)
+ {
+
+ if (forwardp)
+ {
+ while (point < XINT (lim)
+ && fastmap[(unsigned char) syntax_code_spec[(int) SYNTAX (FETCH_CHAR (point))]])
+ SET_PT (point + 1);
+ }
+ else
+ {
+ while (point > XINT (lim)
+ && fastmap[(unsigned char) syntax_code_spec[(int) SYNTAX (FETCH_CHAR (point - 1))]])
+ SET_PT (point - 1);
+ }
+ }
+ else
+ {
+ if (forwardp)
+ {
+ while (point < XINT (lim) && fastmap[FETCH_CHAR (point)])
+ SET_PT (point + 1);
+ }
+ else
+ {
+ while (point > XINT (lim) && fastmap[FETCH_CHAR (point - 1)])
+ SET_PT (point - 1);
+ }
+ }
+ immediate_quit = 0;
+
+ return make_number (point - start_point);
+ }
}
\f
/* Subroutines of Lisp buffer search functions. */
if (lim < BEGV || lim > ZV)
abort ();
SET_PT (lim);
+ return Qnil;
+#if 0 /* This would be clean, but maybe programs depend on
+ a value of nil here. */
+ np = lim;
+#endif
}
- return Qnil;
+ else
+ return Qnil;
}
if (np < BEGV || np > ZV)
return pos;
if (RE)
- compile_pattern (string, &searchbuf, (char *) trt);
+ compile_pattern (string, &searchbuf, &search_regs, (char *) trt);
if (RE /* Here we detect whether the */
/* generality of an RE search is */
}
while (n < 0)
{
- int val = re_search_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2,
- pos - BEGV, lim - pos, &search_regs,
- /* Don't allow match past current point */
- pos - BEGV);
+ int val;
+ val = re_search_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2,
+ pos - BEGV, lim - pos, &search_regs,
+ /* Don't allow match past current point */
+ pos - BEGV);
if (val == -2)
matcher_overflow ();
if (val >= 0)
search_regs.start[i] += j;
search_regs.end[i] += j;
}
- search_regs_from_string = 0;
+ XSET (last_thing_searched, Lisp_Buffer, current_buffer);
/* Set pos to the new position. */
pos = search_regs.start[0];
}
}
while (n > 0)
{
- int val = re_search_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2,
- pos - BEGV, lim - pos, &search_regs,
- lim - BEGV);
+ int val;
+ val = re_search_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2,
+ pos - BEGV, lim - pos, &search_regs,
+ lim - BEGV);
if (val == -2)
matcher_overflow ();
if (val >= 0)
search_regs.start[i] += j;
search_regs.end[i] += j;
}
- search_regs_from_string = 0;
+ XSET (last_thing_searched, Lisp_Buffer, current_buffer);
pos = search_regs.end[0];
}
else
if (i + direction == 0)
{
cursor -= direction;
+
+ /* Make sure we have registers in which to store
+ the match position. */
+ if (search_regs.num_regs == 0)
+ {
+ regoff_t *starts, *ends;
+
+ starts =
+ (regoff_t *) xmalloc (2 * sizeof (regoff_t));
+ ends =
+ (regoff_t *) xmalloc (2 * sizeof (regoff_t));
+ BLOCK_INPUT;
+ re_set_registers (&searchbuf,
+ &search_regs,
+ 2, starts, ends);
+ UNBLOCK_INPUT;
+ }
+
search_regs.start[0]
= pos + cursor - p2 + ((direction > 0)
? 1 - len : 0);
search_regs.end[0] = len + search_regs.start[0];
- search_regs_from_string = 0;
+ XSET (last_thing_searched, Lisp_Buffer, current_buffer);
if ((n -= direction) != 0)
cursor += dirlen; /* to resume search */
else
while ((limit - pos) * direction >= 0)
pos += BM_tab[FETCH_CHAR(pos)];
/* now run the same tests to distinguish going off the */
- /* end, a match or a phoney match. */
+ /* end, a match or a phony match. */
if ((pos - limit) * direction <= len)
break; /* ran off the end */
/* Found what might be a match.
if (i + direction == 0)
{
pos -= direction;
+
+ /* Make sure we have registers in which to store
+ the match position. */
+ if (search_regs.num_regs == 0)
+ {
+ regoff_t *starts, *ends;
+
+ starts =
+ (regoff_t *) xmalloc (2 * sizeof (regoff_t));
+ ends =
+ (regoff_t *) xmalloc (2 * sizeof (regoff_t));
+ BLOCK_INPUT;
+ re_set_registers (&searchbuf,
+ &search_regs,
+ 2, starts, ends);
+ UNBLOCK_INPUT;
+ }
+
search_regs.start[0]
= pos + ((direction > 0) ? 1 - len : 0);
search_regs.end[0] = len + search_regs.start[0];
- search_regs_from_string = 0;
+ XSET (last_thing_searched, Lisp_Buffer, current_buffer);
if ((n -= direction) != 0)
pos += dirlen; /* to resume search */
else
`\\N' means substitute what matched the Nth `\\(...\\)'.\n\
If Nth parens didn't match, substitute nothing.\n\
`\\\\' means insert one `\\'.\n\
+FIXEDCASE and LITERAL are optional arguments.\n\
Leaves point at end of replacement text.")
(string, fixedcase, literal)
Lisp_Object string, fixedcase, literal;
enum { nochange, all_caps, cap_initial } case_action;
register int pos, last;
int some_multiletter_word;
- int some_letter = 0;
+ int some_lowercase;
+ int some_uppercase_initial;
register int c, prevc;
int inslen;
if (search_regs.start[0] < BEGV
|| search_regs.start[0] > search_regs.end[0]
|| search_regs.end[0] > ZV)
- args_out_of_range(make_number (search_regs.start[0]),
- make_number (search_regs.end[0]));
+ args_out_of_range (make_number (search_regs.start[0]),
+ make_number (search_regs.end[0]));
if (NILP (fixedcase))
{
/* some_multiletter_word is set nonzero if any original word
is more than one letter long. */
some_multiletter_word = 0;
+ some_lowercase = 0;
+ some_uppercase_initial = 0;
for (pos = search_regs.start[0]; pos < last; pos++)
{
{
/* Cannot be all caps if any original char is lower case */
- case_action = cap_initial;
+ some_lowercase = 1;
if (SYNTAX (prevc) != Sword)
- {
- /* Cannot even be cap initials
- if some original initial is lower case */
- case_action = nochange;
- break;
- }
+ ;
else
some_multiletter_word = 1;
}
else if (!NOCASEP (c))
{
- some_letter = 1;
- if (!some_multiletter_word && SYNTAX (prevc) == Sword)
+ if (SYNTAX (prevc) != Sword)
+ some_uppercase_initial = 1;
+ else
some_multiletter_word = 1;
}
prevc = c;
}
- /* Do not make new text all caps
- if the original text contained only single letter words. */
- if (case_action == all_caps && !some_multiletter_word)
+ /* Convert to all caps if the old text is all caps
+ and has at least one multiletter word. */
+ if (! some_lowercase && some_multiletter_word)
+ case_action = all_caps;
+ /* Capitalize each word, if the old text has a capitalized word. */
+ else if (some_uppercase_initial)
case_action = cap_initial;
-
- if (!some_letter) case_action = nochange;
+ else
+ case_action = nochange;
}
- SET_PT (search_regs.end[0]);
+ /* We insert the replacement text before the old text, and then
+ delete the original text. This means that markers at the
+ beginning or end of the original will float to the corresponding
+ position in the replacement. */
+ SET_PT (search_regs.start[0]);
if (!NILP (literal))
Finsert (1, &string);
else
for (pos = 0; pos < XSTRING (string)->size; pos++)
{
+ int offset = point - search_regs.start[0];
+
c = XSTRING (string)->data[pos];
if (c == '\\')
{
c = XSTRING (string)->data[++pos];
if (c == '&')
- Finsert_buffer_substring (Fcurrent_buffer (),
- make_number (search_regs.start[0]),
- make_number (search_regs.end[0]));
+ Finsert_buffer_substring
+ (Fcurrent_buffer (),
+ make_number (search_regs.start[0] + offset),
+ make_number (search_regs.end[0] + offset));
else if (c >= '1' && c <= search_regs.num_regs + '0')
{
if (search_regs.start[c - '0'] >= 1)
- Finsert_buffer_substring (Fcurrent_buffer (),
- make_number (search_regs.start[c - '0']),
- make_number (search_regs.end[c - '0']));
+ Finsert_buffer_substring
+ (Fcurrent_buffer (),
+ make_number (search_regs.start[c - '0'] + offset),
+ make_number (search_regs.end[c - '0'] + offset));
}
else
insert_char (c);
UNGCPRO;
}
- inslen = point - (search_regs.end[0]);
- del_range (search_regs.start[0], search_regs.end[0]);
+ inslen = point - (search_regs.start[0]);
+ del_range (search_regs.start[0] + inslen, search_regs.end[0] + inslen);
if (case_action == all_caps)
Fupcase_region (make_number (point - inslen), make_number (point));
Lisp_Object *data;
int i, len;
+ if (NILP (last_thing_searched))
+ error ("match-data called before any match found");
+
data = (Lisp_Object *) alloca ((2 * search_regs.num_regs)
* sizeof (Lisp_Object));
int start = search_regs.start[i];
if (start >= 0)
{
- if (search_regs_from_string)
+ if (EQ (last_thing_searched, Qt))
{
XFASTINT (data[2 * i]) = start;
XFASTINT (data[2 * i + 1]) = search_regs.end[i];
}
- else
+ else if (XTYPE (last_thing_searched) == Lisp_Buffer)
{
data[2 * i] = Fmake_marker ();
- Fset_marker (data[2 * i], make_number (start), Qnil);
+ Fset_marker (data[2 * i],
+ make_number (start),
+ last_thing_searched);
data[2 * i + 1] = Fmake_marker ();
Fset_marker (data[2 * i + 1],
- make_number (search_regs.end[i]), Qnil);
+ make_number (search_regs.end[i]),
+ last_thing_searched);
}
+ else
+ /* last_thing_searched must always be Qt, a buffer, or Qnil. */
+ abort ();
+
len = i;
}
else
register Lisp_Object marker;
if (!CONSP (list) && !NILP (list))
- list = wrong_type_argument (Qconsp, list, 0);
+ list = wrong_type_argument (Qconsp, list);
+
+ /* Unless we find a marker with a buffer in LIST, assume that this
+ match data came from a string. */
+ last_thing_searched = Qt;
/* Allocate registers if they don't already exist. */
{
- int length = Flength (list) / 2;
+ int length = XFASTINT (Flength (list)) / 2;
if (length > search_regs.num_regs)
{
- if (search_regs.start)
- search_regs.start =
- (regoff_t *) realloc (search_regs.start,
- length * sizeof (regoff_t));
- else
- search_regs.start = (regoff_t *) malloc (length * sizeof (regoff_t));
- if (search_regs.end)
- search_regs.end =
- (regoff_t *) realloc (search_regs.end,
- length * sizeof (regoff_t));
+ if (search_regs.num_regs == 0)
+ {
+ search_regs.start
+ = (regoff_t *) xmalloc (length * sizeof (regoff_t));
+ search_regs.end
+ = (regoff_t *) xmalloc (length * sizeof (regoff_t));
+ }
else
- search_regs.end = (regoff_t *) malloc (length * sizeof (regoff_t));
+ {
+ search_regs.start
+ = (regoff_t *) xrealloc (search_regs.start,
+ length * sizeof (regoff_t));
+ search_regs.end
+ = (regoff_t *) xrealloc (search_regs.end,
+ length * sizeof (regoff_t));
+ }
- search_regs.num_regs = length;
+ BLOCK_INPUT;
+ re_set_registers (&searchbuf, &search_regs, length,
+ search_regs.start, search_regs.end);
+ UNBLOCK_INPUT;
}
}
}
else
{
- if (XTYPE (marker) == Lisp_Marker
- && XMARKER (marker)->buffer == 0)
- XFASTINT (marker) = 0;
+ if (XTYPE (marker) == Lisp_Marker)
+ {
+ if (XMARKER (marker)->buffer == 0)
+ XFASTINT (marker) = 0;
+ else
+ XSET (last_thing_searched, Lisp_Buffer,
+ XMARKER (marker)->buffer);
+ }
CHECK_NUMBER_COERCE_MARKER (marker, 0);
search_regs.start[i] = XINT (marker);
last_regexp = Qnil;
staticpro (&last_regexp);
+ last_thing_searched = Qnil;
+ staticpro (&last_thing_searched);
+
defsubr (&Sstring_match);
defsubr (&Slooking_at);
defsubr (&Sskip_chars_forward);
defsubr (&Sskip_chars_backward);
+ defsubr (&Sskip_syntax_forward);
+ defsubr (&Sskip_syntax_backward);
defsubr (&Ssearch_forward);
defsubr (&Ssearch_backward);
defsubr (&Sword_search_forward);