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