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