contrib/diff-highlight/diff-highlight

   1 #!/usr/bin/perl
   2
   3 use warnings FATAL => 'all';
   4 use strict;
   5
   6 # Highlight by reversing foreground and background. You could do
   7 # other things like bold or underline if you prefer.
   8 my $HIGHLIGHT   = "\x1b[7m";
   9 my $UNHIGHLIGHT = "\x1b[27m";
  10 my $COLOR = qr/\x1b\[[0-9;]*m/;
  11 my $BORING = qr/$COLOR|\s/;
  12
  13 my @removed;
  14 my @added;
  15 my $in_hunk;
  16
  17 while (<>) {
  18         if (!$in_hunk) {
  19                 print;
  20                 $in_hunk = /^$COLOR*\@/;
  21         }
  22         elsif (/^$COLOR*-/) {
  23                 push @removed, $_;
  24         }
  25         elsif (/^$COLOR*\+/) {
  26                 push @added, $_;
  27         }
  28         else {
  29                 show_hunk(\@removed, \@added);
  30                 @removed = ();
  31                 @added = ();
  32
  33                 print;
  34                 $in_hunk = /^$COLOR*[\@ ]/;
  35         }
  36
  37         # Most of the time there is enough output to keep things streaming,
  38         # but for something like "git log -Sfoo", you can get one early
  39         # commit and then many seconds of nothing. We want to show
  40         # that one commit as soon as possible.
  41         #
  42         # Since we can receive arbitrary input, there's no optimal
  43         # place to flush. Flushing on a blank line is a heuristic that
  44         # happens to match git-log output.
  45         if (!length) {
  46                 local $| = 1;
  47         }
  48 }
  49
  50 # Flush any queued hunk (this can happen when there is no trailing context in
  51 # the final diff of the input).
  52 show_hunk(\@removed, \@added);
  53
  54 exit 0;
  55
  56 sub show_hunk {
  57         my ($a, $b) = @_;
  58
  59         # If one side is empty, then there is nothing to compare or highlight.
  60         if (!@$a || !@$b) {
  61                 print @$a, @$b;
  62                 return;
  63         }
  64
  65         # If we have mismatched numbers of lines on each side, we could try to
  66         # be clever and match up similar lines. But for now we are simple and
  67         # stupid, and only handle multi-line hunks that remove and add the same
  68         # number of lines.
  69         if (@$a != @$b) {
  70                 print @$a, @$b;
  71                 return;
  72         }
  73
  74         my @queue;
  75         for (my $i = 0; $i < @$a; $i++) {
  76                 my ($rm, $add) = highlight_pair($a->[$i], $b->[$i]);
  77                 print $rm;
  78                 push @queue, $add;
  79         }
  80         print @queue;
  81 }
  82
  83 sub highlight_pair {
  84         my @a = split_line(shift);
  85         my @b = split_line(shift);
  86
  87         # Find common prefix, taking care to skip any ansi
  88         # color codes.
  89         my $seen_plusminus;
  90         my ($pa, $pb) = (0, 0);
  91         while ($pa < @a && $pb < @b) {
  92                 if ($a[$pa] =~ /$COLOR/) {
  93                         $pa++;
  94                 }
  95                 elsif ($b[$pb] =~ /$COLOR/) {
  96                         $pb++;
  97                 }
  98                 elsif ($a[$pa] eq $b[$pb]) {
  99                         $pa++;
 100                         $pb++;
 101                 }
 102                 elsif (!$seen_plusminus && $a[$pa] eq '-' && $b[$pb] eq '+') {
 103                         $seen_plusminus = 1;
 104                         $pa++;
 105                         $pb++;
 106                 }
 107                 else {
 108                         last;
 109                 }
 110         }
 111
 112         # Find common suffix, ignoring colors.
 113         my ($sa, $sb) = ($#a, $#b);
 114         while ($sa >= $pa && $sb >= $pb) {
 115                 if ($a[$sa] =~ /$COLOR/) {
 116                         $sa--;
 117                 }
 118                 elsif ($b[$sb] =~ /$COLOR/) {
 119                         $sb--;
 120                 }
 121                 elsif ($a[$sa] eq $b[$sb]) {
 122                         $sa--;
 123                         $sb--;
 124                 }
 125                 else {
 126                         last;
 127                 }
 128         }
 129
 130         if (is_pair_interesting(\@a, $pa, $sa, \@b, $pb, $sb)) {
 131                 return highlight_line(\@a, $pa, $sa),
 132                        highlight_line(\@b, $pb, $sb);
 133         }
 134         else {
 135                 return join('', @a),
 136                        join('', @b);
 137         }
 138 }
 139
 140 sub split_line {
 141         local $_ = shift;
 142         return map { /$COLOR/ ? $_ : (split //) }
 143                split /($COLOR*)/;
 144 }
 145
 146 sub highlight_line {
 147         my ($line, $prefix, $suffix) = @_;
 148
 149         return join('',
 150                 @{$line}[0..($prefix-1)],
 151                 $HIGHLIGHT,
 152                 @{$line}[$prefix..$suffix],
 153                 $UNHIGHLIGHT,
 154                 @{$line}[($suffix+1)..$#$line]
 155         );
 156 }
 157
 158 # Pairs are interesting to highlight only if we are going to end up
 159 # highlighting a subset (i.e., not the whole line). Otherwise, the highlighting
 160 # is just useless noise. We can detect this by finding either a matching prefix
 161 # or suffix (disregarding boring bits like whitespace and colorization).
 162 sub is_pair_interesting {
 163         my ($a, $pa, $sa, $b, $pb, $sb) = @_;
 164         my $prefix_a = join('', @$a[0..($pa-1)]);
 165         my $prefix_b = join('', @$b[0..($pb-1)]);
 166         my $suffix_a = join('', @$a[($sa+1)..$#$a]);
 167         my $suffix_b = join('', @$b[($sb+1)..$#$b]);
 168
 169         return $prefix_a !~ /^$COLOR*-$BORING*$/ ||
 170                $prefix_b !~ /^$COLOR*\+$BORING*$/ ||
 171                $suffix_a !~ /^$BORING*$/ ||
 172                $suffix_b !~ /^$BORING*$/;
 173 }