/* 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.
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
-#include "config.h"
+#include <config.h>
#include "lisp.h"
#include "syntax.h"
#include "buffer.h"
#include "commands.h"
+#include "blockinput.h"
#include <sys/types.h>
#include "regex.h"
Lisp_Object Qinvalid_regexp;
+static void set_search_regs ();
+
static void
matcher_overflow ()
{
last_regexp = Qnil;
bufp->translate = translate;
- val = re_compile_pattern ((char *) XSTRING (pattern)->data,
- XSTRING (pattern)->size,
- bufp);
+ BLOCK_INPUT;
+ val = (CONST char *) re_compile_pattern ((char *) XSTRING (pattern)->data,
+ XSTRING (pattern)->size, bufp);
+ UNBLOCK_INPUT;
if (val)
{
dummy = build_string (val);
/* 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;
}
If we don't find COUNT instances before reaching the end of the
buffer (or the beginning, if scanning backwards), set *SHORTAGE to
the number of TARGETs left unfound, and return the end of the
- buffer we bumped up against. */
+ buffer we bumped up against.
+
+ If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do
+ except when inside redisplay. */
-scan_buffer (target, start, count, shortage)
+scan_buffer (target, start, count, shortage, allow_quit)
int *shortage, start;
register int count, target;
+ int allow_quit;
{
int limit = ((count > 0) ? ZV - 1 : BEGV);
int direction = ((count > 0) ? 1 : -1);
if (shortage != 0)
*shortage = 0;
- immediate_quit = 1;
+ immediate_quit = allow_quit;
if (count > 0)
while (start != limit + 1)
find_next_newline (from, cnt)
register int from, cnt;
{
- return (scan_buffer ('\n', from, cnt, (int *) 0));
+ return scan_buffer ('\n', from, cnt, (int *) 0, 1);
}
\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\
+ "Move point forward, stopping before a char not in STRING, or at pos LIM.\n\
+STRING 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.\n\
(string, lim)
Lisp_Object string, lim;
{
- return skip_chars (1, string, lim);
+ 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\
+ "Move point backward, stopping after a char not in STRING, or at pos LIM.\n\
See `skip-chars-forward' for details.\n\
Returns the distance traveled, either zero or negative.")
(string, lim)
Lisp_Object string, lim;
{
- return skip_chars (0, string, lim);
+ 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);
}
Lisp_Object
-skip_chars (forwardp, string, lim)
- int forwardp;
+skip_chars (forwardp, syntaxp, string, lim)
+ int forwardp, syntaxp;
Lisp_Object string, lim;
{
register unsigned char *p, *pend;
else
CHECK_NUMBER_COERCE_MARKER (lim, 1);
-#if 0 /* This breaks some things... jla. */
/* In any case, don't allow scan outside bounds of buffer. */
- if (XFASTINT (lim) > ZV)
+ /* jla turned this off, for no known reason.
+ bfox turned the ZV part on, and rms turned the
+ BEGV part back on. */
+ if (XINT (lim) > ZV)
XFASTINT (lim) = ZV;
- if (XFASTINT (lim) < BEGV)
+ if (XINT (lim) < BEGV)
XFASTINT (lim) = BEGV;
-#endif
p = XSTRING (string)->data;
pend = p + XSTRING (string)->size;
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 (syntaxp && fastmap['-'] != 0)
+ fastmap[' '] = 1;
+
/* If ^ was the first character, complement the fastmap. */
if (negate)
int start_point = point;
immediate_quit = 1;
- if (forwardp)
+ if (syntaxp)
{
- while (point < XINT (lim) && fastmap[FETCH_CHAR (point)])
- SET_PT (point + 1);
+
+ 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
{
- while (point > XINT (lim) && fastmap[FETCH_CHAR (point - 1)])
- SET_PT (point - 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;
return make_number (np);
}
\f
-/* search for the n'th occurrence of STRING in the current buffer,
+/* Search for the n'th occurrence of STRING in the current buffer,
starting at position POS and stopping at position LIM,
treating PAT as a literal string if RE is false or as
a regular expression if RE is true.
int s1, s2;
/* Null string is found at starting position. */
- if (!len)
+ if (len == 0)
+ {
+ set_search_regs (pos, 0);
+ return pos;
+ }
+
+ /* Searching 0 times means don't move. */
+ if (n == 0)
return pos;
if (RE)
}
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)
}
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)
of pattern would align in a possible match. */
while (n != 0)
{
- if ((lim - pos - (direction > 0)) * direction < 0)
+ /* It's been reported that some (broken) compiler thinks that
+ Boolean expressions in an arithmetic context are unsigned.
+ Using an explicit ?1:0 prevents this. */
+ if ((lim - pos - ((direction > 0) ? 1 : 0)) * direction < 0)
return (n * (0 - direction));
/* First we do the part we can by pointers (maybe nothing) */
QUIT;
{
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));
- re_set_registers (&searchbuf,
- &search_regs,
- 2, starts, ends);
- }
-
- search_regs.start[0]
- = pos + cursor - p2 + ((direction > 0)
- ? 1 - len : 0);
- search_regs.end[0] = len + search_regs.start[0];
- XSET (last_thing_searched, Lisp_Buffer, current_buffer);
+ set_search_regs (pos + cursor - p2 + ((direction > 0)
+ ? 1 - len : 0),
+ len);
+
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.
{
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));
- re_set_registers (&searchbuf,
- &search_regs,
- 2, starts, ends);
- }
-
- search_regs.start[0]
- = pos + ((direction > 0) ? 1 - len : 0);
- search_regs.end[0] = len + search_regs.start[0];
- XSET (last_thing_searched, Lisp_Buffer, current_buffer);
+ set_search_regs (pos + ((direction > 0) ? 1 - len : 0),
+ len);
+
if ((n -= direction) != 0)
pos += dirlen; /* to resume search */
else
return pos;
}
}
+
+/* Record beginning BEG and end BEG + LEN
+ for a match just found in the current buffer. */
+
+static void
+set_search_regs (beg, len)
+ int beg, len;
+{
+ /* 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] = beg;
+ search_regs.end[0] = beg + len;
+ XSET (last_thing_searched, Lisp_Buffer, current_buffer);
+}
\f
/* Given a string of words separated by word delimiters,
compute a regexp that matches those exact words
"Search backward from point for match for regular expression REGEXP.\n\
Set point to the beginning of the match, and return point.\n\
The match found is the one starting last in the buffer\n\
-and yet ending before the place the origin of the search.\n\
+and yet ending before the origin of the search.\n\
An optional second argument bounds the search; it is a buffer position.\n\
The match found must start at or after that position.\n\
Optional third argument, if t, means if fail just return nil (no error).\n\
If not nil and not t, move to limit of search and return nil.\n\
Optional fourth argument is repeat count--search for successive occurrences.\n\
See also the functions `match-beginning', `match-end' and `replace-match'.")
- (string, bound, noerror, count)
- Lisp_Object string, bound, noerror, count;
+ (regexp, bound, noerror, count)
+ Lisp_Object regexp, bound, noerror, count;
{
- return search_command (string, bound, noerror, count, -1, 1);
+ return search_command (regexp, bound, noerror, count, -1, 1);
}
DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4,
If not nil and not t, move to limit of search and return nil.\n\
Optional fourth argument is repeat count--search for successive occurrences.\n\
See also the functions `match-beginning', `match-end' and `replace-match'.")
- (string, bound, noerror, count)
- Lisp_Object string, bound, noerror, count;
+ (regexp, bound, noerror, count)
+ Lisp_Object regexp, bound, noerror, count;
{
- return search_command (string, bound, noerror, count, 1, 1);
+ return search_command (regexp, bound, noerror, count, 1, 1);
}
\f
DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 3, 0,
"Replace text matched by last search with NEWTEXT.\n\
If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\
-Otherwise convert to all caps or cap initials, like replaced text.\n\
+Otherwise maybe capitalize the whole text, or maybe just word initials,\n\
+based on the replaced text.\n\
+If the replaced text has only capital letters\n\
+and has at least one multiletter word, convert NEWTEXT to all caps.\n\
+If the replaced text has at least one word starting with a capital letter,\n\
+then capitalize each word in NEWTEXT.\n\n\
If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\
Otherwise treat `\\' as special:\n\
`\\&' in NEWTEXT means substitute original matched text.\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;
+ (newtext, fixedcase, literal)
+ Lisp_Object newtext, 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_lowercase_initial;
register int c, prevc;
int inslen;
- CHECK_STRING (string, 0);
+ CHECK_STRING (newtext, 0);
case_action = nochange; /* We tried an initialization */
/* but some C compilers blew it */
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_lowercase_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;
- }
+ some_lowercase_initial = 1;
else
some_multiletter_word = 1;
}
else if (!NOCASEP (c))
{
- some_letter = 1;
- if (!some_multiletter_word && SYNTAX (prevc) == Sword)
+ if (SYNTAX (prevc) != Sword)
+ ;
+ 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 all capitalized words. */
+ else if (!some_lowercase_initial && some_multiletter_word)
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);
+ Finsert_and_inherit (1, &newtext);
else
{
struct gcpro gcpro1;
- GCPRO1 (string);
+ GCPRO1 (newtext);
- for (pos = 0; pos < XSTRING (string)->size; pos++)
+ for (pos = 0; pos < XSTRING (newtext)->size; pos++)
{
- c = XSTRING (string)->data[pos];
+ int offset = point - search_regs.start[0];
+
+ c = XSTRING (newtext)->data[pos];
if (c == '\\')
{
- c = XSTRING (string)->data[++pos];
+ c = XSTRING (newtext)->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));
DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
"Return position of start of text matched by last search.\n\
-ARG, a number, specifies which parenthesized expression in the last regexp.\n\
- Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
+NUM specifies which parenthesized expression in the last regexp.\n\
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.\n\
Zero means the entire text matched by the whole regexp or whole string.")
(num)
Lisp_Object num;
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. */
length * sizeof (regoff_t));
}
+ BLOCK_INPUT;
re_set_registers (&searchbuf, &search_regs, length,
search_regs.start, search_regs.end);
+ UNBLOCK_INPUT;
}
}
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);
HCoop / bpt / emacs.git / blobdiff