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