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