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