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