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