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