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 undef unless defined $line;
1156                 return 0 if $line =~ /^n/i;
1157                 return 1 if $line =~ /^y/i;
1158         }
1159 }
1160
1161 sub edit_hunk_loop {
1162         my ($head, $hunk, $ix) = @_;
1163         my $text = $hunk->[$ix]->{TEXT};
1164
1165         while (1) {
1166                 $text = edit_hunk_manually($text);
1167                 if (!defined $text) {
1168                         return undef;
1169                 }
1170                 my $newhunk = {
1171                         TEXT => $text,
1172                         TYPE => $hunk->[$ix]->{TYPE},
1173                         USE => 1,
1174                         DIRTY => 1,
1175                 };
1176                 if (diff_applies($head,
1177                                  @{$hunk}[0..$ix-1],
1178                                  $newhunk,
1179                                  @{$hunk}[$ix+1..$#{$hunk}])) {
1180                         $newhunk->{DISPLAY} = [color_diff(@{$text})];
1181                         return $newhunk;
1182                 }
1183                 else {
1184                         prompt_yesno(
1185                                 # TRANSLATORS: do not translate [y/n]
1186                                 # The program will only accept that input
1187                                 # at this point.
1188                                 # Consider translating (saying "no" discards!) as
1189                                 # (saying "n" for "no" discards!) if the translation
1190                                 # of the word "no" does not start with n.
1191                                 __('Your edited hunk does not apply. Edit again '
1192                                    . '(saying "no" discards!) [y/n]? ')
1193                                 ) or return undef;
1194                 }
1195         }
1196 }
1197
1198 my %help_patch_modes = (
1199         stage => N__(
1200 "y - stage this hunk
1201 n - do not stage this hunk
1202 q - quit; do not stage this hunk or any of the remaining ones
1203 a - stage this hunk and all later hunks in the file
1204 d - do not stage this hunk or any of the later hunks in the file"),
1205         stash => N__(
1206 "y - stash this hunk
1207 n - do not stash this hunk
1208 q - quit; do not stash this hunk or any of the remaining ones
1209 a - stash this hunk and all later hunks in the file
1210 d - do not stash this hunk or any of the later hunks in the file"),
1211         reset_head => N__(
1212 "y - unstage this hunk
1213 n - do not unstage this hunk
1214 q - quit; do not unstage this hunk or any of the remaining ones
1215 a - unstage this hunk and all later hunks in the file
1216 d - do not unstage this hunk or any of the later hunks in the file"),
1217         reset_nothead => N__(
1218 "y - apply this hunk to index
1219 n - do not apply this hunk to index
1220 q - quit; do not apply this hunk or any of the remaining ones
1221 a - apply this hunk and all later hunks in the file
1222 d - do not apply this hunk or any of the later hunks in the file"),
1223         checkout_index => N__(
1224 "y - discard this hunk from worktree
1225 n - do not discard this hunk from worktree
1226 q - quit; do not discard this hunk or any of the remaining ones
1227 a - discard this hunk and all later hunks in the file
1228 d - do not discard this hunk or any of the later hunks in the file"),
1229         checkout_head => N__(
1230 "y - discard this hunk from index and worktree
1231 n - do not discard this hunk from index and worktree
1232 q - quit; do not discard this hunk or any of the remaining ones
1233 a - discard this hunk and all later hunks in the file
1234 d - do not discard this hunk or any of the later hunks in the file"),
1235         checkout_nothead => N__(
1236 "y - apply this hunk to index and worktree
1237 n - do not apply this hunk to index and worktree
1238 q - quit; do not apply this hunk or any of the remaining ones
1239 a - apply this hunk and all later hunks in the file
1240 d - do not apply this hunk or any of the later hunks in the file"),
1241 );
1242
1243 sub help_patch_cmd {
1244         print colored $help_color, __($help_patch_modes{$patch_mode}), "\n", __ <<EOF ;
1245 g - select a hunk to go to
1246 / - search for a hunk matching the given regex
1247 j - leave this hunk undecided, see next undecided hunk
1248 J - leave this hunk undecided, see next hunk
1249 k - leave this hunk undecided, see previous undecided hunk
1250 K - leave this hunk undecided, see previous hunk
1251 s - split the current hunk into smaller hunks
1252 e - manually edit the current hunk
1253 ? - print help
1254 EOF
1255 }
1256
1257 sub apply_patch {
1258         my $cmd = shift;
1259         my $ret = run_git_apply $cmd, @_;
1260         if (!$ret) {
1261                 print STDERR @_;
1262         }
1263         return $ret;
1264 }
1265
1266 sub apply_patch_for_checkout_commit {
1267         my $reverse = shift;
1268         my $applies_index = run_git_apply 'apply '.$reverse.' --cached --check', @_;
1269         my $applies_worktree = run_git_apply 'apply '.$reverse.' --check', @_;
1270
1271         if ($applies_worktree && $applies_index) {
1272                 run_git_apply 'apply '.$reverse.' --cached', @_;
1273                 run_git_apply 'apply '.$reverse, @_;
1274                 return 1;
1275         } elsif (!$applies_index) {
1276                 print colored $error_color, __("The selected hunks do not apply to the index!\n");
1277                 if (prompt_yesno __("Apply them to the worktree anyway? ")) {
1278                         return run_git_apply 'apply '.$reverse, @_;
1279                 } else {
1280                         print colored $error_color, __("Nothing was applied.\n");
1281                         return 0;
1282                 }
1283         } else {
1284                 print STDERR @_;
1285                 return 0;
1286         }
1287 }
1288
1289 sub patch_update_cmd {
1290         my @all_mods = list_modified($patch_mode_flavour{FILTER});
1291         error_msg sprintf(__("ignoring unmerged: %s\n"), $_->{VALUE})
1292                 for grep { $_->{UNMERGED} } @all_mods;
1293         @all_mods = grep { !$_->{UNMERGED} } @all_mods;
1294
1295         my @mods = grep { !($_->{BINARY}) } @all_mods;
1296         my @them;
1297
1298         if (!@mods) {
1299                 if (@all_mods) {
1300                         print STDERR __("Only binary files changed.\n");
1301                 } else {
1302                         print STDERR __("No changes.\n");
1303                 }
1304                 return 0;
1305         }
1306         if ($patch_mode) {
1307                 @them = @mods;
1308         }
1309         else {
1310                 @them = list_and_choose({ PROMPT => __('Patch update'),
1311                                           HEADER => $status_head, },
1312                                         @mods);
1313         }
1314         for (@them) {
1315                 return 0 if patch_update_file($_->{VALUE});
1316         }
1317 }
1318
1319 # Generate a one line summary of a hunk.
1320 sub summarize_hunk {
1321         my $rhunk = shift;
1322         my $summary = $rhunk->{TEXT}[0];
1323
1324         # Keep the line numbers, discard extra context.
1325         $summary =~ s/@@(.*?)@@.*/$1 /s;
1326         $summary .= " " x (20 - length $summary);
1327
1328         # Add some user context.
1329         for my $line (@{$rhunk->{TEXT}}) {
1330                 if ($line =~ m/^[+-].*\w/) {
1331                         $summary .= $line;
1332                         last;
1333                 }
1334         }
1335
1336         chomp $summary;
1337         return substr($summary, 0, 80) . "\n";
1338 }
1339
1340
1341 # Print a one-line summary of each hunk in the array ref in
1342 # the first argument, starting with the index in the 2nd.
1343 sub display_hunks {
1344         my ($hunks, $i) = @_;
1345         my $ctr = 0;
1346         $i ||= 0;
1347         for (; $i < @$hunks && $ctr < 20; $i++, $ctr++) {
1348                 my $status = " ";
1349                 if (defined $hunks->[$i]{USE}) {
1350                         $status = $hunks->[$i]{USE} ? "+" : "-";
1351                 }
1352                 printf "%s%2d: %s",
1353                         $status,
1354                         $i + 1,
1355                         summarize_hunk($hunks->[$i]);
1356         }
1357         return $i;
1358 }
1359
1360 my %patch_update_prompt_modes = (
1361         stage => {
1362                 mode => N__("Stage mode change [y,n,q,a,d,/%s,?]? "),
1363                 deletion => N__("Stage deletion [y,n,q,a,d,/%s,?]? "),
1364                 hunk => N__("Stage this hunk [y,n,q,a,d,/%s,?]? "),
1365         },
1366         stash => {
1367                 mode => N__("Stash mode change [y,n,q,a,d,/%s,?]? "),
1368                 deletion => N__("Stash deletion [y,n,q,a,d,/%s,?]? "),
1369                 hunk => N__("Stash this hunk [y,n,q,a,d,/%s,?]? "),
1370         },
1371         reset_head => {
1372                 mode => N__("Unstage mode change [y,n,q,a,d,/%s,?]? "),
1373                 deletion => N__("Unstage deletion [y,n,q,a,d,/%s,?]? "),
1374                 hunk => N__("Unstage this hunk [y,n,q,a,d,/%s,?]? "),
1375         },
1376         reset_nothead => {
1377                 mode => N__("Apply mode change to index [y,n,q,a,d,/%s,?]? "),
1378                 deletion => N__("Apply deletion to index [y,n,q,a,d,/%s,?]? "),
1379                 hunk => N__("Apply this hunk to index [y,n,q,a,d,/%s,?]? "),
1380         },
1381         checkout_index => {
1382                 mode => N__("Discard mode change from worktree [y,n,q,a,d,/%s,?]? "),
1383                 deletion => N__("Discard deletion from worktree [y,n,q,a,d,/%s,?]? "),
1384                 hunk => N__("Discard this hunk from worktree [y,n,q,a,d,/%s,?]? "),
1385         },
1386         checkout_head => {
1387                 mode => N__("Discard mode change from index and worktree [y,n,q,a,d,/%s,?]? "),
1388                 deletion => N__("Discard deletion from index and worktree [y,n,q,a,d,/%s,?]? "),
1389                 hunk => N__("Discard this hunk from index and worktree [y,n,q,a,d,/%s,?]? "),
1390         },
1391         checkout_nothead => {
1392                 mode => N__("Apply mode change to index and worktree [y,n,q,a,d,/%s,?]? "),
1393                 deletion => N__("Apply deletion to index and worktree [y,n,q,a,d,/%s,?]? "),
1394                 hunk => N__("Apply this hunk to index and worktree [y,n,q,a,d,/%s,?]? "),
1395         },
1396 );
1397
1398 sub patch_update_file {
1399         my $quit = 0;
1400         my ($ix, $num);
1401         my $path = shift;
1402         my ($head, @hunk) = parse_diff($path);
1403         ($head, my $mode, my $deletion) = parse_diff_header($head);
1404         for (@{$head->{DISPLAY}}) {
1405                 print;
1406         }
1407
1408         if (@{$mode->{TEXT}}) {
1409                 unshift @hunk, $mode;
1410         }
1411         if (@{$deletion->{TEXT}}) {
1412                 foreach my $hunk (@hunk) {
1413                         push @{$deletion->{TEXT}}, @{$hunk->{TEXT}};
1414                         push @{$deletion->{DISPLAY}}, @{$hunk->{DISPLAY}};
1415                 }
1416                 @hunk = ($deletion);
1417         }
1418
1419         $num = scalar @hunk;
1420         $ix = 0;
1421
1422         while (1) {
1423                 my ($prev, $next, $other, $undecided, $i);
1424                 $other = '';
1425
1426                 if ($num <= $ix) {
1427                         $ix = 0;
1428                 }
1429                 for ($i = 0; $i < $ix; $i++) {
1430                         if (!defined $hunk[$i]{USE}) {
1431                                 $prev = 1;
1432                                 $other .= ',k';
1433                                 last;
1434                         }
1435                 }
1436                 if ($ix) {
1437                         $other .= ',K';
1438                 }
1439                 for ($i = $ix + 1; $i < $num; $i++) {
1440                         if (!defined $hunk[$i]{USE}) {
1441                                 $next = 1;
1442                                 $other .= ',j';
1443                                 last;
1444                         }
1445                 }
1446                 if ($ix < $num - 1) {
1447                         $other .= ',J';
1448                 }
1449                 if ($num > 1) {
1450                         $other .= ',g';
1451                 }
1452                 for ($i = 0; $i < $num; $i++) {
1453                         if (!defined $hunk[$i]{USE}) {
1454                                 $undecided = 1;
1455                                 last;
1456                         }
1457                 }
1458                 last if (!$undecided);
1459
1460                 if ($hunk[$ix]{TYPE} eq 'hunk' &&
1461                     hunk_splittable($hunk[$ix]{TEXT})) {
1462                         $other .= ',s';
1463                 }
1464                 if ($hunk[$ix]{TYPE} eq 'hunk') {
1465                         $other .= ',e';
1466                 }
1467                 for (@{$hunk[$ix]{DISPLAY}}) {
1468                         print;
1469                 }
1470                 print colored $prompt_color,
1471                         sprintf(__($patch_update_prompt_modes{$patch_mode}{$hunk[$ix]{TYPE}}), $other);
1472
1473                 my $line = prompt_single_character;
1474                 last unless defined $line;
1475                 if ($line) {
1476                         if ($line =~ /^y/i) {
1477                                 $hunk[$ix]{USE} = 1;
1478                         }
1479                         elsif ($line =~ /^n/i) {
1480                                 $hunk[$ix]{USE} = 0;
1481                         }
1482                         elsif ($line =~ /^a/i) {
1483                                 while ($ix < $num) {
1484                                         if (!defined $hunk[$ix]{USE}) {
1485                                                 $hunk[$ix]{USE} = 1;
1486                                         }
1487                                         $ix++;
1488                                 }
1489                                 next;
1490                         }
1491                         elsif ($other =~ /g/ && $line =~ /^g(.*)/) {
1492                                 my $response = $1;
1493                                 my $no = $ix > 10 ? $ix - 10 : 0;
1494                                 while ($response eq '') {
1495                                         $no = display_hunks(\@hunk, $no);
1496                                         if ($no < $num) {
1497                                                 print __("go to which hunk (<ret> to see more)? ");
1498                                         } else {
1499                                                 print __("go to which hunk? ");
1500                                         }
1501                                         $response = <STDIN>;
1502                                         if (!defined $response) {
1503                                                 $response = '';
1504                                         }
1505                                         chomp $response;
1506                                 }
1507                                 if ($response !~ /^\s*\d+\s*$/) {
1508                                         error_msg sprintf(__("Invalid number: '%s'\n"),
1509                                                              $response);
1510                                 } elsif (0 < $response && $response <= $num) {
1511                                         $ix = $response - 1;
1512                                 } else {
1513                                         error_msg sprintf(__n("Sorry, only %d hunk available.\n",
1514                                                               "Sorry, only %d hunks available.\n", $num), $num);
1515                                 }
1516                                 next;
1517                         }
1518                         elsif ($line =~ /^d/i) {
1519                                 while ($ix < $num) {
1520                                         if (!defined $hunk[$ix]{USE}) {
1521                                                 $hunk[$ix]{USE} = 0;
1522                                         }
1523                                         $ix++;
1524                                 }
1525                                 next;
1526                         }
1527                         elsif ($line =~ /^q/i) {
1528                                 for ($i = 0; $i < $num; $i++) {
1529                                         if (!defined $hunk[$i]{USE}) {
1530                                                 $hunk[$i]{USE} = 0;
1531                                         }
1532                                 }
1533                                 $quit = 1;
1534                                 last;
1535                         }
1536                         elsif ($line =~ m|^/(.*)|) {
1537                                 my $regex = $1;
1538                                 if ($1 eq "") {
1539                                         print colored $prompt_color, __("search for regex? ");
1540                                         $regex = <STDIN>;
1541                                         if (defined $regex) {
1542                                                 chomp $regex;
1543                                         }
1544                                 }
1545                                 my $search_string;
1546                                 eval {
1547                                         $search_string = qr{$regex}m;
1548                                 };
1549                                 if ($@) {
1550                                         my ($err,$exp) = ($@, $1);
1551                                         $err =~ s/ at .*git-add--interactive line \d+, <STDIN> line \d+.*$//;
1552                                         error_msg sprintf(__("Malformed search regexp %s: %s\n"), $exp, $err);
1553                                         next;
1554                                 }
1555                                 my $iy = $ix;
1556                                 while (1) {
1557                                         my $text = join ("", @{$hunk[$iy]{TEXT}});
1558                                         last if ($text =~ $search_string);
1559                                         $iy++;
1560                                         $iy = 0 if ($iy >= $num);
1561                                         if ($ix == $iy) {
1562                                                 error_msg __("No hunk matches the given pattern\n");
1563                                                 last;
1564                                         }
1565                                 }
1566                                 $ix = $iy;
1567                                 next;
1568                         }
1569                         elsif ($line =~ /^K/) {
1570                                 if ($other =~ /K/) {
1571                                         $ix--;
1572                                 }
1573                                 else {
1574                                         error_msg __("No previous hunk\n");
1575                                 }
1576                                 next;
1577                         }
1578                         elsif ($line =~ /^J/) {
1579                                 if ($other =~ /J/) {
1580                                         $ix++;
1581                                 }
1582                                 else {
1583                                         error_msg __("No next hunk\n");
1584                                 }
1585                                 next;
1586                         }
1587                         elsif ($line =~ /^k/) {
1588                                 if ($other =~ /k/) {
1589                                         while (1) {
1590                                                 $ix--;
1591                                                 last if (!$ix ||
1592                                                          !defined $hunk[$ix]{USE});
1593                                         }
1594                                 }
1595                                 else {
1596                                         error_msg __("No previous hunk\n");
1597                                 }
1598                                 next;
1599                         }
1600                         elsif ($line =~ /^j/) {
1601                                 if ($other !~ /j/) {
1602                                         error_msg __("No next hunk\n");
1603                                         next;
1604                                 }
1605                         }
1606                         elsif ($other =~ /s/ && $line =~ /^s/) {
1607                                 my @split = split_hunk($hunk[$ix]{TEXT}, $hunk[$ix]{DISPLAY});
1608                                 if (1 < @split) {
1609                                         print colored $header_color, sprintf(
1610                                                 __n("Split into %d hunk.\n",
1611                                                     "Split into %d hunks.\n",
1612                                                     scalar(@split)), scalar(@split));
1613                                 }
1614                                 splice (@hunk, $ix, 1, @split);
1615                                 $num = scalar @hunk;
1616                                 next;
1617                         }
1618                         elsif ($other =~ /e/ && $line =~ /^e/) {
1619                                 my $newhunk = edit_hunk_loop($head, \@hunk, $ix);
1620                                 if (defined $newhunk) {
1621                                         splice @hunk, $ix, 1, $newhunk;
1622                                 }
1623                         }
1624                         else {
1625                                 help_patch_cmd($other);
1626                                 next;
1627                         }
1628                         # soft increment
1629                         while (1) {
1630                                 $ix++;
1631                                 last if ($ix >= $num ||
1632                                          !defined $hunk[$ix]{USE});
1633                         }
1634                 }
1635         }
1636
1637         @hunk = coalesce_overlapping_hunks(@hunk);
1638
1639         my $n_lofs = 0;
1640         my @result = ();
1641         for (@hunk) {
1642                 if ($_->{USE}) {
1643                         push @result, @{$_->{TEXT}};
1644                 }
1645         }
1646
1647         if (@result) {
1648                 my @patch = reassemble_patch($head->{TEXT}, @result);
1649                 my $apply_routine = $patch_mode_flavour{APPLY};
1650                 &$apply_routine(@patch);
1651                 refresh();
1652         }
1653
1654         print "\n";
1655         return $quit;
1656 }
1657
1658 sub diff_cmd {
1659         my @mods = list_modified('index-only');
1660         @mods = grep { !($_->{BINARY}) } @mods;
1661         return if (!@mods);
1662         my (@them) = list_and_choose({ PROMPT => __('Review diff'),
1663                                      IMMEDIATE => 1,
1664                                      HEADER => $status_head, },
1665                                    @mods);
1666         return if (!@them);
1667         my $reference = (is_initial_commit()) ? get_empty_tree() : 'HEAD';
1668         system(qw(git diff -p --cached), $reference, '--',
1669                 map { $_->{VALUE} } @them);
1670 }
1671
1672 sub quit_cmd {
1673         print __("Bye.\n");
1674         exit(0);
1675 }
1676
1677 sub help_cmd {
1678 # TRANSLATORS: please do not translate the command names
1679 # 'status', 'update', 'revert', etc.
1680         print colored $help_color, __ <<'EOF' ;
1681 status        - show paths with changes
1682 update        - add working tree state to the staged set of changes
1683 revert        - revert staged set of changes back to the HEAD version
1684 patch         - pick hunks and update selectively
1685 diff          - view diff between HEAD and index
1686 add untracked - add contents of untracked files to the staged set of changes
1687 EOF
1688 }
1689
1690 sub process_args {
1691         return unless @ARGV;
1692         my $arg = shift @ARGV;
1693         if ($arg =~ /--patch(?:=(.*))?/) {
1694                 if (defined $1) {
1695                         if ($1 eq 'reset') {
1696                                 $patch_mode = 'reset_head';
1697                                 $patch_mode_revision = 'HEAD';
1698                                 $arg = shift @ARGV or die __("missing --");
1699                                 if ($arg ne '--') {
1700                                         $patch_mode_revision = $arg;
1701                                         $patch_mode = ($arg eq 'HEAD' ?
1702                                                        'reset_head' : 'reset_nothead');
1703                                         $arg = shift @ARGV or die __("missing --");
1704                                 }
1705                         } elsif ($1 eq 'checkout') {
1706                                 $arg = shift @ARGV or die __("missing --");
1707                                 if ($arg eq '--') {
1708                                         $patch_mode = 'checkout_index';
1709                                 } else {
1710                                         $patch_mode_revision = $arg;
1711                                         $patch_mode = ($arg eq 'HEAD' ?
1712                                                        'checkout_head' : 'checkout_nothead');
1713                                         $arg = shift @ARGV or die __("missing --");
1714                                 }
1715                         } elsif ($1 eq 'stage' or $1 eq 'stash') {
1716                                 $patch_mode = $1;
1717                                 $arg = shift @ARGV or die __("missing --");
1718                         } else {
1719                                 die sprintf(__("unknown --patch mode: %s"), $1);
1720                         }
1721                 } else {
1722                         $patch_mode = 'stage';
1723                         $arg = shift @ARGV or die __("missing --");
1724                 }
1725                 die sprintf(__("invalid argument %s, expecting --"),
1726                                $arg) unless $arg eq "--";
1727                 %patch_mode_flavour = %{$patch_modes{$patch_mode}};
1728                 $cmd = 1;
1729         }
1730         elsif ($arg ne "--") {
1731                 die sprintf(__("invalid argument %s, expecting --"), $arg);
1732         }
1733 }
1734
1735 sub main_loop {
1736         my @cmd = ([ 'status', \&status_cmd, ],
1737                    [ 'update', \&update_cmd, ],
1738                    [ 'revert', \&revert_cmd, ],
1739                    [ 'add untracked', \&add_untracked_cmd, ],
1740                    [ 'patch', \&patch_update_cmd, ],
1741                    [ 'diff', \&diff_cmd, ],
1742                    [ 'quit', \&quit_cmd, ],
1743                    [ 'help', \&help_cmd, ],
1744         );
1745         while (1) {
1746                 my ($it) = list_and_choose({ PROMPT => __('What now'),
1747                                              SINGLETON => 1,
1748                                              LIST_FLAT => 4,
1749                                              HEADER => __('*** Commands ***'),
1750                                              ON_EOF => \&quit_cmd,
1751                                              IMMEDIATE => 1 }, @cmd);
1752                 if ($it) {
1753                         eval {
1754                                 $it->[1]->();
1755                         };
1756                         if ($@) {
1757                                 print "$@";
1758                         }
1759                 }
1760         }
1761 }
1762
1763 process_args();
1764 refresh();
1765 if ($cmd) {
1766         patch_update_cmd();
1767 }
1768 else {
1769         status_cmd();
1770         main_loop();
1771 }