summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIlya Zakharevich <ilya@math.berkeley.edu>1998-07-21 19:58:53 -0400
committerGurusamy Sarathy <gsar@cpan.org>1998-08-02 06:26:57 +0000
commitaf819cba4f44bf2074ec4808e403dedf8c3ce2b2 (patch)
tree242fa243bf24d2cb1e544f0da4275b64fd508f2c
parentaab1f907125f90712decb35f2a57d7c7c35d30a2 (diff)
downloadperl-af819cba4f44bf2074ec4808e403dedf8c3ce2b2.tar.gz
better RE colors
Message-Id: <199807220358.XAA19811@monk.mps.ohio-state.edu> p4raw-id: //depot/maint-5.005/perl@1703
-rw-r--r--ext/re/re.pm8
-rw-r--r--regcomp.c53
-rw-r--r--regexec.c19
-rw-r--r--thrdvar.h2
4 files changed, 43 insertions, 39 deletions
diff --git a/ext/re/re.pm b/ext/re/re.pm
index 7cea77dd42..1c225e3a7c 100644
--- a/ext/re/re.pm
+++ b/ext/re/re.pm
@@ -84,16 +84,12 @@ sub setcolor {
require Term::Cap;
my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
- my $props = $ENV{PERL_RE_TC} || 'md,me,so,se'; # can use us/ue later
+ my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
my @props = split /,/, $props;
- $ENV{TERMCAP_COLORS} = join "\t", map {$terminal->Tputs($_,1)} @props;
+ $ENV{PERL_RE_COLORS} = join "\t", map {$terminal->Tputs($_,1)} @props;
};
-
- not defined $ENV{TERMCAP_COLORS} or ($ENV{TERMCAP_COLORS} =~ tr/\t/\t/) >= 4
- or not defined $ENV{PERL_RE_TC}
- or die "Not enough fields in \$ENV{PERL_RE_TC}=`$ENV{PERL_RE_TC}'";
}
sub bits {
diff --git a/regcomp.c b/regcomp.c
index f2f51a4420..dceb5b7bb8 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -730,8 +730,32 @@ pregcomp(char *exp, char *xend, PMOP *pm)
FAIL("NULL regexp argument");
PL_regprecomp = savepvn(exp, xend - exp);
- DEBUG_r(PerlIO_printf(Perl_debug_log, "compiling RE `%*s'\n",
- xend - exp, PL_regprecomp));
+ 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]));
PL_regflags = pm->op_pmflags;
PL_regsawback = 0;
@@ -755,31 +779,6 @@ pregcomp(char *exp, char *xend, PMOP *pm)
}
DEBUG_r(PerlIO_printf(Perl_debug_log, "size %d ", PL_regsize));
- DEBUG_r(
- if (!PL_colorset) {
- int i = 0;
- char *s = PerlEnv_getenv("TERMCAP_COLORS");
-
- PL_colorset = 1;
- if (s) {
- PL_colors[0] = s = savepv(s);
- while (++i < 4) {
- s = strchr(s, '\t');
- if (!s)
- FAIL("Not enough TABs in TERMCAP_COLORS");
- *s = '\0';
- PL_colors[i] = ++s;
- }
- } else {
- while (i < 4)
- PL_colors[i++] = "";
- }
- /* Reset colors: */
- PerlIO_printf(Perl_debug_log, "%s%s%s%s",
- PL_colors[0],PL_colors[1],PL_colors[2],PL_colors[3]);
- }
- );
-
/* Small enough for pointer-storage convention?
If extralen==0, this means that we will not need long jumps. */
if (PL_regsize >= 0x10000L && PL_extralen)
diff --git a/regexec.c b/regexec.c
index f8c5e7e997..e052912e10 100644
--- a/regexec.c
+++ b/regexec.c
@@ -318,11 +318,14 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend,
DEBUG_r(
PerlIO_printf(Perl_debug_log,
- "Matching `%.60s%s' against `%.*s%s'\n",
- prog->precomp,
+ "%sMatching%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
+ PL_colors[4],PL_colors[5],PL_colors[0],
+ prog->precomp,
+ PL_colors[1],
(strlen(prog->precomp) > 60 ? "..." : ""),
+ PL_colors[0],
(strend - startpos > 60 ? 60 : strend - startpos),
- startpos,
+ startpos, PL_colors[1],
(strend - startpos > 60 ? "..." : ""))
);
@@ -794,15 +797,21 @@ regmatch(regnode *prog)
int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput);
int pref_len = (locinput - PL_bostr > (5 + taill) - l
? (5 + taill) - l : locinput - PL_bostr);
+ int pref0_len = pref_len - (locinput - PL_reginput);
if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
l = ( PL_regeol - locinput > (5 + taill) - pref_len
? (5 + taill) - pref_len : PL_regeol - locinput);
+ if (pref0_len < 0)
+ pref0_len = 0;
regprop(prop, scan);
PerlIO_printf(Perl_debug_log,
- "%4i <%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n",
+ "%4i <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n",
locinput - PL_bostr,
- PL_colors[2], pref_len, locinput - pref_len, PL_colors[3],
+ PL_colors[4], pref0_len,
+ locinput - pref_len, PL_colors[5],
+ PL_colors[2], pref_len - pref0_len,
+ locinput - pref_len + pref0_len, PL_colors[3],
(docolor ? "" : "> <"),
PL_colors[0], l, locinput, PL_colors[1],
15 - l - pref_len + 1,
diff --git a/thrdvar.h b/thrdvar.h
index 4ca3ccbd50..3fa4c0643f 100644
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -133,7 +133,7 @@ PERLVAR(Tseen_evals, I32) /* from regcomp.c */
PERLVAR(Tregcomp_rx, regexp *) /* from regcomp.c */
PERLVAR(Textralen, I32) /* from regcomp.c */
PERLVAR(Tcolorset, int) /* from regcomp.c */
-PERLVAR(Tcolors[4], char *) /* from regcomp.c */
+PERLVAR(Tcolors[6], char *) /* from regcomp.c */
PERLVAR(Treginput, char *) /* String-input pointer. */
PERLVAR(Tregbol, char *) /* Beginning of input, for ^ check. */
PERLVAR(Tregeol, char *) /* End of input, for $ check. */