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