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