You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
#include <config.h>
#include "lisp.h"
#include "syntax.h"
+#include "category.h"
#include "buffer.h"
+#include "charset.h"
#include "region-cache.h"
#include "commands.h"
#include "blockinput.h"
#include <sys/types.h>
#include "regex.h"
-#define REGEXP_CACHE_SIZE 5
+#define REGEXP_CACHE_SIZE 20
/* If the regexp is non-nil, then the buffer contains the compiled form
of that regexp, suitable for searching. */
-struct regexp_cache {
+struct regexp_cache
+{
struct regexp_cache *next;
Lisp_Object regexp;
struct re_pattern_buffer buf;
If it is 0, we should compile the pattern not to record any
subexpression bounds.
POSIX is nonzero if we want full backtracking (POSIX style)
- for this pattern. 0 means backtrack only enough to get a valid match. */
+ for this pattern. 0 means backtrack only enough to get a valid match.
+ MULTIBYTE is nonzero if we want to handle multibyte characters in
+ PATTERN. 0 means all multibyte characters are recognized just as
+ sequences of binary data. */
static void
-compile_pattern_1 (cp, pattern, translate, regp, posix)
+compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte)
struct regexp_cache *cp;
Lisp_Object pattern;
Lisp_Object *translate;
struct re_registers *regp;
int posix;
+ int multibyte;
{
CONST char *val;
reg_syntax_t old;
cp->regexp = Qnil;
cp->buf.translate = translate;
cp->posix = posix;
+ cp->buf.multibyte = multibyte;
BLOCK_INPUT;
old = re_set_syntax (RE_SYNTAX_EMACS
| (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
int posix;
{
struct regexp_cache *cp, **cpp;
+ /* Should we check it here, or add an argument `multibyte' to this
+ function? */
+ int multibyte = !NILP (current_buffer->enable_multibyte_characters);
for (cpp = &searchbuf_head; ; cpp = &cp->next)
{
cp = *cpp;
- if (!NILP (Fstring_equal (cp->regexp, pattern))
+ if (XSTRING (cp->regexp)->size == XSTRING (pattern)->size
+ && !NILP (Fstring_equal (cp->regexp, pattern))
&& cp->buf.translate == translate
- && cp->posix == posix)
+ && cp->posix == posix
+ && cp->buf.multibyte == multibyte)
break;
/* If we're at the end of the cache, compile into the last cell. */
if (cp->next == 0)
{
- compile_pattern_1 (cp, pattern, translate, regp, posix);
+ compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte);
break;
}
}
CHECK_STRING (string, 0);
bufp = compile_pattern (string, &search_regs,
(!NILP (current_buffer->case_fold_search)
- ? DOWNCASE_TABLE : 0),
+ ? XCHAR_TABLE (DOWNCASE_TABLE)->contents : 0),
posix);
immediate_quit = 1;
s1 = ZV - BEGV;
s2 = 0;
}
+
+ re_match_object = Qnil;
i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
- point - BEGV, &search_regs,
+ PT - BEGV, &search_regs,
ZV - BEGV);
if (i == -2)
matcher_overflow ();
bufp = compile_pattern (regexp, &search_regs,
(!NILP (current_buffer->case_fold_search)
- ? DOWNCASE_TABLE : 0),
+ ? XCHAR_TABLE (DOWNCASE_TABLE)->contents : 0),
posix);
immediate_quit = 1;
+ re_match_object = string;
+
val = re_search (bufp, (char *) XSTRING (string)->data,
XSTRING (string)->size, s, XSTRING (string)->size - s,
&search_regs);
bufp = compile_pattern (regexp, 0, 0, 0);
immediate_quit = 1;
+ re_match_object = string;
+
val = re_search (bufp, (char *) XSTRING (string)->data,
XSTRING (string)->size, 0, XSTRING (string)->size,
0);
immediate_quit = 0;
return val;
}
+
+/* Match REGEXP against STRING, searching all of STRING ignoring case,
+ and return the index of the match, or negative on failure.
+ This does not clobber the match data. */
+
+extern Lisp_Object Vascii_downcase_table;
+
+int
+fast_c_string_match_ignore_case (regexp, string)
+ Lisp_Object regexp;
+ char *string;
+{
+ int val;
+ struct re_pattern_buffer *bufp;
+ int len = strlen (string);
+
+ re_match_object = Qt;
+ bufp = compile_pattern (regexp, 0,
+ XCHAR_TABLE (Vascii_downcase_table)->contents, 0);
+ immediate_quit = 1;
+ val = re_search (bufp, string, len, 0, len, 0);
+ immediate_quit = 0;
+ return val;
+}
\f
/* max and min. */
{
/* The termination address of the dumb loop. */
- register unsigned char *ceiling_addr = &FETCH_CHAR (ceiling) + 1;
- register unsigned char *cursor = &FETCH_CHAR (start);
+ register unsigned char *ceiling_addr = POS_ADDR (ceiling) + 1;
+ register unsigned char *cursor = POS_ADDR (start);
unsigned char *base = cursor;
while (cursor < ceiling_addr)
{
/* The termination address of the dumb loop. */
- register unsigned char *ceiling_addr = &FETCH_CHAR (ceiling);
- register unsigned char *cursor = &FETCH_CHAR (start - 1);
+ register unsigned char *ceiling_addr = POS_ADDR (ceiling);
+ register unsigned char *cursor = POS_ADDR (start - 1);
unsigned char *base = cursor;
while (cursor >= ceiling_addr)
return pos;
}
\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 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\
-Returns the distance traveled, either zero or positive.")
- (string, lim)
- Lisp_Object 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 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, 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, syntaxp, string, lim)
- int forwardp, syntaxp;
- Lisp_Object string, lim;
-{
- register unsigned char *p, *pend;
- register unsigned char c;
- unsigned char fastmap[0400];
- int negate = 0;
- register int i;
-
- CHECK_STRING (string, 0);
-
- if (NILP (lim))
- XSETINT (lim, forwardp ? ZV : BEGV);
- else
- CHECK_NUMBER_COERCE_MARKER (lim, 1);
-
- /* In any case, don't allow scan outside bounds of buffer. */
- /* 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)
- XSETFASTINT (lim, ZV);
- if (XINT (lim) < BEGV)
- XSETFASTINT (lim, BEGV);
-
- p = XSTRING (string)->data;
- pend = p + XSTRING (string)->size;
- bzero (fastmap, sizeof fastmap);
-
- if (p != pend && *p == '^')
- {
- negate = 1; p++;
- }
-
- /* 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 (syntaxp)
- fastmap[c] = 1;
- else
- {
- if (c == '\\')
- {
- if (p == pend) break;
- c = *p++;
- }
- if (p != pend && *p == '-')
- {
- p++;
- if (p == pend) break;
- while (c <= *p)
- {
- fastmap[c] = 1;
- c++;
- }
- p++;
- }
- else
- fastmap[c] = 1;
- }
- }
-
- if (syntaxp && fastmap['-'] != 0)
- fastmap[' '] = 1;
-
- /* If ^ was the first character, complement the fastmap. */
-
- if (negate)
- for (i = 0; i < sizeof fastmap; i++)
- fastmap[i] ^= 1;
-
- {
- 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. */
static Lisp_Object
{
CHECK_NUMBER_COERCE_MARKER (bound, 1);
lim = XINT (bound);
- if (n > 0 ? lim < point : lim > point)
+ if (n > 0 ? lim < PT : lim > PT)
error ("Invalid search bound (wrong side of point)");
if (lim > ZV)
lim = ZV;
lim = BEGV;
}
- np = search_buffer (string, point, lim, n, RE,
+ np = search_buffer (string, PT, lim, n, RE,
(!NILP (current_buffer->case_fold_search)
? XCHAR_TABLE (current_buffer->case_canon_table)->contents
: 0),
case '|': case '(': case ')': case '`': case '\'': case 'b':
case 'B': case '<': case '>': case 'w': case 'W': case 's':
case 'S': case '=':
+ case 'c': case 'C': /* for categoryspec and notcategoryspec */
case '1': case '2': case '3': case '4': case '5':
case '6': case '7': case '8': case '9':
return 0;
s1 = ZV - BEGV;
s2 = 0;
}
+ re_match_object = Qnil;
+
while (n < 0)
{
int val;
len--;
base_pat++;
}
- *pat++ = (trt ? trt[*base_pat++] : *base_pat++);
+ *pat++ = (trt ? XINT (trt[*base_pat++]) : *base_pat++);
}
len = pat - patbuf;
pat = base_pat = patbuf;
if (i == dirlen) i = infinity;
if (trt != 0)
{
- k = (j = trt[j]);
+ k = (j = XINT (trt[j]));
if (i == infinity)
stride_for_teases = BM_tab[j];
BM_tab[j] = dirlen - i;
/* A translation table is accompanied by its inverse -- see */
/* comment following downcase_table for details */
- while ((j = (unsigned char) inverse_trt[j]) != k)
+ while ((j = (unsigned char) XINT (inverse_trt[j])) != k)
BM_tab[j] = dirlen - i;
}
else
: max (lim, max (limit, pos - 20000)));
if ((limit - pos) * direction > 20)
{
- p_limit = &FETCH_CHAR (limit);
- p2 = (cursor = &FETCH_CHAR (pos));
+ p_limit = POS_ADDR (limit);
+ p2 = (cursor = POS_ADDR (pos));
/* In this loop, pos + cursor - p2 is the surrogate for pos */
while (1) /* use one cursor setting as long as i can */
{
while ((EMACS_INT) cursor <= (EMACS_INT) p_limit)
cursor += BM_tab[*cursor];
else
- while ((unsigned EMACS_INT) cursor <= (unsigned EMACS_INT) p_limit)
+ while ((EMACS_UINT) cursor <= (EMACS_UINT) p_limit)
cursor += BM_tab[*cursor];
}
else
while ((EMACS_INT) cursor >= (EMACS_INT) p_limit)
cursor += BM_tab[*cursor];
else
- while ((unsigned EMACS_INT) cursor >= (unsigned EMACS_INT) p_limit)
+ while ((EMACS_UINT) cursor >= (EMACS_UINT) p_limit)
cursor += BM_tab[*cursor];
}
/* If you are here, cursor is beyond the end of the searched region. */
if (trt != 0)
{
while ((i -= direction) + direction != 0)
- if (pat[i] != trt[*(cursor -= direction)])
+ if (pat[i] != XINT (trt[*(cursor -= direction)]))
break;
}
else
/* (the reach is at most len + 21, and typically */
/* does not exceed len) */
while ((limit - pos) * direction >= 0)
- pos += BM_tab[FETCH_CHAR(pos)];
+ pos += BM_tab[FETCH_BYTE (pos)];
/* now run the same tests to distinguish going off the */
/* end, a match or a phony match. */
if ((pos - limit) * direction <= len)
{
pos -= direction;
if (pat[i] != (trt != 0
- ? trt[FETCH_CHAR(pos)]
- : FETCH_CHAR (pos)))
+ ? XINT (trt[FETCH_BYTE (pos)])
+ : FETCH_BYTE (pos)))
break;
}
/* Above loop has moved POS part or all the way
register int c, prevc;
int inslen;
int sub;
+ int opoint, newpoint;
CHECK_STRING (newtext, 0);
for (pos = search_regs.start[sub]; pos < last; pos++)
{
if (NILP (string))
- c = FETCH_CHAR (pos);
+ c = FETCH_BYTE (pos);
else
c = XSTRING (string)->data[pos];
make_number (search_regs.start[sub]));
after = Fsubstring (string, make_number (search_regs.end[sub]), Qnil);
- /* Do case substitution into NEWTEXT if desired. */
+ /* Substitute parts of the match into NEWTEXT
+ if desired. */
if (NILP (literal))
{
int lastpos = -1;
}
else if (c == '\\')
delbackslash = 1;
+ else
+ error ("Invalid use of `\\' in replacement text");
}
if (substart >= 0)
{
newtext = concat2 (accum, middle);
}
+ /* Do case substitution in NEWTEXT if desired. */
if (case_action == all_caps)
newtext = Fupcase (newtext);
else if (case_action == cap_initial)
return concat3 (before, newtext, after);
}
+ /* Record point, the move (quietly) to the start of the match. */
+ if (PT > search_regs.start[sub])
+ opoint = PT - ZV;
+ else
+ opoint = PT;
+
+ temp_set_point (search_regs.start[sub], current_buffer);
+
/* 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[sub]);
if (!NILP (literal))
Finsert_and_inherit (1, &newtext);
else
for (pos = 0; pos < XSTRING (newtext)->size; pos++)
{
- int offset = point - search_regs.start[sub];
+ int offset = PT - search_regs.start[sub];
c = XSTRING (newtext)->data[pos];
if (c == '\\')
make_number (search_regs.start[c - '0'] + offset),
make_number (search_regs.end[c - '0'] + offset));
}
- else
+ else if (c == '\\')
insert_char (c);
+ else
+ error ("Invalid use of `\\' in replacement text");
}
else
insert_char (c);
UNGCPRO;
}
- inslen = point - (search_regs.start[sub]);
+ inslen = PT - (search_regs.start[sub]);
del_range (search_regs.start[sub] + inslen, search_regs.end[sub] + inslen);
if (case_action == all_caps)
- Fupcase_region (make_number (point - inslen), make_number (point));
+ Fupcase_region (make_number (PT - inslen), make_number (PT));
else if (case_action == cap_initial)
- Fupcase_initials_region (make_number (point - inslen), make_number (point));
+ Fupcase_initials_region (make_number (PT - inslen), make_number (PT));
+
+ newpoint = PT;
+
+ /* Put point back where it was in the text. */
+ if (opoint <= 0)
+ temp_set_point (opoint + ZV, current_buffer);
+ else
+ temp_set_point (opoint, current_buffer);
+
+ /* Now move point "officially" to the start of the inserted replacement. */
+ move_if_not_intangible (newpoint);
+
return Qnil;
}
\f
DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
"Return position of start of text matched by last search.\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\
+SUBEXP, a number, specifies which parenthesized expression in the last\n\
+ regexp.\n\
+Value is nil if SUBEXPth pair didn't match, or there were less than\n\
+ SUBEXP pairs.\n\
Zero means the entire text matched by the whole regexp or whole string.")
- (num)
- Lisp_Object num;
+ (subexp)
+ Lisp_Object subexp;
{
- return match_limit (num, 1);
+ return match_limit (subexp, 1);
}
DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0,
"Return position of end 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\
+SUBEXP, a number, specifies which parenthesized expression in the last\n\
+ regexp.\n\
+Value is nil if SUBEXPth pair didn't match, or there were less than\n\
+ SUBEXP pairs.\n\
Zero means the entire text matched by the whole regexp or whole string.")
- (num)
- Lisp_Object num;
+ (subexp)
+ Lisp_Object subexp;
{
- return match_limit (num, 0);
+ return match_limit (subexp, 0);
}
-DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 0, 0,
+DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 2, 0,
"Return a list containing all info on what the last search matched.\n\
Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.\n\
All the elements are markers or nil (nil if the Nth pair didn't match)\n\
if the last match was on a buffer; integers or nil if a string was matched.\n\
-Use `store-match-data' to reinstate the data in this list.")
- ()
+Use `store-match-data' to reinstate the data in this list.\n\
+\n\
+If INTEGERS (the optional first argument) is non-nil, always use integers\n\
+\(rather than markers) to represent buffer positions.\n\
+If REUSE is a list, reuse it as part of the value. If REUSE is long enough\n\
+to hold all the values, and if INTEGERS is non-nil, no consing is done.")
+ (integers, reuse)
+ Lisp_Object integers, reuse;
{
+ Lisp_Object tail, prev;
Lisp_Object *data;
int i, len;
if (NILP (last_thing_searched))
- error ("match-data called before any match found");
+ return Qnil;
data = (Lisp_Object *) alloca ((2 * search_regs.num_regs)
* sizeof (Lisp_Object));
int start = search_regs.start[i];
if (start >= 0)
{
- if (EQ (last_thing_searched, Qt))
+ if (EQ (last_thing_searched, Qt)
+ || ! NILP (integers))
{
XSETFASTINT (data[2 * i], start);
XSETFASTINT (data[2 * i + 1], search_regs.end[i]);
else
data[2 * i] = data [2 * i + 1] = Qnil;
}
- return Flist (2 * len + 2, data);
+
+ /* If REUSE is not usable, cons up the values and return them. */
+ if (! CONSP (reuse))
+ return Flist (2 * len + 2, data);
+
+ /* If REUSE is a list, store as many value elements as will fit
+ into the elements of REUSE. */
+ for (i = 0, tail = reuse; CONSP (tail);
+ i++, tail = XCONS (tail)->cdr)
+ {
+ if (i < 2 * len + 2)
+ XCONS (tail)->car = data[i];
+ else
+ XCONS (tail)->car = Qnil;
+ prev = tail;
+ }
+
+ /* If we couldn't fit all value elements into REUSE,
+ cons up the rest of them and add them to the end of REUSE. */
+ if (i < 2 * len + 2)
+ XCONS (prev)->cdr = Flist (2 * len + 2 - i, data + i);
+
+ return reuse;
}
DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
"Return a regexp string which matches exactly STRING and nothing else.")
- (str)
- Lisp_Object str;
+ (string)
+ Lisp_Object string;
{
register unsigned char *in, *out, *end;
register unsigned char *temp;
- CHECK_STRING (str, 0);
+ CHECK_STRING (string, 0);
- temp = (unsigned char *) alloca (XSTRING (str)->size * 2);
+ temp = (unsigned char *) alloca (XSTRING (string)->size * 2);
/* Now copy the data into the new string, inserting escapes. */
- in = XSTRING (str)->data;
- end = in + XSTRING (str)->size;
+ in = XSTRING (string)->data;
+ end = in + XSTRING (string)->size;
out = temp;
for (; in != end; in++)
defsubr (&Sposix_looking_at);
defsubr (&Sstring_match);
defsubr (&Sposix_string_match);
- 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