| 1 | package DiffHighlight; |
| 2 | |
| 3 | require v5.008; |
| 4 | use warnings FATAL => 'all'; |
| 5 | use strict; |
| 6 | |
| 7 | # Use the correct value for both UNIX and Windows (/dev/null vs nul) |
| 8 | use File::Spec; |
| 9 | |
| 10 | my $NULL = File::Spec->devnull(); |
| 11 | |
| 12 | # The color theme is initially set to nothing here to allow outside callers |
| 13 | # to set the colors for their application. If nothing is sent in we use |
| 14 | # colors from git config in load_color_config(). |
| 15 | our @OLD_HIGHLIGHT = (); |
| 16 | our @NEW_HIGHLIGHT = (); |
| 17 | |
| 18 | my $RESET = "\x1b[m"; |
| 19 | my $COLOR = qr/\x1b\[[0-9;]*m/; |
| 20 | my $BORING = qr/$COLOR|\s/; |
| 21 | |
| 22 | my @removed; |
| 23 | my @added; |
| 24 | my $in_hunk; |
| 25 | my $graph_indent = 0; |
| 26 | |
| 27 | our $line_cb = sub { print @_ }; |
| 28 | our $flush_cb = sub { local $| = 1 }; |
| 29 | |
| 30 | # Count the visible width of a string, excluding any terminal color sequences. |
| 31 | sub visible_width { |
| 32 | local $_ = shift; |
| 33 | my $ret = 0; |
| 34 | while (length) { |
| 35 | if (s/^$COLOR//) { |
| 36 | # skip colors |
| 37 | } elsif (s/^.//) { |
| 38 | $ret++; |
| 39 | } |
| 40 | } |
| 41 | return $ret; |
| 42 | } |
| 43 | |
| 44 | # Return a substring of $str, omitting $len visible characters from the |
| 45 | # beginning, where terminal color sequences do not count as visible. |
| 46 | sub visible_substr { |
| 47 | my ($str, $len) = @_; |
| 48 | while ($len > 0) { |
| 49 | if ($str =~ s/^$COLOR//) { |
| 50 | next |
| 51 | } |
| 52 | $str =~ s/^.//; |
| 53 | $len--; |
| 54 | } |
| 55 | return $str; |
| 56 | } |
| 57 | |
| 58 | sub handle_line { |
| 59 | my $orig = shift; |
| 60 | local $_ = $orig; |
| 61 | |
| 62 | # match a graph line that begins a commit |
| 63 | if (/^(?:$COLOR?\|$COLOR?[ ])* # zero or more leading "|" with space |
| 64 | $COLOR?\*$COLOR?[ ] # a "*" with its trailing space |
| 65 | (?:$COLOR?\|$COLOR?[ ])* # zero or more trailing "|" |
| 66 | [ ]* # trailing whitespace for merges |
| 67 | /x) { |
| 68 | my $graph_prefix = $&; |
| 69 | |
| 70 | # We must flush before setting graph indent, since the |
| 71 | # new commit may be indented differently from what we |
| 72 | # queued. |
| 73 | flush(); |
| 74 | $graph_indent = visible_width($graph_prefix); |
| 75 | |
| 76 | } elsif ($graph_indent) { |
| 77 | if (length($_) < $graph_indent) { |
| 78 | $graph_indent = 0; |
| 79 | } else { |
| 80 | $_ = visible_substr($_, $graph_indent); |
| 81 | } |
| 82 | } |
| 83 | |
| 84 | if (!$in_hunk) { |
| 85 | $line_cb->($orig); |
| 86 | $in_hunk = /^$COLOR*\@\@ /; |
| 87 | } |
| 88 | elsif (/^$COLOR*-/) { |
| 89 | push @removed, $orig; |
| 90 | } |
| 91 | elsif (/^$COLOR*\+/) { |
| 92 | push @added, $orig; |
| 93 | } |
| 94 | else { |
| 95 | flush(); |
| 96 | $line_cb->($orig); |
| 97 | $in_hunk = /^$COLOR*[\@ ]/; |
| 98 | } |
| 99 | |
| 100 | # Most of the time there is enough output to keep things streaming, |
| 101 | # but for something like "git log -Sfoo", you can get one early |
| 102 | # commit and then many seconds of nothing. We want to show |
| 103 | # that one commit as soon as possible. |
| 104 | # |
| 105 | # Since we can receive arbitrary input, there's no optimal |
| 106 | # place to flush. Flushing on a blank line is a heuristic that |
| 107 | # happens to match git-log output. |
| 108 | if (/^$/) { |
| 109 | $flush_cb->(); |
| 110 | } |
| 111 | } |
| 112 | |
| 113 | sub flush { |
| 114 | # Flush any queued hunk (this can happen when there is no trailing |
| 115 | # context in the final diff of the input). |
| 116 | show_hunk(\@removed, \@added); |
| 117 | @removed = (); |
| 118 | @added = (); |
| 119 | } |
| 120 | |
| 121 | sub highlight_stdin { |
| 122 | while (<STDIN>) { |
| 123 | handle_line($_); |
| 124 | } |
| 125 | flush(); |
| 126 | } |
| 127 | |
| 128 | # Ideally we would feed the default as a human-readable color to |
| 129 | # git-config as the fallback value. But diff-highlight does |
| 130 | # not otherwise depend on git at all, and there are reports |
| 131 | # of it being used in other settings. Let's handle our own |
| 132 | # fallback, which means we will work even if git can't be run. |
| 133 | sub color_config { |
| 134 | our $cached_config; |
| 135 | my ($key, $default) = @_; |
| 136 | |
| 137 | if (!defined $cached_config) { |
| 138 | $cached_config = {}; |
| 139 | my $data = `git config --type=color --get-regexp '^color\.diff-highlight\.' 2>$NULL`; |
| 140 | for my $line (split /\n/, $data) { |
| 141 | my ($key, $color) = split ' ', $line, 2; |
| 142 | $key =~ s/^color\.diff-highlight\.// or next; |
| 143 | $cached_config->{$key} = $color; |
| 144 | } |
| 145 | } |
| 146 | |
| 147 | my $s = $cached_config->{$key}; |
| 148 | return defined($s) ? $s : $default; |
| 149 | } |
| 150 | |
| 151 | sub show_hunk { |
| 152 | my ($a, $b) = @_; |
| 153 | |
| 154 | # If one side is empty, then there is nothing to compare or highlight. |
| 155 | if (!@$a || !@$b) { |
| 156 | $line_cb->(@$a, @$b); |
| 157 | return; |
| 158 | } |
| 159 | |
| 160 | # If we have mismatched numbers of lines on each side, we could try to |
| 161 | # be clever and match up similar lines. But for now we are simple and |
| 162 | # stupid, and only handle multi-line hunks that remove and add the same |
| 163 | # number of lines. |
| 164 | if (@$a != @$b) { |
| 165 | $line_cb->(@$a, @$b); |
| 166 | return; |
| 167 | } |
| 168 | |
| 169 | my @queue; |
| 170 | for (my $i = 0; $i < @$a; $i++) { |
| 171 | my ($rm, $add) = highlight_pair($a->[$i], $b->[$i]); |
| 172 | $line_cb->($rm); |
| 173 | push @queue, $add; |
| 174 | } |
| 175 | $line_cb->(@queue); |
| 176 | } |
| 177 | |
| 178 | sub load_color_config { |
| 179 | # If the colors were NOT set from outside this module we load them on-demand |
| 180 | # from the git config. Note that only one of elements 0 and 2 in each |
| 181 | # array is used (depending on whether you are doing set/unset on an |
| 182 | # attribute, or specifying normal vs highlighted coloring). So we use |
| 183 | # element 1 as our check for whether colors were passed in; it should |
| 184 | # always be set if you want highlighting to do anything. |
| 185 | if (!defined $OLD_HIGHLIGHT[1]) { |
| 186 | @OLD_HIGHLIGHT = ( |
| 187 | color_config('oldnormal'), |
| 188 | color_config('oldhighlight', "\x1b[7m"), |
| 189 | color_config('oldreset', "\x1b[27m") |
| 190 | ); |
| 191 | } |
| 192 | if (!defined $NEW_HIGHLIGHT[1]) { |
| 193 | @NEW_HIGHLIGHT = ( |
| 194 | color_config('newnormal', $OLD_HIGHLIGHT[0]), |
| 195 | color_config('newhighlight', $OLD_HIGHLIGHT[1]), |
| 196 | color_config('newreset', $OLD_HIGHLIGHT[2]) |
| 197 | ); |
| 198 | }; |
| 199 | } |
| 200 | |
| 201 | sub highlight_pair { |
| 202 | my @a = split_line(shift); |
| 203 | my @b = split_line(shift); |
| 204 | |
| 205 | # Find common prefix, taking care to skip any ansi |
| 206 | # color codes. |
| 207 | my $seen_plusminus; |
| 208 | my ($pa, $pb) = (0, 0); |
| 209 | while ($pa < @a && $pb < @b) { |
| 210 | if ($a[$pa] =~ /$COLOR/) { |
| 211 | $pa++; |
| 212 | } |
| 213 | elsif ($b[$pb] =~ /$COLOR/) { |
| 214 | $pb++; |
| 215 | } |
| 216 | elsif ($a[$pa] eq $b[$pb]) { |
| 217 | $pa++; |
| 218 | $pb++; |
| 219 | } |
| 220 | elsif (!$seen_plusminus && $a[$pa] eq '-' && $b[$pb] eq '+') { |
| 221 | $seen_plusminus = 1; |
| 222 | $pa++; |
| 223 | $pb++; |
| 224 | } |
| 225 | else { |
| 226 | last; |
| 227 | } |
| 228 | } |
| 229 | |
| 230 | # Find common suffix, ignoring colors. |
| 231 | my ($sa, $sb) = ($#a, $#b); |
| 232 | while ($sa >= $pa && $sb >= $pb) { |
| 233 | if ($a[$sa] =~ /$COLOR/) { |
| 234 | $sa--; |
| 235 | } |
| 236 | elsif ($b[$sb] =~ /$COLOR/) { |
| 237 | $sb--; |
| 238 | } |
| 239 | elsif ($a[$sa] eq $b[$sb]) { |
| 240 | $sa--; |
| 241 | $sb--; |
| 242 | } |
| 243 | else { |
| 244 | last; |
| 245 | } |
| 246 | } |
| 247 | |
| 248 | if (is_pair_interesting(\@a, $pa, $sa, \@b, $pb, $sb)) { |
| 249 | load_color_config(); |
| 250 | return highlight_line(\@a, $pa, $sa, \@OLD_HIGHLIGHT), |
| 251 | highlight_line(\@b, $pb, $sb, \@NEW_HIGHLIGHT); |
| 252 | } |
| 253 | else { |
| 254 | return join('', @a), |
| 255 | join('', @b); |
| 256 | } |
| 257 | } |
| 258 | |
| 259 | # we split either by $COLOR or by character. This has the side effect of |
| 260 | # leaving in graph cruft. It works because the graph cruft does not contain "-" |
| 261 | # or "+" |
| 262 | sub split_line { |
| 263 | local $_ = shift; |
| 264 | return utf8::decode($_) ? |
| 265 | map { utf8::encode($_); $_ } |
| 266 | map { /$COLOR/ ? $_ : (split //) } |
| 267 | split /($COLOR+)/ : |
| 268 | map { /$COLOR/ ? $_ : (split //) } |
| 269 | split /($COLOR+)/; |
| 270 | } |
| 271 | |
| 272 | sub highlight_line { |
| 273 | my ($line, $prefix, $suffix, $theme) = @_; |
| 274 | |
| 275 | my $start = join('', @{$line}[0..($prefix-1)]); |
| 276 | my $mid = join('', @{$line}[$prefix..$suffix]); |
| 277 | my $end = join('', @{$line}[($suffix+1)..$#$line]); |
| 278 | |
| 279 | # If we have a "normal" color specified, then take over the whole line. |
| 280 | # Otherwise, we try to just manipulate the highlighted bits. |
| 281 | if (defined $theme->[0]) { |
| 282 | s/$COLOR//g for ($start, $mid, $end); |
| 283 | chomp $end; |
| 284 | return join('', |
| 285 | $theme->[0], $start, $RESET, |
| 286 | $theme->[1], $mid, $RESET, |
| 287 | $theme->[0], $end, $RESET, |
| 288 | "\n" |
| 289 | ); |
| 290 | } else { |
| 291 | return join('', |
| 292 | $start, |
| 293 | $theme->[1], $mid, $theme->[2], |
| 294 | $end |
| 295 | ); |
| 296 | } |
| 297 | } |
| 298 | |
| 299 | # Pairs are interesting to highlight only if we are going to end up |
| 300 | # highlighting a subset (i.e., not the whole line). Otherwise, the highlighting |
| 301 | # is just useless noise. We can detect this by finding either a matching prefix |
| 302 | # or suffix (disregarding boring bits like whitespace and colorization). |
| 303 | sub is_pair_interesting { |
| 304 | my ($a, $pa, $sa, $b, $pb, $sb) = @_; |
| 305 | |
| 306 | # We hit this case if the prefix consumed the entire line, meaning |
| 307 | # that two lines are identical. This generally shouldn't happen, |
| 308 | # since it implies the diff isn't minimal (you could shrink the hunk by |
| 309 | # making this a context line). But you can see it when the line |
| 310 | # content is the same, but the trailing newline is dropped, like: |
| 311 | # |
| 312 | # -foo |
| 313 | # +foo |
| 314 | # \No newline at end of file |
| 315 | return 0 if $pa == @$a || $pb == @$b; |
| 316 | |
| 317 | my $prefix_a = join('', @$a[0..($pa-1)]); |
| 318 | my $prefix_b = join('', @$b[0..($pb-1)]); |
| 319 | my $suffix_a = join('', @$a[($sa+1)..$#$a]); |
| 320 | my $suffix_b = join('', @$b[($sb+1)..$#$b]); |
| 321 | |
| 322 | return visible_substr($prefix_a, $graph_indent) !~ /^$COLOR*-$BORING*$/ || |
| 323 | visible_substr($prefix_b, $graph_indent) !~ /^$COLOR*\+$BORING*$/ || |
| 324 | $suffix_a !~ /^$BORING*$/ || |
| 325 | $suffix_b !~ /^$BORING*$/; |
| 326 | } |