From: Ilya Zakharevich Date: Fri, 27 Nov 1998 15:22:19 +0000 (-0500) Subject: regcolors X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d88dccdfb395b1157f084b2065b4dae06e68381b;p=p5sagit%2Fp5-mst-13.2.git regcolors Message-Id: <199811272022.PAA17874@monk.mps.ohio-state.edu> p4raw-id: //depot/perl@2370 --- diff --git a/embed.h b/embed.h index c2c1119..95d8889 100644 --- a/embed.h +++ b/embed.h @@ -774,6 +774,7 @@ #define refkids Perl_refkids #define regdump Perl_regdump #define regexec_flags Perl_regexec_flags +#define reginitcolors Perl_reginitcolors #define regnext Perl_regnext #define regprop Perl_regprop #define repeatcpy Perl_repeatcpy @@ -1909,6 +1910,7 @@ #define reghopmaybe CPerlObj::Perl_reghopmaybe #define reginclass CPerlObj::Perl_reginclass #define reginclassutf8 CPerlObj::Perl_reginclassutf8 +#define reginitcolors CPerlObj::Perl_reginitcolors #define reginsert CPerlObj::Perl_reginsert #define regmatch CPerlObj::Perl_regmatch #define regnext CPerlObj::Perl_regnext diff --git a/global.sym b/global.sym index b2a8f1a..7c1ecc5 100644 --- a/global.sym +++ b/global.sym @@ -419,6 +419,7 @@ push_return push_scope ref refkids +reginitcolors regdump regexec_flags regnext diff --git a/objXSUB.h b/objXSUB.h index ae1dab5..2a86440 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -2613,6 +2613,8 @@ #define reginclass pPerl->Perl_reginclass #undef reginclassutf8 #define reginclassutf8 pPerl->Perl_reginclassutf8 +#undef reginitcolors +#define reginitcolors pPerl->Perl_reginitcolors #undef reginsert #define reginsert pPerl->Perl_reginsert #undef regmatch diff --git a/proto.h b/proto.h index 818c8c7..b22451a 100644 --- a/proto.h +++ b/proto.h @@ -961,3 +961,4 @@ VIRTUAL void do_op_dump _((I32 level, PerlIO *file, OP *o)); VIRTUAL void do_pmop_dump _((I32 level, PerlIO *file, PMOP *pm)); VIRTUAL void do_sv_dump _((I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)); VIRTUAL void magic_dump _((MAGIC *mg)); +VIRTUAL void reginitcolors _((void)); diff --git a/regcomp.c b/regcomp.c index 4fcef36..fb2993b 100644 --- a/regcomp.c +++ b/regcomp.c @@ -39,6 +39,7 @@ # define Perl_pregfree my_regfree # define Perl_regnext my_regnext # define Perl_save_re_context my_save_re_context +# define Perl_reginitcolors my_reginitcolors #endif /*SUPPRESS 112*/ @@ -759,6 +760,31 @@ add_data(I32 n, char *s) return PL_regcomp_rx->data->count - n; } +void +reginitcolors(void) +{ + dTHR; + int i = 0; + char *s = PerlEnv_getenv("PERL_RE_COLORS"); + + if (s) { + PL_colors[0] = s = savepv(s); + while (++i < 6) { + s = strchr(s, '\t'); + if (s) { + *s = '\0'; + PL_colors[i] = ++s; + } + else + PL_colors[i] = ""; + } + } else { + while (i < 6) + PL_colors[i++] = ""; + } + PL_colorset = 1; +} + /* - pregcomp - compile a regular expression into internal code * @@ -799,31 +825,11 @@ pregcomp(char *exp, char *xend, PMOP *pm) PL_regprecomp = savepvn(exp, xend - exp); DEBUG_r( - if (!PL_colorset) { - int i = 0; - char *s = PerlEnv_getenv("PERL_RE_COLORS"); - - if (s) { - PL_colors[0] = s = savepv(s); - while (++i < 6) { - s = strchr(s, '\t'); - if (s) { - *s = '\0'; - PL_colors[i] = ++s; - } - else - PL_colors[i] = ""; - } - } else { - while (i < 6) - PL_colors[i++] = ""; - } - PL_colorset = 1; - } - ); - DEBUG_r(PerlIO_printf(Perl_debug_log, "%sCompiling%s RE `%s%*s%s'\n", - PL_colors[4],PL_colors[5],PL_colors[0], - xend - exp, PL_regprecomp, PL_colors[1])); + if (!PL_colorset) + reginitcolors(); + PerlIO_printf(Perl_debug_log, "%sCompiling%s RE `%s%*s%s'\n", + PL_colors[4],PL_colors[5],PL_colors[0], + xend - exp, PL_regprecomp, PL_colors[1])); PL_regflags = pm->op_pmflags; PL_regsawback = 0; diff --git a/regexec.c b/regexec.c index b590f0e..e4de1ed 100644 --- a/regexec.c +++ b/regexec.c @@ -37,6 +37,7 @@ # define Perl_regprop my_regprop /* *These* symbols are masked to allow static link. */ # define Perl_pregexec my_pregexec +# define Perl_reginitcolors my_reginitcolors #endif /*SUPPRESS 112*/ @@ -401,6 +402,8 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend, } DEBUG_r( + if (!PL_colorset) + reginitcolors(); PerlIO_printf(Perl_debug_log, "%sMatching%s `%s%.60s%s%s' against `%s%.*s%s%s'\n", PL_colors[4],PL_colors[5],PL_colors[0],