git.oblomov.eu Git - git/blob - git-add--interactive.perl

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