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