#include <config.h>
#ifdef STDC_HEADERS
#include <stdlib.h>
#endif
#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 "intervals.h"
#include <sys/types.h>
#include "regex.h"
#define min(a, b) ((a) < (b) ? (a) : (b))
#define max(a, b) ((a) > (b) ? (a) : (b))
#define REGEXP_CACHE_SIZE 20
struct regexp_cache
{
struct regexp_cache *next;
Lisp_Object regexp;
struct re_pattern_buffer buf;
char fastmap[0400];
char posix;
};
struct regexp_cache searchbufs[REGEXP_CACHE_SIZE];
struct regexp_cache *searchbuf_head;
static struct re_registers search_regs;
static Lisp_Object last_thing_searched;
Lisp_Object Qinvalid_regexp;
static void set_search_regs ();
static void save_search_regs ();
static int simple_search ();
static int boyer_moore ();
static int search_buffer ();
static void
matcher_overflow ()
{
error ("Stack overflow in regexp matcher");
}
#ifdef __STDC__
#define CONST const
#else
#define CONST
#endif
static void
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;
{
unsigned char *raw_pattern;
int raw_pattern_size;
char *val;
reg_syntax_t old;
if (multibyte == STRING_MULTIBYTE (pattern))
{
raw_pattern = (unsigned char *) XSTRING (pattern)->data;
raw_pattern_size = STRING_BYTES (XSTRING (pattern));
}
else if (multibyte)
{
raw_pattern_size = count_size_as_multibyte (XSTRING (pattern)->data,
XSTRING (pattern)->size);
raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
copy_text (XSTRING (pattern)->data, raw_pattern,
XSTRING (pattern)->size, 0, 1);
}
else
{
raw_pattern_size = XSTRING (pattern)->size;
raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
copy_text (XSTRING (pattern)->data, raw_pattern,
STRING_BYTES (XSTRING (pattern)), 1, 0);
}
cp->regexp = Qnil;
cp->buf.translate = (! NILP (translate) ? translate : make_number (0));
cp->posix = posix;
cp->buf.multibyte = multibyte;
BLOCK_INPUT;
old = re_set_syntax (RE_SYNTAX_EMACS
| (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
val = (char *) re_compile_pattern ((char *)raw_pattern,
raw_pattern_size, &cp->buf);
re_set_syntax (old);
UNBLOCK_INPUT;
if (val)
Fsignal (Qinvalid_regexp, Fcons (build_string (val), Qnil));
cp->regexp = Fcopy_sequence (pattern);
}
void
shrink_regexp_cache ()
{
struct regexp_cache *cp, **cpp;
for (cp = searchbuf_head; cp != 0; cp = cp->next)
{
cp->buf.allocated = cp->buf.used;
cp->buf.buffer
= (unsigned char *) realloc (cp->buf.buffer, cp->buf.used);
}
}
struct re_pattern_buffer *
compile_pattern (pattern, regp, translate, posix, multibyte)
Lisp_Object pattern;
struct re_registers *regp;
Lisp_Object translate;
int posix, multibyte;
{
struct regexp_cache *cp, **cpp;
for (cpp = &searchbuf_head; ; cpp = &cp->next)
{
cp = *cpp;
if (XSTRING (cp->regexp)->size == XSTRING (pattern)->size
&& !NILP (Fstring_equal (cp->regexp, pattern))
&& EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0)))
&& cp->posix == posix
&& cp->buf.multibyte == multibyte)
break;
if (cp->next == 0)
{
compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte);
break;
}
}
*cpp = cp->next;
cp->next = searchbuf_head;
searchbuf_head = cp;
if (regp)
re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end);
return &cp->buf;
}
Lisp_Object Qsearch_failed;
Lisp_Object
signal_failure (arg)
Lisp_Object arg;
{
Fsignal (Qsearch_failed, Fcons (arg, Qnil));
return Qnil;
}
static Lisp_Object
looking_at_1 (string, posix)
Lisp_Object string;
int posix;
{
Lisp_Object val;
unsigned char *p1, *p2;
int s1, s2;
register int i;
struct re_pattern_buffer *bufp;
if (running_asynch_code)
save_search_regs ();
CHECK_STRING (string, 0);
bufp = compile_pattern (string, &search_regs,
(!NILP (current_buffer->case_fold_search)
? DOWNCASE_TABLE : Qnil),
posix,
!NILP (current_buffer->enable_multibyte_characters));
immediate_quit = 1;
QUIT;
p1 = BEGV_ADDR;
s1 = GPT_BYTE - BEGV_BYTE;
p2 = GAP_END_ADDR;
s2 = ZV_BYTE - GPT_BYTE;
if (s1 < 0)
{
p2 = p1;
s2 = ZV_BYTE - BEGV_BYTE;
s1 = 0;
}
if (s2 < 0)
{
s1 = ZV_BYTE - BEGV_BYTE;
s2 = 0;
}
re_match_object = Qnil;
i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
PT_BYTE - BEGV_BYTE, &search_regs,
ZV_BYTE - BEGV_BYTE);
if (i == -2)
matcher_overflow ();
val = (0 <= i ? Qt : Qnil);
if (i >= 0)
for (i = 0; i < search_regs.num_regs; i++)
if (search_regs.start[i] >= 0)
{
search_regs.start[i]
= BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
search_regs.end[i]
= BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
}
XSETBUFFER (last_thing_searched, current_buffer);
immediate_quit = 0;
return val;
}
DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0,
"Return t if text after point matches regular expression REGEXP.\n\
This function modifies the match data that `match-beginning',\n\
`match-end' and `match-data' access; save and restore the match\n\
data if you want to preserve them.")
(regexp)
Lisp_Object regexp;
{
return looking_at_1 (regexp, 0);
}
DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0,
"Return t if text after point matches regular expression REGEXP.\n\
Find the longest match, in accord with Posix regular expression rules.\n\
This function modifies the match data that `match-beginning',\n\
`match-end' and `match-data' access; save and restore the match\n\
data if you want to preserve them.")
(regexp)
Lisp_Object regexp;
{
return looking_at_1 (regexp, 1);
}
static Lisp_Object
string_match_1 (regexp, string, start, posix)
Lisp_Object regexp, string, start;
int posix;
{
int val;
struct re_pattern_buffer *bufp;
int pos, pos_byte;
int i;
if (running_asynch_code)
save_search_regs ();
CHECK_STRING (regexp, 0);
CHECK_STRING (string, 1);
if (NILP (start))
pos = 0, pos_byte = 0;
else
{
int len = XSTRING (string)->size;
CHECK_NUMBER (start, 2);
pos = XINT (start);
if (pos < 0 && -pos <= len)
pos = len + pos;
else if (0 > pos || pos > len)
args_out_of_range (string, start);
pos_byte = string_char_to_byte (string, pos);
}
bufp = compile_pattern (regexp, &search_regs,
(!NILP (current_buffer->case_fold_search)
? DOWNCASE_TABLE : Qnil),
posix,
STRING_MULTIBYTE (string));
immediate_quit = 1;
re_match_object = string;
val = re_search (bufp, (char *) XSTRING (string)->data,
STRING_BYTES (XSTRING (string)), pos_byte,
STRING_BYTES (XSTRING (string)) - pos_byte,
&search_regs);
immediate_quit = 0;
last_thing_searched = Qt;
if (val == -2)
matcher_overflow ();
if (val < 0) return Qnil;
for (i = 0; i < search_regs.num_regs; i++)
if (search_regs.start[i] >= 0)
{
search_regs.start[i]
= string_byte_to_char (string, search_regs.start[i]);
search_regs.end[i]
= string_byte_to_char (string, search_regs.end[i]);
}
return make_number (string_byte_to_char (string, val));
}
DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0,
"Return index of start of first match for REGEXP in STRING, or nil.\n\
Case is ignored if `case-fold-search' is non-nil in the current buffer.\n\
If third arg START is non-nil, start search at that index in STRING.\n\
For index of first char beyond the match, do (match-end 0).\n\
`match-end' and `match-beginning' also give indices of substrings\n\
matched by parenthesis constructs in the pattern.")
(regexp, string, start)
Lisp_Object regexp, string, start;
{
return string_match_1 (regexp, string, start, 0);
}
DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0,
"Return index of start of first match for REGEXP in STRING, or nil.\n\
Find the longest match, in accord with Posix regular expression rules.\n\
Case is ignored if `case-fold-search' is non-nil in the current buffer.\n\
If third arg START is non-nil, start search at that index in STRING.\n\
For index of first char beyond the match, do (match-end 0).\n\
`match-end' and `match-beginning' also give indices of substrings\n\
matched by parenthesis constructs in the pattern.")
(regexp, string, start)
Lisp_Object regexp, string, start;
{
return string_match_1 (regexp, string, start, 1);
}
int
fast_string_match (regexp, string)
Lisp_Object regexp, string;
{
int val;
struct re_pattern_buffer *bufp;
bufp = compile_pattern (regexp, 0, Qnil,
0, STRING_MULTIBYTE (string));
immediate_quit = 1;
re_match_object = string;
val = re_search (bufp, (char *) XSTRING (string)->data,
STRING_BYTES (XSTRING (string)), 0,
STRING_BYTES (XSTRING (string)), 0);
immediate_quit = 0;
return val;
}
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);
regexp = string_make_unibyte (regexp);
re_match_object = Qt;
bufp = compile_pattern (regexp, 0,
Vascii_downcase_table, 0,
0);
immediate_quit = 1;
val = re_search (bufp, string, len, 0, len, 0);
immediate_quit = 0;
return val;
}
static void
newline_cache_on_off (buf)
struct buffer *buf;
{
if (NILP (buf->cache_long_line_scans))
{
if (buf->newline_cache)
{
free_region_cache (buf->newline_cache);
buf->newline_cache = 0;
}
}
else
{
if (buf->newline_cache == 0)
buf->newline_cache = new_region_cache ();
}
}
int
scan_buffer (target, start, end, count, shortage, allow_quit)
register int target;
int start, end;
int count;
int *shortage;
int allow_quit;
{
struct region_cache *newline_cache;
int direction;
if (count > 0)
{
direction = 1;
if (! end) end = ZV;
}
else
{
direction = -1;
if (! end) end = BEGV;
}
newline_cache_on_off (current_buffer);
newline_cache = current_buffer->newline_cache;
if (shortage != 0)
*shortage = 0;
immediate_quit = allow_quit;
if (count > 0)
while (start != end)
{
int ceiling_byte = CHAR_TO_BYTE (end) - 1;
int start_byte = CHAR_TO_BYTE (start);
int tem;
if (target == '\n' && newline_cache)
{
int next_change;
immediate_quit = 0;
while (region_cache_forward
(current_buffer, newline_cache, start_byte, &next_change))
start_byte = next_change;
immediate_quit = allow_quit;
if (start_byte > ceiling_byte)
start_byte = ceiling_byte;
ceiling_byte = min (next_change - 1, ceiling_byte);
}
tem = BUFFER_CEILING_OF (start_byte);
ceiling_byte = min (tem, ceiling_byte);
{
register unsigned char *ceiling_addr
= BYTE_POS_ADDR (ceiling_byte) + 1;
register unsigned char *cursor
= BYTE_POS_ADDR (start_byte);
unsigned char *base = cursor;
while (cursor < ceiling_addr)
{
unsigned char *scan_start = cursor;
while (*cursor != target && ++cursor < ceiling_addr)
;
if (target == '\n' && newline_cache)
know_region_cache (current_buffer, newline_cache,
start_byte + scan_start - base,
start_byte + cursor - base);
if (cursor < ceiling_addr)
{
if (--count == 0)
{
immediate_quit = 0;
return BYTE_TO_CHAR (start_byte + cursor - base + 1);
}
cursor++;
}
}
start = BYTE_TO_CHAR (start_byte + cursor - base);
}
}
else
while (start > end)
{
int ceiling_byte = CHAR_TO_BYTE (end);
int start_byte = CHAR_TO_BYTE (start);
int tem;
if (target == '\n' && newline_cache)
{
int next_change;
immediate_quit = 0;
while (region_cache_backward
(current_buffer, newline_cache, start_byte, &next_change))
start_byte = next_change;
immediate_quit = allow_quit;
if (start_byte <= ceiling_byte)
start_byte = ceiling_byte + 1;
ceiling_byte = max (next_change, ceiling_byte);
}
tem = BUFFER_FLOOR_OF (start_byte - 1);
ceiling_byte = max (tem, ceiling_byte);
{
register unsigned char *ceiling_addr = BYTE_POS_ADDR (ceiling_byte);
register unsigned char *cursor = BYTE_POS_ADDR (start_byte - 1);
unsigned char *base = cursor;
while (cursor >= ceiling_addr)
{
unsigned char *scan_start = cursor;
while (*cursor != target && --cursor >= ceiling_addr)
;
if (target == '\n' && newline_cache)
know_region_cache (current_buffer, newline_cache,
start_byte + cursor - base,
start_byte + scan_start - base);
if (cursor >= ceiling_addr)
{
if (++count >= 0)
{
immediate_quit = 0;
return BYTE_TO_CHAR (start_byte + cursor - base);
}
cursor--;
}
}
start = BYTE_TO_CHAR (start_byte + cursor - base);
}
}
immediate_quit = 0;
if (shortage != 0)
*shortage = count * direction;
return start;
}
int
scan_newline (start, start_byte, limit, limit_byte, count, allow_quit)
int start, start_byte;
int limit, limit_byte;
register int count;
int allow_quit;
{
int direction = ((count > 0) ? 1 : -1);
register unsigned char *cursor;
unsigned char *base;
register int ceiling;
register unsigned char *ceiling_addr;
int old_immediate_quit = immediate_quit;
int selective_display = (!NILP (current_buffer->selective_display)
&& !INTEGERP (current_buffer->selective_display));
if (allow_quit)
immediate_quit++;
start_byte = CHAR_TO_BYTE (start);
if (count > 0)
{
while (start_byte < limit_byte)
{
ceiling = BUFFER_CEILING_OF (start_byte);
ceiling = min (limit_byte - 1, ceiling);
ceiling_addr = BYTE_POS_ADDR (ceiling) + 1;
base = (cursor = BYTE_POS_ADDR (start_byte));
while (1)
{
while (*cursor != '\n' && ++cursor != ceiling_addr)
;
if (cursor != ceiling_addr)
{
if (--count == 0)
{
immediate_quit = old_immediate_quit;
start_byte = start_byte + cursor - base + 1;
start = BYTE_TO_CHAR (start_byte);
TEMP_SET_PT_BOTH (start, start_byte);
return 0;
}
else
if (++cursor == ceiling_addr)
break;
}
else
break;
}
start_byte += cursor - base;
}
}
else
{
while (start_byte > limit_byte)
{
ceiling = BUFFER_FLOOR_OF (start_byte - 1);
ceiling = max (limit_byte, ceiling);
ceiling_addr = BYTE_POS_ADDR (ceiling) - 1;
base = (cursor = BYTE_POS_ADDR (start_byte - 1) + 1);
while (1)
{
while (--cursor != ceiling_addr && *cursor != '\n')
;
if (cursor != ceiling_addr)
{
if (++count == 0)
{
immediate_quit = old_immediate_quit;
start_byte = start_byte + cursor - base + 1;
start = BYTE_TO_CHAR (start_byte);
TEMP_SET_PT_BOTH (start, start_byte);
return 0;
}
}
else
break;
}
start_byte += cursor - base + 1;
}
}
TEMP_SET_PT_BOTH (limit, limit_byte);
immediate_quit = old_immediate_quit;
return count * direction;
}
int
find_next_newline_no_quit (from, cnt)
register int from, cnt;
{
return scan_buffer ('\n', from, 0, cnt, (int *) 0, 0);
}
int
find_before_next_newline (from, to, cnt)
int from, to, cnt;
{
int shortage;
int pos = scan_buffer ('\n', from, to, cnt, &shortage, 1);
if (shortage == 0)
pos--;
return pos;
}
static Lisp_Object
search_command (string, bound, noerror, count, direction, RE, posix)
Lisp_Object string, bound, noerror, count;
int direction;
int RE;
int posix;
{
register int np;
int lim, lim_byte;
int n = direction;
if (!NILP (count))
{
CHECK_NUMBER (count, 3);
n *= XINT (count);
}
CHECK_STRING (string, 0);
if (NILP (bound))
{
if (n > 0)
lim = ZV, lim_byte = ZV_BYTE;
else
lim = BEGV, lim_byte = BEGV_BYTE;
}
else
{
CHECK_NUMBER_COERCE_MARKER (bound, 1);
lim = XINT (bound);
if (n > 0 ? lim < PT : lim > PT)
error ("Invalid search bound (wrong side of point)");
if (lim > ZV)
lim = ZV, lim_byte = ZV_BYTE;
else if (lim < BEGV)
lim = BEGV, lim_byte = BEGV_BYTE;
else
lim_byte = CHAR_TO_BYTE (lim);
}
np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE,
(!NILP (current_buffer->case_fold_search)
? current_buffer->case_canon_table
: Qnil),
(!NILP (current_buffer->case_fold_search)
? current_buffer->case_eqv_table
: Qnil),
posix);
if (np <= 0)
{
if (NILP (noerror))
return signal_failure (string);
if (!EQ (noerror, Qt))
{
if (lim < BEGV || lim > ZV)
abort ();
SET_PT_BOTH (lim, lim_byte);
return Qnil;
#if 0
np = lim;
#endif
}
else
return Qnil;
}
if (np < BEGV || np > ZV)
abort ();
SET_PT (np);
return make_number (np);
}
static int
trivial_regexp_p (regexp)
Lisp_Object regexp;
{
int len = STRING_BYTES (XSTRING (regexp));
unsigned char *s = XSTRING (regexp)->data;
unsigned char c;
while (--len >= 0)
{
switch (*s++)
{
case '.': case '*': case '+': case '?': case '[': case '^': case '$':
return 0;
case '\\':
if (--len < 0)
return 0;
switch (*s++)
{
case '|': case '(': case ')': case '`': case '\'': case 'b':
case 'B': case '<': case '>': case 'w': case 'W': case 's':
case 'S': case '=':
case 'c': case 'C':
case '1': case '2': case '3': case '4': case '5':
case '6': case '7': case '8': case '9':
return 0;
}
}
}
return 1;
}
#define TRANSLATE(out, trt, d) \
do \
{ \
if (! NILP (trt)) \
{ \
Lisp_Object temp; \
temp = Faref (trt, make_number (d)); \
if (INTEGERP (temp)) \
out = XINT (temp); \
else \
out = d; \
} \
else \
out = d; \
} \
while (0)
static int
search_buffer (string, pos, pos_byte, lim, lim_byte, n,
RE, trt, inverse_trt, posix)
Lisp_Object string;
int pos;
int pos_byte;
int lim;
int lim_byte;
int n;
int RE;
Lisp_Object trt;
Lisp_Object inverse_trt;
int posix;
{
int len = XSTRING (string)->size;
int len_byte = STRING_BYTES (XSTRING (string));
register int i;
if (running_asynch_code)
save_search_regs ();
if (len == 0 || n == 0)
{
set_search_regs (pos, 0);
return pos;
}
if (RE && !trivial_regexp_p (string))
{
unsigned char *p1, *p2;
int s1, s2;
struct re_pattern_buffer *bufp;
bufp = compile_pattern (string, &search_regs, trt, posix,
!NILP (current_buffer->enable_multibyte_characters));
immediate_quit = 1;
QUIT;
p1 = BEGV_ADDR;
s1 = GPT_BYTE - BEGV_BYTE;
p2 = GAP_END_ADDR;
s2 = ZV_BYTE - GPT_BYTE;
if (s1 < 0)
{
p2 = p1;
s2 = ZV_BYTE - BEGV_BYTE;
s1 = 0;
}
if (s2 < 0)
{
s1 = ZV_BYTE - BEGV_BYTE;
s2 = 0;
}
re_match_object = Qnil;
while (n < 0)
{
int val;
val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
pos_byte - BEGV_BYTE, lim_byte - pos_byte,
&search_regs,
pos_byte - BEGV_BYTE);
if (val == -2)
{
matcher_overflow ();
}
if (val >= 0)
{
pos_byte = search_regs.start[0] + BEGV_BYTE;
for (i = 0; i < search_regs.num_regs; i++)
if (search_regs.start[i] >= 0)
{
search_regs.start[i]
= BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
search_regs.end[i]
= BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
}
XSETBUFFER (last_thing_searched, current_buffer);
pos = search_regs.start[0];
}
else
{
immediate_quit = 0;
return (n);
}
n++;
}
while (n > 0)
{
int val;
val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
pos_byte - BEGV_BYTE, lim_byte - pos_byte,
&search_regs,
lim_byte - BEGV_BYTE);
if (val == -2)
{
matcher_overflow ();
}
if (val >= 0)
{
pos_byte = search_regs.end[0] + BEGV_BYTE;
for (i = 0; i < search_regs.num_regs; i++)
if (search_regs.start[i] >= 0)
{
search_regs.start[i]
= BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
search_regs.end[i]
= BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
}
XSETBUFFER (last_thing_searched, current_buffer);
pos = search_regs.end[0];
}
else
{
immediate_quit = 0;
return (0 - n);
}
n--;
}
immediate_quit = 0;
return (pos);
}
else
{
unsigned char *raw_pattern, *pat;
int raw_pattern_size;
int raw_pattern_size_byte;
unsigned char *patbuf;
int multibyte = !NILP (current_buffer->enable_multibyte_characters);
unsigned char *base_pat = XSTRING (string)->data;
int charset_base = -1;
int boyer_moore_ok = 1;
if (multibyte == STRING_MULTIBYTE (string))
{
raw_pattern = (unsigned char *) XSTRING (string)->data;
raw_pattern_size = XSTRING (string)->size;
raw_pattern_size_byte = STRING_BYTES (XSTRING (string));
}
else if (multibyte)
{
raw_pattern_size = XSTRING (string)->size;
raw_pattern_size_byte
= count_size_as_multibyte (XSTRING (string)->data,
raw_pattern_size);
raw_pattern = (unsigned char *) alloca (raw_pattern_size_byte + 1);
copy_text (XSTRING (string)->data, raw_pattern,
XSTRING (string)->size, 0, 1);
}
else
{
raw_pattern_size = XSTRING (string)->size;
raw_pattern_size_byte = XSTRING (string)->size;
raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
copy_text (XSTRING (string)->data, raw_pattern,
STRING_BYTES (XSTRING (string)), 1, 0);
}
len = raw_pattern_size;
len_byte = raw_pattern_size_byte;
patbuf = (unsigned char *) alloca (len_byte);
pat = patbuf;
base_pat = raw_pattern;
if (multibyte)
{
while (--len >= 0)
{
unsigned char workbuf[4], *str;
int c, translated, inverse;
int in_charlen, charlen;
if (RE && *base_pat == '\\')
{
len--;
len_byte--;
base_pat++;
}
c = STRING_CHAR_AND_LENGTH (base_pat, len_byte, in_charlen);
TRANSLATE (translated, trt, c);
charlen = CHAR_STRING (translated, workbuf, str);
if (in_charlen != charlen)
{
translated = c;
charlen = CHAR_STRING (c, workbuf, str);
}
if (! ASCII_BYTE_P (translated)
&& (charlen == 1
|| charlen != in_charlen
))
boyer_moore_ok = 0;
TRANSLATE (inverse, inverse_trt, c);
if (translated != c || inverse != c)
{
int charset_base_code = c & ~CHAR_FIELD3_MASK;
if (charset_base == -1)
charset_base = charset_base_code;
else if (charset_base != charset_base_code)
boyer_moore_ok = 0;
}
bcopy (str, pat, charlen);
pat += charlen;
base_pat += in_charlen;
len_byte -= in_charlen;
}
}
else
{
charset_base = 0;
while (--len >= 0)
{
int c, translated;
if (RE && *base_pat == '\\')
{
len--;
base_pat++;
}
c = *base_pat++;
TRANSLATE (translated, trt, c);
*pat++ = translated;
}
}
len_byte = pat - patbuf;
len = raw_pattern_size;
pat = base_pat = patbuf;
if (boyer_moore_ok)
return boyer_moore (n, pat, len, len_byte, trt, inverse_trt,
pos, pos_byte, lim, lim_byte,
charset_base);
else
return simple_search (n, pat, len, len_byte, trt,
pos, pos_byte, lim, lim_byte);
}
}
static int
simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte)
int n;
unsigned char *pat;
int len, len_byte;
Lisp_Object trt;
int pos, pos_byte;
int lim, lim_byte;
{
int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
int forward = n > 0;
if (lim > pos && multibyte)
while (n > 0)
{
while (1)
{
int this_pos = pos;
int this_pos_byte = pos_byte;
int this_len = len;
int this_len_byte = len_byte;
unsigned char *p = pat;
if (pos + len > lim)
goto stop;
while (this_len > 0)
{
int charlen, buf_charlen;
int pat_ch, buf_ch;
pat_ch = STRING_CHAR_AND_LENGTH (p, this_len_byte, charlen);
buf_ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (this_pos_byte),
ZV_BYTE - this_pos_byte,
buf_charlen);
TRANSLATE (buf_ch, trt, buf_ch);
if (buf_ch != pat_ch)
break;
this_len_byte -= charlen;
this_len--;
p += charlen;
this_pos_byte += buf_charlen;
this_pos++;
}
if (this_len == 0)
{
pos += len;
pos_byte += len_byte;
break;
}
INC_BOTH (pos, pos_byte);
}
n--;
}
else if (lim > pos)
while (n > 0)
{
while (1)
{
int this_pos = pos;
int this_len = len;
unsigned char *p = pat;
if (pos + len > lim)
goto stop;
while (this_len > 0)
{
int pat_ch = *p++;
int buf_ch = FETCH_BYTE (this_pos);
TRANSLATE (buf_ch, trt, buf_ch);
if (buf_ch != pat_ch)
break;
this_len--;
this_pos++;
}
if (this_len == 0)
{
pos += len;
break;
}
pos++;
}
n--;
}
else if (lim < pos && multibyte)
while (n < 0)
{
while (1)
{
int this_pos = pos - len;
int this_pos_byte = pos_byte - len_byte;
int this_len = len;
int this_len_byte = len_byte;
unsigned char *p = pat;
if (pos - len < lim)
goto stop;
while (this_len > 0)
{
int charlen, buf_charlen;
int pat_ch, buf_ch;
pat_ch = STRING_CHAR_AND_LENGTH (p, this_len_byte, charlen);
buf_ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (this_pos_byte),
ZV_BYTE - this_pos_byte,
buf_charlen);
TRANSLATE (buf_ch, trt, buf_ch);
if (buf_ch != pat_ch)
break;
this_len_byte -= charlen;
this_len--;
p += charlen;
this_pos_byte += buf_charlen;
this_pos++;
}
if (this_len == 0)
{
pos -= len;
pos_byte -= len_byte;
break;
}
DEC_BOTH (pos, pos_byte);
}
n++;
}
else if (lim < pos)
while (n < 0)
{
while (1)
{
int this_pos = pos - len;
int this_len = len;
unsigned char *p = pat;
if (pos - len < lim)
goto stop;
while (this_len > 0)
{
int pat_ch = *p++;
int buf_ch = FETCH_BYTE (this_pos);
TRANSLATE (buf_ch, trt, buf_ch);
if (buf_ch != pat_ch)
break;
this_len--;
this_pos++;
}
if (this_len == 0)
{
pos -= len;
break;
}
pos--;
}
n++;
}
stop:
if (n == 0)
{
if (forward)
set_search_regs ((multibyte ? pos_byte : pos) - len_byte, len_byte);
else
set_search_regs (multibyte ? pos_byte : pos, len_byte);
return pos;
}
else if (n > 0)
return -n;
else
return n;
}
static int
boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt,
pos, pos_byte, lim, lim_byte, charset_base)
int n;
unsigned char *base_pat;
int len, len_byte;
Lisp_Object trt;
Lisp_Object inverse_trt;
int pos, pos_byte;
int lim, lim_byte;
int charset_base;
{
int direction = ((n > 0) ? 1 : -1);
register int dirlen;
int infinity, limit, k, stride_for_teases;
register int *BM_tab;
int *BM_tab_base;
register unsigned char *cursor, *p_limit;
register int i, j;
unsigned char *pat, *pat_end;
int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
unsigned char simple_translate[0400];
int translate_prev_byte;
int translate_anteprev_byte;
#ifdef C_ALLOCA
int BM_tab_space[0400];
BM_tab = &BM_tab_space[0];
#else
BM_tab = (int *) alloca (0400 * sizeof (int));
#endif
dirlen = len_byte * direction;
infinity = dirlen - (lim_byte + pos_byte + len_byte + len_byte) * direction;
pat_end = base_pat + len_byte;
if (direction < 0)
base_pat = pat_end - 1;
BM_tab_base = BM_tab;
BM_tab += 0400;
j = dirlen;
while (BM_tab_base != BM_tab)
{
*--BM_tab = j;
*--BM_tab = j;
*--BM_tab = j;
*--BM_tab = j;
}
bzero (simple_translate, sizeof simple_translate);
for (i = 0; i < 0400; i++)
simple_translate[i] = i;
i = 0;
while (i != infinity)
{
unsigned char *ptr = base_pat + i;
i += direction;
if (i == dirlen)
i = infinity;
if (! NILP (trt))
{
int ch;
int untranslated;
int this_translated = 1;
if (multibyte
&& (pat_end - ptr == 1 || CHAR_HEAD_P (ptr[1])))
{
unsigned char *charstart = ptr;
while (! CHAR_HEAD_P (*charstart))
charstart--;
untranslated = STRING_CHAR (charstart, ptr - charstart + 1);
if (charset_base == (untranslated & ~CHAR_FIELD3_MASK))
{
TRANSLATE (ch, trt, untranslated);
if (! CHAR_HEAD_P (*ptr))
{
translate_prev_byte = ptr[-1];
if (! CHAR_HEAD_P (translate_prev_byte))
translate_anteprev_byte = ptr[-2];
}
}
else
{
this_translated = 0;
ch = *ptr;
}
}
else if (!multibyte)
TRANSLATE (ch, trt, *ptr);
else
{
ch = *ptr;
this_translated = 0;
}
if (ch > 0400)
j = ((unsigned char) ch) | 0200;
else
j = (unsigned char) ch;
if (i == infinity)
stride_for_teases = BM_tab[j];
BM_tab[j] = dirlen - i;
if (this_translated)
{
int starting_ch = ch;
int starting_j = j;
while (1)
{
TRANSLATE (ch, inverse_trt, ch);
if (ch > 0400)
j = ((unsigned char) ch) | 0200;
else
j = (unsigned char) ch;
simple_translate[j] = starting_j;
if (ch == starting_ch)
break;
BM_tab[j] = dirlen - i;
}
}
}
else
{
j = *ptr;
if (i == infinity)
stride_for_teases = BM_tab[j];
BM_tab[j] = dirlen - i;
}
}
infinity = dirlen - infinity;
pos_byte += dirlen - ((direction > 0) ? direction : 0);
while (n != 0)
{
int tail_end;
unsigned char *tail_end_ptr;
if ((lim_byte - pos_byte - ((direction > 0) ? 1 : 0)) * direction
< 0)
return (n * (0 - direction));
QUIT;
pat = base_pat;
limit = pos_byte - dirlen + direction;
if (direction > 0)
{
limit = BUFFER_CEILING_OF (limit);
limit = min (limit, pos_byte + 20000);
limit = min (limit, lim_byte - 1);
}
else
{
limit = BUFFER_FLOOR_OF (limit);
limit = max (limit, pos_byte - 20000);
limit = max (limit, lim_byte);
}
tail_end = BUFFER_CEILING_OF (pos_byte) + 1;
tail_end_ptr = BYTE_POS_ADDR (tail_end);
if ((limit - pos_byte) * direction > 20)
{
unsigned char *p2;
p_limit = BYTE_POS_ADDR (limit);
p2 = (cursor = BYTE_POS_ADDR (pos_byte));
while (1)
{
if (direction > 0)
{
if ((EMACS_INT) (p_limit + infinity) > (EMACS_INT) p_limit)
while ((EMACS_INT) cursor <= (EMACS_INT) p_limit)
cursor += BM_tab[*cursor];
else
while ((EMACS_UINT) cursor <= (EMACS_UINT) p_limit)
cursor += BM_tab[*cursor];
}
else
{
if ((EMACS_INT) (p_limit + infinity) < (EMACS_INT) p_limit)
while ((EMACS_INT) cursor >= (EMACS_INT) p_limit)
cursor += BM_tab[*cursor];
else
while ((EMACS_UINT) cursor >= (EMACS_UINT) p_limit)
cursor += BM_tab[*cursor];
}
if ((cursor - p_limit) * direction <= len_byte)
break;
cursor -= infinity;
i = dirlen - direction;
if (! NILP (trt))
{
while ((i -= direction) + direction != 0)
{
int ch;
cursor -= direction;
if (! multibyte
|| ((cursor == tail_end_ptr
|| CHAR_HEAD_P (cursor[1]))
&& (CHAR_HEAD_P (cursor[0])
|| (translate_prev_byte == cursor[-1]
&& (CHAR_HEAD_P (translate_prev_byte)
|| translate_anteprev_byte == cursor[-2])))))
ch = simple_translate[*cursor];
else
ch = *cursor;
if (pat[i] != ch)
break;
}
}
else
{
while ((i -= direction) + direction != 0)
{
cursor -= direction;
if (pat[i] != *cursor)
break;
}
}
cursor += dirlen - i - direction;
if (i + direction == 0)
{
int position;
cursor -= direction;
position = pos_byte + cursor - p2 + ((direction > 0)
? 1 - len_byte : 0);
set_search_regs (position, len_byte);
if ((n -= direction) != 0)
cursor += dirlen;
else
return ((direction > 0)
? search_regs.end[0] : search_regs.start[0]);
}
else
cursor += stride_for_teases;
}
pos_byte += cursor - p2;
}
else
{
limit = ((direction > 0)
? BUFFER_CEILING_OF (pos_byte - dirlen + 1)
: BUFFER_FLOOR_OF (pos_byte - dirlen - 1));
limit = ((direction > 0)
? min (limit + len_byte, lim_byte - 1)
: max (limit - len_byte, lim_byte));
while (1)
{
while ((limit - pos_byte) * direction >= 0)
pos_byte += BM_tab[FETCH_BYTE (pos_byte)];
if ((pos_byte - limit) * direction <= len_byte)
break;
pos_byte -= infinity;
i = dirlen - direction;
while ((i -= direction) + direction != 0)
{
int ch;
unsigned char *ptr;
pos_byte -= direction;
ptr = BYTE_POS_ADDR (pos_byte);
if (! multibyte
|| ((ptr == tail_end_ptr
|| CHAR_HEAD_P (ptr[1]))
&& (CHAR_HEAD_P (ptr[0])
|| (translate_prev_byte == ptr[-1]
&& (CHAR_HEAD_P (translate_prev_byte)
|| translate_anteprev_byte == ptr[-2])))))
ch = simple_translate[*ptr];
else
ch = *ptr;
if (pat[i] != ch)
break;
}
pos_byte += dirlen - i- direction;
if (i + direction == 0)
{
int position;
pos_byte -= direction;
position = pos_byte + ((direction > 0) ? 1 - len_byte : 0);
set_search_regs (position, len_byte);
if ((n -= direction) != 0)
pos_byte += dirlen;
else
return ((direction > 0)
? search_regs.end[0] : search_regs.start[0]);
}
else
pos_byte += stride_for_teases;
}
}
if ((lim_byte - pos_byte) * direction < 0)
return ((0 - n) * direction);
}
return BYTE_TO_CHAR (pos_byte);
}
static void
set_search_regs (beg_byte, nbytes)
int beg_byte, nbytes;
{
int i;
if (search_regs.num_regs == 0)
{
search_regs.start = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
search_regs.end = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
search_regs.num_regs = 2;
}
for (i = 1; i < search_regs.num_regs; i++)
{
search_regs.start[i] = -1;
search_regs.end[i] = -1;
}
search_regs.start[0] = BYTE_TO_CHAR (beg_byte);
search_regs.end[0] = BYTE_TO_CHAR (beg_byte + nbytes);
XSETBUFFER (last_thing_searched, current_buffer);
}
static Lisp_Object
wordify (string)
Lisp_Object string;
{
register unsigned char *p, *o;
register int i, i_byte, len, punct_count = 0, word_count = 0;
Lisp_Object val;
int prev_c = 0;
int adjust;
CHECK_STRING (string, 0);
p = XSTRING (string)->data;
len = XSTRING (string)->size;
for (i = 0, i_byte = 0; i < len; )
{
int c;
if (STRING_MULTIBYTE (string))
FETCH_STRING_CHAR_ADVANCE (c, string, i, i_byte);
else
c = XSTRING (string)->data[i++];
if (SYNTAX (c) != Sword)
{
punct_count++;
if (i > 0 && SYNTAX (prev_c) == Sword)
word_count++;
}
prev_c = c;
}
if (SYNTAX (prev_c) == Sword)
word_count++;
if (!word_count)
return build_string ("");
adjust = - punct_count + 5 * (word_count - 1) + 4;
if (STRING_MULTIBYTE (string))
val = make_uninit_multibyte_string (len + adjust,
STRING_BYTES (XSTRING (string))
+ adjust);
else
val = make_uninit_string (len + adjust);
o = XSTRING (val)->data;
*o++ = '\\';
*o++ = 'b';
prev_c = 0;
for (i = 0, i_byte = 0; i < len; )
{
int c;
int i_byte_orig = i_byte;
if (STRING_MULTIBYTE (string))
FETCH_STRING_CHAR_ADVANCE (c, string, i, i_byte);
else
{
c = XSTRING (string)->data[i++];
i_byte++;
}
if (SYNTAX (c) == Sword)
{
bcopy (&XSTRING (string)->data[i_byte_orig], o,
i_byte - i_byte_orig);
o += i_byte - i_byte_orig;
}
else if (i > 0 && SYNTAX (prev_c) == Sword && --word_count)
{
*o++ = '\\';
*o++ = 'W';
*o++ = '\\';
*o++ = 'W';
*o++ = '*';
}
prev_c = c;
}
*o++ = '\\';
*o++ = 'b';
return val;
}
DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
"MSearch backward: ",
"Search backward from point for STRING.\n\
Set point to the beginning of the occurrence found, and return point.\n\
An optional second argument bounds the search; it is a buffer position.\n\
The match found must not extend before that position.\n\
Optional third argument, if t, means if fail just return nil (no error).\n\
If not nil and not t, position at 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;
{
return search_command (string, bound, noerror, count, -1, 0, 0);
}
DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "MSearch: ",
"Search forward from point for STRING.\n\
Set point to the end of the occurrence found, and return point.\n\
An optional second argument bounds the search; it is a buffer position.\n\
The match found must not extend after that position. nil is equivalent\n\
to (point-max).\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;
{
return search_command (string, bound, noerror, count, 1, 0, 0);
}
DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
"sWord search backward: ",
"Search backward from point for STRING, ignoring differences in punctuation.\n\
Set point to the beginning of the occurrence found, and return point.\n\
An optional second argument bounds the search; it is a buffer position.\n\
The match found must not extend before 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.")
(string, bound, noerror, count)
Lisp_Object string, bound, noerror, count;
{
return search_command (wordify (string), bound, noerror, count, -1, 1, 0);
}
DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
"sWord search: ",
"Search forward from point for STRING, ignoring differences in punctuation.\n\
Set point to the end of the occurrence found, and return point.\n\
An optional second argument bounds the search; it is a buffer position.\n\
The match found must not extend 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.")
(string, bound, noerror, count)
Lisp_Object string, bound, noerror, count;
{
return search_command (wordify (string), bound, noerror, count, 1, 1, 0);
}
DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
"sRE search backward: ",
"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 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'.")
(regexp, bound, noerror, count)
Lisp_Object regexp, bound, noerror, count;
{
return search_command (regexp, bound, noerror, count, -1, 1, 0);
}
DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4,
"sRE search: ",
"Search forward from point for regular expression REGEXP.\n\
Set point to the end of the occurrence found, and return point.\n\
An optional second argument bounds the search; it is a buffer position.\n\
The match found must not extend 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'.")
(regexp, bound, noerror, count)
Lisp_Object regexp, bound, noerror, count;
{
return search_command (regexp, bound, noerror, count, 1, 1, 0);
}
DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, 1, 4,
"sPosix search backward: ",
"Search backward from point for match for regular expression REGEXP.\n\
Find the longest match in accord with Posix regular expression rules.\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 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'.")
(regexp, bound, noerror, count)
Lisp_Object regexp, bound, noerror, count;
{
return search_command (regexp, bound, noerror, count, -1, 1, 1);
}
DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, 1, 4,
"sPosix search: ",
"Search forward from point for regular expression REGEXP.\n\
Find the longest match in accord with Posix regular expression rules.\n\
Set point to the end of the occurrence found, and return point.\n\
An optional second argument bounds the search; it is a buffer position.\n\
The match found must not extend 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'.")
(regexp, bound, noerror, count)
Lisp_Object regexp, bound, noerror, count;
{
return search_command (regexp, bound, noerror, count, 1, 1, 1);
}
DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 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 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\
`\\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.\n\
\n\
The optional fourth argument STRING can be a string to modify.\n\
In that case, this function creates and returns a new string\n\
which is made by replacing the part of STRING that was matched.\n\
\n\
The optional fifth argument SUBEXP specifies a subexpression of the match.\n\
It says to replace just that subexpression instead of the whole match.\n\
This is useful only after a regular expression search or match\n\
since only regular expressions have distinguished subexpressions.")
(newtext, fixedcase, literal, string, subexp)
Lisp_Object newtext, fixedcase, literal, string, subexp;
{
enum { nochange, all_caps, cap_initial } case_action;
register int pos, pos_byte;
int some_multiletter_word;
int some_lowercase;
int some_uppercase;
int some_nonuppercase_initial;
register int c, prevc;
int inslen;
int sub;
int opoint, newpoint;
CHECK_STRING (newtext, 0);
if (! NILP (string))
CHECK_STRING (string, 4);
case_action = nochange;
if (search_regs.num_regs <= 0)
error ("replace-match called before any match found");
if (NILP (subexp))
sub = 0;
else
{
CHECK_NUMBER (subexp, 3);
sub = XINT (subexp);
if (sub < 0 || sub >= search_regs.num_regs)
args_out_of_range (subexp, make_number (search_regs.num_regs));
}
if (NILP (string))
{
if (search_regs.start[sub] < BEGV
|| search_regs.start[sub] > search_regs.end[sub]
|| search_regs.end[sub] > ZV)
args_out_of_range (make_number (search_regs.start[sub]),
make_number (search_regs.end[sub]));
}
else
{
if (search_regs.start[sub] < 0
|| search_regs.start[sub] > search_regs.end[sub]
|| search_regs.end[sub] > XSTRING (string)->size)
args_out_of_range (make_number (search_regs.start[sub]),
make_number (search_regs.end[sub]));
}
if (NILP (fixedcase))
{
int last;
pos = search_regs.start[sub];
last = search_regs.end[sub];
if (NILP (string))
pos_byte = CHAR_TO_BYTE (pos);
else
pos_byte = string_char_to_byte (string, pos);
prevc = '\n';
case_action = all_caps;
some_multiletter_word = 0;
some_lowercase = 0;
some_nonuppercase_initial = 0;
some_uppercase = 0;
while (pos < last)
{
if (NILP (string))
{
c = FETCH_CHAR (pos_byte);
INC_BOTH (pos, pos_byte);
}
else
FETCH_STRING_CHAR_ADVANCE (c, string, pos, pos_byte);
if (LOWERCASEP (c))
{
some_lowercase = 1;
if (SYNTAX (prevc) != Sword)
some_nonuppercase_initial = 1;
else
some_multiletter_word = 1;
}
else if (!NOCASEP (c))
{
some_uppercase = 1;
if (SYNTAX (prevc) != Sword)
;
else
some_multiletter_word = 1;
}
else
{
if (SYNTAX (prevc) != Sword)
some_nonuppercase_initial = 1;
}
prevc = c;
}
if (! some_lowercase && some_multiletter_word)
case_action = all_caps;
else if (!some_nonuppercase_initial && some_multiletter_word)
case_action = cap_initial;
else if (!some_nonuppercase_initial && some_uppercase)
case_action = all_caps;
else
case_action = nochange;
}
if (!NILP (string))
{
Lisp_Object before, after;
before = Fsubstring (string, make_number (0),
make_number (search_regs.start[sub]));
after = Fsubstring (string, make_number (search_regs.end[sub]), Qnil);
if (NILP (literal))
{
int lastpos = 0;
int lastpos_byte = 0;
Lisp_Object accum;
Lisp_Object middle;
int length = STRING_BYTES (XSTRING (newtext));
accum = Qnil;
for (pos_byte = 0, pos = 0; pos_byte < length;)
{
int substart = -1;
int subend;
int delbackslash = 0;
FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
if (c == '\\')
{
FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
if (c == '&')
{
substart = search_regs.start[sub];
subend = search_regs.end[sub];
}
else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0')
{
if (search_regs.start[c - '0'] >= 0)
{
substart = search_regs.start[c - '0'];
subend = search_regs.end[c - '0'];
}
}
else if (c == '\\')
delbackslash = 1;
else
error ("Invalid use of `\\' in replacement text");
}
if (substart >= 0)
{
if (pos - 2 != lastpos)
middle = substring_both (newtext, lastpos,
lastpos_byte,
pos - 2, pos_byte - 2);
else
middle = Qnil;
accum = concat3 (accum, middle,
Fsubstring (string,
make_number (substart),
make_number (subend)));
lastpos = pos;
lastpos_byte = pos_byte;
}
else if (delbackslash)
{
middle = substring_both (newtext, lastpos,
lastpos_byte,
pos - 1, pos_byte - 1);
accum = concat2 (accum, middle);
lastpos = pos;
lastpos_byte = pos_byte;
}
}
if (pos != lastpos)
middle = substring_both (newtext, lastpos,
lastpos_byte,
pos, pos_byte);
else
middle = Qnil;
newtext = concat2 (accum, middle);
}
if (case_action == all_caps)
newtext = Fupcase (newtext);
else if (case_action == cap_initial)
newtext = Fupcase_initials (newtext);
return concat3 (before, newtext, after);
}
if (PT >= search_regs.end[sub])
opoint = PT - ZV;
else if (PT > search_regs.start[sub])
opoint = search_regs.end[sub] - ZV;
else
opoint = PT;
TEMP_SET_PT (search_regs.start[sub]);
if (!NILP (literal))
Finsert_and_inherit (1, &newtext);
else
{
struct gcpro gcpro1;
int length = STRING_BYTES (XSTRING (newtext));
GCPRO1 (newtext);
for (pos_byte = 0, pos = 0; pos_byte < length;)
{
int offset = PT - search_regs.start[sub];
FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
if (c == '\\')
{
FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
if (c == '&')
Finsert_buffer_substring
(Fcurrent_buffer (),
make_number (search_regs.start[sub] + offset),
make_number (search_regs.end[sub] + offset));
else if (c >= '1' && c <= '9' && 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'] + offset),
make_number (search_regs.end[c - '0'] + offset));
}
else if (c == '\\')
insert_char (c);
else
error ("Invalid use of `\\' in replacement text");
}
else
insert_char (c);
}
UNGCPRO;
}
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 (PT - inslen), make_number (PT));
else if (case_action == cap_initial)
Fupcase_initials_region (make_number (PT - inslen), make_number (PT));
newpoint = PT;
if (opoint <= 0)
TEMP_SET_PT (opoint + ZV);
else
TEMP_SET_PT (opoint);
move_if_not_intangible (newpoint);
return Qnil;
}
static Lisp_Object
match_limit (num, beginningp)
Lisp_Object num;
int beginningp;
{
register int n;
CHECK_NUMBER (num, 0);
n = XINT (num);
if (n < 0 || n >= search_regs.num_regs)
args_out_of_range (num, make_number (search_regs.num_regs));
if (search_regs.num_regs <= 0
|| search_regs.start[n] < 0)
return Qnil;
return (make_number ((beginningp) ? search_regs.start[n]
: search_regs.end[n]));
}
DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
"Return position of start of text matched by last search.\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.")
(subexp)
Lisp_Object subexp;
{
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\
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.")
(subexp)
Lisp_Object subexp;
{
return match_limit (subexp, 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.\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))
return Qnil;
data = (Lisp_Object *) alloca ((2 * search_regs.num_regs)
* sizeof (Lisp_Object));
len = -1;
for (i = 0; i < search_regs.num_regs; i++)
{
int start = search_regs.start[i];
if (start >= 0)
{
if (EQ (last_thing_searched, Qt)
|| ! NILP (integers))
{
XSETFASTINT (data[2 * i], start);
XSETFASTINT (data[2 * i + 1], search_regs.end[i]);
}
else if (BUFFERP (last_thing_searched))
{
data[2 * i] = Fmake_marker ();
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]),
last_thing_searched);
}
else
abort ();
len = i;
}
else
data[2 * i] = data [2 * i + 1] = Qnil;
}
if (! CONSP (reuse))
return Flist (2 * len + 2, data);
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 (i < 2 * len + 2)
XCONS (prev)->cdr = Flist (2 * len + 2 - i, data + i);
return reuse;
}
DEFUN ("set-match-data", Fset_match_data, Sset_match_data, 1, 1, 0,
"Set internal data on last search match from elements of LIST.\n\
LIST should have been created by calling `match-data' previously.")
(list)
register Lisp_Object list;
{
register int i;
register Lisp_Object marker;
if (running_asynch_code)
save_search_regs ();
if (!CONSP (list) && !NILP (list))
list = wrong_type_argument (Qconsp, list);
last_thing_searched = Qt;
{
int length = XFASTINT (Flength (list)) / 2;
if (length > search_regs.num_regs)
{
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.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;
}
}
for (i = 0; i < search_regs.num_regs; i++)
{
marker = Fcar (list);
if (NILP (marker))
{
search_regs.start[i] = -1;
list = Fcdr (list);
}
else
{
if (MARKERP (marker))
{
if (XMARKER (marker)->buffer == 0)
XSETFASTINT (marker, 0);
else
XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer);
}
CHECK_NUMBER_COERCE_MARKER (marker, 0);
search_regs.start[i] = XINT (marker);
list = Fcdr (list);
marker = Fcar (list);
if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
XSETFASTINT (marker, 0);
CHECK_NUMBER_COERCE_MARKER (marker, 0);
search_regs.end[i] = XINT (marker);
}
list = Fcdr (list);
}
return Qnil;
}
static int search_regs_saved;
static struct re_registers saved_search_regs;
static void
save_search_regs ()
{
if (!search_regs_saved)
{
saved_search_regs.num_regs = search_regs.num_regs;
saved_search_regs.start = search_regs.start;
saved_search_regs.end = search_regs.end;
search_regs.num_regs = 0;
search_regs.start = 0;
search_regs.end = 0;
search_regs_saved = 1;
}
}
void
restore_match_data ()
{
if (search_regs_saved)
{
if (search_regs.num_regs > 0)
{
xfree (search_regs.start);
xfree (search_regs.end);
}
search_regs.num_regs = saved_search_regs.num_regs;
search_regs.start = saved_search_regs.start;
search_regs.end = saved_search_regs.end;
search_regs_saved = 0;
}
}
DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
"Return a regexp string which matches exactly STRING and nothing else.")
(string)
Lisp_Object string;
{
register unsigned char *in, *out, *end;
register unsigned char *temp;
int backslashes_added = 0;
CHECK_STRING (string, 0);
temp = (unsigned char *) alloca (STRING_BYTES (XSTRING (string)) * 2);
in = XSTRING (string)->data;
end = in + STRING_BYTES (XSTRING (string));
out = temp;
for (; in != end; in++)
{
if (*in == '[' || *in == ']'
|| *in == '*' || *in == '.' || *in == '\\'
|| *in == '?' || *in == '+'
|| *in == '^' || *in == '$')
*out++ = '\\', backslashes_added++;
*out++ = *in;
}
return make_specified_string (temp,
XSTRING (string)->size + backslashes_added,
out - temp,
STRING_MULTIBYTE (string));
}
void
syms_of_search ()
{
register int i;
for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
{
searchbufs[i].buf.allocated = 100;
searchbufs[i].buf.buffer = (unsigned char *) malloc (100);
searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
searchbufs[i].regexp = Qnil;
staticpro (&searchbufs[i].regexp);
searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]);
}
searchbuf_head = &searchbufs[0];
Qsearch_failed = intern ("search-failed");
staticpro (&Qsearch_failed);
Qinvalid_regexp = intern ("invalid-regexp");
staticpro (&Qinvalid_regexp);
Fput (Qsearch_failed, Qerror_conditions,
Fcons (Qsearch_failed, Fcons (Qerror, Qnil)));
Fput (Qsearch_failed, Qerror_message,
build_string ("Search failed"));
Fput (Qinvalid_regexp, Qerror_conditions,
Fcons (Qinvalid_regexp, Fcons (Qerror, Qnil)));
Fput (Qinvalid_regexp, Qerror_message,
build_string ("Invalid regexp"));
last_thing_searched = Qnil;
staticpro (&last_thing_searched);
defsubr (&Slooking_at);
defsubr (&Sposix_looking_at);
defsubr (&Sstring_match);
defsubr (&Sposix_string_match);
defsubr (&Ssearch_forward);
defsubr (&Ssearch_backward);
defsubr (&Sword_search_forward);
defsubr (&Sword_search_backward);
defsubr (&Sre_search_forward);
defsubr (&Sre_search_backward);
defsubr (&Sposix_search_forward);
defsubr (&Sposix_search_backward);
defsubr (&Sreplace_match);
defsubr (&Smatch_beginning);
defsubr (&Smatch_end);
defsubr (&Smatch_data);
defsubr (&Sset_match_data);
defsubr (&Sregexp_quote);
}