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