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