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         for (my $i = 0; $i < @diff; $i++) {
 709                 if ($diff[$i] =~ /^@@ /) {
 710                         push @hunk, { TEXT => [], DISPLAY => [],
 711                                 TYPE => 'hunk' };
 712                 }
 713                 push @{$hunk[-1]{TEXT}}, $diff[$i];
 714                 push @{$hunk[-1]{DISPLAY}},
 715                         (@colored ? $colored[$i] : $diff[$i]);
 716         }
 717         return @hunk;
 718 }
 719
 720 sub parse_diff_header {
 721         my $src = shift;
 722
 723         my $head = { TEXT => [], DISPLAY => [], TYPE => 'header' };
 724         my $mode = { TEXT => [], DISPLAY => [], TYPE => 'mode' };
 725         my $deletion = { TEXT => [], DISPLAY => [], TYPE => 'deletion' };
 726
 727         for (my $i = 0; $i < @{$src->{TEXT}}; $i++) {
 728                 my $dest =
 729                    $src->{TEXT}->[$i] =~ /^(old|new) mode (\d+)$/ ? $mode :
 730                    $src->{TEXT}->[$i] =~ /^deleted file/ ? $deletion :
 731                    $head;
 732                 push @{$dest->{TEXT}}, $src->{TEXT}->[$i];
 733                 push @{$dest->{DISPLAY}}, $src->{DISPLAY}->[$i];
 734         }
 735         return ($head, $mode, $deletion);
 736 }
 737
 738 sub hunk_splittable {
 739         my ($text) = @_;
 740
 741         my @s = split_hunk($text);
 742         return (1 < @s);
 743 }
 744
 745 sub parse_hunk_header {
 746         my ($line) = @_;
 747         my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
 748             $line =~ /^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/;
 749         $o_cnt = 1 unless defined $o_cnt;
 750         $n_cnt = 1 unless defined $n_cnt;
 751         return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
 752 }
 753
 754 sub split_hunk {
 755         my ($text, $display) = @_;
 756         my @split = ();
 757         if (!defined $display) {
 758                 $display = $text;
 759         }
 760         # If there are context lines in the middle of a hunk,
 761         # it can be split, but we would need to take care of
 762         # overlaps later.
 763
 764         my ($o_ofs, undef, $n_ofs) = parse_hunk_header($text->[0]);
 765         my $hunk_start = 1;
 766
 767       OUTER:
 768         while (1) {
 769                 my $next_hunk_start = undef;
 770                 my $i = $hunk_start - 1;
 771                 my $this = +{
 772                         TEXT => [],
 773                         DISPLAY => [],
 774                         TYPE => 'hunk',
 775                         OLD => $o_ofs,
 776                         NEW => $n_ofs,
 777                         OCNT => 0,
 778                         NCNT => 0,
 779                         ADDDEL => 0,
 780                         POSTCTX => 0,
 781                         USE => undef,
 782                 };
 783
 784                 while (++$i < @$text) {
 785                         my $line = $text->[$i];
 786                         my $display = $display->[$i];
 787                         if ($line =~ /^ /) {
 788                                 if ($this->{ADDDEL} &&
 789                                     !defined $next_hunk_start) {
 790                                         # We have seen leading context and
 791                                         # adds/dels and then here is another
 792                                         # context, which is trailing for this
 793                                         # split hunk and leading for the next
 794                                         # one.
 795                                         $next_hunk_start = $i;
 796                                 }
 797                                 push @{$this->{TEXT}}, $line;
 798                                 push @{$this->{DISPLAY}}, $display;
 799                                 $this->{OCNT}++;
 800                                 $this->{NCNT}++;
 801                                 if (defined $next_hunk_start) {
 802                                         $this->{POSTCTX}++;
 803                                 }
 804                                 next;
 805                         }
 806
 807                         # add/del
 808                         if (defined $next_hunk_start) {
 809                                 # We are done with the current hunk and
 810                                 # this is the first real change for the
 811                                 # next split one.
 812                                 $hunk_start = $next_hunk_start;
 813                                 $o_ofs = $this->{OLD} + $this->{OCNT};
 814                                 $n_ofs = $this->{NEW} + $this->{NCNT};
 815                                 $o_ofs -= $this->{POSTCTX};
 816                                 $n_ofs -= $this->{POSTCTX};
 817                                 push @split, $this;
 818                                 redo OUTER;
 819                         }
 820                         push @{$this->{TEXT}}, $line;
 821                         push @{$this->{DISPLAY}}, $display;
 822                         $this->{ADDDEL}++;
 823                         if ($line =~ /^-/) {
 824                                 $this->{OCNT}++;
 825                         }
 826                         else {
 827                                 $this->{NCNT}++;
 828                         }
 829                 }
 830
 831                 push @split, $this;
 832                 last;
 833         }
 834
 835         for my $hunk (@split) {
 836                 $o_ofs = $hunk->{OLD};
 837                 $n_ofs = $hunk->{NEW};
 838                 my $o_cnt = $hunk->{OCNT};
 839                 my $n_cnt = $hunk->{NCNT};
 840
 841                 my $head = ("@@ -$o_ofs" .
 842                             (($o_cnt != 1) ? ",$o_cnt" : '') .
 843                             " +$n_ofs" .
 844                             (($n_cnt != 1) ? ",$n_cnt" : '') .
 845                             " @@\n");
 846                 my $display_head = $head;
 847                 unshift @{$hunk->{TEXT}}, $head;
 848                 if ($diff_use_color) {
 849                         $display_head = colored($fraginfo_color, $head);
 850                 }
 851                 unshift @{$hunk->{DISPLAY}}, $display_head;
 852         }
 853         return @split;
 854 }
 855
 856 sub find_last_o_ctx {
 857         my ($it) = @_;
 858         my $text = $it->{TEXT};
 859         my ($o_ofs, $o_cnt) = parse_hunk_header($text->[0]);
 860         my $i = @{$text};
 861         my $last_o_ctx = $o_ofs + $o_cnt;
 862         while (0 < --$i) {
 863                 my $line = $text->[$i];
 864                 if ($line =~ /^ /) {
 865                         $last_o_ctx--;
 866                         next;
 867                 }
 868                 last;
 869         }
 870         return $last_o_ctx;
 871 }
 872
 873 sub merge_hunk {
 874         my ($prev, $this) = @_;
 875         my ($o0_ofs, $o0_cnt, $n0_ofs, $n0_cnt) =
 876             parse_hunk_header($prev->{TEXT}[0]);
 877         my ($o1_ofs, $o1_cnt, $n1_ofs, $n1_cnt) =
 878             parse_hunk_header($this->{TEXT}[0]);
 879
 880         my (@line, $i, $ofs, $o_cnt, $n_cnt);
 881         $ofs = $o0_ofs;
 882         $o_cnt = $n_cnt = 0;
 883         for ($i = 1; $i < @{$prev->{TEXT}}; $i++) {
 884                 my $line = $prev->{TEXT}[$i];
 885                 if ($line =~ /^\+/) {
 886                         $n_cnt++;
 887                         push @line, $line;
 888                         next;
 889                 }
 890
 891                 last if ($o1_ofs <= $ofs);
 892
 893                 $o_cnt++;
 894                 $ofs++;
 895                 if ($line =~ /^ /) {
 896                         $n_cnt++;
 897                 }
 898                 push @line, $line;
 899         }
 900
 901         for ($i = 1; $i < @{$this->{TEXT}}; $i++) {
 902                 my $line = $this->{TEXT}[$i];
 903                 if ($line =~ /^\+/) {
 904                         $n_cnt++;
 905                         push @line, $line;
 906                         next;
 907                 }
 908                 $ofs++;
 909                 $o_cnt++;
 910                 if ($line =~ /^ /) {
 911                         $n_cnt++;
 912                 }
 913                 push @line, $line;
 914         }
 915         my $head = ("@@ -$o0_ofs" .
 916                     (($o_cnt != 1) ? ",$o_cnt" : '') .
 917                     " +$n0_ofs" .
 918                     (($n_cnt != 1) ? ",$n_cnt" : '') .
 919                     " @@\n");
 920         @{$prev->{TEXT}} = ($head, @line);
 921 }
 922
 923 sub coalesce_overlapping_hunks {
 924         my (@in) = @_;
 925         my @out = ();
 926
 927         my ($last_o_ctx, $last_was_dirty);
 928
 929         for (grep { $_->{USE} } @in) {
 930                 if ($_->{TYPE} ne 'hunk') {
 931                         push @out, $_;
 932                         next;
 933                 }
 934                 my $text = $_->{TEXT};
 935                 my ($o_ofs) = parse_hunk_header($text->[0]);
 936                 if (defined $last_o_ctx &&
 937                     $o_ofs <= $last_o_ctx &&
 938                     !$_->{DIRTY} &&
 939                     !$last_was_dirty) {
 940                         merge_hunk($out[-1], $_);
 941                 }
 942                 else {
 943                         push @out, $_;
 944                 }
 945                 $last_o_ctx = find_last_o_ctx($out[-1]);
 946                 $last_was_dirty = $_->{DIRTY};
 947         }
 948         return @out;
 949 }
 950
 951 sub reassemble_patch {
 952         my $head = shift;
 953         my @patch;
 954
 955         # Include everything in the header except the beginning of the diff.
 956         push @patch, (grep { !/^[-+]{3}/ } @$head);
 957
 958         # Then include any headers from the hunk lines, which must
 959         # come before any actual hunk.
 960         while (@_ && $_[0] !~ /^@/) {
 961                 push @patch, shift;
 962         }
 963
 964         # Then begin the diff.
 965         push @patch, grep { /^[-+]{3}/ } @$head;
 966
 967         # And then the actual hunks.
 968         push @patch, @_;
 969
 970         return @patch;
 971 }
 972
 973 sub color_diff {
 974         return map {
 975                 colored((/^@/  ? $fraginfo_color :
 976                          /^\+/ ? $diff_new_color :
 977                          /^-/  ? $diff_old_color :
 978                          $diff_plain_color),
 979                         $_);
 980         } @_;
 981 }
 982
 983 my %edit_hunk_manually_modes = (
 984         stage => N__(
 985 "If the patch applies cleanly, the edited hunk will immediately be
 986 marked for staging."),
 987         stash => N__(
 988 "If the patch applies cleanly, the edited hunk will immediately be
 989 marked for stashing."),
 990         reset_head => N__(
 991 "If the patch applies cleanly, the edited hunk will immediately be
 992 marked for unstaging."),
 993         reset_nothead => N__(
 994 "If the patch applies cleanly, the edited hunk will immediately be
 995 marked for applying."),
 996         checkout_index => N__(
 997 "If the patch applies cleanly, the edited hunk will immediately be
 998 marked for discarding."),
 999         checkout_head => N__(
1000 "If the patch applies cleanly, the edited hunk will immediately be
1001 marked for discarding."),
1002         checkout_nothead => N__(
1003 "If the patch applies cleanly, the edited hunk will immediately be
1004 marked for applying."),
1005 );
1006
1007 sub edit_hunk_manually {
1008         my ($oldtext) = @_;
1009
1010         my $hunkfile = $repo->repo_path . "/addp-hunk-edit.diff";
1011         my $fh;
1012         open $fh, '>', $hunkfile
1013                 or die sprintf(__("failed to open hunk edit file for writing: %s"), $!);
1014         print $fh Git::comment_lines __("Manual hunk edit mode -- see bottom for a quick guide.\n");
1015         print $fh @$oldtext;
1016         my $is_reverse = $patch_mode_flavour{IS_REVERSE};
1017         my ($remove_plus, $remove_minus) = $is_reverse ? ('-', '+') : ('+', '-');
1018         my $comment_line_char = Git::get_comment_line_char;
1019         print $fh Git::comment_lines sprintf(__ <<EOF, $remove_minus, $remove_plus, $comment_line_char),
1020 ---
1021 To remove '%s' lines, make them ' ' lines (context).
1022 To remove '%s' lines, delete them.
1023 Lines starting with %s will be removed.
1024 EOF
1025 __($edit_hunk_manually_modes{$patch_mode}),
1026 # TRANSLATORS: 'it' refers to the patch mentioned in the previous messages.
1027 __ <<EOF2 ;
1028 If it does not apply cleanly, you will be given an opportunity to
1029 edit again.  If all lines of the hunk are removed, then the edit is
1030 aborted and the hunk is left unchanged.
1031 EOF2
1032         close $fh;
1033
1034         chomp(my $editor = run_cmd_pipe(qw(git var GIT_EDITOR)));
1035         system('sh', '-c', $editor.' "$@"', $editor, $hunkfile);
1036
1037         if ($? != 0) {
1038                 return undef;
1039         }
1040
1041         open $fh, '<', $hunkfile
1042                 or die sprintf(__("failed to open hunk edit file for reading: %s"), $!);
1043         my @newtext = grep { !/^\Q$comment_line_char\E/ } <$fh>;
1044         close $fh;
1045         unlink $hunkfile;
1046
1047         # Abort if nothing remains
1048         if (!grep { /\S/ } @newtext) {
1049                 return undef;
1050         }
1051
1052         # Reinsert the first hunk header if the user accidentally deleted it
1053         if ($newtext[0] !~ /^@/) {
1054                 unshift @newtext, $oldtext->[0];
1055         }
1056         return \@newtext;
1057 }
1058
1059 sub diff_applies {
1060         return run_git_apply($patch_mode_flavour{APPLY_CHECK} . ' --check',
1061                              map { @{$_->{TEXT}} } @_);
1062 }
1063
1064 sub _restore_terminal_and_die {
1065         ReadMode 'restore';
1066         print "\n";
1067         exit 1;
1068 }
1069
1070 sub prompt_single_character {
1071         if ($use_readkey) {
1072                 local $SIG{TERM} = \&_restore_terminal_and_die;
1073                 local $SIG{INT} = \&_restore_terminal_and_die;
1074                 ReadMode 'cbreak';
1075                 my $key = ReadKey 0;
1076                 ReadMode 'restore';
1077                 if ($use_termcap and $key eq "\e") {
1078                         while (!defined $term_escapes{$key}) {
1079                                 my $next = ReadKey 0.5;
1080                                 last if (!defined $next);
1081                                 $key .= $next;
1082                         }
1083                         $key =~ s/\e/^[/;
1084                 }
1085                 print "$key" if defined $key;
1086                 print "\n";
1087                 return $key;
1088         } else {
1089                 return <STDIN>;
1090         }
1091 }
1092
1093 sub prompt_yesno {
1094         my ($prompt) = @_;
1095         while (1) {
1096                 print colored $prompt_color, $prompt;
1097                 my $line = prompt_single_character;
1098                 return undef unless defined $line;
1099                 return 0 if $line =~ /^n/i;
1100                 return 1 if $line =~ /^y/i;
1101         }
1102 }
1103
1104 sub edit_hunk_loop {
1105         my ($head, $hunk, $ix) = @_;
1106         my $text = $hunk->[$ix]->{TEXT};
1107
1108         while (1) {
1109                 $text = edit_hunk_manually($text);
1110                 if (!defined $text) {
1111                         return undef;
1112                 }
1113                 my $newhunk = {
1114                         TEXT => $text,
1115                         TYPE => $hunk->[$ix]->{TYPE},
1116                         USE => 1,
1117                         DIRTY => 1,
1118                 };
1119                 if (diff_applies($head,
1120                                  @{$hunk}[0..$ix-1],
1121                                  $newhunk,
1122                                  @{$hunk}[$ix+1..$#{$hunk}])) {
1123                         $newhunk->{DISPLAY} = [color_diff(@{$text})];
1124                         return $newhunk;
1125                 }
1126                 else {
1127                         prompt_yesno(
1128                                 # TRANSLATORS: do not translate [y/n]
1129                                 # The program will only accept that input
1130                                 # at this point.
1131                                 # Consider translating (saying "no" discards!) as
1132                                 # (saying "n" for "no" discards!) if the translation
1133                                 # of the word "no" does not start with n.
1134                                 __('Your edited hunk does not apply. Edit again '
1135                                    . '(saying "no" discards!) [y/n]? ')
1136                                 ) or return undef;
1137                 }
1138         }
1139 }
1140
1141 my %help_patch_modes = (
1142         stage => N__(
1143 "y - stage this hunk
1144 n - do not stage this hunk
1145 q - quit; do not stage this hunk or any of the remaining ones
1146 a - stage this hunk and all later hunks in the file
1147 d - do not stage this hunk or any of the later hunks in the file"),
1148         stash => N__(
1149 "y - stash this hunk
1150 n - do not stash this hunk
1151 q - quit; do not stash this hunk or any of the remaining ones
1152 a - stash this hunk and all later hunks in the file
1153 d - do not stash this hunk or any of the later hunks in the file"),
1154         reset_head => N__(
1155 "y - unstage this hunk
1156 n - do not unstage this hunk
1157 q - quit; do not unstage this hunk or any of the remaining ones
1158 a - unstage this hunk and all later hunks in the file
1159 d - do not unstage this hunk or any of the later hunks in the file"),
1160         reset_nothead => N__(
1161 "y - apply this hunk to index
1162 n - do not apply this hunk to index
1163 q - quit; do not apply this hunk or any of the remaining ones
1164 a - apply this hunk and all later hunks in the file
1165 d - do not apply this hunk or any of the later hunks in the file"),
1166         checkout_index => N__(
1167 "y - discard this hunk from worktree
1168 n - do not discard this hunk from worktree
1169 q - quit; do not discard this hunk or any of the remaining ones
1170 a - discard this hunk and all later hunks in the file
1171 d - do not discard this hunk or any of the later hunks in the file"),
1172         checkout_head => N__(
1173 "y - discard this hunk from index and worktree
1174 n - do not discard this hunk from index and worktree
1175 q - quit; do not discard this hunk or any of the remaining ones
1176 a - discard this hunk and all later hunks in the file
1177 d - do not discard this hunk or any of the later hunks in the file"),
1178         checkout_nothead => N__(
1179 "y - apply this hunk to index and worktree
1180 n - do not apply this hunk to index and worktree
1181 q - quit; do not apply this hunk or any of the remaining ones
1182 a - apply this hunk and all later hunks in the file
1183 d - do not apply this hunk or any of the later hunks in the file"),
1184 );
1185
1186 sub help_patch_cmd {
1187         local $_;
1188         my $other = $_[0] . ",?";
1189         print colored $help_color, __($help_patch_modes{$patch_mode}), "\n",
1190                 map { "$_\n" } grep {
1191                         my $c = quotemeta(substr($_, 0, 1));
1192                         $other =~ /,$c/
1193                 } split "\n", __ <<EOF ;
1194 g - select a hunk to go to
1195 / - search for a hunk matching the given regex
1196 j - leave this hunk undecided, see next undecided hunk
1197 J - leave this hunk undecided, see next hunk
1198 k - leave this hunk undecided, see previous undecided hunk
1199 K - leave this hunk undecided, see previous hunk
1200 s - split the current hunk into smaller hunks
1201 e - manually edit the current hunk
1202 ? - print help
1203 EOF
1204 }
1205
1206 sub apply_patch {
1207         my $cmd = shift;
1208         my $ret = run_git_apply $cmd, @_;
1209         if (!$ret) {
1210                 print STDERR @_;
1211         }
1212         return $ret;
1213 }
1214
1215 sub apply_patch_for_checkout_commit {
1216         my $reverse = shift;
1217         my $applies_index = run_git_apply 'apply '.$reverse.' --cached --check', @_;
1218         my $applies_worktree = run_git_apply 'apply '.$reverse.' --check', @_;
1219
1220         if ($applies_worktree && $applies_index) {
1221                 run_git_apply 'apply '.$reverse.' --cached', @_;
1222                 run_git_apply 'apply '.$reverse, @_;
1223                 return 1;
1224         } elsif (!$applies_index) {
1225                 print colored $error_color, __("The selected hunks do not apply to the index!\n");
1226                 if (prompt_yesno __("Apply them to the worktree anyway? ")) {
1227                         return run_git_apply 'apply '.$reverse, @_;
1228                 } else {
1229                         print colored $error_color, __("Nothing was applied.\n");
1230                         return 0;
1231                 }
1232         } else {
1233                 print STDERR @_;
1234                 return 0;
1235         }
1236 }
1237
1238 sub patch_update_cmd {
1239         my @all_mods = list_modified($patch_mode_flavour{FILTER});
1240         error_msg sprintf(__("ignoring unmerged: %s\n"), $_->{VALUE})
1241                 for grep { $_->{UNMERGED} } @all_mods;
1242         @all_mods = grep { !$_->{UNMERGED} } @all_mods;
1243
1244         my @mods = grep { !($_->{BINARY}) } @all_mods;
1245         my @them;
1246
1247         if (!@mods) {
1248                 if (@all_mods) {
1249                         print STDERR __("Only binary files changed.\n");
1250                 } else {
1251                         print STDERR __("No changes.\n");
1252                 }
1253                 return 0;
1254         }
1255         if ($patch_mode_only) {
1256                 @them = @mods;
1257         }
1258         else {
1259                 @them = list_and_choose({ PROMPT => __('Patch update'),
1260                                           HEADER => $status_head, },
1261                                         @mods);
1262         }
1263         for (@them) {
1264                 return 0 if patch_update_file($_->{VALUE});
1265         }
1266 }
1267
1268 # Generate a one line summary of a hunk.
1269 sub summarize_hunk {
1270         my $rhunk = shift;
1271         my $summary = $rhunk->{TEXT}[0];
1272
1273         # Keep the line numbers, discard extra context.
1274         $summary =~ s/@@(.*?)@@.*/$1 /s;
1275         $summary .= " " x (20 - length $summary);
1276
1277         # Add some user context.
1278         for my $line (@{$rhunk->{TEXT}}) {
1279                 if ($line =~ m/^[+-].*\w/) {
1280                         $summary .= $line;
1281                         last;
1282                 }
1283         }
1284
1285         chomp $summary;
1286         return substr($summary, 0, 80) . "\n";
1287 }
1288
1289
1290 # Print a one-line summary of each hunk in the array ref in
1291 # the first argument, starting with the index in the 2nd.
1292 sub display_hunks {
1293         my ($hunks, $i) = @_;
1294         my $ctr = 0;
1295         $i ||= 0;
1296         for (; $i < @$hunks && $ctr < 20; $i++, $ctr++) {
1297                 my $status = " ";
1298                 if (defined $hunks->[$i]{USE}) {
1299                         $status = $hunks->[$i]{USE} ? "+" : "-";
1300                 }
1301                 printf "%s%2d: %s",
1302                         $status,
1303                         $i + 1,
1304                         summarize_hunk($hunks->[$i]);
1305         }
1306         return $i;
1307 }
1308
1309 my %patch_update_prompt_modes = (
1310         stage => {
1311                 mode => N__("Stage mode change [y,n,q,a,d%s,?]? "),
1312                 deletion => N__("Stage deletion [y,n,q,a,d%s,?]? "),
1313                 hunk => N__("Stage this hunk [y,n,q,a,d%s,?]? "),
1314         },
1315         stash => {
1316                 mode => N__("Stash mode change [y,n,q,a,d%s,?]? "),
1317                 deletion => N__("Stash deletion [y,n,q,a,d%s,?]? "),
1318                 hunk => N__("Stash this hunk [y,n,q,a,d%s,?]? "),
1319         },
1320         reset_head => {
1321                 mode => N__("Unstage mode change [y,n,q,a,d%s,?]? "),
1322                 deletion => N__("Unstage deletion [y,n,q,a,d%s,?]? "),
1323                 hunk => N__("Unstage this hunk [y,n,q,a,d%s,?]? "),
1324         },
1325         reset_nothead => {
1326                 mode => N__("Apply mode change to index [y,n,q,a,d%s,?]? "),
1327                 deletion => N__("Apply deletion to index [y,n,q,a,d%s,?]? "),
1328                 hunk => N__("Apply this hunk to index [y,n,q,a,d%s,?]? "),
1329         },
1330         checkout_index => {
1331                 mode => N__("Discard mode change from worktree [y,n,q,a,d%s,?]? "),
1332                 deletion => N__("Discard deletion from worktree [y,n,q,a,d%s,?]? "),
1333                 hunk => N__("Discard this hunk from worktree [y,n,q,a,d%s,?]? "),
1334         },
1335         checkout_head => {
1336                 mode => N__("Discard mode change from index and worktree [y,n,q,a,d%s,?]? "),
1337                 deletion => N__("Discard deletion from index and worktree [y,n,q,a,d%s,?]? "),
1338                 hunk => N__("Discard this hunk from index and worktree [y,n,q,a,d%s,?]? "),
1339         },
1340         checkout_nothead => {
1341                 mode => N__("Apply mode change to index and worktree [y,n,q,a,d%s,?]? "),
1342                 deletion => N__("Apply deletion to index and worktree [y,n,q,a,d%s,?]? "),
1343                 hunk => N__("Apply this hunk to index and worktree [y,n,q,a,d%s,?]? "),
1344         },
1345 );
1346
1347 sub patch_update_file {
1348         my $quit = 0;
1349         my ($ix, $num);
1350         my $path = shift;
1351         my ($head, @hunk) = parse_diff($path);
1352         ($head, my $mode, my $deletion) = parse_diff_header($head);
1353         for (@{$head->{DISPLAY}}) {
1354                 print;
1355         }
1356
1357         if (@{$mode->{TEXT}}) {
1358                 unshift @hunk, $mode;
1359         }
1360         if (@{$deletion->{TEXT}}) {
1361                 foreach my $hunk (@hunk) {
1362                         push @{$deletion->{TEXT}}, @{$hunk->{TEXT}};
1363                         push @{$deletion->{DISPLAY}}, @{$hunk->{DISPLAY}};
1364                 }
1365                 @hunk = ($deletion);
1366         }
1367
1368         $num = scalar @hunk;
1369         $ix = 0;
1370
1371         while (1) {
1372                 my ($prev, $next, $other, $undecided, $i);
1373                 $other = '';
1374
1375                 if ($num <= $ix) {
1376                         $ix = 0;
1377                 }
1378                 for ($i = 0; $i < $ix; $i++) {
1379                         if (!defined $hunk[$i]{USE}) {
1380                                 $prev = 1;
1381                                 $other .= ',k';
1382                                 last;
1383                         }
1384                 }
1385                 if ($ix) {
1386                         $other .= ',K';
1387                 }
1388                 for ($i = $ix + 1; $i < $num; $i++) {
1389                         if (!defined $hunk[$i]{USE}) {
1390                                 $next = 1;
1391                                 $other .= ',j';
1392                                 last;
1393                         }
1394                 }
1395                 if ($ix < $num - 1) {
1396                         $other .= ',J';
1397                 }
1398                 if ($num > 1) {
1399                         $other .= ',g,/';
1400                 }
1401                 for ($i = 0; $i < $num; $i++) {
1402                         if (!defined $hunk[$i]{USE}) {
1403                                 $undecided = 1;
1404                                 last;
1405                         }
1406                 }
1407                 last if (!$undecided);
1408
1409                 if ($hunk[$ix]{TYPE} eq 'hunk' &&
1410                     hunk_splittable($hunk[$ix]{TEXT})) {
1411                         $other .= ',s';
1412                 }
1413                 if ($hunk[$ix]{TYPE} eq 'hunk') {
1414                         $other .= ',e';
1415                 }
1416                 for (@{$hunk[$ix]{DISPLAY}}) {
1417                         print;
1418                 }
1419                 print colored $prompt_color,
1420                         sprintf(__($patch_update_prompt_modes{$patch_mode}{$hunk[$ix]{TYPE}}), $other);
1421
1422                 my $line = prompt_single_character;
1423                 last unless defined $line;
1424                 if ($line) {
1425                         if ($line =~ /^y/i) {
1426                                 $hunk[$ix]{USE} = 1;
1427                         }
1428                         elsif ($line =~ /^n/i) {
1429                                 $hunk[$ix]{USE} = 0;
1430                         }
1431                         elsif ($line =~ /^a/i) {
1432                                 while ($ix < $num) {
1433                                         if (!defined $hunk[$ix]{USE}) {
1434                                                 $hunk[$ix]{USE} = 1;
1435                                         }
1436                                         $ix++;
1437                                 }
1438                                 next;
1439                         }
1440                         elsif ($line =~ /^g(.*)/) {
1441                                 my $response = $1;
1442                                 unless ($other =~ /g/) {
1443                                         error_msg __("No other hunks to goto\n");
1444                                         next;
1445                                 }
1446                                 my $no = $ix > 10 ? $ix - 10 : 0;
1447                                 while ($response eq '') {
1448                                         $no = display_hunks(\@hunk, $no);
1449                                         if ($no < $num) {
1450                                                 print __("go to which hunk (<ret> to see more)? ");
1451                                         } else {
1452                                                 print __("go to which hunk? ");
1453                                         }
1454                                         $response = <STDIN>;
1455                                         if (!defined $response) {
1456                                                 $response = '';
1457                                         }
1458                                         chomp $response;
1459                                 }
1460                                 if ($response !~ /^\s*\d+\s*$/) {
1461                                         error_msg sprintf(__("Invalid number: '%s'\n"),
1462                                                              $response);
1463                                 } elsif (0 < $response && $response <= $num) {
1464                                         $ix = $response - 1;
1465                                 } else {
1466                                         error_msg sprintf(__n("Sorry, only %d hunk available.\n",
1467                                                               "Sorry, only %d hunks available.\n", $num), $num);
1468                                 }
1469                                 next;
1470                         }
1471                         elsif ($line =~ /^d/i) {
1472                                 while ($ix < $num) {
1473                                         if (!defined $hunk[$ix]{USE}) {
1474                                                 $hunk[$ix]{USE} = 0;
1475                                         }
1476                                         $ix++;
1477                                 }
1478                                 next;
1479                         }
1480                         elsif ($line =~ /^q/i) {
1481                                 for ($i = 0; $i < $num; $i++) {
1482                                         if (!defined $hunk[$i]{USE}) {
1483                                                 $hunk[$i]{USE} = 0;
1484                                         }
1485                                 }
1486                                 $quit = 1;
1487                                 last;
1488                         }
1489                         elsif ($line =~ m|^/(.*)|) {
1490                                 my $regex = $1;
1491                                 unless ($other =~ m|/|) {
1492                                         error_msg __("No other hunks to search\n");
1493                                         next;
1494                                 }
1495                                 if ($1 eq "") {
1496                                         print colored $prompt_color, __("search for regex? ");
1497                                         $regex = <STDIN>;
1498                                         if (defined $regex) {
1499                                                 chomp $regex;
1500                                         }
1501                                 }
1502                                 my $search_string;
1503                                 eval {
1504                                         $search_string = qr{$regex}m;
1505                                 };
1506                                 if ($@) {
1507                                         my ($err,$exp) = ($@, $1);
1508                                         $err =~ s/ at .*git-add--interactive line \d+, <STDIN> line \d+.*$//;
1509                                         error_msg sprintf(__("Malformed search regexp %s: %s\n"), $exp, $err);
1510                                         next;
1511                                 }
1512                                 my $iy = $ix;
1513                                 while (1) {
1514                                         my $text = join ("", @{$hunk[$iy]{TEXT}});
1515                                         last if ($text =~ $search_string);
1516                                         $iy++;
1517                                         $iy = 0 if ($iy >= $num);
1518                                         if ($ix == $iy) {
1519                                                 error_msg __("No hunk matches the given pattern\n");
1520                                                 last;
1521                                         }
1522                                 }
1523                                 $ix = $iy;
1524                                 next;
1525                         }
1526                         elsif ($line =~ /^K/) {
1527                                 if ($other =~ /K/) {
1528                                         $ix--;
1529                                 }
1530                                 else {
1531                                         error_msg __("No previous hunk\n");
1532                                 }
1533                                 next;
1534                         }
1535                         elsif ($line =~ /^J/) {
1536                                 if ($other =~ /J/) {
1537                                         $ix++;
1538                                 }
1539                                 else {
1540                                         error_msg __("No next hunk\n");
1541                                 }
1542                                 next;
1543                         }
1544                         elsif ($line =~ /^k/) {
1545                                 if ($other =~ /k/) {
1546                                         while (1) {
1547                                                 $ix--;
1548                                                 last if (!$ix ||
1549                                                          !defined $hunk[$ix]{USE});
1550                                         }
1551                                 }
1552                                 else {
1553                                         error_msg __("No previous hunk\n");
1554                                 }
1555                                 next;
1556                         }
1557                         elsif ($line =~ /^j/) {
1558                                 if ($other !~ /j/) {
1559                                         error_msg __("No next hunk\n");
1560                                         next;
1561                                 }
1562                         }
1563                         elsif ($line =~ /^s/) {
1564                                 unless ($other =~ /s/) {
1565                                         error_msg __("Sorry, cannot split this hunk\n");
1566                                         next;
1567                                 }
1568                                 my @split = split_hunk($hunk[$ix]{TEXT}, $hunk[$ix]{DISPLAY});
1569                                 if (1 < @split) {
1570                                         print colored $header_color, sprintf(
1571                                                 __n("Split into %d hunk.\n",
1572                                                     "Split into %d hunks.\n",
1573                                                     scalar(@split)), scalar(@split));
1574                                 }
1575                                 splice (@hunk, $ix, 1, @split);
1576                                 $num = scalar @hunk;
1577                                 next;
1578                         }
1579                         elsif ($line =~ /^e/) {
1580                                 unless ($other =~ /e/) {
1581                                         error_msg __("Sorry, cannot edit this hunk\n");
1582                                         next;
1583                                 }
1584                                 my $newhunk = edit_hunk_loop($head, \@hunk, $ix);
1585                                 if (defined $newhunk) {
1586                                         splice @hunk, $ix, 1, $newhunk;
1587                                 }
1588                         }
1589                         else {
1590                                 help_patch_cmd($other);
1591                                 next;
1592                         }
1593                         # soft increment
1594                         while (1) {
1595                                 $ix++;
1596                                 last if ($ix >= $num ||
1597                                          !defined $hunk[$ix]{USE});
1598                         }
1599                 }
1600         }
1601
1602         @hunk = coalesce_overlapping_hunks(@hunk);
1603
1604         my $n_lofs = 0;
1605         my @result = ();
1606         for (@hunk) {
1607                 if ($_->{USE}) {
1608                         push @result, @{$_->{TEXT}};
1609                 }
1610         }
1611
1612         if (@result) {
1613                 my @patch = reassemble_patch($head->{TEXT}, @result);
1614                 my $apply_routine = $patch_mode_flavour{APPLY};
1615                 &$apply_routine(@patch);
1616                 refresh();
1617         }
1618
1619         print "\n";
1620         return $quit;
1621 }
1622
1623 sub diff_cmd {
1624         my @mods = list_modified('index-only');
1625         @mods = grep { !($_->{BINARY}) } @mods;
1626         return if (!@mods);
1627         my (@them) = list_and_choose({ PROMPT => __('Review diff'),
1628                                      IMMEDIATE => 1,
1629                                      HEADER => $status_head, },
1630                                    @mods);
1631         return if (!@them);
1632         my $reference = (is_initial_commit()) ? get_empty_tree() : 'HEAD';
1633         system(qw(git diff -p --cached), $reference, '--',
1634                 map { $_->{VALUE} } @them);
1635 }
1636
1637 sub quit_cmd {
1638         print __("Bye.\n");
1639         exit(0);
1640 }
1641
1642 sub help_cmd {
1643 # TRANSLATORS: please do not translate the command names
1644 # 'status', 'update', 'revert', etc.
1645         print colored $help_color, __ <<'EOF' ;
1646 status        - show paths with changes
1647 update        - add working tree state to the staged set of changes
1648 revert        - revert staged set of changes back to the HEAD version
1649 patch         - pick hunks and update selectively
1650 diff          - view diff between HEAD and index
1651 add untracked - add contents of untracked files to the staged set of changes
1652 EOF
1653 }
1654
1655 sub process_args {
1656         return unless @ARGV;
1657         my $arg = shift @ARGV;
1658         if ($arg =~ /--patch(?:=(.*))?/) {
1659                 if (defined $1) {
1660                         if ($1 eq 'reset') {
1661                                 $patch_mode = 'reset_head';
1662                                 $patch_mode_revision = 'HEAD';
1663                                 $arg = shift @ARGV or die __("missing --");
1664                                 if ($arg ne '--') {
1665                                         $patch_mode_revision = $arg;
1666                                         $patch_mode = ($arg eq 'HEAD' ?
1667                                                        'reset_head' : 'reset_nothead');
1668                                         $arg = shift @ARGV or die __("missing --");
1669                                 }
1670                         } elsif ($1 eq 'checkout') {
1671                                 $arg = shift @ARGV or die __("missing --");
1672                                 if ($arg eq '--') {
1673                                         $patch_mode = 'checkout_index';
1674                                 } else {
1675                                         $patch_mode_revision = $arg;
1676                                         $patch_mode = ($arg eq 'HEAD' ?
1677                                                        'checkout_head' : 'checkout_nothead');
1678                                         $arg = shift @ARGV or die __("missing --");
1679                                 }
1680                         } elsif ($1 eq 'stage' or $1 eq 'stash') {
1681                                 $patch_mode = $1;
1682                                 $arg = shift @ARGV or die __("missing --");
1683                         } else {
1684                                 die sprintf(__("unknown --patch mode: %s"), $1);
1685                         }
1686                 } else {
1687                         $patch_mode = 'stage';
1688                         $arg = shift @ARGV or die __("missing --");
1689                 }
1690                 die sprintf(__("invalid argument %s, expecting --"),
1691                                $arg) unless $arg eq "--";
1692                 %patch_mode_flavour = %{$patch_modes{$patch_mode}};
1693                 $patch_mode_only = 1;
1694         }
1695         elsif ($arg ne "--") {
1696                 die sprintf(__("invalid argument %s, expecting --"), $arg);
1697         }
1698 }
1699
1700 sub main_loop {
1701         my @cmd = ([ 'status', \&status_cmd, ],
1702                    [ 'update', \&update_cmd, ],
1703                    [ 'revert', \&revert_cmd, ],
1704                    [ 'add untracked', \&add_untracked_cmd, ],
1705                    [ 'patch', \&patch_update_cmd, ],
1706                    [ 'diff', \&diff_cmd, ],
1707                    [ 'quit', \&quit_cmd, ],
1708                    [ 'help', \&help_cmd, ],
1709         );
1710         while (1) {
1711                 my ($it) = list_and_choose({ PROMPT => __('What now'),
1712                                              SINGLETON => 1,
1713                                              LIST_FLAT => 4,
1714                                              HEADER => __('*** Commands ***'),
1715                                              ON_EOF => \&quit_cmd,
1716                                              IMMEDIATE => 1 }, @cmd);
1717                 if ($it) {
1718                         eval {
1719                                 $it->[1]->();
1720                         };
1721                         if ($@) {
1722                                 print "$@";
1723                         }
1724                 }
1725         }
1726 }
1727
1728 process_args();
1729 refresh();
1730 if ($patch_mode_only) {
1731         patch_update_cmd();
1732 }
1733 else {
1734         status_cmd();
1735         main_loop();
1736 }