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