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