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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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],