git-add--interactive.perl

   1 #!/usr/bin/perl
   2
   3 use 5.008;
   4 use strict;
   5 use warnings;
   6 use Git qw(unquote_path);
   7 use Git::I18N;
   8
   9 binmode(STDOUT, ":raw");
  10
  11 my $repo = Git->repository();
  12
  13 my $menu_use_color = $repo->get_colorbool('color.interactive');
  14 my ($prompt_color, $header_color, $help_color) =
  15         $menu_use_color ? (
  16                 $repo->get_color('color.interactive.prompt', 'bold blue'),
  17                 $repo->get_color('color.interactive.header', 'bold'),
  18                 $repo->get_color('color.interactive.help', 'red bold'),
  19         ) : ();
  20 my $error_color = ();
  21 if ($menu_use_color) {
  22         my $help_color_spec = ($repo->config('color.interactive.help') or
  23                                 'red bold');
  24         $error_color = $repo->get_color('color.interactive.error',
  25                                         $help_color_spec);
  26 }
  27
  28 my $diff_use_color = $repo->get_colorbool('color.diff');
  29 my ($fraginfo_color) =
  30         $diff_use_color ? (
  31                 $repo->get_color('color.diff.frag', 'cyan'),
  32         ) : ();
  33 my ($diff_plain_color) =
  34         $diff_use_color ? (
  35                 $repo->get_color('color.diff.plain', ''),
  36         ) : ();
  37 my ($diff_old_color) =
  38         $diff_use_color ? (
  39                 $repo->get_color('color.diff.old', 'red'),
  40         ) : ();
  41 my ($diff_new_color) =
  42         $diff_use_color ? (
  43                 $repo->get_color('color.diff.new', 'green'),
  44         ) : ();
  45
  46 my $normal_color = $repo->get_color("", "reset");
  47
  48 my $diff_algorithm = $repo->config('diff.algorithm');
  49 my $diff_indent_heuristic = $repo->config_bool('diff.indentheuristic');
  50 my $diff_filter = $repo->config('interactive.difffilter');
  51
  52 my $use_readkey = 0;
  53 my $use_termcap = 0;
  54 my %term_escapes;
  55
  56 sub ReadMode;
  57 sub ReadKey;
  58 if ($repo->config_bool("interactive.singlekey")) {
  59         eval {
  60                 require Term::ReadKey;
  61                 Term::ReadKey->import;
  62                 $use_readkey = 1;
  63         };
  64         if (!$use_readkey) {
  65                 print STDERR "missing Term::ReadKey, disabling interactive.singlekey\n";
  66         }
  67         eval {
  68                 require Term::Cap;
  69                 my $termcap = Term::Cap->Tgetent;
  70                 foreach (values %$termcap) {
  71                         $term_escapes{$_} = 1 if /^\e/;
  72                 }
  73                 $use_termcap = 1;
  74         };
  75 }
  76
  77 sub colored {
  78         my $color = shift;
  79         my $string = join("", @_);
  80
  81         if (defined $color) {
  82                 # Put a color code at the beginning of each line, a reset at the end
  83                 # color after newlines that are not at the end of the string
  84                 $string =~ s/(\n+)(.)/$1$color$2/g;
  85                 # reset before newlines
  86                 $string =~ s/(\n+)/$normal_color$1/g;
  87                 # codes at beginning and end (if necessary):
  88                 $string =~ s/^/$color/;
  89                 $string =~ s/$/$normal_color/ unless $string =~ /\n$/;
  90         }
  91         return $string;
  92 }
  93
  94 # command line options
  95 my $patch_mode_only;
  96 my $patch_mode;
  97 my $patch_mode_revision;
  98
  99 sub apply_patch;
 100 sub apply_patch_for_checkout_commit;
 101 sub apply_patch_for_stash;
 102
 103 my %patch_modes = (
 104         'stage' => {
 105                 DIFF => 'diff-files -p',
 106                 APPLY => sub { apply_patch 'apply --cached', @_; },
 107                 APPLY_CHECK => 'apply --cached',
 108                 FILTER => 'file-only',
 109                 IS_REVERSE => 0,
 110         },
 111         'stash' => {
 112                 DIFF => 'diff-index -p HEAD',
 113                 APPLY => sub { apply_patch 'apply --cached', @_; },
 114                 APPLY_CHECK => 'apply --cached',
 115                 FILTER => undef,
 116                 IS_REVERSE => 0,
 117         },
 118         'reset_head' => {
 119                 DIFF => 'diff-index -p --cached',
 120                 APPLY => sub { apply_patch 'apply -R --cached', @_; },
 121                 APPLY_CHECK => 'apply -R --cached',
 122                 FILTER => 'index-only',
 123                 IS_REVERSE => 1,
 124         },
 125         'reset_nothead' => {
 126                 DIFF => 'diff-index -R -p --cached',
 127                 APPLY => sub { apply_patch 'apply --cached', @_; },
 128                 APPLY_CHECK => 'apply --cached',
 129                 FILTER => 'index-only',
 130                 IS_REVERSE => 0,
 131         },
 132         'checkout_index' => {
 133                 DIFF => 'diff-files -p',
 134                 APPLY => sub { apply_patch 'apply -R', @_; },
 135                 APPLY_CHECK => 'apply -R',
 136                 FILTER => 'file-only',
 137                 IS_REVERSE => 1,
 138         },
 139         'checkout_head' => {
 140                 DIFF => 'diff-index -p',
 141                 APPLY => sub { apply_patch_for_checkout_commit '-R', @_ },
 142                 APPLY_CHECK => 'apply -R',
 143                 FILTER => undef,
 144                 IS_REVERSE => 1,
 145         },
 146         'checkout_nothead' => {
 147                 DIFF => 'diff-index -R -p',
 148                 APPLY => sub { apply_patch_for_checkout_commit '', @_ },
 149                 APPLY_CHECK => 'apply',
 150                 FILTER => undef,
 151                 IS_REVERSE => 0,
 152         },
 153 );
 154
 155 $patch_mode = 'stage';
 156 my %patch_mode_flavour = %{$patch_modes{$patch_mode}};
 157
 158 sub run_cmd_pipe {
 159         if ($^O eq 'MSWin32') {
 160                 my @invalid = grep {m/[":*]/} @_;
 161                 die "$^O does not support: @invalid\n" if @invalid;
 162                 my @args = map { m/ /o ? "\"$_\"": $_ } @_;
 163                 return qx{@args};
 164         } else {
 165                 my $fh = undef;
 166                 open($fh, '-|', @_) or die;
 167                 return <$fh>;
 168         }
 169 }
 170
 171 my ($GIT_DIR) = run_cmd_pipe(qw(git rev-parse --git-dir));
 172
 173 if (!defined $GIT_DIR) {
 174         exit(1); # rev-parse would have already said "not a git repo"
 175 }
 176 chomp($GIT_DIR);
 177
 178 sub refresh {
 179         my $fh;
 180         open $fh, 'git update-index --refresh |'
 181             or die;
 182         while (<$fh>) {
 183                 ;# ignore 'needs update'
 184         }
 185         close $fh;
 186 }
 187
 188 sub list_untracked {
 189         map {
 190                 chomp $_;
 191                 unquote_path($_);
 192         }
 193         run_cmd_pipe(qw(git ls-files --others --exclude-standard --), @ARGV);
 194 }
 195
 196 # TRANSLATORS: you can adjust this to align "git add -i" status menu
 197 my $status_fmt = __('%12s %12s %s');
 198 my $status_head = sprintf($status_fmt, __('staged'), __('unstaged'), __('path'));
 199
 200 {
 201         my $initial;
 202         sub is_initial_commit {
 203                 $initial = system('git rev-parse HEAD -- >/dev/null 2>&1') != 0
 204                         unless defined $initial;
 205                 return $initial;
 206         }
 207 }
 208
 209 sub get_empty_tree {
 210         return '4b825dc642cb6eb9a060e54bf8d69288fbee4904';
 211 }
 212
 213 sub get_diff_reference {
 214         my $ref = shift;
 215         if (defined $ref and $ref ne 'HEAD') {
 216                 return $ref;
 217         } elsif (is_initial_commit()) {
 218                 return get_empty_tree();
 219         } else {
 220                 return 'HEAD';
 221         }
 222 }
 223
 224 # Returns list of hashes, contents of each of which are:
 225 # VALUE:        pathname
 226 # BINARY:       is a binary path
 227 # INDEX:        is index different from HEAD?
 228 # FILE:         is file different from index?
 229 # INDEX_ADDDEL: is it add/delete between HEAD and index?
 230 # FILE_ADDDEL:  is it add/delete between index and file?
 231 # UNMERGED:     is the path unmerged
 232
 233 sub list_modified {
 234         my ($only) = @_;
 235         my (%data, @return);
 236         my ($add, $del, $adddel, $file);
 237
 238         my $reference = get_diff_reference($patch_mode_revision);
 239         for (run_cmd_pipe(qw(git diff-index --cached
 240                              --numstat --summary), $reference,
 241                              '--', @ARGV)) {
 242                 if (($add, $del, $file) =
 243                     /^([-\d]+)  ([-\d]+)        (.*)/) {
 244                         my ($change, $bin);
 245                         $file = unquote_path($file);
 246                         if ($add eq '-' && $del eq '-') {
 247                                 $change = __('binary');
 248                                 $bin = 1;
 249                         }
 250                         else {
 251                                 $change = "+$add/-$del";
 252                         }
 253                         $data{$file} = {
 254                                 INDEX => $change,
 255                                 BINARY => $bin,
 256                                 FILE => __('nothing'),
 257                         }
 258                 }
 259                 elsif (($adddel, $file) =
 260                        /^ (create|delete) mode [0-7]+ (.*)$/) {
 261                         $file = unquote_path($file);
 262                         $data{$file}{INDEX_ADDDEL} = $adddel;
 263                 }
 264         }
 265
 266         for (run_cmd_pipe(qw(git diff-files --numstat --summary --raw --), @ARGV)) {
 267                 if (($add, $del, $file) =
 268                     /^([-\d]+)  ([-\d]+)        (.*)/) {
 269                         $file = unquote_path($file);
 270                         my ($change, $bin);
 271                         if ($add eq '-' && $del eq '-') {
 272                                 $change = __('binary');
 273                                 $bin = 1;
 274                         }
 275                         else {
 276                                 $change = "+$add/-$del";
 277                         }
 278                         $data{$file}{FILE} = $change;
 279                         if ($bin) {
 280                                 $data{$file}{BINARY} = 1;
 281                         }
 282                 }
 283                 elsif (($adddel, $file) =
 284                        /^ (create|delete) mode [0-7]+ (.*)$/) {
 285                         $file = unquote_path($file);
 286                         $data{$file}{FILE_ADDDEL} = $adddel;
 287                 }
 288                 elsif (/^:[0-7]+ [0-7]+ [0-9a-f]+ [0-9a-f]+ (.) (.*)$/) {
 289                         $file = unquote_path($2);
 290                         if (!exists $data{$file}) {
 291                                 $data{$file} = +{
 292                                         INDEX => __('unchanged'),
 293                                         BINARY => 0,
 294                                 };
 295                         }
 296                         if ($1 eq 'U') {
 297                                 $data{$file}{UNMERGED} = 1;
 298                         }
 299                 }
 300         }
 301
 302         for (sort keys %data) {
 303                 my $it = $data{$_};
 304
 305                 if ($only) {
 306                         if ($only eq 'index-only') {
 307                                 next if ($it->{INDEX} eq __('unchanged'));
 308                         }
 309                         if ($only eq 'file-only') {
 310                                 next if ($it->{FILE} eq __('nothing'));
 311                         }
 312                 }
 313                 push @return, +{
 314                         VALUE => $_,
 315                         %$it,
 316                 };
 317         }
 318         return @return;
 319 }
 320
 321 sub find_unique {
 322         my ($string, @stuff) = @_;
 323         my $found = undef;
 324         for (my $i = 0; $i < @stuff; $i++) {
 325                 my $it = $stuff[$i];
 326                 my $hit = undef;
 327                 if (ref $it) {
 328                         if ((ref $it) eq 'ARRAY') {
 329                                 $it = $it->[0];
 330                         }
 331                         else {
 332                                 $it = $it->{VALUE};
 333                         }
 334                 }
 335                 eval {
 336                         if ($it =~ /^$string/) {
 337                                 $hit = 1;
 338                         };
 339                 };
 340                 if (defined $hit && defined $found) {
 341                         return undef;
 342                 }
 343                 if ($hit) {
 344                         $found = $i + 1;
 345                 }
 346         }
 347         return $found;
 348 }
 349
 350 # inserts string into trie and updates count for each character
 351 sub update_trie {
 352         my ($trie, $string) = @_;
 353         foreach (split //, $string) {
 354                 $trie = $trie->{$_} ||= {COUNT => 0};
 355                 $trie->{COUNT}++;
 356         }
 357 }
 358
 359 # returns an array of tuples (prefix, remainder)
 360 sub find_unique_prefixes {
 361         my @stuff = @_;
 362         my @return = ();
 363
 364         # any single prefix exceeding the soft limit is omitted
 365         # if any prefix exceeds the hard limit all are omitted
 366         # 0 indicates no limit
 367         my $soft_limit = 0;
 368         my $hard_limit = 3;
 369
 370         # build a trie modelling all possible options
 371         my %trie;
 372         foreach my $print (@stuff) {
 373                 if ((ref $print) eq 'ARRAY') {
 374                         $print = $print->[0];
 375                 }
 376                 elsif ((ref $print) eq 'HASH') {
 377                         $print = $print->{VALUE};
 378                 }
 379                 update_trie(\%trie, $print);
 380                 push @return, $print;
 381         }
 382
 383         # use the trie to find the unique prefixes
 384         for (my $i = 0; $i < @return; $i++) {
 385                 my $ret = $return[$i];
 386                 my @letters = split //, $ret;
 387                 my %search = %trie;
 388                 my ($prefix, $remainder);
 389                 my $j;
 390                 for ($j = 0; $j < @letters; $j++) {
 391                         my $letter = $letters[$j];
 392                         if ($search{$letter}{COUNT} == 1) {
 393                                 $prefix = substr $ret, 0, $j + 1;
 394                                 $remainder = substr $ret, $j + 1;
 395                                 last;
 396                         }
 397                         else {
 398                                 my $prefix = substr $ret, 0, $j;
 399                                 return ()
 400                                     if ($hard_limit && $j + 1 > $hard_limit);
 401                         }
 402                         %search = %{$search{$letter}};
 403                 }
 404                 if (ord($letters[0]) > 127 ||
 405                     ($soft_limit && $j + 1 > $soft_limit)) {
 406                         $prefix = undef;
 407                         $remainder = $ret;
 408                 }
 409                 $return[$i] = [$prefix, $remainder];
 410         }
 411         return @return;
 412 }
 413
 414 # filters out prefixes which have special meaning to list_and_choose()
 415 sub is_valid_prefix {
 416         my $prefix = shift;
 417         return (defined $prefix) &&
 418             !($prefix =~ /[\s,]/) && # separators
 419             !($prefix =~ /^-/) &&    # deselection
 420             !($prefix =~ /^\d+/) &&  # selection
 421             ($prefix ne '*') &&      # "all" wildcard
 422             ($prefix ne '?');        # prompt help
 423 }
 424
 425 # given a prefix/remainder tuple return a string with the prefix highlighted
 426 # for now use square brackets; later might use ANSI colors (underline, bold)
 427 sub highlight_prefix {
 428         my $prefix = shift;
 429         my $remainder = shift;
 430
 431         if (!defined $prefix) {
 432                 return $remainder;
 433         }
 434
 435         if (!is_valid_prefix($prefix)) {
 436                 return "$prefix$remainder";
 437         }
 438
 439         if (!$menu_use_color) {
 440                 return "[$prefix]$remainder";
 441         }
 442
 443         return "$prompt_color$prefix$normal_color$remainder";
 444 }
 445
 446 sub error_msg {
 447         print STDERR colored $error_color, @_;
 448 }
 449
 450 sub list_and_choose {
 451         my ($opts, @stuff) = @_;
 452         my (@chosen, @return);
 453         if (!@stuff) {
 454             return @return;
 455         }
 456         my $i;
 457         my @prefixes = find_unique_prefixes(@stuff) unless $opts->{LIST_ONLY};
 458
 459       TOPLOOP:
 460         while (1) {
 461                 my $last_lf = 0;
 462
 463                 if ($opts->{HEADER}) {
 464                         if (!$opts->{LIST_FLAT}) {
 465                                 print "     ";
 466                         }
 467                         print colored $header_color, "$opts->{HEADER}\n";
 468                 }
 469                 for ($i = 0; $i < @stuff; $i++) {
 470                         my $chosen = $chosen[$i] ? '*' : ' ';
 471                         my $print = $stuff[$i];
 472                         my $ref = ref $print;
 473                         my $highlighted = highlight_prefix(@{$prefixes[$i]})
 474                             if @prefixes;
 475                         if ($ref eq 'ARRAY') {
 476                                 $print = $highlighted || $print->[0];
 477                         }
 478                         elsif ($ref eq 'HASH') {
 479                                 my $value = $highlighted || $print->{VALUE};
 480                                 $print = sprintf($status_fmt,
 481                                     $print->{INDEX},
 482                                     $print->{FILE},
 483                                     $value);
 484                         }
 485                         else {
 486                                 $print = $highlighted || $print;
 487                         }
 488                         printf("%s%2d: %s", $chosen, $i+1, $print);
 489                         if (($opts->{LIST_FLAT}) &&
 490                             (($i + 1) % ($opts->{LIST_FLAT}))) {
 491                                 print "\t";
 492                                 $last_lf = 0;
 493                         }
 494                         else {
 495                                 print "\n";
 496                                 $last_lf = 1;
 497                         }
 498                 }
 499                 if (!$last_lf) {
 500                         print "\n";
 501                 }
 502
 503                 return if ($opts->{LIST_ONLY});
 504
 505                 print colored $prompt_color, $opts->{PROMPT};
 506                 if ($opts->{SINGLETON}) {
 507                         print "> ";
 508                 }
 509                 else {
 510                         print ">> ";
 511                 }
 512                 my $line = <STDIN>;
 513                 if (!$line) {
 514                         print "\n";
 515                         $opts->{ON_EOF}->() if $opts->{ON_EOF};
 516                         last;
 517                 }
 518                 chomp $line;
 519                 last if $line eq '';
 520                 if ($line eq '?') {
 521                         $opts->{SINGLETON} ?
 522                             singleton_prompt_help_cmd() :
 523                             prompt_help_cmd();
 524                         next TOPLOOP;
 525                 }
 526                 for my $choice (split(/[\s,]+/, $line)) {
 527                         my $choose = 1;
 528                         my ($bottom, $top);
 529
 530                         # Input that begins with '-'; unchoose
 531                         if ($choice =~ s/^-//) {
 532                                 $choose = 0;
 533                         }
 534                         # A range can be specified like 5-7 or 5-.
 535                         if ($choice =~ /^(\d+)-(\d*)$/) {
 536                                 ($bottom, $top) = ($1, length($2) ? $2 : 1 + @stuff);
 537                         }
 538                         elsif ($choice =~ /^\d+$/) {
 539                                 $bottom = $top = $choice;
 540                         }
 541                         elsif ($choice eq '*') {
 542                                 $bottom = 1;
 543                                 $top = 1 + @stuff;
 544                         }
 545                         else {
 546                                 $bottom = $top = find_unique($choice, @stuff);
 547                                 if (!defined $bottom) {
 548                                         error_msg sprintf(__("Huh (%s)?\n"), $choice);
 549                                         next TOPLOOP;
 550                                 }
 551                         }
 552                         if ($opts->{SINGLETON} && $bottom != $top) {
 553                                 error_msg sprintf(__("Huh (%s)?\n"), $choice);
 554                                 next TOPLOOP;
 555                         }
 556                         for ($i = $bottom-1; $i <= $top-1; $i++) {
 557                                 next if (@stuff <= $i || $i < 0);
 558                                 $chosen[$i] = $choose;
 559                         }
 560                 }
 561                 last if ($opts->{IMMEDIATE} || $line eq '*');
 562         }
 563         for ($i = 0; $i < @stuff; $i++) {
 564                 if ($chosen[$i]) {
 565                         push @return, $stuff[$i];
 566                 }
 567         }
 568         return @return;
 569 }
 570
 571 sub singleton_prompt_help_cmd {
 572         print colored $help_color, __ <<'EOF' ;
 573 Prompt help:
 574 1          - select a numbered item
 575 foo        - select item based on unique prefix
 576            - (empty) select nothing
 577 EOF
 578 }
 579
 580 sub prompt_help_cmd {
 581         print colored $help_color, __ <<'EOF' ;
 582 Prompt help:
 583 1          - select a single item
 584 3-5        - select a range of items
 585 2-3,6-9    - select multiple ranges
 586 foo        - select item based on unique prefix
 587 -...       - unselect specified items
 588 *          - choose all items
 589            - (empty) finish selecting
 590 EOF
 591 }
 592
 593 sub status_cmd {
 594         list_and_choose({ LIST_ONLY => 1, HEADER => $status_head },
 595                         list_modified());
 596         print "\n";
 597 }
 598
 599 sub say_n_paths {
 600         my $did = shift @_;
 601         my $cnt = scalar @_;
 602         if ($did eq 'added') {
 603                 printf(__n("added %d path\n", "added %d paths\n",
 604                            $cnt), $cnt);
 605         } elsif ($did eq 'updated') {
 606                 printf(__n("updated %d path\n", "updated %d paths\n",
 607                            $cnt), $cnt);
 608         } elsif ($did eq 'reverted') {
 609                 printf(__n("reverted %d path\n", "reverted %d paths\n",
 610                            $cnt), $cnt);
 611         } else {
 612                 printf(__n("touched %d path\n", "touched %d paths\n",
 613                            $cnt), $cnt);
 614         }
 615 }
 616
 617 sub update_cmd {
 618         my @mods = list_modified('file-only');
 619         return if (!@mods);
 620
 621         my @update = list_and_choose({ PROMPT => __('Update'),
 622                                        HEADER => $status_head, },
 623                                      @mods);
 624         if (@update) {
 625                 system(qw(git update-index --add --remove --),
 626                        map { $_->{VALUE} } @update);
 627                 say_n_paths('updated', @update);
 628         }
 629         print "\n";
 630 }
 631
 632 sub revert_cmd {
 633         my @update = list_and_choose({ PROMPT => __('Revert'),
 634                                        HEADER => $status_head, },
 635                                      list_modified());
 636         if (@update) {
 637                 if (is_initial_commit()) {
 638                         system(qw(git rm --cached),
 639                                 map { $_->{VALUE} } @update);
 640                 }
 641                 else {
 642                         my @lines = run_cmd_pipe(qw(git ls-tree HEAD --),
 643                                                  map { $_->{VALUE} } @update);
 644                         my $fh;
 645                         open $fh, '| git update-index --index-info'
 646                             or die;
 647                         for (@lines) {
 648                                 print $fh $_;
 649                         }
 650                         close($fh);
 651                         for (@update) {
 652                                 if ($_->{INDEX_ADDDEL} &&
 653                                     $_->{INDEX_ADDDEL} eq 'create') {
 654                                         system(qw(git update-index --force-remove --),
 655                                                $_->{VALUE});
 656                                         printf(__("note: %s is untracked now.\n"), $_->{VALUE});
 657                                 }
 658                         }
 659                 }
 660                 refresh();
 661                 say_n_paths('reverted', @update);
 662         }
 663         print "\n";
 664 }
 665
 666 sub add_untracked_cmd {
 667         my @add = list_and_choose({ PROMPT => __('Add untracked') },
 668                                   list_untracked());
 669         if (@add) {
 670                 system(qw(git update-index --add --), @add);
 671                 say_n_paths('added', @add);
 672         } else {
 673                 print __("No untracked files.\n");
 674         }
 675         print "\n";
 676 }
 677
 678 sub run_git_apply {
 679         my $cmd = shift;
 680         my $fh;
 681         open $fh, '| git ' . $cmd . " --recount --allow-overlap";
 682         print $fh @_;
 683         return close $fh;
 684 }
 685
 686 sub parse_diff {
 687         my ($path) = @_;
 688         my @diff_cmd = split(" ", $patch_mode_flavour{DIFF});
 689         if (defined $diff_algorithm) {
 690                 splice @diff_cmd, 1, 0, "--diff-algorithm=${diff_algorithm}";
 691         }
 692         if ($diff_indent_heuristic) {
 693                 splice @diff_cmd, 1, 0, "--indent-heuristic";
 694         }
 695         if (defined $patch_mode_revision) {
 696                 push @diff_cmd, get_diff_reference($patch_mode_revision);
 697         }
 698         my @diff = run_cmd_pipe("git", @diff_cmd, "--", $path);
 699         my @colored = ();
 700         if ($diff_use_color) {
 701                 my @display_cmd = ("git", @diff_cmd, qw(--color --), $path);
 702                 if (defined $diff_filter) {
 703                         # quotemeta is overkill, but sufficient for shell-quoting
 704                         my $diff = join(' ', map { quotemeta } @display_cmd);
 705                         @display_cmd = ("$diff | $diff_filter");
 706                 }
 707
 708                 @colored = run_cmd_pipe(@display_cmd);
 709         }
 710         my (@hunk) = { TEXT => [], DISPLAY => [], TYPE => 'header' };
 711
 712         for (my $i = 0; $i < @diff; $i++) {
 713                 if ($diff[$i] =~ /^@@ /) {
 714                         push @hunk, { TEXT => [], DISPLAY => [],
 715                                 TYPE => 'hunk' };
 716                 }
 717                 push @{$hunk[-1]{TEXT}}, $diff[$i];
 718                 push @{$hunk[-1]{DISPLAY}},
 719                         (@colored ? $colored[$i] : $diff[$i]);
 720         }
 721         return @hunk;
 722 }
 723
 724 sub parse_diff_header {
 725         my $src = shift;
 726
 727         my $head = { TEXT => [], DISPLAY => [], TYPE => 'header' };
 728         my $mode = { TEXT => [], DISPLAY => [], TYPE => 'mode' };
 729         my $deletion = { TEXT => [], DISPLAY => [], TYPE => 'deletion' };
 730
 731         for (my $i = 0; $i < @{$src->{TEXT}}; $i++) {
 732                 my $dest =
 733                    $src->{TEXT}->[$i] =~ /^(old|new) mode (\d+)$/ ? $mode :
 734                    $src->{TEXT}->[$i] =~ /^deleted file/ ? $deletion :
 735                    $head;
 736                 push @{$dest->{TEXT}}, $src->{TEXT}->[$i];
 737                 push @{$dest->{DISPLAY}}, $src->{DISPLAY}->[$i];
 738         }
 739         return ($head, $mode, $deletion);
 740 }
 741
 742 sub hunk_splittable {
 743         my ($text) = @_;
 744
 745         my @s = split_hunk($text);
 746         return (1 < @s);
 747 }
 748
 749 sub parse_hunk_header {
 750         my ($line) = @_;
 751         my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
 752             $line =~ /^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/;
 753         $o_cnt = 1 unless defined $o_cnt;
 754         $n_cnt = 1 unless defined $n_cnt;
 755         return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
 756 }
 757
 758 sub split_hunk {
 759         my ($text, $display) = @_;
 760         my @split = ();
 761         if (!defined $display) {
 762                 $display = $text;
 763         }
 764         # If there are context lines in the middle of a hunk,
 765         # it can be split, but we would need to take care of
 766         # overlaps later.
 767
 768         my ($o_ofs, undef, $n_ofs) = parse_hunk_header($text->[0]);
 769         my $hunk_start = 1;
 770
 771       OUTER:
 772         while (1) {
 773                 my $next_hunk_start = undef;
 774                 my $i = $hunk_start - 1;
 775                 my $this = +{
 776                         TEXT => [],
 777                         DISPLAY => [],
 778                         TYPE => 'hunk',
 779                         OLD => $o_ofs,
 780                         NEW => $n_ofs,
 781                         OCNT => 0,
 782                         NCNT => 0,
 783                         ADDDEL => 0,
 784                         POSTCTX => 0,
 785                         USE => undef,
 786                 };
 787
 788                 while (++$i < @$text) {
 789                         my $line = $text->[$i];
 790                         my $display = $display->[$i];
 791                         if ($line =~ /^ /) {
 792                                 if ($this->{ADDDEL} &&
 793                                     !defined $next_hunk_start) {
 794                                         # We have seen leading context and
 795                                         # adds/dels and then here is another
 796                                         # context, which is trailing for this
 797                                         # split hunk and leading for the next
 798                                         # one.
 799                                         $next_hunk_start = $i;
 800                                 }
 801                                 push @{$this->{TEXT}}, $line;
 802                                 push @{$this->{DISPLAY}}, $display;
 803                                 $this->{OCNT}++;
 804                                 $this->{NCNT}++;
 805                                 if (defined $next_hunk_start) {
 806                                         $this->{POSTCTX}++;
 807                                 }
 808                                 next;
 809                         }
 810
 811                         # add/del
 812                         if (defined $next_hunk_start) {
 813                                 # We are done with the current hunk and
 814                                 # this is the first real change for the
 815                                 # next split one.
 816                                 $hunk_start = $next_hunk_start;
 817                                 $o_ofs = $this->{OLD} + $this->{OCNT};
 818                                 $n_ofs = $this->{NEW} + $this->{NCNT};
 819                                 $o_ofs -= $this->{POSTCTX};
 820                                 $n_ofs -= $this->{POSTCTX};
 821                                 push @split, $this;
 822                                 redo OUTER;
 823                         }
 824                         push @{$this->{TEXT}}, $line;
 825                         push @{$this->{DISPLAY}}, $display;
 826                         $this->{ADDDEL}++;
 827                         if ($line =~ /^-/) {
 828                                 $this->{OCNT}++;
 829                         }
 830                         else {
 831                                 $this->{NCNT}++;
 832                         }
 833                 }
 834
 835                 push @split, $this;
 836                 last;
 837         }
 838
 839         for my $hunk (@split) {
 840                 $o_ofs = $hunk->{OLD};
 841                 $n_ofs = $hunk->{NEW};
 842                 my $o_cnt = $hunk->{OCNT};
 843                 my $n_cnt = $hunk->{NCNT};
 844
 845                 my $head = ("@@ -$o_ofs" .
 846                             (($o_cnt != 1) ? ",$o_cnt" : '') .
 847                             " +$n_ofs" .
 848                             (($n_cnt != 1) ? ",$n_cnt" : '') .
 849                             " @@\n");
 850                 my $display_head = $head;
 851                 unshift @{$hunk->{TEXT}}, $head;
 852                 if ($diff_use_color) {
 853                         $display_head = colored($fraginfo_color, $head);
 854                 }
 855                 unshift @{$hunk->{DISPLAY}}, $display_head;
 856         }
 857         return @split;
 858 }
 859
 860 sub find_last_o_ctx {
 861         my ($it) = @_;
 862         my $text = $it->{TEXT};
 863         my ($o_ofs, $o_cnt) = parse_hunk_header($text->[0]);
 864         my $i = @{$text};
 865         my $last_o_ctx = $o_ofs + $o_cnt;
 866         while (0 < --$i) {
 867                 my $line = $text->[$i];
 868                 if ($line =~ /^ /) {
 869                         $last_o_ctx--;
 870                         next;
 871                 }
 872                 last;
 873         }
 874         return $last_o_ctx;
 875 }
 876
 877 sub merge_hunk {
 878         my ($prev, $this) = @_;
 879         my ($o0_ofs, $o0_cnt, $n0_ofs, $n0_cnt) =
 880             parse_hunk_header($prev->{TEXT}[0]);
 881         my ($o1_ofs, $o1_cnt, $n1_ofs, $n1_cnt) =
 882             parse_hunk_header($this->{TEXT}[0]);
 883
 884         my (@line, $i, $ofs, $o_cnt, $n_cnt);
 885         $ofs = $o0_ofs;
 886         $o_cnt = $n_cnt = 0;
 887         for ($i = 1; $i < @{$prev->{TEXT}}; $i++) {
 888                 my $line = $prev->{TEXT}[$i];
 889                 if ($line =~ /^\+/) {
 890                         $n_cnt++;
 891                         push @line, $line;
 892                         next;
 893                 }
 894
 895                 last if ($o1_ofs <= $ofs);
 896
 897                 $o_cnt++;
 898                 $ofs++;
 899                 if ($line =~ /^ /) {
 900                         $n_cnt++;
 901                 }
 902                 push @line, $line;
 903         }
 904
 905         for ($i = 1; $i < @{$this->{TEXT}}; $i++) {
 906                 my $line = $this->{TEXT}[$i];
 907                 if ($line =~ /^\+/) {
 908                         $n_cnt++;
 909                         push @line, $line;
 910                         next;
 911                 }
 912                 $ofs++;
 913                 $o_cnt++;
 914                 if ($line =~ /^ /) {
 915                         $n_cnt++;
 916                 }
 917                 push @line, $line;
 918         }
 919         my $head = ("@@ -$o0_ofs" .
 920                     (($o_cnt != 1) ? ",$o_cnt" : '') .
 921                     " +$n0_ofs" .
 922                     (($n_cnt != 1) ? ",$n_cnt" : '') .
 923                     " @@\n");
 924         @{$prev->{TEXT}} = ($head, @line);
 925 }
 926
 927 sub coalesce_overlapping_hunks {
 928         my (@in) = @_;
 929         my @out = ();
 930
 931         my ($last_o_ctx, $last_was_dirty);
 932
 933         for (grep { $_->{USE} } @in) {
 934                 if ($_->{TYPE} ne 'hunk') {
 935                         push @out, $_;
 936                         next;
 937                 }
 938                 my $text = $_->{TEXT};
 939                 my ($o_ofs) = parse_hunk_header($text->[0]);
 940                 if (defined $last_o_ctx &&
 941                     $o_ofs <= $last_o_ctx &&
 942                     !$_->{DIRTY} &&
 943                     !$last_was_dirty) {
 944                         merge_hunk($out[-1], $_);
 945                 }
 946                 else {
 947                         push @out, $_;
 948                 }
 949                 $last_o_ctx = find_last_o_ctx($out[-1]);
 950                 $last_was_dirty = $_->{DIRTY};
 951         }
 952         return @out;
 953 }
 954
 955 sub reassemble_patch {
 956         my $head = shift;
 957         my @patch;
 958
 959         # Include everything in the header except the beginning of the diff.
 960         push @patch, (grep { !/^[-+]{3}/ } @$head);
 961
 962         # Then include any headers from the hunk lines, which must
 963         # come before any actual hunk.
 964         while (@_ && $_[0] !~ /^@/) {
 965                 push @patch, shift;
 966         }
 967
 968         # Then begin the diff.
 969         push @patch, grep { /^[-+]{3}/ } @$head;
 970
 971         # And then the actual hunks.
 972         push @patch, @_;
 973
 974         return @patch;
 975 }
 976
 977 sub color_diff {
 978         return map {
 979                 colored((/^@/  ? $fraginfo_color :
 980                          /^\+/ ? $diff_new_color :
 981                          /^-/  ? $diff_old_color :
 982                          $diff_plain_color),
 983                         $_);
 984         } @_;
 985 }
 986
 987 my %edit_hunk_manually_modes = (
 988         stage => N__(
 989 "If the patch applies cleanly, the edited hunk will immediately be
 990 marked for staging."),
 991         stash => N__(
 992 "If the patch applies cleanly, the edited hunk will immediately be
 993 marked for stashing."),
 994         reset_head => N__(
 995 "If the patch applies cleanly, the edited hunk will immediately be
 996 marked for unstaging."),
 997         reset_nothead => N__(
 998 "If the patch applies cleanly, the edited hunk will immediately be
 999 marked for applying."),
1000         checkout_index => N__(
1001 "If the patch applies cleanly, the edited hunk will immediately be
1002 marked for discarding."),
1003         checkout_head => N__(
1004 "If the patch applies cleanly, the edited hunk will immediately be
1005 marked for discarding."),
1006         checkout_nothead => N__(
1007 "If the patch applies cleanly, the edited hunk will immediately be
1008 marked for applying."),
1009 );
1010
1011 sub edit_hunk_manually {
1012         my ($oldtext) = @_;
1013
1014         my $hunkfile = $repo->repo_path . "/addp-hunk-edit.diff";
1015         my $fh;
1016         open $fh, '>', $hunkfile
1017                 or die sprintf(__("failed to open hunk edit file for writing: %s"), $!);
1018         print $fh Git::comment_lines __("Manual hunk edit mode -- see bottom for a quick guide.\n");
1019         print $fh @$oldtext;
1020         my $is_reverse = $patch_mode_flavour{IS_REVERSE};
1021         my ($remove_plus, $remove_minus) = $is_reverse ? ('-', '+') : ('+', '-');
1022         my $comment_line_char = Git::get_comment_line_char;
1023         print $fh Git::comment_lines sprintf(__ <<EOF, $remove_minus, $remove_plus, $comment_line_char),
1024 ---
1025 To remove '%s' lines, make them ' ' lines (context).
1026 To remove '%s' lines, delete them.
1027 Lines starting with %s will be removed.
1028 EOF
1029 __($edit_hunk_manually_modes{$patch_mode}),
1030 # TRANSLATORS: 'it' refers to the patch mentioned in the previous messages.
1031 __ <<EOF2 ;
1032 If it does not apply cleanly, you will be given an opportunity to
1033 edit again.  If all lines of the hunk are removed, then the edit is
1034 aborted and the hunk is left unchanged.
1035 EOF2
1036         close $fh;
1037
1038         chomp(my $editor = run_cmd_pipe(qw(git var GIT_EDITOR)));
1039         system('sh', '-c', $editor.' "$@"', $editor, $hunkfile);
1040
1041         if ($? != 0) {
1042                 return undef;
1043         }
1044
1045         open $fh, '<', $hunkfile
1046                 or die sprintf(__("failed to open hunk edit file for reading: %s"), $!);
1047         my @newtext = grep { !/^\Q$comment_line_char\E/ } <$fh>;
1048         close $fh;
1049         unlink $hunkfile;
1050
1051         # Abort if nothing remains
1052         if (!grep { /\S/ } @newtext) {
1053                 return undef;
1054         }
1055
1056         # Reinsert the first hunk header if the user accidentally deleted it
1057         if ($newtext[0] !~ /^@/) {
1058                 unshift @newtext, $oldtext->[0];
1059         }
1060         return \@newtext;
1061 }
1062
1063 sub diff_applies {
1064         return run_git_apply($patch_mode_flavour{APPLY_CHECK} . ' --check',
1065                              map { @{$_->{TEXT}} } @_);
1066 }
1067
1068 sub _restore_terminal_and_die {
1069         ReadMode 'restore';
1070         print "\n";
1071         exit 1;
1072 }
1073
1074 sub prompt_single_character {
1075         if ($use_readkey) {
1076                 local $SIG{TERM} = \&_restore_terminal_and_die;
1077                 local $SIG{INT} = \&_restore_terminal_and_die;
1078                 ReadMode 'cbreak';
1079                 my $key = ReadKey 0;
1080                 ReadMode 'restore';
1081                 if ($use_termcap and $key eq "\e") {
1082                         while (!defined $term_escapes{$key}) {
1083                                 my $next = ReadKey 0.5;
1084                                 last if (!defined $next);
1085                                 $key .= $next;
1086                         }
1087                         $key =~ s/\e/^[/;
1088                 }
1089                 print "$key" if defined $key;
1090                 print "\n";
1091                 return $key;
1092         } else {
1093                 return <STDIN>;
1094         }
1095 }
1096
1097 sub prompt_yesno {
1098         my ($prompt) = @_;
1099         while (1) {
1100                 print colored $prompt_color, $prompt;
1101                 my $line = prompt_single_character;
1102                 return undef unless defined $line;
1103                 return 0 if $line =~ /^n/i;
1104                 return 1 if $line =~ /^y/i;
1105         }
1106 }
1107
1108 sub edit_hunk_loop {
1109         my ($head, $hunk, $ix) = @_;
1110         my $text = $hunk->[$ix]->{TEXT};
1111
1112         while (1) {
1113                 $text = edit_hunk_manually($text);
1114                 if (!defined $text) {
1115                         return undef;
1116                 }
1117                 my $newhunk = {
1118                         TEXT => $text,
1119                         TYPE => $hunk->[$ix]->{TYPE},
1120                         USE => 1,
1121                         DIRTY => 1,
1122                 };
1123                 if (diff_applies($head,
1124                                  @{$hunk}[0..$ix-1],
1125                                  $newhunk,
1126                                  @{$hunk}[$ix+1..$#{$hunk}])) {
1127                         $newhunk->{DISPLAY} = [color_diff(@{$text})];
1128                         return $newhunk;
1129                 }
1130                 else {
1131                         prompt_yesno(
1132                                 # TRANSLATORS: do not translate [y/n]
1133                                 # The program will only accept that input
1134                                 # at this point.
1135                                 # Consider translating (saying "no" discards!) as
1136                                 # (saying "n" for "no" discards!) if the translation
1137                                 # of the word "no" does not start with n.
1138                                 __('Your edited hunk does not apply. Edit again '
1139                                    . '(saying "no" discards!) [y/n]? ')
1140                                 ) or return undef;
1141                 }
1142         }
1143 }
1144
1145 my %help_patch_modes = (
1146         stage => N__(
1147 "y - stage this hunk
1148 n - do not stage this hunk
1149 q - quit; do not stage this hunk or any of the remaining ones
1150 a - stage this hunk and all later hunks in the file
1151 d - do not stage this hunk or any of the later hunks in the file"),
1152         stash => N__(
1153 "y - stash this hunk
1154 n - do not stash this hunk
1155 q - quit; do not stash this hunk or any of the remaining ones
1156 a - stash this hunk and all later hunks in the file
1157 d - do not stash this hunk or any of the later hunks in the file"),
1158         reset_head => N__(
1159 "y - unstage this hunk
1160 n - do not unstage this hunk
1161 q - quit; do not unstage this hunk or any of the remaining ones
1162 a - unstage this hunk and all later hunks in the file
1163 d - do not unstage this hunk or any of the later hunks in the file"),
1164         reset_nothead => N__(
1165 "y - apply this hunk to index
1166 n - do not apply this hunk to index
1167 q - quit; do not apply this hunk or any of the remaining ones
1168 a - apply this hunk and all later hunks in the file
1169 d - do not apply this hunk or any of the later hunks in the file"),
1170         checkout_index => N__(
1171 "y - discard this hunk from worktree
1172 n - do not discard this hunk from worktree
1173 q - quit; do not discard this hunk or any of the remaining ones
1174 a - discard this hunk and all later hunks in the file
1175 d - do not discard this hunk or any of the later hunks in the file"),
1176         checkout_head => N__(
1177 "y - discard this hunk from index and worktree
1178 n - do not discard this hunk from index and worktree
1179 q - quit; do not discard this hunk or any of the remaining ones
1180 a - discard this hunk and all later hunks in the file
1181 d - do not discard this hunk or any of the later hunks in the file"),
1182         checkout_nothead => N__(
1183 "y - apply this hunk to index and worktree
1184 n - do not apply this hunk to index and worktree
1185 q - quit; do not apply this hunk or any of the remaining ones
1186 a - apply this hunk and all later hunks in the file
1187 d - do not apply this hunk or any of the later hunks in the file"),
1188 );
1189
1190 sub help_patch_cmd {
1191         print colored $help_color, __($help_patch_modes{$patch_mode}), "\n", __ <<EOF ;
1192 g - select a hunk to go to
1193 / - search for a hunk matching the given regex
1194 j - leave this hunk undecided, see next undecided hunk
1195 J - leave this hunk undecided, see next hunk
1196 k - leave this hunk undecided, see previous undecided hunk
1197 K - leave this hunk undecided, see previous hunk
1198 s - split the current hunk into smaller hunks
1199 e - manually edit the current hunk
1200 ? - print help
1201 EOF
1202 }
1203
1204 sub apply_patch {
1205         my $cmd = shift;
1206         my $ret = run_git_apply $cmd, @_;
1207         if (!$ret) {
1208                 print STDERR @_;
1209         }
1210         return $ret;
1211 }
1212
1213 sub apply_patch_for_checkout_commit {
1214         my $reverse = shift;
1215         my $applies_index = run_git_apply 'apply '.$reverse.' --cached --check', @_;
1216         my $applies_worktree = run_git_apply 'apply '.$reverse.' --check', @_;
1217
1218         if ($applies_worktree && $applies_index) {
1219                 run_git_apply 'apply '.$reverse.' --cached', @_;
1220                 run_git_apply 'apply '.$reverse, @_;
1221                 return 1;
1222         } elsif (!$applies_index) {
1223                 print colored $error_color, __("The selected hunks do not apply to the index!\n");
1224                 if (prompt_yesno __("Apply them to the worktree anyway? ")) {
1225                         return run_git_apply 'apply '.$reverse, @_;
1226                 } else {
1227                         print colored $error_color, __("Nothing was applied.\n");
1228                         return 0;
1229                 }
1230         } else {
1231                 print STDERR @_;
1232                 return 0;
1233         }
1234 }
1235
1236 sub patch_update_cmd {
1237         my @all_mods = list_modified($patch_mode_flavour{FILTER});
1238         error_msg sprintf(__("ignoring unmerged: %s\n"), $_->{VALUE})
1239                 for grep { $_->{UNMERGED} } @all_mods;
1240         @all_mods = grep { !$_->{UNMERGED} } @all_mods;
1241
1242         my @mods = grep { !($_->{BINARY}) } @all_mods;
1243         my @them;
1244
1245         if (!@mods) {
1246                 if (@all_mods) {
1247                         print STDERR __("Only binary files changed.\n");
1248                 } else {
1249                         print STDERR __("No changes.\n");
1250                 }
1251                 return 0;
1252         }
1253         if ($patch_mode_only) {
1254                 @them = @mods;
1255         }
1256         else {
1257                 @them = list_and_choose({ PROMPT => __('Patch update'),
1258                                           HEADER => $status_head, },
1259                                         @mods);
1260         }
1261         for (@them) {
1262                 return 0 if patch_update_file($_->{VALUE});
1263         }
1264 }
1265
1266 # Generate a one line summary of a hunk.
1267 sub summarize_hunk {
1268         my $rhunk = shift;
1269         my $summary = $rhunk->{TEXT}[0];
1270
1271         # Keep the line numbers, discard extra context.
1272         $summary =~ s/@@(.*?)@@.*/$1 /s;
1273         $summary .= " " x (20 - length $summary);
1274
1275         # Add some user context.
1276         for my $line (@{$rhunk->{TEXT}}) {
1277                 if ($line =~ m/^[+-].*\w/) {
1278                         $summary .= $line;
1279                         last;
1280                 }
1281         }
1282
1283         chomp $summary;
1284         return substr($summary, 0, 80) . "\n";
1285 }
1286
1287
1288 # Print a one-line summary of each hunk in the array ref in
1289 # the first argument, starting with the index in the 2nd.
1290 sub display_hunks {
1291         my ($hunks, $i) = @_;
1292         my $ctr = 0;
1293         $i ||= 0;
1294         for (; $i < @$hunks && $ctr < 20; $i++, $ctr++) {
1295                 my $status = " ";
1296                 if (defined $hunks->[$i]{USE}) {
1297                         $status = $hunks->[$i]{USE} ? "+" : "-";
1298                 }
1299                 printf "%s%2d: %s",
1300                         $status,
1301                         $i + 1,
1302                         summarize_hunk($hunks->[$i]);
1303         }
1304         return $i;
1305 }
1306
1307 my %patch_update_prompt_modes = (
1308         stage => {
1309                 mode => N__("Stage mode change [y,n,q,a,d,/%s,?]? "),
1310                 deletion => N__("Stage deletion [y,n,q,a,d,/%s,?]? "),
1311                 hunk => N__("Stage this hunk [y,n,q,a,d,/%s,?]? "),
1312         },
1313         stash => {
1314                 mode => N__("Stash mode change [y,n,q,a,d,/%s,?]? "),
1315                 deletion => N__("Stash deletion [y,n,q,a,d,/%s,?]? "),
1316                 hunk => N__("Stash this hunk [y,n,q,a,d,/%s,?]? "),
1317         },
1318         reset_head => {
1319                 mode => N__("Unstage mode change [y,n,q,a,d,/%s,?]? "),
1320                 deletion => N__("Unstage deletion [y,n,q,a,d,/%s,?]? "),
1321                 hunk => N__("Unstage this hunk [y,n,q,a,d,/%s,?]? "),
1322         },
1323         reset_nothead => {
1324                 mode => N__("Apply mode change to index [y,n,q,a,d,/%s,?]? "),
1325                 deletion => N__("Apply deletion to index [y,n,q,a,d,/%s,?]? "),
1326                 hunk => N__("Apply this hunk to index [y,n,q,a,d,/%s,?]? "),
1327         },
1328         checkout_index => {
1329                 mode => N__("Discard mode change from worktree [y,n,q,a,d,/%s,?]? "),
1330                 deletion => N__("Discard deletion from worktree [y,n,q,a,d,/%s,?]? "),
1331                 hunk => N__("Discard this hunk from worktree [y,n,q,a,d,/%s,?]? "),
1332         },
1333         checkout_head => {
1334                 mode => N__("Discard mode change from index and worktree [y,n,q,a,d,/%s,?]? "),
1335                 deletion => N__("Discard deletion from index and worktree [y,n,q,a,d,/%s,?]? "),
1336                 hunk => N__("Discard this hunk from index and worktree [y,n,q,a,d,/%s,?]? "),
1337         },
1338         checkout_nothead => {
1339                 mode => N__("Apply mode change to index and worktree [y,n,q,a,d,/%s,?]? "),
1340                 deletion => N__("Apply deletion to index and worktree [y,n,q,a,d,/%s,?]? "),
1341                 hunk => N__("Apply this hunk to index and worktree [y,n,q,a,d,/%s,?]? "),
1342         },
1343 );
1344
1345 sub patch_update_file {
1346         my $quit = 0;
1347         my ($ix, $num);
1348         my $path = shift;
1349         my ($head, @hunk) = parse_diff($path);
1350         ($head, my $mode, my $deletion) = parse_diff_header($head);
1351         for (@{$head->{DISPLAY}}) {
1352                 print;
1353         }
1354
1355         if (@{$mode->{TEXT}}) {
1356                 unshift @hunk, $mode;
1357         }
1358         if (@{$deletion->{TEXT}}) {
1359                 foreach my $hunk (@hunk) {
1360                         push @{$deletion->{TEXT}}, @{$hunk->{TEXT}};
1361                         push @{$deletion->{DISPLAY}}, @{$hunk->{DISPLAY}};
1362                 }
1363                 @hunk = ($deletion);
1364         }
1365
1366         $num = scalar @hunk;
1367         $ix = 0;
1368
1369         while (1) {
1370                 my ($prev, $next, $other, $undecided, $i);
1371                 $other = '';
1372
1373                 if ($num <= $ix) {
1374                         $ix = 0;
1375                 }
1376                 for ($i = 0; $i < $ix; $i++) {
1377                         if (!defined $hunk[$i]{USE}) {
1378                                 $prev = 1;
1379                                 $other .= ',k';
1380                                 last;
1381                         }
1382                 }
1383                 if ($ix) {
1384                         $other .= ',K';
1385                 }
1386                 for ($i = $ix + 1; $i < $num; $i++) {
1387                         if (!defined $hunk[$i]{USE}) {
1388                                 $next = 1;
1389                                 $other .= ',j';
1390                                 last;
1391                         }
1392                 }
1393                 if ($ix < $num - 1) {
1394                         $other .= ',J';
1395                 }
1396                 if ($num > 1) {
1397                         $other .= ',g';
1398                 }
1399                 for ($i = 0; $i < $num; $i++) {
1400                         if (!defined $hunk[$i]{USE}) {
1401                                 $undecided = 1;
1402                                 last;
1403                         }
1404                 }
1405                 last if (!$undecided);
1406
1407                 if ($hunk[$ix]{TYPE} eq 'hunk' &&
1408                     hunk_splittable($hunk[$ix]{TEXT})) {
1409                         $other .= ',s';
1410                 }
1411                 if ($hunk[$ix]{TYPE} eq 'hunk') {
1412                         $other .= ',e';
1413                 }
1414                 for (@{$hunk[$ix]{DISPLAY}}) {
1415                         print;
1416                 }
1417                 print colored $prompt_color,
1418                         sprintf(__($patch_update_prompt_modes{$patch_mode}{$hunk[$ix]{TYPE}}), $other);
1419
1420                 my $line = prompt_single_character;
1421                 last unless defined $line;
1422                 if ($line) {
1423                         if ($line =~ /^y/i) {
1424                                 $hunk[$ix]{USE} = 1;
1425                         }
1426                         elsif ($line =~ /^n/i) {
1427                                 $hunk[$ix]{USE} = 0;
1428                         }
1429                         elsif ($line =~ /^a/i) {
1430                                 while ($ix < $num) {
1431                                         if (!defined $hunk[$ix]{USE}) {
1432                                                 $hunk[$ix]{USE} = 1;
1433                                         }
1434                                         $ix++;
1435                                 }
1436                                 next;
1437                         }
1438                         elsif ($other =~ /g/ && $line =~ /^g(.*)/) {
1439                                 my $response = $1;
1440                                 my $no = $ix > 10 ? $ix - 10 : 0;
1441                                 while ($response eq '') {
1442                                         $no = display_hunks(\@hunk, $no);
1443                                         if ($no < $num) {
1444                                                 print __("go to which hunk (<ret> to see more)? ");
1445                                         } else {
1446                                                 print __("go to which hunk? ");
1447                                         }
1448                                         $response = <STDIN>;
1449                                         if (!defined $response) {
1450                                                 $response = '';
1451                                         }
1452                                         chomp $response;
1453                                 }
1454                                 if ($response !~ /^\s*\d+\s*$/) {
1455                                         error_msg sprintf(__("Invalid number: '%s'\n"),
1456                                                              $response);
1457                                 } elsif (0 < $response && $response <= $num) {
1458                                         $ix = $response - 1;
1459                                 } else {
1460                                         error_msg sprintf(__n("Sorry, only %d hunk available.\n",
1461                                                               "Sorry, only %d hunks available.\n", $num), $num);
1462                                 }
1463                                 next;
1464                         }
1465                         elsif ($line =~ /^d/i) {
1466                                 while ($ix < $num) {
1467                                         if (!defined $hunk[$ix]{USE}) {
1468                                                 $hunk[$ix]{USE} = 0;
1469                                         }
1470                                         $ix++;
1471                                 }
1472                                 next;
1473                         }
1474                         elsif ($line =~ /^q/i) {
1475                                 for ($i = 0; $i < $num; $i++) {
1476                                         if (!defined $hunk[$i]{USE}) {
1477                                                 $hunk[$i]{USE} = 0;
1478                                         }
1479                                 }
1480                                 $quit = 1;
1481                                 last;
1482                         }
1483                         elsif ($line =~ m|^/(.*)|) {
1484                                 my $regex = $1;
1485                                 if ($1 eq "") {
1486                                         print colored $prompt_color, __("search for regex? ");
1487                                         $regex = <STDIN>;
1488                                         if (defined $regex) {
1489                                                 chomp $regex;
1490                                         }
1491                                 }
1492                                 my $search_string;
1493                                 eval {
1494                                         $search_string = qr{$regex}m;
1495                                 };
1496                                 if ($@) {
1497                                         my ($err,$exp) = ($@, $1);
1498                                         $err =~ s/ at .*git-add--interactive line \d+, <STDIN> line \d+.*$//;
1499                                         error_msg sprintf(__("Malformed search regexp %s: %s\n"), $exp, $err);
1500                                         next;
1501                                 }
1502                                 my $iy = $ix;
1503                                 while (1) {
1504                                         my $text = join ("", @{$hunk[$iy]{TEXT}});
1505                                         last if ($text =~ $search_string);
1506                                         $iy++;
1507                                         $iy = 0 if ($iy >= $num);
1508                                         if ($ix == $iy) {
1509                                                 error_msg __("No hunk matches the given pattern\n");
1510                                                 last;
1511                                         }
1512                                 }
1513                                 $ix = $iy;
1514                                 next;
1515                         }
1516                         elsif ($line =~ /^K/) {
1517                                 if ($other =~ /K/) {
1518                                         $ix--;
1519                                 }
1520                                 else {
1521                                         error_msg __("No previous hunk\n");
1522                                 }
1523                                 next;
1524                         }
1525                         elsif ($line =~ /^J/) {
1526                                 if ($other =~ /J/) {
1527                                         $ix++;
1528                                 }
1529                                 else {
1530                                         error_msg __("No next hunk\n");
1531                                 }
1532                                 next;
1533                         }
1534                         elsif ($line =~ /^k/) {
1535                                 if ($other =~ /k/) {
1536                                         while (1) {
1537                                                 $ix--;
1538                                                 last if (!$ix ||
1539                                                          !defined $hunk[$ix]{USE});
1540                                         }
1541                                 }
1542                                 else {
1543                                         error_msg __("No previous hunk\n");
1544                                 }
1545                                 next;
1546                         }
1547                         elsif ($line =~ /^j/) {
1548                                 if ($other !~ /j/) {
1549                                         error_msg __("No next hunk\n");
1550                                         next;
1551                                 }
1552                         }
1553                         elsif ($other =~ /s/ && $line =~ /^s/) {
1554                                 my @split = split_hunk($hunk[$ix]{TEXT}, $hunk[$ix]{DISPLAY});
1555                                 if (1 < @split) {
1556                                         print colored $header_color, sprintf(
1557                                                 __n("Split into %d hunk.\n",
1558                                                     "Split into %d hunks.\n",
1559                                                     scalar(@split)), scalar(@split));
1560                                 }
1561                                 splice (@hunk, $ix, 1, @split);
1562                                 $num = scalar @hunk;
1563                                 next;
1564                         }
1565                         elsif ($other =~ /e/ && $line =~ /^e/) {
1566                                 my $newhunk = edit_hunk_loop($head, \@hunk, $ix);
1567                                 if (defined $newhunk) {
1568                                         splice @hunk, $ix, 1, $newhunk;
1569                                 }
1570                         }
1571                         else {
1572                                 help_patch_cmd($other);
1573                                 next;
1574                         }
1575                         # soft increment
1576                         while (1) {
1577                                 $ix++;
1578                                 last if ($ix >= $num ||
1579                                          !defined $hunk[$ix]{USE});
1580                         }
1581                 }
1582         }
1583
1584         @hunk = coalesce_overlapping_hunks(@hunk);
1585
1586         my $n_lofs = 0;
1587         my @result = ();
1588         for (@hunk) {
1589                 if ($_->{USE}) {
1590                         push @result, @{$_->{TEXT}};
1591                 }
1592         }
1593
1594         if (@result) {
1595                 my @patch = reassemble_patch($head->{TEXT}, @result);
1596                 my $apply_routine = $patch_mode_flavour{APPLY};
1597                 &$apply_routine(@patch);
1598                 refresh();
1599         }
1600
1601         print "\n";
1602         return $quit;
1603 }
1604
1605 sub diff_cmd {
1606         my @mods = list_modified('index-only');
1607         @mods = grep { !($_->{BINARY}) } @mods;
1608         return if (!@mods);
1609         my (@them) = list_and_choose({ PROMPT => __('Review diff'),
1610                                      IMMEDIATE => 1,
1611                                      HEADER => $status_head, },
1612                                    @mods);
1613         return if (!@them);
1614         my $reference = (is_initial_commit()) ? get_empty_tree() : 'HEAD';
1615         system(qw(git diff -p --cached), $reference, '--',
1616                 map { $_->{VALUE} } @them);
1617 }
1618
1619 sub quit_cmd {
1620         print __("Bye.\n");
1621         exit(0);
1622 }
1623
1624 sub help_cmd {
1625 # TRANSLATORS: please do not translate the command names
1626 # 'status', 'update', 'revert', etc.
1627         print colored $help_color, __ <<'EOF' ;
1628 status        - show paths with changes
1629 update        - add working tree state to the staged set of changes
1630 revert        - revert staged set of changes back to the HEAD version
1631 patch         - pick hunks and update selectively
1632 diff          - view diff between HEAD and index
1633 add untracked - add contents of untracked files to the staged set of changes
1634 EOF
1635 }
1636
1637 sub process_args {
1638         return unless @ARGV;
1639         my $arg = shift @ARGV;
1640         if ($arg =~ /--patch(?:=(.*))?/) {
1641                 if (defined $1) {
1642                         if ($1 eq 'reset') {
1643                                 $patch_mode = 'reset_head';
1644                                 $patch_mode_revision = 'HEAD';
1645                                 $arg = shift @ARGV or die __("missing --");
1646                                 if ($arg ne '--') {
1647                                         $patch_mode_revision = $arg;
1648                                         $patch_mode = ($arg eq 'HEAD' ?
1649                                                        'reset_head' : 'reset_nothead');
1650                                         $arg = shift @ARGV or die __("missing --");
1651                                 }
1652                         } elsif ($1 eq 'checkout') {
1653                                 $arg = shift @ARGV or die __("missing --");
1654                                 if ($arg eq '--') {
1655                                         $patch_mode = 'checkout_index';
1656                                 } else {
1657                                         $patch_mode_revision = $arg;
1658                                         $patch_mode = ($arg eq 'HEAD' ?
1659                                                        'checkout_head' : 'checkout_nothead');
1660                                         $arg = shift @ARGV or die __("missing --");
1661                                 }
1662                         } elsif ($1 eq 'stage' or $1 eq 'stash') {
1663                                 $patch_mode = $1;
1664                                 $arg = shift @ARGV or die __("missing --");
1665                         } else {
1666                                 die sprintf(__("unknown --patch mode: %s"), $1);
1667                         }
1668                 } else {
1669                         $patch_mode = 'stage';
1670                         $arg = shift @ARGV or die __("missing --");
1671                 }
1672                 die sprintf(__("invalid argument %s, expecting --"),
1673                                $arg) unless $arg eq "--";
1674                 %patch_mode_flavour = %{$patch_modes{$patch_mode}};
1675                 $patch_mode_only = 1;
1676         }
1677         elsif ($arg ne "--") {
1678                 die sprintf(__("invalid argument %s, expecting --"), $arg);
1679         }
1680 }
1681
1682 sub main_loop {
1683         my @cmd = ([ 'status', \&status_cmd, ],
1684                    [ 'update', \&update_cmd, ],
1685                    [ 'revert', \&revert_cmd, ],
1686                    [ 'add untracked', \&add_untracked_cmd, ],
1687                    [ 'patch', \&patch_update_cmd, ],
1688                    [ 'diff', \&diff_cmd, ],
1689                    [ 'quit', \&quit_cmd, ],
1690                    [ 'help', \&help_cmd, ],
1691         );
1692         while (1) {
1693                 my ($it) = list_and_choose({ PROMPT => __('What now'),
1694                                              SINGLETON => 1,
1695                                              LIST_FLAT => 4,
1696                                              HEADER => __('*** Commands ***'),
1697                                              ON_EOF => \&quit_cmd,
1698                                              IMMEDIATE => 1 }, @cmd);
1699                 if ($it) {
1700                         eval {
1701                                 $it->[1]->();
1702                         };
1703                         if ($@) {
1704                                 print "$@";
1705                         }
1706                 }
1707         }
1708 }
1709
1710 process_args();
1711 refresh();
1712 if ($patch_mode_only) {
1713         patch_update_cmd();
1714 }
1715 else {
1716         status_cmd();
1717         main_loop();
1718 }