From 1aafe2099b0b238c656a9ae90608c60ec708b386 Mon Sep 17 00:00:00 2001
From: Hauke D <haukex@zero-g.net>
Date: Sat, 1 Sep 2018 15:33:25 +0200
Subject: [PATCH] Match highlighting fixes and updates

- Zero-length matches weren't being handled correctly
- Non-matching capture groups weren't being handled correctly
- Added capture group names
---
 web/regex_demo.html | 42 +++++++++++++++++++++++++++++++-----------
 1 file changed, 31 insertions(+), 11 deletions(-)

diff --git a/web/regex_demo.html b/web/regex_demo.html
index 1702b4c..aec4dc4 100644
--- a/web/regex_demo.html
+++ b/web/regex_demo.html
@@ -49,10 +49,17 @@ textarea.samp_ta {
 }
 .match {
 	background-color: lightblue;
+	border: 1px solid blue;
 }
 .capture {
 	background-color: lightgreen;
 }
+.capture.zlen {
+	border: 1px solid green;
+}
+.zlen:hover:after {
+	content: " ";
+}
 </style>
 
 <script src="webperl.js"></script>
@@ -69,6 +76,9 @@ use File::Temp qw/tempfile/;
 use Data::Dumper ();
 my $jq = js('jQuery');
 
+sub pp { Data::Dumper->new([@_])->Useqq(1)->Terse(1)->Pair('=>')
+	->Sortkeys(1)->Quotekeys(0)->Indent(0)->Purity(1)->Dump }
+
 $jq->('#perlinfo')->text("perl $^V");
 
 sub sample_init {
@@ -167,9 +177,7 @@ sub update {
 	for my $samptxt ($jq->('.samptxt')->@*) {
 		$samptxt = $jq->($samptxt);
 		my $text = $samptxt->text;
-		$re_debug and say STDERR "----- ----- ----- ",
-			Data::Dumper->new([$text])->Useqq(1)->Terse(1)->Indent(0)->Dump,
-			" ----- ----- -----";
+		$re_debug and say STDERR "----- ----- ----- ",pp($text)," ----- ----- -----";
 		push @samps, $text;
 		my @m;
 		my $code = $flags=~/g/
@@ -179,19 +187,31 @@ sub update {
 		if (eval $code) {
 			$samptxt->removeClass('nomatch');
 			my %hi;
-			for my $m (@m) {
-				my ($s,$e) = @$m;
-				$hi{shift @$s}{match}++;
-				$hi{$_}{cap}++ for @$s;
-				$hi{$_}{end}++ for @$e;
+			$re_debug and say STDERR '@-/@+ are ',pp(\@m);
+			for my $i (0..$#m) {
+				my ($s,$e) = $m[$i]->@*;
+				for my $j (0..$#$e) { # Use @+ to count all capture groups instead of @-!
+					next if !defined($$s[$j]) && !defined($$e[$j]);
+					my $name = "Match ".($i+1).($j?" Capture Group $j":"");
+					if ($$s[$j]==$$e[$j]) {
+						push @{ $hi{$$s[$j]}{
+								$j==0 ? 'zlen_match' : 'zlen_cap' }
+							}, $name  }
+					else {
+						push @{ $hi{$$s[$j]}{ $j==0 ? 'match' : 'cap' } }, $name;
+						$hi{$$e[$j]}{end}++  }
+				}
 			}
+			$re_debug and say STDERR 'highlights are ',pp(\%hi);
 			my $html='';
 			my $p=0;
 			for my $i (sort {$a<=>$b} keys %hi) {
 				$html .= substr($text,$p,$i-$p);
-				$html .= '</span>' for 1..$hi{$i}{end}//0;
-				$html .= '<span class="match">' for 1..$hi{$i}{match}//0;
-				$html .= '<span class="capture">' for 1..$hi{$i}{cap}//0;
+				$html .= '</span>' x ($hi{$i}{end}//0);
+				$html .= "<span class='zlen match' title='$_'></span>" for @{ $hi{$i}{zlen_match}//[] };
+				$html .= "<span class='zlen capture' title='$_'></span>" for @{ $hi{$i}{zlen_cap}//[] };
+				$html .= "<span class='match' title='$_'>" for @{ $hi{$i}{match}//[] };
+				$html .= "<span class='capture' title='$_'>" for @{ $hi{$i}{cap}//[] };
 			} continue { $p=$i }
 			$html .= substr($text,$p);
 			$samptxt->html($html);