git-add--interactive.perlon commit t4205: sort log output in a hash-independent way (2a73022)
   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 --ignore-submodules=dirty --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 . " --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        if (@colored && @colored != @diff) {
 709                print STDERR
 710                  "fatal: mismatched output from interactive.diffFilter\n",
 711                  "hint: Your filter must maintain a one-to-one correspondence\n",
 712                  "hint: between its input and output lines.\n";
 713                exit 1;
 714        }
 715
 716        for (my $i = 0; $i < @diff; $i++) {
 717                if ($diff[$i] =~ /^@@ /) {
 718                        push @hunk, { TEXT => [], DISPLAY => [],
 719                                TYPE => 'hunk' };
 720                }
 721                push @{$hunk[-1]{TEXT}}, $diff[$i];
 722                push @{$hunk[-1]{DISPLAY}},
 723                        (@colored ? $colored[$i] : $diff[$i]);
 724        }
 725        return @hunk;
 726}
 727
 728sub parse_diff_header {
 729        my $src = shift;
 730
 731        my $head = { TEXT => [], DISPLAY => [], TYPE => 'header' };
 732        my $mode = { TEXT => [], DISPLAY => [], TYPE => 'mode' };
 733        my $deletion = { TEXT => [], DISPLAY => [], TYPE => 'deletion' };
 734
 735        for (my $i = 0; $i < @{$src->{TEXT}}; $i++) {
 736                my $dest =
 737                   $src->{TEXT}->[$i] =~ /^(old|new) mode (\d+)$/ ? $mode :
 738                   $src->{TEXT}->[$i] =~ /^deleted file/ ? $deletion :
 739                   $head;
 740                push @{$dest->{TEXT}}, $src->{TEXT}->[$i];
 741                push @{$dest->{DISPLAY}}, $src->{DISPLAY}->[$i];
 742        }
 743        return ($head, $mode, $deletion);
 744}
 745
 746sub hunk_splittable {
 747        my ($text) = @_;
 748
 749        my @s = split_hunk($text);
 750        return (1 < @s);
 751}
 752
 753sub parse_hunk_header {
 754        my ($line) = @_;
 755        my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
 756            $line =~ /^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/;
 757        $o_cnt = 1 unless defined $o_cnt;
 758        $n_cnt = 1 unless defined $n_cnt;
 759        return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
 760}
 761
 762sub format_hunk_header {
 763        my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) = @_;
 764        return ("@@ -$o_ofs" .
 765                (($o_cnt != 1) ? ",$o_cnt" : '') .
 766                " +$n_ofs" .
 767                (($n_cnt != 1) ? ",$n_cnt" : '') .
 768                " @@\n");
 769}
 770
 771sub split_hunk {
 772        my ($text, $display) = @_;
 773        my @split = ();
 774        if (!defined $display) {
 775                $display = $text;
 776        }
 777        # If there are context lines in the middle of a hunk,
 778        # it can be split, but we would need to take care of
 779        # overlaps later.
 780
 781        my ($o_ofs, undef, $n_ofs) = parse_hunk_header($text->[0]);
 782        my $hunk_start = 1;
 783
 784      OUTER:
 785        while (1) {
 786                my $next_hunk_start = undef;
 787                my $i = $hunk_start - 1;
 788                my $this = +{
 789                        TEXT => [],
 790                        DISPLAY => [],
 791                        TYPE => 'hunk',
 792                        OLD => $o_ofs,
 793                        NEW => $n_ofs,
 794                        OCNT => 0,
 795                        NCNT => 0,
 796                        ADDDEL => 0,
 797                        POSTCTX => 0,
 798                        USE => undef,
 799                };
 800
 801                while (++$i < @$text) {
 802                        my $line = $text->[$i];
 803                        my $display = $display->[$i];
 804                        if ($line =~ /^\\/) {
 805                                push @{$this->{TEXT}}, $line;
 806                                push @{$this->{DISPLAY}}, $display;
 807                                next;
 808                        }
 809                        if ($line =~ /^ /) {
 810                                if ($this->{ADDDEL} &&
 811                                    !defined $next_hunk_start) {
 812                                        # We have seen leading context and
 813                                        # adds/dels and then here is another
 814                                        # context, which is trailing for this
 815                                        # split hunk and leading for the next
 816                                        # one.
 817                                        $next_hunk_start = $i;
 818                                }
 819                                push @{$this->{TEXT}}, $line;
 820                                push @{$this->{DISPLAY}}, $display;
 821                                $this->{OCNT}++;
 822                                $this->{NCNT}++;
 823                                if (defined $next_hunk_start) {
 824                                        $this->{POSTCTX}++;
 825                                }
 826                                next;
 827                        }
 828
 829                        # add/del
 830                        if (defined $next_hunk_start) {
 831                                # We are done with the current hunk and
 832                                # this is the first real change for the
 833                                # next split one.
 834                                $hunk_start = $next_hunk_start;
 835                                $o_ofs = $this->{OLD} + $this->{OCNT};
 836                                $n_ofs = $this->{NEW} + $this->{NCNT};
 837                                $o_ofs -= $this->{POSTCTX};
 838                                $n_ofs -= $this->{POSTCTX};
 839                                push @split, $this;
 840                                redo OUTER;
 841                        }
 842                        push @{$this->{TEXT}}, $line;
 843                        push @{$this->{DISPLAY}}, $display;
 844                        $this->{ADDDEL}++;
 845                        if ($line =~ /^-/) {
 846                                $this->{OCNT}++;
 847                        }
 848                        else {
 849                                $this->{NCNT}++;
 850                        }
 851                }
 852
 853                push @split, $this;
 854                last;
 855        }
 856
 857        for my $hunk (@split) {
 858                $o_ofs = $hunk->{OLD};
 859                $n_ofs = $hunk->{NEW};
 860                my $o_cnt = $hunk->{OCNT};
 861                my $n_cnt = $hunk->{NCNT};
 862
 863                my $head = format_hunk_header($o_ofs, $o_cnt, $n_ofs, $n_cnt);
 864                my $display_head = $head;
 865                unshift @{$hunk->{TEXT}}, $head;
 866                if ($diff_use_color) {
 867                        $display_head = colored($fraginfo_color, $head);
 868                }
 869                unshift @{$hunk->{DISPLAY}}, $display_head;
 870        }
 871        return @split;
 872}
 873
 874sub find_last_o_ctx {
 875        my ($it) = @_;
 876        my $text = $it->{TEXT};
 877        my ($o_ofs, $o_cnt) = parse_hunk_header($text->[0]);
 878        my $i = @{$text};
 879        my $last_o_ctx = $o_ofs + $o_cnt;
 880        while (0 < --$i) {
 881                my $line = $text->[$i];
 882                if ($line =~ /^ /) {
 883                        $last_o_ctx--;
 884                        next;
 885                }
 886                last;
 887        }
 888        return $last_o_ctx;
 889}
 890
 891sub merge_hunk {
 892        my ($prev, $this) = @_;
 893        my ($o0_ofs, $o0_cnt, $n0_ofs, $n0_cnt) =
 894            parse_hunk_header($prev->{TEXT}[0]);
 895        my ($o1_ofs, $o1_cnt, $n1_ofs, $n1_cnt) =
 896            parse_hunk_header($this->{TEXT}[0]);
 897
 898        my (@line, $i, $ofs, $o_cnt, $n_cnt);
 899        $ofs = $o0_ofs;
 900        $o_cnt = $n_cnt = 0;
 901        for ($i = 1; $i < @{$prev->{TEXT}}; $i++) {
 902                my $line = $prev->{TEXT}[$i];
 903                if ($line =~ /^\+/) {
 904                        $n_cnt++;
 905                        push @line, $line;
 906                        next;
 907                } elsif ($line =~ /^\\/) {
 908                        push @line, $line;
 909                        next;
 910                }
 911
 912                last if ($o1_ofs <= $ofs);
 913
 914                $o_cnt++;
 915                $ofs++;
 916                if ($line =~ /^ /) {
 917                        $n_cnt++;
 918                }
 919                push @line, $line;
 920        }
 921
 922        for ($i = 1; $i < @{$this->{TEXT}}; $i++) {
 923                my $line = $this->{TEXT}[$i];
 924                if ($line =~ /^\+/) {
 925                        $n_cnt++;
 926                        push @line, $line;
 927                        next;
 928                } elsif ($line =~ /^\\/) {
 929                        push @line, $line;
 930                        next;
 931                }
 932                $ofs++;
 933                $o_cnt++;
 934                if ($line =~ /^ /) {
 935                        $n_cnt++;
 936                }
 937                push @line, $line;
 938        }
 939        my $head = format_hunk_header($o0_ofs, $o_cnt, $n0_ofs, $n_cnt);
 940        @{$prev->{TEXT}} = ($head, @line);
 941}
 942
 943sub coalesce_overlapping_hunks {
 944        my (@in) = @_;
 945        my @out = ();
 946
 947        my ($last_o_ctx, $last_was_dirty);
 948        my $ofs_delta = 0;
 949
 950        for (@in) {
 951                if ($_->{TYPE} ne 'hunk') {
 952                        push @out, $_;
 953                        next;
 954                }
 955                my $text = $_->{TEXT};
 956                my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
 957                                                parse_hunk_header($text->[0]);
 958                unless ($_->{USE}) {
 959                        $ofs_delta += $o_cnt - $n_cnt;
 960                        # If this hunk has been edited then subtract
 961                        # the delta that is due to the edit.
 962                        if ($_->{OFS_DELTA}) {
 963                                $ofs_delta -= $_->{OFS_DELTA};
 964                        }
 965                        next;
 966                }
 967                if ($ofs_delta) {
 968                        $n_ofs += $ofs_delta;
 969                        $_->{TEXT}->[0] = format_hunk_header($o_ofs, $o_cnt,
 970                                                             $n_ofs, $n_cnt);
 971                }
 972                # If this hunk was edited then adjust the offset delta
 973                # to reflect the edit.
 974                if ($_->{OFS_DELTA}) {
 975                        $ofs_delta += $_->{OFS_DELTA};
 976                }
 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
 992sub 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
1014sub 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
1024my %edit_hunk_manually_modes = (
1025        stage => N__(
1026"If the patch applies cleanly, the edited hunk will immediately be
1027marked for staging."),
1028        stash => N__(
1029"If the patch applies cleanly, the edited hunk will immediately be
1030marked for stashing."),
1031        reset_head => N__(
1032"If the patch applies cleanly, the edited hunk will immediately be
1033marked for unstaging."),
1034        reset_nothead => N__(
1035"If the patch applies cleanly, the edited hunk will immediately be
1036marked for applying."),
1037        checkout_index => N__(
1038"If the patch applies cleanly, the edited hunk will immediately be
1039marked for discarding."),
1040        checkout_head => N__(
1041"If the patch applies cleanly, the edited hunk will immediately be
1042marked for discarding."),
1043        checkout_nothead => N__(
1044"If the patch applies cleanly, the edited hunk will immediately be
1045marked for applying."),
1046);
1047
1048sub recount_edited_hunk {
1049        local $_;
1050        my ($oldtext, $newtext) = @_;
1051        my ($o_cnt, $n_cnt) = (0, 0);
1052        for (@{$newtext}[1..$#{$newtext}]) {
1053                my $mode = substr($_, 0, 1);
1054                if ($mode eq '-') {
1055                        $o_cnt++;
1056                } elsif ($mode eq '+') {
1057                        $n_cnt++;
1058                } elsif ($mode eq ' ') {
1059                        $o_cnt++;
1060                        $n_cnt++;
1061                }
1062        }
1063        my ($o_ofs, undef, $n_ofs, undef) =
1064                                        parse_hunk_header($newtext->[0]);
1065        $newtext->[0] = format_hunk_header($o_ofs, $o_cnt, $n_ofs, $n_cnt);
1066        my (undef, $orig_o_cnt, undef, $orig_n_cnt) =
1067                                        parse_hunk_header($oldtext->[0]);
1068        # Return the change in the number of lines inserted by this hunk
1069        return $orig_o_cnt - $orig_n_cnt - $o_cnt + $n_cnt;
1070}
1071
1072sub edit_hunk_manually {
1073        my ($oldtext) = @_;
1074
1075        my $hunkfile = $repo->repo_path . "/addp-hunk-edit.diff";
1076        my $fh;
1077        open $fh, '>', $hunkfile
1078                or die sprintf(__("failed to open hunk edit file for writing: %s"), $!);
1079        print $fh Git::comment_lines __("Manual hunk edit mode -- see bottom for a quick guide.\n");
1080        print $fh @$oldtext;
1081        my $is_reverse = $patch_mode_flavour{IS_REVERSE};
1082        my ($remove_plus, $remove_minus) = $is_reverse ? ('-', '+') : ('+', '-');
1083        my $comment_line_char = Git::get_comment_line_char;
1084        print $fh Git::comment_lines sprintf(__ <<EOF, $remove_minus, $remove_plus, $comment_line_char),
1085---
1086To remove '%s' lines, make them ' ' lines (context).
1087To remove '%s' lines, delete them.
1088Lines starting with %s will be removed.
1089EOF
1090__($edit_hunk_manually_modes{$patch_mode}),
1091# TRANSLATORS: 'it' refers to the patch mentioned in the previous messages.
1092__ <<EOF2 ;
1093If it does not apply cleanly, you will be given an opportunity to
1094edit again.  If all lines of the hunk are removed, then the edit is
1095aborted and the hunk is left unchanged.
1096EOF2
1097        close $fh;
1098
1099        chomp(my $editor = run_cmd_pipe(qw(git var GIT_EDITOR)));
1100        system('sh', '-c', $editor.' "$@"', $editor, $hunkfile);
1101
1102        if ($? != 0) {
1103                return undef;
1104        }
1105
1106        open $fh, '<', $hunkfile
1107                or die sprintf(__("failed to open hunk edit file for reading: %s"), $!);
1108        my @newtext = grep { !/^\Q$comment_line_char\E/ } <$fh>;
1109        close $fh;
1110        unlink $hunkfile;
1111
1112        # Abort if nothing remains
1113        if (!grep { /\S/ } @newtext) {
1114                return undef;
1115        }
1116
1117        # Reinsert the first hunk header if the user accidentally deleted it
1118        if ($newtext[0] !~ /^@/) {
1119                unshift @newtext, $oldtext->[0];
1120        }
1121        return \@newtext;
1122}
1123
1124sub diff_applies {
1125        return run_git_apply($patch_mode_flavour{APPLY_CHECK} . ' --check',
1126                             map { @{$_->{TEXT}} } @_);
1127}
1128
1129sub _restore_terminal_and_die {
1130        ReadMode 'restore';
1131        print "\n";
1132        exit 1;
1133}
1134
1135sub prompt_single_character {
1136        if ($use_readkey) {
1137                local $SIG{TERM} = \&_restore_terminal_and_die;
1138                local $SIG{INT} = \&_restore_terminal_and_die;
1139                ReadMode 'cbreak';
1140                my $key = ReadKey 0;
1141                ReadMode 'restore';
1142                if ($use_termcap and $key eq "\e") {
1143                        while (!defined $term_escapes{$key}) {
1144                                my $next = ReadKey 0.5;
1145                                last if (!defined $next);
1146                                $key .= $next;
1147                        }
1148                        $key =~ s/\e/^[/;
1149                }
1150                print "$key" if defined $key;
1151                print "\n";
1152                return $key;
1153        } else {
1154                return <STDIN>;
1155        }
1156}
1157
1158sub prompt_yesno {
1159        my ($prompt) = @_;
1160        while (1) {
1161                print colored $prompt_color, $prompt;
1162                my $line = prompt_single_character;
1163                return undef unless defined $line;
1164                return 0 if $line =~ /^n/i;
1165                return 1 if $line =~ /^y/i;
1166        }
1167}
1168
1169sub edit_hunk_loop {
1170        my ($head, $hunks, $ix) = @_;
1171        my $hunk = $hunks->[$ix];
1172        my $text = $hunk->{TEXT};
1173
1174        while (1) {
1175                my $newtext = edit_hunk_manually($text);
1176                if (!defined $newtext) {
1177                        return undef;
1178                }
1179                my $newhunk = {
1180                        TEXT => $newtext,
1181                        TYPE => $hunk->{TYPE},
1182                        USE => 1,
1183                        DIRTY => 1,
1184                };
1185                $newhunk->{OFS_DELTA} = recount_edited_hunk($text, $newtext);
1186                # If this hunk has already been edited then add the
1187                # offset delta of the previous edit to get the real
1188                # delta from the original unedited hunk.
1189                $hunk->{OFS_DELTA} and
1190                                $newhunk->{OFS_DELTA} += $hunk->{OFS_DELTA};
1191                if (diff_applies($head,
1192                                 @{$hunks}[0..$ix-1],
1193                                 $newhunk,
1194                                 @{$hunks}[$ix+1..$#{$hunks}])) {
1195                        $newhunk->{DISPLAY} = [color_diff(@{$newtext})];
1196                        return $newhunk;
1197                }
1198                else {
1199                        prompt_yesno(
1200                                # TRANSLATORS: do not translate [y/n]
1201                                # The program will only accept that input
1202                                # at this point.
1203                                # Consider translating (saying "no" discards!) as
1204                                # (saying "n" for "no" discards!) if the translation
1205                                # of the word "no" does not start with n.
1206                                __('Your edited hunk does not apply. Edit again '
1207                                   . '(saying "no" discards!) [y/n]? ')
1208                                ) or return undef;
1209                }
1210        }
1211}
1212
1213my %help_patch_modes = (
1214        stage => N__(
1215"y - stage this hunk
1216n - do not stage this hunk
1217q - quit; do not stage this hunk or any of the remaining ones
1218a - stage this hunk and all later hunks in the file
1219d - do not stage this hunk or any of the later hunks in the file"),
1220        stash => N__(
1221"y - stash this hunk
1222n - do not stash this hunk
1223q - quit; do not stash this hunk or any of the remaining ones
1224a - stash this hunk and all later hunks in the file
1225d - do not stash this hunk or any of the later hunks in the file"),
1226        reset_head => N__(
1227"y - unstage this hunk
1228n - do not unstage this hunk
1229q - quit; do not unstage this hunk or any of the remaining ones
1230a - unstage this hunk and all later hunks in the file
1231d - do not unstage this hunk or any of the later hunks in the file"),
1232        reset_nothead => N__(
1233"y - apply this hunk to index
1234n - do not apply this hunk to index
1235q - quit; do not apply this hunk or any of the remaining ones
1236a - apply this hunk and all later hunks in the file
1237d - do not apply this hunk or any of the later hunks in the file"),
1238        checkout_index => N__(
1239"y - discard this hunk from worktree
1240n - do not discard this hunk from worktree
1241q - quit; do not discard this hunk or any of the remaining ones
1242a - discard this hunk and all later hunks in the file
1243d - do not discard this hunk or any of the later hunks in the file"),
1244        checkout_head => N__(
1245"y - discard this hunk from index and worktree
1246n - do not discard this hunk from index and worktree
1247q - quit; do not discard this hunk or any of the remaining ones
1248a - discard this hunk and all later hunks in the file
1249d - do not discard this hunk or any of the later hunks in the file"),
1250        checkout_nothead => N__(
1251"y - apply this hunk to index and worktree
1252n - do not apply this hunk to index and worktree
1253q - quit; do not apply this hunk or any of the remaining ones
1254a - apply this hunk and all later hunks in the file
1255d - do not apply this hunk or any of the later hunks in the file"),
1256);
1257
1258sub help_patch_cmd {
1259        local $_;
1260        my $other = $_[0] . ",?";
1261        print colored $help_color, __($help_patch_modes{$patch_mode}), "\n",
1262                map { "$_\n" } grep {
1263                        my $c = quotemeta(substr($_, 0, 1));
1264                        $other =~ /,$c/
1265                } split "\n", __ <<EOF ;
1266g - select a hunk to go to
1267/ - search for a hunk matching the given regex
1268j - leave this hunk undecided, see next undecided hunk
1269J - leave this hunk undecided, see next hunk
1270k - leave this hunk undecided, see previous undecided hunk
1271K - leave this hunk undecided, see previous hunk
1272s - split the current hunk into smaller hunks
1273e - manually edit the current hunk
1274? - print help
1275EOF
1276}
1277
1278sub apply_patch {
1279        my $cmd = shift;
1280        my $ret = run_git_apply $cmd, @_;
1281        if (!$ret) {
1282                print STDERR @_;
1283        }
1284        return $ret;
1285}
1286
1287sub apply_patch_for_checkout_commit {
1288        my $reverse = shift;
1289        my $applies_index = run_git_apply 'apply '.$reverse.' --cached --check', @_;
1290        my $applies_worktree = run_git_apply 'apply '.$reverse.' --check', @_;
1291
1292        if ($applies_worktree && $applies_index) {
1293                run_git_apply 'apply '.$reverse.' --cached', @_;
1294                run_git_apply 'apply '.$reverse, @_;
1295                return 1;
1296        } elsif (!$applies_index) {
1297                print colored $error_color, __("The selected hunks do not apply to the index!\n");
1298                if (prompt_yesno __("Apply them to the worktree anyway? ")) {
1299                        return run_git_apply 'apply '.$reverse, @_;
1300                } else {
1301                        print colored $error_color, __("Nothing was applied.\n");
1302                        return 0;
1303                }
1304        } else {
1305                print STDERR @_;
1306                return 0;
1307        }
1308}
1309
1310sub patch_update_cmd {
1311        my @all_mods = list_modified($patch_mode_flavour{FILTER});
1312        error_msg sprintf(__("ignoring unmerged: %s\n"), $_->{VALUE})
1313                for grep { $_->{UNMERGED} } @all_mods;
1314        @all_mods = grep { !$_->{UNMERGED} } @all_mods;
1315
1316        my @mods = grep { !($_->{BINARY}) } @all_mods;
1317        my @them;
1318
1319        if (!@mods) {
1320                if (@all_mods) {
1321                        print STDERR __("Only binary files changed.\n");
1322                } else {
1323                        print STDERR __("No changes.\n");
1324                }
1325                return 0;
1326        }
1327        if ($patch_mode_only) {
1328                @them = @mods;
1329        }
1330        else {
1331                @them = list_and_choose({ PROMPT => __('Patch update'),
1332                                          HEADER => $status_head, },
1333                                        @mods);
1334        }
1335        for (@them) {
1336                return 0 if patch_update_file($_->{VALUE});
1337        }
1338}
1339
1340# Generate a one line summary of a hunk.
1341sub summarize_hunk {
1342        my $rhunk = shift;
1343        my $summary = $rhunk->{TEXT}[0];
1344
1345        # Keep the line numbers, discard extra context.
1346        $summary =~ s/@@(.*?)@@.*/$1 /s;
1347        $summary .= " " x (20 - length $summary);
1348
1349        # Add some user context.
1350        for my $line (@{$rhunk->{TEXT}}) {
1351                if ($line =~ m/^[+-].*\w/) {
1352                        $summary .= $line;
1353                        last;
1354                }
1355        }
1356
1357        chomp $summary;
1358        return substr($summary, 0, 80) . "\n";
1359}
1360
1361
1362# Print a one-line summary of each hunk in the array ref in
1363# the first argument, starting with the index in the 2nd.
1364sub display_hunks {
1365        my ($hunks, $i) = @_;
1366        my $ctr = 0;
1367        $i ||= 0;
1368        for (; $i < @$hunks && $ctr < 20; $i++, $ctr++) {
1369                my $status = " ";
1370                if (defined $hunks->[$i]{USE}) {
1371                        $status = $hunks->[$i]{USE} ? "+" : "-";
1372                }
1373                printf "%s%2d: %s",
1374                        $status,
1375                        $i + 1,
1376                        summarize_hunk($hunks->[$i]);
1377        }
1378        return $i;
1379}
1380
1381my %patch_update_prompt_modes = (
1382        stage => {
1383                mode => N__("Stage mode change [y,n,q,a,d%s,?]? "),
1384                deletion => N__("Stage deletion [y,n,q,a,d%s,?]? "),
1385                hunk => N__("Stage this hunk [y,n,q,a,d%s,?]? "),
1386        },
1387        stash => {
1388                mode => N__("Stash mode change [y,n,q,a,d%s,?]? "),
1389                deletion => N__("Stash deletion [y,n,q,a,d%s,?]? "),
1390                hunk => N__("Stash this hunk [y,n,q,a,d%s,?]? "),
1391        },
1392        reset_head => {
1393                mode => N__("Unstage mode change [y,n,q,a,d%s,?]? "),
1394                deletion => N__("Unstage deletion [y,n,q,a,d%s,?]? "),
1395                hunk => N__("Unstage this hunk [y,n,q,a,d%s,?]? "),
1396        },
1397        reset_nothead => {
1398                mode => N__("Apply mode change to index [y,n,q,a,d%s,?]? "),
1399                deletion => N__("Apply deletion to index [y,n,q,a,d%s,?]? "),
1400                hunk => N__("Apply this hunk to index [y,n,q,a,d%s,?]? "),
1401        },
1402        checkout_index => {
1403                mode => N__("Discard mode change from worktree [y,n,q,a,d%s,?]? "),
1404                deletion => N__("Discard deletion from worktree [y,n,q,a,d%s,?]? "),
1405                hunk => N__("Discard this hunk from worktree [y,n,q,a,d%s,?]? "),
1406        },
1407        checkout_head => {
1408                mode => N__("Discard mode change from index and worktree [y,n,q,a,d%s,?]? "),
1409                deletion => N__("Discard deletion from index and worktree [y,n,q,a,d%s,?]? "),
1410                hunk => N__("Discard this hunk from index and worktree [y,n,q,a,d%s,?]? "),
1411        },
1412        checkout_nothead => {
1413                mode => N__("Apply mode change to index and worktree [y,n,q,a,d%s,?]? "),
1414                deletion => N__("Apply deletion to index and worktree [y,n,q,a,d%s,?]? "),
1415                hunk => N__("Apply this hunk to index and worktree [y,n,q,a,d%s,?]? "),
1416        },
1417);
1418
1419sub patch_update_file {
1420        my $quit = 0;
1421        my ($ix, $num);
1422        my $path = shift;
1423        my ($head, @hunk) = parse_diff($path);
1424        ($head, my $mode, my $deletion) = parse_diff_header($head);
1425        for (@{$head->{DISPLAY}}) {
1426                print;
1427        }
1428
1429        if (@{$mode->{TEXT}}) {
1430                unshift @hunk, $mode;
1431        }
1432        if (@{$deletion->{TEXT}}) {
1433                foreach my $hunk (@hunk) {
1434                        push @{$deletion->{TEXT}}, @{$hunk->{TEXT}};
1435                        push @{$deletion->{DISPLAY}}, @{$hunk->{DISPLAY}};
1436                }
1437                @hunk = ($deletion);
1438        }
1439
1440        $num = scalar @hunk;
1441        $ix = 0;
1442
1443        while (1) {
1444                my ($prev, $next, $other, $undecided, $i);
1445                $other = '';
1446
1447                if ($num <= $ix) {
1448                        $ix = 0;
1449                }
1450                for ($i = 0; $i < $ix; $i++) {
1451                        if (!defined $hunk[$i]{USE}) {
1452                                $prev = 1;
1453                                $other .= ',k';
1454                                last;
1455                        }
1456                }
1457                if ($ix) {
1458                        $other .= ',K';
1459                }
1460                for ($i = $ix + 1; $i < $num; $i++) {
1461                        if (!defined $hunk[$i]{USE}) {
1462                                $next = 1;
1463                                $other .= ',j';
1464                                last;
1465                        }
1466                }
1467                if ($ix < $num - 1) {
1468                        $other .= ',J';
1469                }
1470                if ($num > 1) {
1471                        $other .= ',g,/';
1472                }
1473                for ($i = 0; $i < $num; $i++) {
1474                        if (!defined $hunk[$i]{USE}) {
1475                                $undecided = 1;
1476                                last;
1477                        }
1478                }
1479                last if (!$undecided);
1480
1481                if ($hunk[$ix]{TYPE} eq 'hunk' &&
1482                    hunk_splittable($hunk[$ix]{TEXT})) {
1483                        $other .= ',s';
1484                }
1485                if ($hunk[$ix]{TYPE} eq 'hunk') {
1486                        $other .= ',e';
1487                }
1488                for (@{$hunk[$ix]{DISPLAY}}) {
1489                        print;
1490                }
1491                print colored $prompt_color,
1492                        sprintf(__($patch_update_prompt_modes{$patch_mode}{$hunk[$ix]{TYPE}}), $other);
1493
1494                my $line = prompt_single_character;
1495                last unless defined $line;
1496                if ($line) {
1497                        if ($line =~ /^y/i) {
1498                                $hunk[$ix]{USE} = 1;
1499                        }
1500                        elsif ($line =~ /^n/i) {
1501                                $hunk[$ix]{USE} = 0;
1502                        }
1503                        elsif ($line =~ /^a/i) {
1504                                while ($ix < $num) {
1505                                        if (!defined $hunk[$ix]{USE}) {
1506                                                $hunk[$ix]{USE} = 1;
1507                                        }
1508                                        $ix++;
1509                                }
1510                                next;
1511                        }
1512                        elsif ($line =~ /^g(.*)/) {
1513                                my $response = $1;
1514                                unless ($other =~ /g/) {
1515                                        error_msg __("No other hunks to goto\n");
1516                                        next;
1517                                }
1518                                my $no = $ix > 10 ? $ix - 10 : 0;
1519                                while ($response eq '') {
1520                                        $no = display_hunks(\@hunk, $no);
1521                                        if ($no < $num) {
1522                                                print __("go to which hunk (<ret> to see more)? ");
1523                                        } else {
1524                                                print __("go to which hunk? ");
1525                                        }
1526                                        $response = <STDIN>;
1527                                        if (!defined $response) {
1528                                                $response = '';
1529                                        }
1530                                        chomp $response;
1531                                }
1532                                if ($response !~ /^\s*\d+\s*$/) {
1533                                        error_msg sprintf(__("Invalid number: '%s'\n"),
1534                                                             $response);
1535                                } elsif (0 < $response && $response <= $num) {
1536                                        $ix = $response - 1;
1537                                } else {
1538                                        error_msg sprintf(__n("Sorry, only %d hunk available.\n",
1539                                                              "Sorry, only %d hunks available.\n", $num), $num);
1540                                }
1541                                next;
1542                        }
1543                        elsif ($line =~ /^d/i) {
1544                                while ($ix < $num) {
1545                                        if (!defined $hunk[$ix]{USE}) {
1546                                                $hunk[$ix]{USE} = 0;
1547                                        }
1548                                        $ix++;
1549                                }
1550                                next;
1551                        }
1552                        elsif ($line =~ /^q/i) {
1553                                for ($i = 0; $i < $num; $i++) {
1554                                        if (!defined $hunk[$i]{USE}) {
1555                                                $hunk[$i]{USE} = 0;
1556                                        }
1557                                }
1558                                $quit = 1;
1559                                last;
1560                        }
1561                        elsif ($line =~ m|^/(.*)|) {
1562                                my $regex = $1;
1563                                unless ($other =~ m|/|) {
1564                                        error_msg __("No other hunks to search\n");
1565                                        next;
1566                                }
1567                                if ($regex eq "") {
1568                                        print colored $prompt_color, __("search for regex? ");
1569                                        $regex = <STDIN>;
1570                                        if (defined $regex) {
1571                                                chomp $regex;
1572                                        }
1573                                }
1574                                my $search_string;
1575                                eval {
1576                                        $search_string = qr{$regex}m;
1577                                };
1578                                if ($@) {
1579                                        my ($err,$exp) = ($@, $1);
1580                                        $err =~ s/ at .*git-add--interactive line \d+, <STDIN> line \d+.*$//;
1581                                        error_msg sprintf(__("Malformed search regexp %s: %s\n"), $exp, $err);
1582                                        next;
1583                                }
1584                                my $iy = $ix;
1585                                while (1) {
1586                                        my $text = join ("", @{$hunk[$iy]{TEXT}});
1587                                        last if ($text =~ $search_string);
1588                                        $iy++;
1589                                        $iy = 0 if ($iy >= $num);
1590                                        if ($ix == $iy) {
1591                                                error_msg __("No hunk matches the given pattern\n");
1592                                                last;
1593                                        }
1594                                }
1595                                $ix = $iy;
1596                                next;
1597                        }
1598                        elsif ($line =~ /^K/) {
1599                                if ($other =~ /K/) {
1600                                        $ix--;
1601                                }
1602                                else {
1603                                        error_msg __("No previous hunk\n");
1604                                }
1605                                next;
1606                        }
1607                        elsif ($line =~ /^J/) {
1608                                if ($other =~ /J/) {
1609                                        $ix++;
1610                                }
1611                                else {
1612                                        error_msg __("No next hunk\n");
1613                                }
1614                                next;
1615                        }
1616                        elsif ($line =~ /^k/) {
1617                                if ($other =~ /k/) {
1618                                        while (1) {
1619                                                $ix--;
1620                                                last if (!$ix ||
1621                                                         !defined $hunk[$ix]{USE});
1622                                        }
1623                                }
1624                                else {
1625                                        error_msg __("No previous hunk\n");
1626                                }
1627                                next;
1628                        }
1629                        elsif ($line =~ /^j/) {
1630                                if ($other !~ /j/) {
1631                                        error_msg __("No next hunk\n");
1632                                        next;
1633                                }
1634                        }
1635                        elsif ($line =~ /^s/) {
1636                                unless ($other =~ /s/) {
1637                                        error_msg __("Sorry, cannot split this hunk\n");
1638                                        next;
1639                                }
1640                                my @split = split_hunk($hunk[$ix]{TEXT}, $hunk[$ix]{DISPLAY});
1641                                if (1 < @split) {
1642                                        print colored $header_color, sprintf(
1643                                                __n("Split into %d hunk.\n",
1644                                                    "Split into %d hunks.\n",
1645                                                    scalar(@split)), scalar(@split));
1646                                }
1647                                splice (@hunk, $ix, 1, @split);
1648                                $num = scalar @hunk;
1649                                next;
1650                        }
1651                        elsif ($line =~ /^e/) {
1652                                unless ($other =~ /e/) {
1653                                        error_msg __("Sorry, cannot edit this hunk\n");
1654                                        next;
1655                                }
1656                                my $newhunk = edit_hunk_loop($head, \@hunk, $ix);
1657                                if (defined $newhunk) {
1658                                        splice @hunk, $ix, 1, $newhunk;
1659                                }
1660                        }
1661                        else {
1662                                help_patch_cmd($other);
1663                                next;
1664                        }
1665                        # soft increment
1666                        while (1) {
1667                                $ix++;
1668                                last if ($ix >= $num ||
1669                                         !defined $hunk[$ix]{USE});
1670                        }
1671                }
1672        }
1673
1674        @hunk = coalesce_overlapping_hunks(@hunk);
1675
1676        my $n_lofs = 0;
1677        my @result = ();
1678        for (@hunk) {
1679                if ($_->{USE}) {
1680                        push @result, @{$_->{TEXT}};
1681                }
1682        }
1683
1684        if (@result) {
1685                my @patch = reassemble_patch($head->{TEXT}, @result);
1686                my $apply_routine = $patch_mode_flavour{APPLY};
1687                &$apply_routine(@patch);
1688                refresh();
1689        }
1690
1691        print "\n";
1692        return $quit;
1693}
1694
1695sub diff_cmd {
1696        my @mods = list_modified('index-only');
1697        @mods = grep { !($_->{BINARY}) } @mods;
1698        return if (!@mods);
1699        my (@them) = list_and_choose({ PROMPT => __('Review diff'),
1700                                     IMMEDIATE => 1,
1701                                     HEADER => $status_head, },
1702                                   @mods);
1703        return if (!@them);
1704        my $reference = (is_initial_commit()) ? get_empty_tree() : 'HEAD';
1705        system(qw(git diff -p --cached), $reference, '--',
1706                map { $_->{VALUE} } @them);
1707}
1708
1709sub quit_cmd {
1710        print __("Bye.\n");
1711        exit(0);
1712}
1713
1714sub help_cmd {
1715# TRANSLATORS: please do not translate the command names
1716# 'status', 'update', 'revert', etc.
1717        print colored $help_color, __ <<'EOF' ;
1718status        - show paths with changes
1719update        - add working tree state to the staged set of changes
1720revert        - revert staged set of changes back to the HEAD version
1721patch         - pick hunks and update selectively
1722diff          - view diff between HEAD and index
1723add untracked - add contents of untracked files to the staged set of changes
1724EOF
1725}
1726
1727sub process_args {
1728        return unless @ARGV;
1729        my $arg = shift @ARGV;
1730        if ($arg =~ /--patch(?:=(.*))?/) {
1731                if (defined $1) {
1732                        if ($1 eq 'reset') {
1733                                $patch_mode = 'reset_head';
1734                                $patch_mode_revision = 'HEAD';
1735                                $arg = shift @ARGV or die __("missing --");
1736                                if ($arg ne '--') {
1737                                        $patch_mode_revision = $arg;
1738                                        $patch_mode = ($arg eq 'HEAD' ?
1739                                                       'reset_head' : 'reset_nothead');
1740                                        $arg = shift @ARGV or die __("missing --");
1741                                }
1742                        } elsif ($1 eq 'checkout') {
1743                                $arg = shift @ARGV or die __("missing --");
1744                                if ($arg eq '--') {
1745                                        $patch_mode = 'checkout_index';
1746                                } else {
1747                                        $patch_mode_revision = $arg;
1748                                        $patch_mode = ($arg eq 'HEAD' ?
1749                                                       'checkout_head' : 'checkout_nothead');
1750                                        $arg = shift @ARGV or die __("missing --");
1751                                }
1752                        } elsif ($1 eq 'stage' or $1 eq 'stash') {
1753                                $patch_mode = $1;
1754                                $arg = shift @ARGV or die __("missing --");
1755                        } else {
1756                                die sprintf(__("unknown --patch mode: %s"), $1);
1757                        }
1758                } else {
1759                        $patch_mode = 'stage';
1760                        $arg = shift @ARGV or die __("missing --");
1761                }
1762                die sprintf(__("invalid argument %s, expecting --"),
1763                               $arg) unless $arg eq "--";
1764                %patch_mode_flavour = %{$patch_modes{$patch_mode}};
1765                $patch_mode_only = 1;
1766        }
1767        elsif ($arg ne "--") {
1768                die sprintf(__("invalid argument %s, expecting --"), $arg);
1769        }
1770}
1771
1772sub main_loop {
1773        my @cmd = ([ 'status', \&status_cmd, ],
1774                   [ 'update', \&update_cmd, ],
1775                   [ 'revert', \&revert_cmd, ],
1776                   [ 'add untracked', \&add_untracked_cmd, ],
1777                   [ 'patch', \&patch_update_cmd, ],
1778                   [ 'diff', \&diff_cmd, ],
1779                   [ 'quit', \&quit_cmd, ],
1780                   [ 'help', \&help_cmd, ],
1781        );
1782        while (1) {
1783                my ($it) = list_and_choose({ PROMPT => __('What now'),
1784                                             SINGLETON => 1,
1785                                             LIST_FLAT => 4,
1786                                             HEADER => __('*** Commands ***'),
1787                                             ON_EOF => \&quit_cmd,
1788                                             IMMEDIATE => 1 }, @cmd);
1789                if ($it) {
1790                        eval {
1791                                $it->[1]->();
1792                        };
1793                        if ($@) {
1794                                print "$@";
1795                        }
1796                }
1797        }
1798}
1799
1800process_args();
1801refresh();
1802if ($patch_mode_only) {
1803        patch_update_cmd();
1804}
1805else {
1806        status_cmd();
1807        main_loop();
1808}