/[gcl]/gcl/o/regexpr.c
ViewVC logotype

Diff of /gcl/o/regexpr.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.1.1 by wfs, Mon Dec 6 22:44:13 1999 UTC revision 1.2 by camm, Sat Jul 20 07:10:56 2002 UTC
# Line 25  Foundation, 675 Mass Ave, Cambridge, MA Line 25  Foundation, 675 Mass Ave, Cambridge, MA
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  }  }
# Line 41  DEFVAR("*MATCH-DATA*",sSAmatch_dataA,SI, Line 40  DEFVAR("*MATCH-DATA*",sSAmatch_dataA,SI,
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 \
# Line 75  be over written.   \ Line 74  be over written.   \
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;
# Line 118  va_dcl Line 115  va_dcl
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);
# Line 134  va_dcl Line 131  va_dcl
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;
# Line 151  va_dcl Line 148  va_dcl
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)
# Line 160  va_dcl Line 157  va_dcl
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                    

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26