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