25 |
#undef STATIC |
#undef STATIC |
26 |
#define regerror gcl_regerror |
#define regerror gcl_regerror |
27 |
void |
void |
28 |
gcl_regerror(s) |
gcl_regerror(char *s) |
|
char *s; |
|
29 |
{ |
{ |
30 |
FEerror("Regexp Error: ~a",1,make_simple_string(s)); |
FEerror("Regexp Error: ~a",1,make_simple_string(s)); |
31 |
} |
} |
40 |
DEFVAR("*CASE-FOLD-SEARCH*",sSAcase_fold_searchA,SI,sLnil, |
DEFVAR("*CASE-FOLD-SEARCH*",sSAcase_fold_searchA,SI,sLnil, |
41 |
"Non nil means that a string-match should ignore case"); |
"Non nil means that a string-match should ignore case"); |
42 |
|
|
43 |
DEFUN("MATCH-BEGINNING",int,fSmatch_beginning,SI,1,1,NONE,II,OO,OO,OO, |
DEFUN("MATCH-BEGINNING",object,fSmatch_beginning,SI,1,1,NONE,OI,OO,OO,OO, |
44 |
"Returns the beginning of the I'th match from the previous STRING-MATCH, \ |
"Returns the beginning of the I'th match from the previous STRING-MATCH, \ |
45 |
where the 0th is for the whole regexp and the subsequent ones match parenthetical expressions. -1 is returned if there is no match, or if the *match-data* \ |
where the 0th is for the whole regexp and the subsequent ones match parenthetical expressions. -1 is returned if there is no match, or if the *match-data* \ |
46 |
vector is not a fixnum array.")(i) |
vector is not a fixnum array.")(i) |
47 |
{ object v = sSAmatch_dataA->s.s_dbind; |
{ object v = sSAmatch_dataA->s.s_dbind; |
48 |
if (type_of(v)==t_vector |
if (type_of(v)==t_vector |
49 |
&& (v->v.v_elttype == aet_fix)) |
&& (v->v.v_elttype == aet_fix)) |
50 |
RETURN1(sSAmatch_dataA->s.s_dbind->fixa.fixa_self[i]); |
RETURN1(make_fixnum(sSAmatch_dataA->s.s_dbind->fixa.fixa_self[i])); |
51 |
RETURN1(-1); |
RETURN1(make_fixnum(-1)); |
52 |
} |
} |
53 |
|
|
54 |
DEFUN("MATCH-END",int,fSmatch_end,SI,1,1,NONE,II,OO,OO,OO, |
DEFUN("MATCH-END",object,fSmatch_end,SI,1,1,NONE,OI,OO,OO,OO, |
55 |
"Returns the end of the I'th match from the previous STRING-MATCH")(i) |
"Returns the end of the I'th match from the previous STRING-MATCH")(i) |
56 |
{ object v = sSAmatch_dataA->s.s_dbind; |
{ object v = sSAmatch_dataA->s.s_dbind; |
57 |
if (type_of(v)==t_vector |
if (type_of(v)==t_vector |
58 |
&& (v->v.v_elttype == aet_fix)) |
&& (v->v.v_elttype == aet_fix)) |
59 |
RETURN1(sSAmatch_dataA->s.s_dbind->fixa.fixa_self[i+NSUBEXP]); |
RETURN1(make_fixnum(sSAmatch_dataA->s.s_dbind->fixa.fixa_self[i+NSUBEXP])); |
60 |
RETURN1(-1); |
RETURN1(make_fixnum(-1)); |
61 |
} |
} |
62 |
|
|
63 |
|
|
64 |
DEFUN("STRING-MATCH",int,fSstring_match,SI,2,4,NONE,IO,OI,IO,OO, |
DEFUN("STRING-MATCH",object,fSstring_match,SI,2,4,NONE,OO,OI,IO,OO, |
65 |
"Match regexp PATTERN in STRING starting in string starting at START \ |
"Match regexp PATTERN in STRING starting in string starting at START \ |
66 |
and ending at END. Return -1 if match not found, otherwise \ |
and ending at END. Return -1 if match not found, otherwise \ |
67 |
return the start index of the first matchs. The variable \ |
return the start index of the first matchs. The variable \ |
74 |
object pattern,string; |
object pattern,string; |
75 |
va_dcl |
va_dcl |
76 |
{ int nargs=VFUN_NARGS; |
{ int nargs=VFUN_NARGS; |
|
char *compiled_reggexp; |
|
77 |
static char buf[400]; |
static char buf[400]; |
78 |
static char case_fold; |
static char case_fold; |
79 |
static regexp *compiled_regexp; |
static regexp *compiled_regexp; |
|
char *tmp = 0; |
|
80 |
int len; |
int len; |
81 |
int start; |
int start; |
82 |
int end; |
int end; |
115 |
v->fixa.fixa_self[NSUBEXP+ i] = (i== 0? 0 : -1); |
v->fixa.fixa_self[NSUBEXP+ i] = (i== 0? 0 : -1); |
116 |
i++; |
i++; |
117 |
}; |
}; |
118 |
RETURN1(0); |
RETURN1(make_fixnum(0)); |
119 |
} |
} |
120 |
{BEGIN_NO_INTERRUPT; |
{BEGIN_NO_INTERRUPT; |
121 |
case_fold_search = (sSAcase_fold_searchA->s.s_dbind != sLnil); |
case_fold_search = (sSAcase_fold_searchA->s.s_dbind != sLnil); |
131 |
compiled_regexp = regcomp(tmp); |
compiled_regexp = regcomp(tmp); |
132 |
if (tmp!=buf) free(tmp); |
if (tmp!=buf) free(tmp); |
133 |
} |
} |
134 |
if (compiled_regexp ==0) {END_NO_INTERRUPT;RETURN1(-1);} |
if (compiled_regexp ==0) {END_NO_INTERRUPT;RETURN1(make_fixnum(-1));} |
135 |
{ char *str = string->st.st_self; |
{ char *str = string->st.st_self; |
136 |
char save_c = str[end]; |
char save_c = str[end]; |
137 |
int ans; |
int ans; |
148 |
ans = regexec(compiled_regexp,str+start,str,end - start); |
ans = regexec(compiled_regexp,str+start,str,end - start); |
149 |
str[end] = save_c; |
str[end] = save_c; |
150 |
if (str!=string->st.st_self) free(str); |
if (str!=string->st.st_self) free(str); |
151 |
if (ans == 0 ) {END_NO_INTERRUPT;RETURN1(-1);} |
if (ans == 0 ) {END_NO_INTERRUPT;RETURN1(make_fixnum(-1));} |
152 |
{int i = -1; |
{int i = -1; |
153 |
regexp *r=compiled_regexp; |
regexp *r=compiled_regexp; |
154 |
while (++i < NSUBEXP) |
while (++i < NSUBEXP) |
157 |
p = r->endp[i] ; |
p = r->endp[i] ; |
158 |
v->fixa.fixa_self[NSUBEXP+ i] = (p == 0 ? -1 : p - str);} |
v->fixa.fixa_self[NSUBEXP+ i] = (p == 0 ? -1 : p - str);} |
159 |
END_NO_INTERRUPT; |
END_NO_INTERRUPT; |
160 |
RETURN1(v->fixa.fixa_self[0]); |
RETURN1(make_fixnum(v->fixa.fixa_self[0])); |
161 |
}} |
}} |
162 |
}} |
}} |
163 |
|
|