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