regcolors

	Message-Id: <199811272022.PAA17874@monk.mps.ohio-state.edu>

p4raw-id: //depot/perl@2370

6 files changed, 40 insertions, 25 deletions

diff --git a/embed.h b/embed.h
index c2c11191b3..95d8889e10 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 b2a8f1a542..7c1ecc55d8 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 ae1dab5524..2a86440797 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 818c8c72b3..b22451a7da 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 4fcef363ab..fb2993b6ac 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 b590f0e20c..e4de1edeea 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],