git-add--interactive.perl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Git;
   5
   6 # Prompt colors:
   7 my ($prompt_color, $header_color, $help_color, $normal_color);
   8 # Diff colors:
   9 my ($fraginfo_color);
  10
  11 my ($use_color, $diff_use_color);
  12 my $repo = Git->repository();
  13
  14 $use_color = $repo->get_colorbool('color.interactive');
  15
  16 if ($use_color) {
  17         # Set interactive colors:
  18
  19         # Grab the 3 main colors in git color string format, with sane
  20         # (visible) defaults:
  21         $prompt_color = $repo->get_color("color.interactive.prompt", "bold blue");
  22         $header_color = $repo->get_color("color.interactive.header", "bold");
  23         $help_color = $repo->get_color("color.interactive.help", "red bold");
  24         $normal_color = $repo->get_color("", "reset");
  25
  26         # Do we also set diff colors?
  27         $diff_use_color = $repo->get_colorbool('color.diff');
  28         if ($diff_use_color) {
  29                 $fraginfo_color = $repo->get_color("color.diff.frag", "cyan");
  30         }
  31 }
  32
  33 sub colored {
  34         my $color = shift;
  35         my $string = join("", @_);
  36
  37         if ($use_color) {
  38                 # Put a color code at the beginning of each line, a reset at the end
  39                 # color after newlines that are not at the end of the string
  40                 $string =~ s/(\n+)(.)/$1$color$2/g;
  41                 # reset before newlines
  42                 $string =~ s/(\n+)/$normal_color$1/g;
  43                 # codes at beginning and end (if necessary):
  44                 $string =~ s/^/$color/;
  45                 $string =~ s/$/$normal_color/ unless $string =~ /\n$/;
  46         }
  47         return $string;
  48 }
  49
  50 # command line options
  51 my $patch_mode;
  52
  53 sub run_cmd_pipe {
  54         if ($^O eq 'MSWin32') {
  55                 my @invalid = grep {m/[":*]/} @_;
  56                 die "$^O does not support: @invalid\n" if @invalid;
  57                 my @args = map { m/ /o ? "\"$_\"": $_ } @_;
  58                 return qx{@args};
  59         } else {
  60                 my $fh = undef;
  61                 open($fh, '-|', @_) or die;
  62                 return <$fh>;
  63         }
  64 }
  65
  66 my ($GIT_DIR) = run_cmd_pipe(qw(git rev-parse --git-dir));
  67
  68 if (!defined $GIT_DIR) {
  69         exit(1); # rev-parse would have already said "not a git repo"
  70 }
  71 chomp($GIT_DIR);
  72
  73 sub refresh {
  74         my $fh;
  75         open $fh, 'git update-index --refresh |'
  76             or die;
  77         while (<$fh>) {
  78                 ;# ignore 'needs update'
  79         }
  80         close $fh;
  81 }
  82
  83 sub list_untracked {
  84         map {
  85                 chomp $_;
  86                 $_;
  87         }
  88         run_cmd_pipe(qw(git ls-files --others --exclude-standard --), @ARGV);
  89 }
  90
  91 my $status_fmt = '%12s %12s %s';
  92 my $status_head = sprintf($status_fmt, 'staged', 'unstaged', 'path');
  93
  94 # Returns list of hashes, contents of each of which are:
  95 # VALUE:        pathname
  96 # BINARY:       is a binary path
  97 # INDEX:        is index different from HEAD?
  98 # FILE:         is file different from index?
  99 # INDEX_ADDDEL: is it add/delete between HEAD and index?
 100 # FILE_ADDDEL:  is it add/delete between index and file?
 101
 102 sub list_modified {
 103         my ($only) = @_;
 104         my (%data, @return);
 105         my ($add, $del, $adddel, $file);
 106         my @tracked = ();
 107
 108         if (@ARGV) {
 109                 @tracked = map {
 110                         chomp $_; $_;
 111                 } run_cmd_pipe(qw(git ls-files --exclude-standard --), @ARGV);
 112                 return if (!@tracked);
 113         }
 114
 115         for (run_cmd_pipe(qw(git diff-index --cached
 116                              --numstat --summary HEAD --), @tracked)) {
 117                 if (($add, $del, $file) =
 118                     /^([-\d]+)  ([-\d]+)        (.*)/) {
 119                         my ($change, $bin);
 120                         if ($add eq '-' && $del eq '-') {
 121                                 $change = 'binary';
 122                                 $bin = 1;
 123                         }
 124                         else {
 125                                 $change = "+$add/-$del";
 126                         }
 127                         $data{$file} = {
 128                                 INDEX => $change,
 129                                 BINARY => $bin,
 130                                 FILE => 'nothing',
 131                         }
 132                 }
 133                 elsif (($adddel, $file) =
 134                        /^ (create|delete) mode [0-7]+ (.*)$/) {
 135                         $data{$file}{INDEX_ADDDEL} = $adddel;
 136                 }
 137         }
 138
 139         for (run_cmd_pipe(qw(git diff-files --numstat --summary --), @tracked)) {
 140                 if (($add, $del, $file) =
 141                     /^([-\d]+)  ([-\d]+)        (.*)/) {
 142                         if (!exists $data{$file}) {
 143                                 $data{$file} = +{
 144                                         INDEX => 'unchanged',
 145                                         BINARY => 0,
 146                                 };
 147                         }
 148                         my ($change, $bin);
 149                         if ($add eq '-' && $del eq '-') {
 150                                 $change = 'binary';
 151                                 $bin = 1;
 152                         }
 153                         else {
 154                                 $change = "+$add/-$del";
 155                         }
 156                         $data{$file}{FILE} = $change;
 157                         if ($bin) {
 158                                 $data{$file}{BINARY} = 1;
 159                         }
 160                 }
 161                 elsif (($adddel, $file) =
 162                        /^ (create|delete) mode [0-7]+ (.*)$/) {
 163                         $data{$file}{FILE_ADDDEL} = $adddel;
 164                 }
 165         }
 166
 167         for (sort keys %data) {
 168                 my $it = $data{$_};
 169
 170                 if ($only) {
 171                         if ($only eq 'index-only') {
 172                                 next if ($it->{INDEX} eq 'unchanged');
 173                         }
 174                         if ($only eq 'file-only') {
 175                                 next if ($it->{FILE} eq 'nothing');
 176                         }
 177                 }
 178                 push @return, +{
 179                         VALUE => $_,
 180                         %$it,
 181                 };
 182         }
 183         return @return;
 184 }
 185
 186 sub find_unique {
 187         my ($string, @stuff) = @_;
 188         my $found = undef;
 189         for (my $i = 0; $i < @stuff; $i++) {
 190                 my $it = $stuff[$i];
 191                 my $hit = undef;
 192                 if (ref $it) {
 193                         if ((ref $it) eq 'ARRAY') {
 194                                 $it = $it->[0];
 195                         }
 196                         else {
 197                                 $it = $it->{VALUE};
 198                         }
 199                 }
 200                 eval {
 201                         if ($it =~ /^$string/) {
 202                                 $hit = 1;
 203                         };
 204                 };
 205                 if (defined $hit && defined $found) {
 206                         return undef;
 207                 }
 208                 if ($hit) {
 209                         $found = $i + 1;
 210                 }
 211         }
 212         return $found;
 213 }
 214
 215 # inserts string into trie and updates count for each character
 216 sub update_trie {
 217         my ($trie, $string) = @_;
 218         foreach (split //, $string) {
 219                 $trie = $trie->{$_} ||= {COUNT => 0};
 220                 $trie->{COUNT}++;
 221         }
 222 }
 223
 224 # returns an array of tuples (prefix, remainder)
 225 sub find_unique_prefixes {
 226         my @stuff = @_;
 227         my @return = ();
 228
 229         # any single prefix exceeding the soft limit is omitted
 230         # if any prefix exceeds the hard limit all are omitted
 231         # 0 indicates no limit
 232         my $soft_limit = 0;
 233         my $hard_limit = 3;
 234
 235         # build a trie modelling all possible options
 236         my %trie;
 237         foreach my $print (@stuff) {
 238                 if ((ref $print) eq 'ARRAY') {
 239                         $print = $print->[0];
 240                 }
 241                 elsif ((ref $print) eq 'HASH') {
 242                         $print = $print->{VALUE};
 243                 }
 244                 update_trie(\%trie, $print);
 245                 push @return, $print;
 246         }
 247
 248         # use the trie to find the unique prefixes
 249         for (my $i = 0; $i < @return; $i++) {
 250                 my $ret = $return[$i];
 251                 my @letters = split //, $ret;
 252                 my %search = %trie;
 253                 my ($prefix, $remainder);
 254                 my $j;
 255                 for ($j = 0; $j < @letters; $j++) {
 256                         my $letter = $letters[$j];
 257                         if ($search{$letter}{COUNT} == 1) {
 258                                 $prefix = substr $ret, 0, $j + 1;
 259                                 $remainder = substr $ret, $j + 1;
 260                                 last;
 261                         }
 262                         else {
 263                                 my $prefix = substr $ret, 0, $j;
 264                                 return ()
 265                                     if ($hard_limit && $j + 1 > $hard_limit);
 266                         }
 267                         %search = %{$search{$letter}};
 268                 }
 269                 if ($soft_limit && $j + 1 > $soft_limit) {
 270                         $prefix = undef;
 271                         $remainder = $ret;
 272                 }
 273                 $return[$i] = [$prefix, $remainder];
 274         }
 275         return @return;
 276 }
 277
 278 # filters out prefixes which have special meaning to list_and_choose()
 279 sub is_valid_prefix {
 280         my $prefix = shift;
 281         return (defined $prefix) &&
 282             !($prefix =~ /[\s,]/) && # separators
 283             !($prefix =~ /^-/) &&    # deselection
 284             !($prefix =~ /^\d+/) &&  # selection
 285             ($prefix ne '*') &&      # "all" wildcard
 286             ($prefix ne '?');        # prompt help
 287 }
 288
 289 # given a prefix/remainder tuple return a string with the prefix highlighted
 290 # for now use square brackets; later might use ANSI colors (underline, bold)
 291 sub highlight_prefix {
 292         my $prefix = shift;
 293         my $remainder = shift;
 294
 295         if (!defined $prefix) {
 296                 return $remainder;
 297         }
 298
 299         if (!is_valid_prefix($prefix)) {
 300                 return "$prefix$remainder";
 301         }
 302
 303         if (!$use_color) {
 304                 return "[$prefix]$remainder";
 305         }
 306
 307         return "$prompt_color$prefix$normal_color$remainder";
 308 }
 309
 310 sub list_and_choose {
 311         my ($opts, @stuff) = @_;
 312         my (@chosen, @return);
 313         my $i;
 314         my @prefixes = find_unique_prefixes(@stuff) unless $opts->{LIST_ONLY};
 315
 316       TOPLOOP:
 317         while (1) {
 318                 my $last_lf = 0;
 319
 320                 if ($opts->{HEADER}) {
 321                         if (!$opts->{LIST_FLAT}) {
 322                                 print "     ";
 323                         }
 324                         print colored $header_color, "$opts->{HEADER}\n";
 325                 }
 326                 for ($i = 0; $i < @stuff; $i++) {
 327                         my $chosen = $chosen[$i] ? '*' : ' ';
 328                         my $print = $stuff[$i];
 329                         my $ref = ref $print;
 330                         my $highlighted = highlight_prefix(@{$prefixes[$i]})
 331                             if @prefixes;
 332                         if ($ref eq 'ARRAY') {
 333                                 $print = $highlighted || $print->[0];
 334                         }
 335                         elsif ($ref eq 'HASH') {
 336                                 my $value = $highlighted || $print->{VALUE};
 337                                 $print = sprintf($status_fmt,
 338                                     $print->{INDEX},
 339                                     $print->{FILE},
 340                                     $value);
 341                         }
 342                         else {
 343                                 $print = $highlighted || $print;
 344                         }
 345                         printf("%s%2d: %s", $chosen, $i+1, $print);
 346                         if (($opts->{LIST_FLAT}) &&
 347                             (($i + 1) % ($opts->{LIST_FLAT}))) {
 348                                 print "\t";
 349                                 $last_lf = 0;
 350                         }
 351                         else {
 352                                 print "\n";
 353                                 $last_lf = 1;
 354                         }
 355                 }
 356                 if (!$last_lf) {
 357                         print "\n";
 358                 }
 359
 360                 return if ($opts->{LIST_ONLY});
 361
 362                 print colored $prompt_color, $opts->{PROMPT};
 363                 if ($opts->{SINGLETON}) {
 364                         print "> ";
 365                 }
 366                 else {
 367                         print ">> ";
 368                 }
 369                 my $line = <STDIN>;
 370                 if (!$line) {
 371                         print "\n";
 372                         $opts->{ON_EOF}->() if $opts->{ON_EOF};
 373                         last;
 374                 }
 375                 chomp $line;
 376                 last if $line eq '';
 377                 if ($line eq '?') {
 378                         $opts->{SINGLETON} ?
 379                             singleton_prompt_help_cmd() :
 380                             prompt_help_cmd();
 381                         next TOPLOOP;
 382                 }
 383                 for my $choice (split(/[\s,]+/, $line)) {
 384                         my $choose = 1;
 385                         my ($bottom, $top);
 386
 387                         # Input that begins with '-'; unchoose
 388                         if ($choice =~ s/^-//) {
 389                                 $choose = 0;
 390                         }
 391                         # A range can be specified like 5-7
 392                         if ($choice =~ /^(\d+)-(\d+)$/) {
 393                                 ($bottom, $top) = ($1, $2);
 394                         }
 395                         elsif ($choice =~ /^\d+$/) {
 396                                 $bottom = $top = $choice;
 397                         }
 398                         elsif ($choice eq '*') {
 399                                 $bottom = 1;
 400                                 $top = 1 + @stuff;
 401                         }
 402                         else {
 403                                 $bottom = $top = find_unique($choice, @stuff);
 404                                 if (!defined $bottom) {
 405                                         print "Huh ($choice)?\n";
 406                                         next TOPLOOP;
 407                                 }
 408                         }
 409                         if ($opts->{SINGLETON} && $bottom != $top) {
 410                                 print "Huh ($choice)?\n";
 411                                 next TOPLOOP;
 412                         }
 413                         for ($i = $bottom-1; $i <= $top-1; $i++) {
 414                                 next if (@stuff <= $i || $i < 0);
 415                                 $chosen[$i] = $choose;
 416                         }
 417                 }
 418                 last if ($opts->{IMMEDIATE} || $line eq '*');
 419         }
 420         for ($i = 0; $i < @stuff; $i++) {
 421                 if ($chosen[$i]) {
 422                         push @return, $stuff[$i];
 423                 }
 424         }
 425         return @return;
 426 }
 427
 428 sub singleton_prompt_help_cmd {
 429         print colored $help_color, <<\EOF ;
 430 Prompt help:
 431 1          - select a numbered item
 432 foo        - select item based on unique prefix
 433            - (empty) select nothing
 434 EOF
 435 }
 436
 437 sub prompt_help_cmd {
 438         print colored $help_color, <<\EOF ;
 439 Prompt help:
 440 1          - select a single item
 441 3-5        - select a range of items
 442 2-3,6-9    - select multiple ranges
 443 foo        - select item based on unique prefix
 444 -...       - unselect specified items
 445 *          - choose all items
 446            - (empty) finish selecting
 447 EOF
 448 }
 449
 450 sub status_cmd {
 451         list_and_choose({ LIST_ONLY => 1, HEADER => $status_head },
 452                         list_modified());
 453         print "\n";
 454 }
 455
 456 sub say_n_paths {
 457         my $did = shift @_;
 458         my $cnt = scalar @_;
 459         print "$did ";
 460         if (1 < $cnt) {
 461                 print "$cnt paths\n";
 462         }
 463         else {
 464                 print "one path\n";
 465         }
 466 }
 467
 468 sub update_cmd {
 469         my @mods = list_modified('file-only');
 470         return if (!@mods);
 471
 472         my @update = list_and_choose({ PROMPT => 'Update',
 473                                        HEADER => $status_head, },
 474                                      @mods);
 475         if (@update) {
 476                 system(qw(git update-index --add --remove --),
 477                        map { $_->{VALUE} } @update);
 478                 say_n_paths('updated', @update);
 479         }
 480         print "\n";
 481 }
 482
 483 sub revert_cmd {
 484         my @update = list_and_choose({ PROMPT => 'Revert',
 485                                        HEADER => $status_head, },
 486                                      list_modified());
 487         if (@update) {
 488                 my @lines = run_cmd_pipe(qw(git ls-tree HEAD --),
 489                                          map { $_->{VALUE} } @update);
 490                 my $fh;
 491                 open $fh, '| git update-index --index-info'
 492                     or die;
 493                 for (@lines) {
 494                         print $fh $_;
 495                 }
 496                 close($fh);
 497                 for (@update) {
 498                         if ($_->{INDEX_ADDDEL} &&
 499                             $_->{INDEX_ADDDEL} eq 'create') {
 500                                 system(qw(git update-index --force-remove --),
 501                                        $_->{VALUE});
 502                                 print "note: $_->{VALUE} is untracked now.\n";
 503                         }
 504                 }
 505                 refresh();
 506                 say_n_paths('reverted', @update);
 507         }
 508         print "\n";
 509 }
 510
 511 sub add_untracked_cmd {
 512         my @add = list_and_choose({ PROMPT => 'Add untracked' },
 513                                   list_untracked());
 514         if (@add) {
 515                 system(qw(git update-index --add --), @add);
 516                 say_n_paths('added', @add);
 517         }
 518         print "\n";
 519 }
 520
 521 sub parse_diff {
 522         my ($path) = @_;
 523         my @diff = run_cmd_pipe(qw(git diff-files -p --), $path);
 524         my @colored = ();
 525         if ($diff_use_color) {
 526                 @colored = run_cmd_pipe(qw(git diff-files -p --color --), $path);
 527         }
 528         my (@hunk) = { TEXT => [], DISPLAY => [] };
 529
 530         for (my $i = 0; $i < @diff; $i++) {
 531                 if ($diff[$i] =~ /^@@ /) {
 532                         push @hunk, { TEXT => [], DISPLAY => [] };
 533                 }
 534                 push @{$hunk[-1]{TEXT}}, $diff[$i];
 535                 push @{$hunk[-1]{DISPLAY}},
 536                         ($diff_use_color ? $colored[$i] : $diff[$i]);
 537         }
 538         return @hunk;
 539 }
 540
 541 sub hunk_splittable {
 542         my ($text) = @_;
 543
 544         my @s = split_hunk($text);
 545         return (1 < @s);
 546 }
 547
 548 sub parse_hunk_header {
 549         my ($line) = @_;
 550         my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
 551             $line =~ /^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/;
 552         $o_cnt = 1 unless defined $o_cnt;
 553         $n_cnt = 1 unless defined $n_cnt;
 554         return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
 555 }
 556
 557 sub split_hunk {
 558         my ($text, $display) = @_;
 559         my @split = ();
 560         if (!defined $display) {
 561                 $display = $text;
 562         }
 563         # If there are context lines in the middle of a hunk,
 564         # it can be split, but we would need to take care of
 565         # overlaps later.
 566
 567         my ($o_ofs, undef, $n_ofs) = parse_hunk_header($text->[0]);
 568         my $hunk_start = 1;
 569
 570       OUTER:
 571         while (1) {
 572                 my $next_hunk_start = undef;
 573                 my $i = $hunk_start - 1;
 574                 my $this = +{
 575                         TEXT => [],
 576                         DISPLAY => [],
 577                         OLD => $o_ofs,
 578                         NEW => $n_ofs,
 579                         OCNT => 0,
 580                         NCNT => 0,
 581                         ADDDEL => 0,
 582                         POSTCTX => 0,
 583                         USE => undef,
 584                 };
 585
 586                 while (++$i < @$text) {
 587                         my $line = $text->[$i];
 588                         my $display = $display->[$i];
 589                         if ($line =~ /^ /) {
 590                                 if ($this->{ADDDEL} &&
 591                                     !defined $next_hunk_start) {
 592                                         # We have seen leading context and
 593                                         # adds/dels and then here is another
 594                                         # context, which is trailing for this
 595                                         # split hunk and leading for the next
 596                                         # one.
 597                                         $next_hunk_start = $i;
 598                                 }
 599                                 push @{$this->{TEXT}}, $line;
 600                                 push @{$this->{DISPLAY}}, $display;
 601                                 $this->{OCNT}++;
 602                                 $this->{NCNT}++;
 603                                 if (defined $next_hunk_start) {
 604                                         $this->{POSTCTX}++;
 605                                 }
 606                                 next;
 607                         }
 608
 609                         # add/del
 610                         if (defined $next_hunk_start) {
 611                                 # We are done with the current hunk and
 612                                 # this is the first real change for the
 613                                 # next split one.
 614                                 $hunk_start = $next_hunk_start;
 615                                 $o_ofs = $this->{OLD} + $this->{OCNT};
 616                                 $n_ofs = $this->{NEW} + $this->{NCNT};
 617                                 $o_ofs -= $this->{POSTCTX};
 618                                 $n_ofs -= $this->{POSTCTX};
 619                                 push @split, $this;
 620                                 redo OUTER;
 621                         }
 622                         push @{$this->{TEXT}}, $line;
 623                         push @{$this->{DISPLAY}}, $display;
 624                         $this->{ADDDEL}++;
 625                         if ($line =~ /^-/) {
 626                                 $this->{OCNT}++;
 627                         }
 628                         else {
 629                                 $this->{NCNT}++;
 630                         }
 631                 }
 632
 633                 push @split, $this;
 634                 last;
 635         }
 636
 637         for my $hunk (@split) {
 638                 $o_ofs = $hunk->{OLD};
 639                 $n_ofs = $hunk->{NEW};
 640                 my $o_cnt = $hunk->{OCNT};
 641                 my $n_cnt = $hunk->{NCNT};
 642
 643                 my $head = ("@@ -$o_ofs" .
 644                             (($o_cnt != 1) ? ",$o_cnt" : '') .
 645                             " +$n_ofs" .
 646                             (($n_cnt != 1) ? ",$n_cnt" : '') .
 647                             " @@\n");
 648                 my $display_head = $head;
 649                 unshift @{$hunk->{TEXT}}, $head;
 650                 if ($diff_use_color) {
 651                         $display_head = colored($fraginfo_color, $head);
 652                 }
 653                 unshift @{$hunk->{DISPLAY}}, $display_head;
 654         }
 655         return @split;
 656 }
 657
 658 sub find_last_o_ctx {
 659         my ($it) = @_;
 660         my $text = $it->{TEXT};
 661         my ($o_ofs, $o_cnt) = parse_hunk_header($text->[0]);
 662         my $i = @{$text};
 663         my $last_o_ctx = $o_ofs + $o_cnt;
 664         while (0 < --$i) {
 665                 my $line = $text->[$i];
 666                 if ($line =~ /^ /) {
 667                         $last_o_ctx--;
 668                         next;
 669                 }
 670                 last;
 671         }
 672         return $last_o_ctx;
 673 }
 674
 675 sub merge_hunk {
 676         my ($prev, $this) = @_;
 677         my ($o0_ofs, $o0_cnt, $n0_ofs, $n0_cnt) =
 678             parse_hunk_header($prev->{TEXT}[0]);
 679         my ($o1_ofs, $o1_cnt, $n1_ofs, $n1_cnt) =
 680             parse_hunk_header($this->{TEXT}[0]);
 681
 682         my (@line, $i, $ofs, $o_cnt, $n_cnt);
 683         $ofs = $o0_ofs;
 684         $o_cnt = $n_cnt = 0;
 685         for ($i = 1; $i < @{$prev->{TEXT}}; $i++) {
 686                 my $line = $prev->{TEXT}[$i];
 687                 if ($line =~ /^\+/) {
 688                         $n_cnt++;
 689                         push @line, $line;
 690                         next;
 691                 }
 692
 693                 last if ($o1_ofs <= $ofs);
 694
 695                 $o_cnt++;
 696                 $ofs++;
 697                 if ($line =~ /^ /) {
 698                         $n_cnt++;
 699                 }
 700                 push @line, $line;
 701         }
 702
 703         for ($i = 1; $i < @{$this->{TEXT}}; $i++) {
 704                 my $line = $this->{TEXT}[$i];
 705                 if ($line =~ /^\+/) {
 706                         $n_cnt++;
 707                         push @line, $line;
 708                         next;
 709                 }
 710                 $ofs++;
 711                 $o_cnt++;
 712                 if ($line =~ /^ /) {
 713                         $n_cnt++;
 714                 }
 715                 push @line, $line;
 716         }
 717         my $head = ("@@ -$o0_ofs" .
 718                     (($o_cnt != 1) ? ",$o_cnt" : '') .
 719                     " +$n0_ofs" .
 720                     (($n_cnt != 1) ? ",$n_cnt" : '') .
 721                     " @@\n");
 722         @{$prev->{TEXT}} = ($head, @line);
 723 }
 724
 725 sub coalesce_overlapping_hunks {
 726         my (@in) = @_;
 727         my @out = ();
 728
 729         my ($last_o_ctx);
 730
 731         for (grep { $_->{USE} } @in) {
 732                 my $text = $_->{TEXT};
 733                 my ($o_ofs) = parse_hunk_header($text->[0]);
 734                 if (defined $last_o_ctx &&
 735                     $o_ofs <= $last_o_ctx) {
 736                         merge_hunk($out[-1], $_);
 737                 }
 738                 else {
 739                         push @out, $_;
 740                 }
 741                 $last_o_ctx = find_last_o_ctx($out[-1]);
 742         }
 743         return @out;
 744 }
 745
 746 sub help_patch_cmd {
 747         print colored $help_color, <<\EOF ;
 748 y - stage this hunk
 749 n - do not stage this hunk
 750 a - stage this and all the remaining hunks in the file
 751 d - do not stage this hunk nor any of the remaining hunks in the file
 752 j - leave this hunk undecided, see next undecided hunk
 753 J - leave this hunk undecided, see next hunk
 754 k - leave this hunk undecided, see previous undecided hunk
 755 K - leave this hunk undecided, see previous hunk
 756 s - split the current hunk into smaller hunks
 757 ? - print help
 758 EOF
 759 }
 760
 761 sub patch_update_cmd {
 762         my @mods = grep { !($_->{BINARY}) } list_modified('file-only');
 763         my @them;
 764
 765         if (!@mods) {
 766                 print STDERR "No changes.\n";
 767                 return 0;
 768         }
 769         if ($patch_mode) {
 770                 @them = @mods;
 771         }
 772         else {
 773                 @them = list_and_choose({ PROMPT => 'Patch update',
 774                                           HEADER => $status_head, },
 775                                         @mods);
 776         }
 777         for (@them) {
 778                 patch_update_file($_->{VALUE});
 779         }
 780 }
 781
 782 sub patch_update_file {
 783         my ($ix, $num);
 784         my $path = shift;
 785         my ($head, @hunk) = parse_diff($path);
 786         for (@{$head->{DISPLAY}}) {
 787                 print;
 788         }
 789         $num = scalar @hunk;
 790         $ix = 0;
 791
 792         while (1) {
 793                 my ($prev, $next, $other, $undecided, $i);
 794                 $other = '';
 795
 796                 if ($num <= $ix) {
 797                         $ix = 0;
 798                 }
 799                 for ($i = 0; $i < $ix; $i++) {
 800                         if (!defined $hunk[$i]{USE}) {
 801                                 $prev = 1;
 802                                 $other .= '/k';
 803                                 last;
 804                         }
 805                 }
 806                 if ($ix) {
 807                         $other .= '/K';
 808                 }
 809                 for ($i = $ix + 1; $i < $num; $i++) {
 810                         if (!defined $hunk[$i]{USE}) {
 811                                 $next = 1;
 812                                 $other .= '/j';
 813                                 last;
 814                         }
 815                 }
 816                 if ($ix < $num - 1) {
 817                         $other .= '/J';
 818                 }
 819                 for ($i = 0; $i < $num; $i++) {
 820                         if (!defined $hunk[$i]{USE}) {
 821                                 $undecided = 1;
 822                                 last;
 823                         }
 824                 }
 825                 last if (!$undecided);
 826
 827                 if (hunk_splittable($hunk[$ix]{TEXT})) {
 828                         $other .= '/s';
 829                 }
 830                 for (@{$hunk[$ix]{DISPLAY}}) {
 831                         print;
 832                 }
 833                 print colored $prompt_color, "Stage this hunk [y/n/a/d$other/?]? ";
 834                 my $line = <STDIN>;
 835                 if ($line) {
 836                         if ($line =~ /^y/i) {
 837                                 $hunk[$ix]{USE} = 1;
 838                         }
 839                         elsif ($line =~ /^n/i) {
 840                                 $hunk[$ix]{USE} = 0;
 841                         }
 842                         elsif ($line =~ /^a/i) {
 843                                 while ($ix < $num) {
 844                                         if (!defined $hunk[$ix]{USE}) {
 845                                                 $hunk[$ix]{USE} = 1;
 846                                         }
 847                                         $ix++;
 848                                 }
 849                                 next;
 850                         }
 851                         elsif ($line =~ /^d/i) {
 852                                 while ($ix < $num) {
 853                                         if (!defined $hunk[$ix]{USE}) {
 854                                                 $hunk[$ix]{USE} = 0;
 855                                         }
 856                                         $ix++;
 857                                 }
 858                                 next;
 859                         }
 860                         elsif ($other =~ /K/ && $line =~ /^K/) {
 861                                 $ix--;
 862                                 next;
 863                         }
 864                         elsif ($other =~ /J/ && $line =~ /^J/) {
 865                                 $ix++;
 866                                 next;
 867                         }
 868                         elsif ($other =~ /k/ && $line =~ /^k/) {
 869                                 while (1) {
 870                                         $ix--;
 871                                         last if (!$ix ||
 872                                                  !defined $hunk[$ix]{USE});
 873                                 }
 874                                 next;
 875                         }
 876                         elsif ($other =~ /j/ && $line =~ /^j/) {
 877                                 while (1) {
 878                                         $ix++;
 879                                         last if ($ix >= $num ||
 880                                                  !defined $hunk[$ix]{USE});
 881                                 }
 882                                 next;
 883                         }
 884                         elsif ($other =~ /s/ && $line =~ /^s/) {
 885                                 my @split = split_hunk($hunk[$ix]{TEXT}, $hunk[$ix]{DISPLAY});
 886                                 if (1 < @split) {
 887                                         print colored $header_color, "Split into ",
 888                                         scalar(@split), " hunks.\n";
 889                                 }
 890                                 splice (@hunk, $ix, 1, @split);
 891                                 $num = scalar @hunk;
 892                                 next;
 893                         }
 894                         else {
 895                                 help_patch_cmd($other);
 896                                 next;
 897                         }
 898                         # soft increment
 899                         while (1) {
 900                                 $ix++;
 901                                 last if ($ix >= $num ||
 902                                          !defined $hunk[$ix]{USE});
 903                         }
 904                 }
 905         }
 906
 907         @hunk = coalesce_overlapping_hunks(@hunk);
 908
 909         my $n_lofs = 0;
 910         my @result = ();
 911         for (@hunk) {
 912                 my $text = $_->{TEXT};
 913                 my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
 914                     parse_hunk_header($text->[0]);
 915
 916                 if (!$_->{USE}) {
 917                         # We would have added ($n_cnt - $o_cnt) lines
 918                         # to the postimage if we were to use this hunk,
 919                         # but we didn't.  So the line number that the next
 920                         # hunk starts at would be shifted by that much.
 921                         $n_lofs -= ($n_cnt - $o_cnt);
 922                         next;
 923                 }
 924                 else {
 925                         if ($n_lofs) {
 926                                 $n_ofs += $n_lofs;
 927                                 $text->[0] = ("@@ -$o_ofs" .
 928                                               (($o_cnt != 1)
 929                                                ? ",$o_cnt" : '') .
 930                                               " +$n_ofs" .
 931                                               (($n_cnt != 1)
 932                                                ? ",$n_cnt" : '') .
 933                                               " @@\n");
 934                         }
 935                         for (@$text) {
 936                                 push @result, $_;
 937                         }
 938                 }
 939         }
 940
 941         if (@result) {
 942                 my $fh;
 943
 944                 open $fh, '| git apply --cached';
 945                 for (@{$head->{TEXT}}, @result) {
 946                         print $fh $_;
 947                 }
 948                 if (!close $fh) {
 949                         for (@{$head->{TEXT}}, @result) {
 950                                 print STDERR $_;
 951                         }
 952                 }
 953                 refresh();
 954         }
 955
 956         print "\n";
 957 }
 958
 959 sub diff_cmd {
 960         my @mods = list_modified('index-only');
 961         @mods = grep { !($_->{BINARY}) } @mods;
 962         return if (!@mods);
 963         my (@them) = list_and_choose({ PROMPT => 'Review diff',
 964                                      IMMEDIATE => 1,
 965                                      HEADER => $status_head, },
 966                                    @mods);
 967         return if (!@them);
 968         system(qw(git diff -p --cached HEAD --), map { $_->{VALUE} } @them);
 969 }
 970
 971 sub quit_cmd {
 972         print "Bye.\n";
 973         exit(0);
 974 }
 975
 976 sub help_cmd {
 977         print colored $help_color, <<\EOF ;
 978 status        - show paths with changes
 979 update        - add working tree state to the staged set of changes
 980 revert        - revert staged set of changes back to the HEAD version
 981 patch         - pick hunks and update selectively
 982 diff          - view diff between HEAD and index
 983 add untracked - add contents of untracked files to the staged set of changes
 984 EOF
 985 }
 986
 987 sub process_args {
 988         return unless @ARGV;
 989         my $arg = shift @ARGV;
 990         if ($arg eq "--patch") {
 991                 $patch_mode = 1;
 992                 $arg = shift @ARGV or die "missing --";
 993                 die "invalid argument $arg, expecting --"
 994                     unless $arg eq "--";
 995         }
 996         elsif ($arg ne "--") {
 997                 die "invalid argument $arg, expecting --";
 998         }
 999 }
1000
1001 sub main_loop {
1002         my @cmd = ([ 'status', \&status_cmd, ],
1003                    [ 'update', \&update_cmd, ],
1004                    [ 'revert', \&revert_cmd, ],
1005                    [ 'add untracked', \&add_untracked_cmd, ],
1006                    [ 'patch', \&patch_update_cmd, ],
1007                    [ 'diff', \&diff_cmd, ],
1008                    [ 'quit', \&quit_cmd, ],
1009                    [ 'help', \&help_cmd, ],
1010         );
1011         while (1) {
1012                 my ($it) = list_and_choose({ PROMPT => 'What now',
1013                                              SINGLETON => 1,
1014                                              LIST_FLAT => 4,
1015                                              HEADER => '*** Commands ***',
1016                                              ON_EOF => \&quit_cmd,
1017                                              IMMEDIATE => 1 }, @cmd);
1018                 if ($it) {
1019                         eval {
1020                                 $it->[1]->();
1021                         };
1022                         if ($@) {
1023                                 print "$@";
1024                         }
1025                 }
1026         }
1027 }
1028
1029 process_args();
1030 refresh();
1031 if ($patch_mode) {
1032         patch_update_cmd();
1033 }
1034 else {
1035         status_cmd();
1036         main_loop();
1037 }