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 @window;
  14
  15 while (<>) {
  16         # We highlight only single-line changes, so we need
  17         # a 4-line window to make a decision on whether
  18         # to highlight.
  19         push @window, $_;
  20         next if @window < 4;
  21         if ($window[0] =~ /^$COLOR*(\@| )/ &&
  22             $window[1] =~ /^$COLOR*-/ &&
  23             $window[2] =~ /^$COLOR*\+/ &&
  24             $window[3] !~ /^$COLOR*\+/) {
  25                 print shift @window;
  26                 show_pair(shift @window, shift @window);
  27         }
  28         else {
  29                 print shift @window;
  30         }
  31
  32         # Most of the time there is enough output to keep things streaming,
  33         # but for something like "git log -Sfoo", you can get one early
  34         # commit and then many seconds of nothing. We want to show
  35         # that one commit as soon as possible.
  36         #
  37         # Since we can receive arbitrary input, there's no optimal
  38         # place to flush. Flushing on a blank line is a heuristic that
  39         # happens to match git-log output.
  40         if (!length) {
  41                 local $| = 1;
  42         }
  43 }
  44
  45 # Special case a single-line hunk at the end of file.
  46 if (@window == 3 &&
  47     $window[0] =~ /^$COLOR*(\@| )/ &&
  48     $window[1] =~ /^$COLOR*-/ &&
  49     $window[2] =~ /^$COLOR*\+/) {
  50         print shift @window;
  51         show_pair(shift @window, shift @window);
  52 }
  53
  54 # And then flush any remaining lines.
  55 while (@window) {
  56         print shift @window;
  57 }
  58
  59 exit 0;
  60
  61 sub show_pair {
  62         my @a = split_line(shift);
  63         my @b = split_line(shift);
  64
  65         # Find common prefix, taking care to skip any ansi
  66         # color codes.
  67         my $seen_plusminus;
  68         my ($pa, $pb) = (0, 0);
  69         while ($pa < @a && $pb < @b) {
  70                 if ($a[$pa] =~ /$COLOR/) {
  71                         $pa++;
  72                 }
  73                 elsif ($b[$pb] =~ /$COLOR/) {
  74                         $pb++;
  75                 }
  76                 elsif ($a[$pa] eq $b[$pb]) {
  77                         $pa++;
  78                         $pb++;
  79                 }
  80                 elsif (!$seen_plusminus && $a[$pa] eq '-' && $b[$pb] eq '+') {
  81                         $seen_plusminus = 1;
  82                         $pa++;
  83                         $pb++;
  84                 }
  85                 else {
  86                         last;
  87                 }
  88         }
  89
  90         # Find common suffix, ignoring colors.
  91         my ($sa, $sb) = ($#a, $#b);
  92         while ($sa >= $pa && $sb >= $pb) {
  93                 if ($a[$sa] =~ /$COLOR/) {
  94                         $sa--;
  95                 }
  96                 elsif ($b[$sb] =~ /$COLOR/) {
  97                         $sb--;
  98                 }
  99                 elsif ($a[$sa] eq $b[$sb]) {
 100                         $sa--;
 101                         $sb--;
 102                 }
 103                 else {
 104                         last;
 105                 }
 106         }
 107
 108         if (is_pair_interesting(\@a, $pa, $sa, \@b, $pb, $sb)) {
 109                 print highlight(\@a, $pa, $sa);
 110                 print highlight(\@b, $pb, $sb);
 111         }
 112         else {
 113                 print join('', @a);
 114                 print join('', @b);
 115         }
 116 }
 117
 118 sub split_line {
 119         local $_ = shift;
 120         return map { /$COLOR/ ? $_ : (split //) }
 121                split /($COLOR*)/;
 122 }
 123
 124 sub highlight {
 125         my ($line, $prefix, $suffix) = @_;
 126
 127         return join('',
 128                 @{$line}[0..($prefix-1)],
 129                 $HIGHLIGHT,
 130                 @{$line}[$prefix..$suffix],
 131                 $UNHIGHLIGHT,
 132                 @{$line}[($suffix+1)..$#$line]
 133         );
 134 }
 135
 136 # Pairs are interesting to highlight only if we are going to end up
 137 # highlighting a subset (i.e., not the whole line). Otherwise, the highlighting
 138 # is just useless noise. We can detect this by finding either a matching prefix
 139 # or suffix (disregarding boring bits like whitespace and colorization).
 140 sub is_pair_interesting {
 141         my ($a, $pa, $sa, $b, $pb, $sb) = @_;
 142         my $prefix_a = join('', @$a[0..($pa-1)]);
 143         my $prefix_b = join('', @$b[0..($pb-1)]);
 144         my $suffix_a = join('', @$a[($sa+1)..$#$a]);
 145         my $suffix_b = join('', @$b[($sb+1)..$#$b]);
 146
 147         return $prefix_a !~ /^$COLOR*-$BORING*$/ ||
 148                $prefix_b !~ /^$COLOR*\+$BORING*$/ ||
 149                $suffix_a !~ /^$BORING*$/ ||
 150                $suffix_b !~ /^$BORING*$/;
 151 }