Andrew's git / gitweb.git / git-add--interactive.perl
?
git-add--interactive.perlon commit Merge branch 'sb/packfiles-in-repository' into next (caa68db)
   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 --ignore-submodules=dirty --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 . " --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        if (@colored && @colored != @diff) {
 709                print STDERR
 710                  "fatal: mismatched output from interactive.diffFilter\n",
 711                  "hint: Your filter must maintain a one-to-one correspondence\n",
 712                  "hint: between its input and output lines.\n";
 713                exit 1;
 714        }
 715
 716        for (my $i = 0; $i < @diff; $i++) {
 717                if ($diff[$i] =~ /^@@ /) {
 718                        push @hunk, { TEXT => [], DISPLAY => [],
 719                                TYPE => 'hunk' };
 720                }
 721                push @{$hunk[-1]{TEXT}}, $diff[$i];
 722                push @{$hunk[-1]{DISPLAY}},
 723                        (@colored ? $colored[$i] : $diff[$i]);
 724        }
 725        return @hunk;
 726}
 727
 728sub parse_diff_header {
 729        my $src = shift;
 730
 731        my $head = { TEXT => [], DISPLAY => [], TYPE => 'header' };
 732        my $mode = { TEXT => [], DISPLAY => [], TYPE => 'mode' };
 733        my $deletion = { TEXT => [], DISPLAY => [], TYPE => 'deletion' };
 734
 735        for (my $i = 0; $i < @{$src->{TEXT}}; $i++) {
 736                my $dest =
 737                   $src->{TEXT}->[$i] =~ /^(old|new) mode (\d+)$/ ? $mode :
 738                   $src->{TEXT}->[$i] =~ /^deleted file/ ? $deletion :
 739                   $head;
 740                push @{$dest->{TEXT}}, $src->{TEXT}->[$i];
 741                push @{$dest->{DISPLAY}}, $src->{DISPLAY}->[$i];
 742        }
 743        return ($head, $mode, $deletion);
 744}
 745
 746sub hunk_splittable {
 747        my ($text) = @_;
 748
 749        my @s = split_hunk($text);
 750        return (1 < @s);
 751}
 752
 753sub parse_hunk_header {
 754        my ($line) = @_;
 755        my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
 756            $line =~ /^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/;
 757        $o_cnt = 1 unless defined $o_cnt;
 758        $n_cnt = 1 unless defined $n_cnt;
 759        return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
 760}
 761
 762sub format_hunk_header {
 763        my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) = @_;
 764        return ("@@ -$o_ofs" .
 765                (($o_cnt != 1) ? ",$o_cnt" : '') .
 766                " +$n_ofs" .
 767                (($n_cnt != 1) ? ",$n_cnt" : '') .
 768                " @@\n");
 769}
 770
 771sub split_hunk {
 772        my ($text, $display) = @_;
 773        my @split = ();
 774        if (!defined $display) {
 775                $display = $text;
 776        }
 777        # If there are context lines in the middle of a hunk,
 778        # it can be split, but we would need to take care of
 779        # overlaps later.
 780
 781        my ($o_ofs, undef, $n_ofs) = parse_hunk_header($text->[0]);
 782        my $hunk_start = 1;
 783
 784      OUTER:
 785        while (1) {
 786                my $next_hunk_start = undef;
 787                my $i = $hunk_start - 1;
 788                my $this = +{
 789                        TEXT => [],
 790                        DISPLAY => [],
 791                        TYPE => 'hunk',
 792                        OLD => $o_ofs,
 793                        NEW => $n_ofs,
 794                        OCNT => 0,
 795                        NCNT => 0,
 796                        ADDDEL => 0,
 797                        POSTCTX => 0,
 798                        USE => undef,
 799                };
 800
 801                while (++$i < @$text) {
 802                        my $line = $text->[$i];
 803                        my $display = $display->[$i];
 804                        if ($line =~ /^\\/) {
 805                                push @{$this->{TEXT}}, $line;
 806                                push @{$this->{DISPLAY}}, $display;
 807                                next;
 808                        }
 809                        if ($line =~ /^ /) {
 810                                if ($this->{ADDDEL} &&
 811                                    !defined $next_hunk_start) {
 812                                        # We have seen leading context and
 813                                        # adds/dels and then here is another
 814                                        # context, which is trailing for this
 815                                        # split hunk and leading for the next
 816                                        # one.
 817                                        $next_hunk_start = $i;
 818                                }
 819                                push @{$this->{TEXT}}, $line;
 820                                push @{$this->{DISPLAY}}, $display;
 821                                $this->{OCNT}++;
 822                                $this->{NCNT}++;
 823                                if (defined $next_hunk_start) {
 824                                        $this->{POSTCTX}++;
 825                                }
 826                                next;
 827                        }
 828
 829                        # add/del
 830                        if (defined $next_hunk_start) {
 831                                # We are done with the current hunk and
 832                                # this is the first real change for the
 833                                # next split one.
 834                                $hunk_start = $next_hunk_start;
 835                                $o_ofs = $this->{OLD} + $this->{OCNT};
 836                                $n_ofs = $this->{NEW} + $this->{NCNT};
 837                                $o_ofs -= $this->{POSTCTX};
 838                                $n_ofs -= $this->{POSTCTX};
 839                                push @split, $this;
 840                                redo OUTER;
 841                        }
 842                        push @{$this->{TEXT}}, $line;
 843                        push @{$this->{DISPLAY}}, $display;
 844                        $this->{ADDDEL}++;
 845                        if ($line =~ /^-/) {
 846                                $this->{OCNT}++;
 847                        }
 848                        else {
 849                                $this->{NCNT}++;
 850                        }
 851                }
 852
 853                push @split, $this;
 854                last;
 855        }
 856
 857        for my $hunk (@split) {
 858                $o_ofs = $hunk->{OLD};
 859                $n_ofs = $hunk->{NEW};
 860                my $o_cnt = $hunk->{OCNT};
 861                my $n_cnt = $hunk->{NCNT};
 862
 863                my $head = format_hunk_header($o_ofs, $o_cnt, $n_ofs, $n_cnt);
 864                my $display_head = $head;
 865                unshift @{$hunk->{TEXT}}, $head;
 866                if ($diff_use_color) {
 867                        $display_head = colored($fraginfo_color, $head);
 868                }
 869                unshift @{$hunk->{DISPLAY}}, $display_head;
 870        }
 871        return @split;
 872}
 873
 874sub find_last_o_ctx {
 875        my ($it) = @_;
 876        my $text = $it->{TEXT};
 877        my ($o_ofs, $o_cnt) = parse_hunk_header($text->[0]);
 878        my $i = @{$text};
 879        my $last_o_ctx = $o_ofs + $o_cnt;
 880        while (0 < --$i) {
 881                my $line = $text->[$i];
 882                if ($line =~ /^ /) {
 883                        $last_o_ctx--;
 884                        next;
 885                }
 886                last;
 887        }
 888        return $last_o_ctx;
 889}
 890
 891sub merge_hunk {
 892        my ($prev, $this) = @_;
 893        my ($o0_ofs, $o0_cnt, $n0_ofs, $n0_cnt) =
 894            parse_hunk_header($prev->{TEXT}[0]);
 895        my ($o1_ofs, $o1_cnt, $n1_ofs, $n1_cnt) =
 896            parse_hunk_header($this->{TEXT}[0]);
 897
 898        my (@line, $i, $ofs, $o_cnt, $n_cnt);
 899        $ofs = $o0_ofs;
 900        $o_cnt = $n_cnt = 0;
 901        for ($i = 1; $i < @{$prev->{TEXT}}; $i++) {
 902                my $line = $prev->{TEXT}[$i];
 903                if ($line =~ /^\+/) {
 904                        $n_cnt++;
 905                        push @line, $line;
 906                        next;
 907                } elsif ($line =~ /^\\/) {
 908                        push @line, $line;
 909                        next;
 910                }
 911
 912                last if ($o1_ofs <= $ofs);
 913
 914                $o_cnt++;
 915                $ofs++;
 916                if ($line =~ /^ /) {
 917                        $n_cnt++;
 918                }
 919                push @line, $line;
 920        }
 921
 922        for ($i = 1; $i < @{$this->{TEXT}}; $i++) {
 923                my $line = $this->{TEXT}[$i];
 924                if ($line =~ /^\+/) {
 925                        $n_cnt++;
 926                        push @line, $line;
 927                        next;
 928                } elsif ($line =~ /^\\/) {
 929                        push @line, $line;
 930                        next;
 931                }
 932                $ofs++;
 933                $o_cnt++;
 934                if ($line =~ /^ /) {
 935                        $n_cnt++;
 936                }
 937                push @line, $line;
 938        }
 939        my $head = format_hunk_header($o0_ofs, $o_cnt, $n0_ofs, $n_cnt);
 940        @{$prev->{TEXT}} = ($head, @line);
 941}
 942
 943sub coalesce_overlapping_hunks {
 944        my (@in) = @_;
 945        my @out = ();
 946
 947        my ($last_o_ctx, $last_was_dirty);
 948        my $ofs_delta = 0;
 949
 950        for (@in) {
 951                if ($_->{TYPE} ne 'hunk') {
 952                        push @out, $_;
 953                        next;
 954                }
 955                my $text = $_->{TEXT};
 956                my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
 957                                                parse_hunk_header($text->[0]);
 958                unless ($_->{USE}) {
 959                        $ofs_delta += $o_cnt - $n_cnt;
 960                        # If this hunk has been edited then subtract
 961                        # the delta that is due to the edit.
 962                        if ($_->{OFS_DELTA}) {
 963                                $ofs_delta -= $_->{OFS_DELTA};
 964                        }
 965                        next;
 966                }
 967                if ($ofs_delta) {
 968                        $n_ofs += $ofs_delta;
 969                        $_->{TEXT}->[0] = format_hunk_header($o_ofs, $o_cnt,
 970                                                             $n_ofs, $n_cnt);
 971                }
 972                # If this hunk was edited then adjust the offset delta
 973                # to reflect the edit.
 974                if ($_->{OFS_DELTA}) {
 975                        $ofs_delta += $_->{OFS_DELTA};
 976                }
 977                if (defined $last_o_ctx &&
 978                    $o_ofs <= $last_o_ctx &&
 979                    !$_->{DIRTY} &&
 980                    !$last_was_dirty) {
 981                        merge_hunk($out[-1], $_);
 982                }
 983                else {
 984                        push @out, $_;
 985                }
 986                $last_o_ctx = find_last_o_ctx($out[-1]);
 987                $last_was_dirty = $_->{DIRTY};
 988        }
 989        return @out;
 990}
 991
 992sub reassemble_patch {
 993        my $head = shift;
 994        my @patch;
 995
 996        # Include everything in the header except the beginning of the diff.
 997        push @patch, (grep { !/^[-+]{3}/ } @$head);
 998
 999        # Then include any headers from the hunk lines, which must
1000        # come before any actual hunk.
1001        while (@_ && $_[0] !~ /^@/) {
1002                push @patch, shift;
1003        }
1004
1005        # Then begin the diff.
1006        push @patch, grep { /^[-+]{3}/ } @$head;
1007
1008        # And then the actual hunks.
1009        push @patch, @_;
1010
1011        return @patch;
1012}
1013
1014sub color_diff {
1015        return map {
1016                colored((/^@/  ? $fraginfo_color :
1017                         /^\+/ ? $diff_new_color :
1018                         /^-/  ? $diff_old_color :
1019                         $diff_plain_color),
1020                        $_);
1021        } @_;
1022}
1023
1024sub label_hunk_lines {
1025        local $_;
1026        my $hunk = shift;
1027        my $i = 0;
1028        my $labels = [ map { /^[-+]/ ? ++$i : 0 } @{$hunk->{TEXT}} ];
1029        if ($i > 1) {
1030                @{$hunk}{qw(LABELS MAX_LABEL)} = ($labels, $i);
1031                return 1;
1032        }
1033        return 0;
1034}
1035
1036sub select_hunk_lines {
1037        my ($hunk, $selected) = @_;
1038        my ($text, $labels) = @{$hunk}{qw(TEXT LABELS)};
1039        my ($i, $o_cnt, $n_cnt) = (0, 0, 0);
1040        my ($push_eol, @newtext);
1041        # Lines with this mode will become context lines if they are
1042        # not selected
1043        my $context_mode = $patch_mode_flavour{IS_REVERSE} ? '+' : '-';
1044        for $i (1..$#{$text}) {
1045                my $mode = substr($text->[$i], 0, 1);
1046                if ($mode eq '\\') {
1047                        push @newtext, $text->[$i] if ($push_eol);
1048                        undef $push_eol;
1049                } elsif ($labels->[$i] and $selected->[$labels->[$i]]) {
1050                        push @newtext, $text->[$i];
1051                        if ($mode eq '+') {
1052                                $n_cnt++;
1053                        } else {
1054                                $o_cnt++;
1055                        }
1056                        $push_eol = 1;
1057                } elsif ($mode eq ' ' or $mode eq $context_mode) {
1058                        push @newtext, ' ' . substr($text->[$i], 1);
1059                        $o_cnt++; $n_cnt++;
1060                        $push_eol = 1;
1061                } else {
1062                        undef $push_eol;
1063                }
1064        }
1065        my ($o_ofs, $orig_o_cnt, $n_ofs, $orig_n_cnt) =
1066                                        parse_hunk_header($text->[0]);
1067        unshift @newtext, format_hunk_header($o_ofs, $o_cnt, $n_ofs, $n_cnt);
1068        my $newhunk = {
1069                TEXT => \@newtext,
1070                DISPLAY => [ color_diff(@newtext) ],
1071                OFS_DELTA => $orig_o_cnt - $orig_n_cnt - $o_cnt + $n_cnt,
1072                TYPE => $hunk->{TYPE},
1073                USE => 1,
1074        };
1075        # If this hunk has previously been edited add the offset delta
1076        # of the old hunk to get the real delta from the original
1077        # hunk.
1078        if ($hunk->{OFS_DELTA}) {
1079                $newhunk->{OFS_DELTA} += $hunk->{OFS_DELTA};
1080        }
1081        return $newhunk;
1082}
1083
1084sub check_hunk_label {
1085        my ($max_label, $label) = ($_[0]->{MAX_LABEL}, $_[1]);
1086        if ($label < 1 or $label > $max_label) {
1087                error_msg sprintf(__("invalid hunk line '%d'\n"), $label);
1088                return 0;
1089        }
1090        return 1;
1091}
1092
1093sub split_hunk_selection {
1094        local $_;
1095        my @fields = @_;
1096        my @ret;
1097        for (@fields) {
1098                while ($_ ne '') {
1099                        if (/^[0-9]-$/) {
1100                                push @ret, $_;
1101                                last;
1102                        } elsif (/^([0-9](?:-[0-9])?)(.*)/) {
1103                                push @ret, $1;
1104                                $_ = $2;
1105                        } else {
1106                                error_msg sprintf
1107                                    __("invalid hunk line '%s'\n"),
1108                                    substr($_, 0, 1);
1109                                return ();
1110                        }
1111                }
1112        }
1113        return @ret;
1114}
1115
1116sub parse_hunk_selection {
1117        local $_;
1118        my ($hunk, $line) = @_;
1119        my ($max_label, $invert) = ($hunk->{MAX_LABEL}, undef);
1120        my @selected = (0) x ($max_label + 1);
1121        my @fields = split(/[,\s]+/, $line);
1122        if ($fields[0] =~ /^-(.*)/) {
1123                $invert = 1;
1124                if ($1 ne '') {
1125                        $fields[0] = $1;
1126                } else {
1127                        shift @fields;
1128                        unless (@fields) {
1129                                error_msg __("no lines to invert\n");
1130                                return undef;
1131                        }
1132                }
1133        }
1134        if ($max_label < 10) {
1135                @fields = split_hunk_selection(@fields) or return undef;
1136        }
1137        for (@fields) {
1138                if (my ($lo, $hi) = /^([0-9]+)-([0-9]*)$/) {
1139                        if ($hi eq '') {
1140                                $hi = $max_label;
1141                        }
1142                        check_hunk_label($hunk, $lo) or return undef;
1143                        check_hunk_label($hunk, $hi) or return undef;
1144                        if ($hi < $lo) {
1145                                ($lo, $hi) = ($hi, $lo);
1146                        }
1147                        @selected[$lo..$hi] = (1) x (1 + $hi - $lo);
1148                } elsif (/^([0-9]+)$/) {
1149                        check_hunk_label($hunk, $1) or return undef;
1150                        $selected[$1] = 1;
1151                } else {
1152                        error_msg sprintf(__("invalid hunk line '%s'\n"), $_);
1153                        return undef;
1154                }
1155        }
1156        if ($invert) {
1157                @selected = map { !$_ } @selected;
1158        }
1159        return \@selected;
1160}
1161
1162sub display_hunk_lines {
1163        my ($display, $labels, $max_label) =
1164                                @{$_[0]}{qw(DISPLAY LABELS MAX_LABEL)};
1165        my $width = int(log($max_label) / log(10)) + 1;
1166        my $padding = ' ' x ($width + 1);
1167        for my $i (0..$#{$display}) {
1168                if ($labels->[$i]) {
1169                        printf '%*d %s', $width, $labels->[$i], $display->[$i];
1170                } else {
1171                        print $padding . $display->[$i];
1172                }
1173        }
1174}
1175
1176sub select_lines_loop {
1177        my $hunk = shift;
1178        display_hunk_lines($hunk);
1179        my $selection = undef;
1180        until (defined $selection) {
1181                print colored $prompt_color, __("select lines? ");
1182                my $text = <STDIN>;
1183                defined $text and $text =~ /\S/ or return undef;
1184                $selection = parse_hunk_selection($hunk, $text);
1185        }
1186        return select_hunk_lines($hunk, $selection);
1187}
1188
1189my %edit_hunk_manually_modes = (
1190        stage => N__(
1191"If the patch applies cleanly, the edited hunk will immediately be
1192marked for staging."),
1193        stash => N__(
1194"If the patch applies cleanly, the edited hunk will immediately be
1195marked for stashing."),
1196        reset_head => N__(
1197"If the patch applies cleanly, the edited hunk will immediately be
1198marked for unstaging."),
1199        reset_nothead => N__(
1200"If the patch applies cleanly, the edited hunk will immediately be
1201marked for applying."),
1202        checkout_index => N__(
1203"If the patch applies cleanly, the edited hunk will immediately be
1204marked for discarding."),
1205        checkout_head => N__(
1206"If the patch applies cleanly, the edited hunk will immediately be
1207marked for discarding."),
1208        checkout_nothead => N__(
1209"If the patch applies cleanly, the edited hunk will immediately be
1210marked for applying."),
1211);
1212
1213sub recount_edited_hunk {
1214        local $_;
1215        my ($oldtext, $newtext) = @_;
1216        my ($o_cnt, $n_cnt) = (0, 0);
1217        for (@{$newtext}[1..$#{$newtext}]) {
1218                my $mode = substr($_, 0, 1);
1219                if ($mode eq '-') {
1220                        $o_cnt++;
1221                } elsif ($mode eq '+') {
1222                        $n_cnt++;
1223                } elsif ($mode eq ' ') {
1224                        $o_cnt++;
1225                        $n_cnt++;
1226                }
1227        }
1228        my ($o_ofs, undef, $n_ofs, undef) =
1229                                        parse_hunk_header($newtext->[0]);
1230        $newtext->[0] = format_hunk_header($o_ofs, $o_cnt, $n_ofs, $n_cnt);
1231        my (undef, $orig_o_cnt, undef, $orig_n_cnt) =
1232                                        parse_hunk_header($oldtext->[0]);
1233        # Return the change in the number of lines inserted by this hunk
1234        return $orig_o_cnt - $orig_n_cnt - $o_cnt + $n_cnt;
1235}
1236
1237sub edit_hunk_manually {
1238        my ($oldtext) = @_;
1239
1240        my $hunkfile = $repo->repo_path . "/addp-hunk-edit.diff";
1241        my $fh;
1242        open $fh, '>', $hunkfile
1243                or die sprintf(__("failed to open hunk edit file for writing: %s"), $!);
1244        print $fh Git::comment_lines __("Manual hunk edit mode -- see bottom for a quick guide.\n");
1245        print $fh @$oldtext;
1246        my $is_reverse = $patch_mode_flavour{IS_REVERSE};
1247        my ($remove_plus, $remove_minus) = $is_reverse ? ('-', '+') : ('+', '-');
1248        my $comment_line_char = Git::get_comment_line_char;
1249        print $fh Git::comment_lines sprintf(__ <<EOF, $remove_minus, $remove_plus, $comment_line_char),
1250---
1251To remove '%s' lines, make them ' ' lines (context).
1252To remove '%s' lines, delete them.
1253Lines starting with %s will be removed.
1254EOF
1255__($edit_hunk_manually_modes{$patch_mode}),
1256# TRANSLATORS: 'it' refers to the patch mentioned in the previous messages.
1257__ <<EOF2 ;
1258If it does not apply cleanly, you will be given an opportunity to
1259edit again.  If all lines of the hunk are removed, then the edit is
1260aborted and the hunk is left unchanged.
1261EOF2
1262        close $fh;
1263
1264        chomp(my $editor = run_cmd_pipe(qw(git var GIT_EDITOR)));
1265        system('sh', '-c', $editor.' "$@"', $editor, $hunkfile);
1266
1267        if ($? != 0) {
1268                return undef;
1269        }
1270
1271        open $fh, '<', $hunkfile
1272                or die sprintf(__("failed to open hunk edit file for reading: %s"), $!);
1273        my @newtext = grep { !/^\Q$comment_line_char\E/ } <$fh>;
1274        close $fh;
1275        unlink $hunkfile;
1276
1277        # Abort if nothing remains
1278        if (!grep { /\S/ } @newtext) {
1279                return undef;
1280        }
1281
1282        # Reinsert the first hunk header if the user accidentally deleted it
1283        if ($newtext[0] !~ /^@/) {
1284                unshift @newtext, $oldtext->[0];
1285        }
1286        return \@newtext;
1287}
1288
1289sub diff_applies {
1290        return run_git_apply($patch_mode_flavour{APPLY_CHECK} . ' --check',
1291                             map { @{$_->{TEXT}} } @_);
1292}
1293
1294sub _restore_terminal_and_die {
1295        ReadMode 'restore';
1296        print "\n";
1297        exit 1;
1298}
1299
1300sub prompt_single_character {
1301        if ($use_readkey) {
1302                local $SIG{TERM} = \&_restore_terminal_and_die;
1303                local $SIG{INT} = \&_restore_terminal_and_die;
1304                ReadMode 'cbreak';
1305                my $key = ReadKey 0;
1306                ReadMode 'restore';
1307                if ($use_termcap and $key eq "\e") {
1308                        while (!defined $term_escapes{$key}) {
1309                                my $next = ReadKey 0.5;
1310                                last if (!defined $next);
1311                                $key .= $next;
1312                        }
1313                        $key =~ s/\e/^[/;
1314                }
1315                print "$key" if defined $key;
1316                print "\n";
1317                return $key;
1318        } else {
1319                return <STDIN>;
1320        }
1321}
1322
1323sub prompt_yesno {
1324        my ($prompt) = @_;
1325        while (1) {
1326                print colored $prompt_color, $prompt;
1327                my $line = prompt_single_character;
1328                return undef unless defined $line;
1329                return 0 if $line =~ /^n/i;
1330                return 1 if $line =~ /^y/i;
1331        }
1332}
1333
1334sub edit_hunk_loop {
1335        my ($head, $hunks, $ix) = @_;
1336        my $hunk = $hunks->[$ix];
1337        my $text = $hunk->{TEXT};
1338
1339        while (1) {
1340                my $newtext = edit_hunk_manually($text);
1341                if (!defined $newtext) {
1342                        return undef;
1343                }
1344                my $newhunk = {
1345                        TEXT => $newtext,
1346                        TYPE => $hunk->{TYPE},
1347                        USE => 1,
1348                        DIRTY => 1,
1349                };
1350                $newhunk->{OFS_DELTA} = recount_edited_hunk($text, $newtext);
1351                # If this hunk has already been edited then add the
1352                # offset delta of the previous edit to get the real
1353                # delta from the original unedited hunk.
1354                $hunk->{OFS_DELTA} and
1355                                $newhunk->{OFS_DELTA} += $hunk->{OFS_DELTA};
1356                if (diff_applies($head,
1357                                 @{$hunks}[0..$ix-1],
1358                                 $newhunk,
1359                                 @{$hunks}[$ix+1..$#{$hunks}])) {
1360                        $newhunk->{DISPLAY} = [color_diff(@{$newtext})];
1361                        return $newhunk;
1362                }
1363                else {
1364                        prompt_yesno(
1365                                # TRANSLATORS: do not translate [y/n]
1366                                # The program will only accept that input
1367                                # at this point.
1368                                # Consider translating (saying "no" discards!) as
1369                                # (saying "n" for "no" discards!) if the translation
1370                                # of the word "no" does not start with n.
1371                                __('Your edited hunk does not apply. Edit again '
1372                                   . '(saying "no" discards!) [y/n]? ')
1373                                ) or return undef;
1374                }
1375        }
1376}
1377
1378my %help_patch_modes = (
1379        stage => N__(
1380"y - stage this hunk
1381n - do not stage this hunk
1382q - quit; do not stage this hunk or any of the remaining ones
1383a - stage this hunk and all later hunks in the file
1384d - do not stage this hunk or any of the later hunks in the file"),
1385        stash => N__(
1386"y - stash this hunk
1387n - do not stash this hunk
1388q - quit; do not stash this hunk or any of the remaining ones
1389a - stash this hunk and all later hunks in the file
1390d - do not stash this hunk or any of the later hunks in the file"),
1391        reset_head => N__(
1392"y - unstage this hunk
1393n - do not unstage this hunk
1394q - quit; do not unstage this hunk or any of the remaining ones
1395a - unstage this hunk and all later hunks in the file
1396d - do not unstage this hunk or any of the later hunks in the file"),
1397        reset_nothead => N__(
1398"y - apply this hunk to index
1399n - do not apply this hunk to index
1400q - quit; do not apply this hunk or any of the remaining ones
1401a - apply this hunk and all later hunks in the file
1402d - do not apply this hunk or any of the later hunks in the file"),
1403        checkout_index => N__(
1404"y - discard this hunk from worktree
1405n - do not discard this hunk from worktree
1406q - quit; do not discard this hunk or any of the remaining ones
1407a - discard this hunk and all later hunks in the file
1408d - do not discard this hunk or any of the later hunks in the file"),
1409        checkout_head => N__(
1410"y - discard this hunk from index and worktree
1411n - do not discard this hunk from index and worktree
1412q - quit; do not discard this hunk or any of the remaining ones
1413a - discard this hunk and all later hunks in the file
1414d - do not discard this hunk or any of the later hunks in the file"),
1415        checkout_nothead => N__(
1416"y - apply this hunk to index and worktree
1417n - do not apply this hunk to index and worktree
1418q - quit; do not apply this hunk or any of the remaining ones
1419a - apply this hunk and all later hunks in the file
1420d - do not apply this hunk or any of the later hunks in the file"),
1421);
1422
1423sub help_patch_cmd {
1424        local $_;
1425        my $other = $_[0] . ",?";
1426        print colored $help_color, __($help_patch_modes{$patch_mode}), "\n",
1427                map { "$_\n" } grep {
1428                        my $c = quotemeta(substr($_, 0, 1));
1429                        $other =~ /,$c/
1430                } split "\n", __ <<EOF ;
1431g - select a hunk to go to
1432/ - search for a hunk matching the given regex
1433j - leave this hunk undecided, see next undecided hunk
1434J - leave this hunk undecided, see next hunk
1435k - leave this hunk undecided, see previous undecided hunk
1436K - leave this hunk undecided, see previous hunk
1437l - select hunk lines to use
1438s - split the current hunk into smaller hunks
1439e - manually edit the current hunk
1440? - print help
1441EOF
1442}
1443
1444sub apply_patch {
1445        my $cmd = shift;
1446        my $ret = run_git_apply $cmd, @_;
1447        if (!$ret) {
1448                print STDERR @_;
1449        }
1450        return $ret;
1451}
1452
1453sub apply_patch_for_checkout_commit {
1454        my $reverse = shift;
1455        my $applies_index = run_git_apply 'apply '.$reverse.' --cached --check', @_;
1456        my $applies_worktree = run_git_apply 'apply '.$reverse.' --check', @_;
1457
1458        if ($applies_worktree && $applies_index) {
1459                run_git_apply 'apply '.$reverse.' --cached', @_;
1460                run_git_apply 'apply '.$reverse, @_;
1461                return 1;
1462        } elsif (!$applies_index) {
1463                print colored $error_color, __("The selected hunks do not apply to the index!\n");
1464                if (prompt_yesno __("Apply them to the worktree anyway? ")) {
1465                        return run_git_apply 'apply '.$reverse, @_;
1466                } else {
1467                        print colored $error_color, __("Nothing was applied.\n");
1468                        return 0;
1469                }
1470        } else {
1471                print STDERR @_;
1472                return 0;
1473        }
1474}
1475
1476sub patch_update_cmd {
1477        my @all_mods = list_modified($patch_mode_flavour{FILTER});
1478        error_msg sprintf(__("ignoring unmerged: %s\n"), $_->{VALUE})
1479                for grep { $_->{UNMERGED} } @all_mods;
1480        @all_mods = grep { !$_->{UNMERGED} } @all_mods;
1481
1482        my @mods = grep { !($_->{BINARY}) } @all_mods;
1483        my @them;
1484
1485        if (!@mods) {
1486                if (@all_mods) {
1487                        print STDERR __("Only binary files changed.\n");
1488                } else {
1489                        print STDERR __("No changes.\n");
1490                }
1491                return 0;
1492        }
1493        if ($patch_mode_only) {
1494                @them = @mods;
1495        }
1496        else {
1497                @them = list_and_choose({ PROMPT => __('Patch update'),
1498                                          HEADER => $status_head, },
1499                                        @mods);
1500        }
1501        for (@them) {
1502                return 0 if patch_update_file($_->{VALUE});
1503        }
1504}
1505
1506# Generate a one line summary of a hunk.
1507sub summarize_hunk {
1508        my $rhunk = shift;
1509        my $summary = $rhunk->{TEXT}[0];
1510
1511        # Keep the line numbers, discard extra context.
1512        $summary =~ s/@@(.*?)@@.*/$1 /s;
1513        $summary .= " " x (20 - length $summary);
1514
1515        # Add some user context.
1516        for my $line (@{$rhunk->{TEXT}}) {
1517                if ($line =~ m/^[+-].*\w/) {
1518                        $summary .= $line;
1519                        last;
1520                }
1521        }
1522
1523        chomp $summary;
1524        return substr($summary, 0, 80) . "\n";
1525}
1526
1527
1528# Print a one-line summary of each hunk in the array ref in
1529# the first argument, starting with the index in the 2nd.
1530sub display_hunks {
1531        my ($hunks, $i) = @_;
1532        my $ctr = 0;
1533        $i ||= 0;
1534        for (; $i < @$hunks && $ctr < 20; $i++, $ctr++) {
1535                my $status = " ";
1536                if (defined $hunks->[$i]{USE}) {
1537                        $status = $hunks->[$i]{USE} ? "+" : "-";
1538                }
1539                printf "%s%2d: %s",
1540                        $status,
1541                        $i + 1,
1542                        summarize_hunk($hunks->[$i]);
1543        }
1544        return $i;
1545}
1546
1547my %patch_update_prompt_modes = (
1548        stage => {
1549                mode => N__("Stage mode change [y,n,q,a,d%s,?]? "),
1550                deletion => N__("Stage deletion [y,n,q,a,d%s,?]? "),
1551                hunk => N__("Stage this hunk [y,n,q,a,d%s,?]? "),
1552        },
1553        stash => {
1554                mode => N__("Stash mode change [y,n,q,a,d%s,?]? "),
1555                deletion => N__("Stash deletion [y,n,q,a,d%s,?]? "),
1556                hunk => N__("Stash this hunk [y,n,q,a,d%s,?]? "),
1557        },
1558        reset_head => {
1559                mode => N__("Unstage mode change [y,n,q,a,d%s,?]? "),
1560                deletion => N__("Unstage deletion [y,n,q,a,d%s,?]? "),
1561                hunk => N__("Unstage this hunk [y,n,q,a,d%s,?]? "),
1562        },
1563        reset_nothead => {
1564                mode => N__("Apply mode change to index [y,n,q,a,d%s,?]? "),
1565                deletion => N__("Apply deletion to index [y,n,q,a,d%s,?]? "),
1566                hunk => N__("Apply this hunk to index [y,n,q,a,d%s,?]? "),
1567        },
1568        checkout_index => {
1569                mode => N__("Discard mode change from worktree [y,n,q,a,d%s,?]? "),
1570                deletion => N__("Discard deletion from worktree [y,n,q,a,d%s,?]? "),
1571                hunk => N__("Discard this hunk from worktree [y,n,q,a,d%s,?]? "),
1572        },
1573        checkout_head => {
1574                mode => N__("Discard mode change from index and worktree [y,n,q,a,d%s,?]? "),
1575                deletion => N__("Discard deletion from index and worktree [y,n,q,a,d%s,?]? "),
1576                hunk => N__("Discard this hunk from index and worktree [y,n,q,a,d%s,?]? "),
1577        },
1578        checkout_nothead => {
1579                mode => N__("Apply mode change to index and worktree [y,n,q,a,d%s,?]? "),
1580                deletion => N__("Apply deletion to index and worktree [y,n,q,a,d%s,?]? "),
1581                hunk => N__("Apply this hunk to index and worktree [y,n,q,a,d%s,?]? "),
1582        },
1583);
1584
1585sub patch_update_file {
1586        my $quit = 0;
1587        my ($ix, $num);
1588        my $path = shift;
1589        my ($head, @hunk) = parse_diff($path);
1590        ($head, my $mode, my $deletion) = parse_diff_header($head);
1591        for (@{$head->{DISPLAY}}) {
1592                print;
1593        }
1594
1595        if (@{$mode->{TEXT}}) {
1596                unshift @hunk, $mode;
1597        }
1598        if (@{$deletion->{TEXT}}) {
1599                foreach my $hunk (@hunk) {
1600                        push @{$deletion->{TEXT}}, @{$hunk->{TEXT}};
1601                        push @{$deletion->{DISPLAY}}, @{$hunk->{DISPLAY}};
1602                }
1603                @hunk = ($deletion);
1604        }
1605
1606        $num = scalar @hunk;
1607        $ix = 0;
1608
1609        while (1) {
1610                my ($prev, $next, $other, $undecided, $i);
1611                $other = '';
1612
1613                if ($num <= $ix) {
1614                        $ix = 0;
1615                }
1616                for ($i = 0; $i < $ix; $i++) {
1617                        if (!defined $hunk[$i]{USE}) {
1618                                $prev = 1;
1619                                $other .= ',k';
1620                                last;
1621                        }
1622                }
1623                if ($ix) {
1624                        $other .= ',K';
1625                }
1626                for ($i = $ix + 1; $i < $num; $i++) {
1627                        if (!defined $hunk[$i]{USE}) {
1628                                $next = 1;
1629                                $other .= ',j';
1630                                last;
1631                        }
1632                }
1633                if ($ix < $num - 1) {
1634                        $other .= ',J';
1635                }
1636                if ($num > 1) {
1637                        $other .= ',g,/';
1638                }
1639                for ($i = 0; $i < $num; $i++) {
1640                        if (!defined $hunk[$i]{USE}) {
1641                                $undecided = 1;
1642                                last;
1643                        }
1644                }
1645                last if (!$undecided);
1646
1647                if ($hunk[$ix]{TYPE} eq 'hunk' &&
1648                    hunk_splittable($hunk[$ix]{TEXT})) {
1649                        $other .= ',s';
1650                }
1651                if ($hunk[$ix]{TYPE} eq 'hunk') {
1652                        $other .= ',e';
1653                }
1654                if (label_hunk_lines($hunk[$ix])) {
1655                        $other .= ',l';
1656                }
1657                for (@{$hunk[$ix]{DISPLAY}}) {
1658                        print;
1659                }
1660                print colored $prompt_color,
1661                        sprintf(__($patch_update_prompt_modes{$patch_mode}{$hunk[$ix]{TYPE}}), $other);
1662
1663                my $line = prompt_single_character;
1664                last unless defined $line;
1665                if ($line) {
1666                        if ($line =~ /^y/i) {
1667                                $hunk[$ix]{USE} = 1;
1668                        }
1669                        elsif ($line =~ /^n/i) {
1670                                $hunk[$ix]{USE} = 0;
1671                        }
1672                        elsif ($line =~ /^a/i) {
1673                                while ($ix < $num) {
1674                                        if (!defined $hunk[$ix]{USE}) {
1675                                                $hunk[$ix]{USE} = 1;
1676                                        }
1677                                        $ix++;
1678                                }
1679                                next;
1680                        }
1681                        elsif ($line =~ /^g(.*)/) {
1682                                my $response = $1;
1683                                unless ($other =~ /g/) {
1684                                        error_msg __("No other hunks to goto\n");
1685                                        next;
1686                                }
1687                                my $no = $ix > 10 ? $ix - 10 : 0;
1688                                while ($response eq '') {
1689                                        $no = display_hunks(\@hunk, $no);
1690                                        if ($no < $num) {
1691                                                print __("go to which hunk (<ret> to see more)? ");
1692                                        } else {
1693                                                print __("go to which hunk? ");
1694                                        }
1695                                        $response = <STDIN>;
1696                                        if (!defined $response) {
1697                                                $response = '';
1698                                        }
1699                                        chomp $response;
1700                                }
1701                                if ($response !~ /^\s*\d+\s*$/) {
1702                                        error_msg sprintf(__("Invalid number: '%s'\n"),
1703                                                             $response);
1704                                } elsif (0 < $response && $response <= $num) {
1705                                        $ix = $response - 1;
1706                                } else {
1707                                        error_msg sprintf(__n("Sorry, only %d hunk available.\n",
1708                                                              "Sorry, only %d hunks available.\n", $num), $num);
1709                                }
1710                                next;
1711                        }
1712                        elsif ($line =~ /^d/i) {
1713                                while ($ix < $num) {
1714                                        if (!defined $hunk[$ix]{USE}) {
1715                                                $hunk[$ix]{USE} = 0;
1716                                        }
1717                                        $ix++;
1718                                }
1719                                next;
1720                        }
1721                        elsif ($line =~ /^q/i) {
1722                                for ($i = 0; $i < $num; $i++) {
1723                                        if (!defined $hunk[$i]{USE}) {
1724                                                $hunk[$i]{USE} = 0;
1725                                        }
1726                                }
1727                                $quit = 1;
1728                                last;
1729                        }
1730                        elsif ($line =~ m|^/(.*)|) {
1731                                my $regex = $1;
1732                                unless ($other =~ m|/|) {
1733                                        error_msg __("No other hunks to search\n");
1734                                        next;
1735                                }
1736                                if ($1 eq "") {
1737                                        print colored $prompt_color, __("search for regex? ");
1738                                        $regex = <STDIN>;
1739                                        if (defined $regex) {
1740                                                chomp $regex;
1741                                        }
1742                                }
1743                                my $search_string;
1744                                eval {
1745                                        $search_string = qr{$regex}m;
1746                                };
1747                                if ($@) {
1748                                        my ($err,$exp) = ($@, $1);
1749                                        $err =~ s/ at .*git-add--interactive line \d+, <STDIN> line \d+.*$//;
1750                                        error_msg sprintf(__("Malformed search regexp %s: %s\n"), $exp, $err);
1751                                        next;
1752                                }
1753                                my $iy = $ix;
1754                                while (1) {
1755                                        my $text = join ("", @{$hunk[$iy]{TEXT}});
1756                                        last if ($text =~ $search_string);
1757                                        $iy++;
1758                                        $iy = 0 if ($iy >= $num);
1759                                        if ($ix == $iy) {
1760                                                error_msg __("No hunk matches the given pattern\n");
1761                                                last;
1762                                        }
1763                                }
1764                                $ix = $iy;
1765                                next;
1766                        }
1767                        elsif ($line =~ /^K/) {
1768                                if ($other =~ /K/) {
1769                                        $ix--;
1770                                }
1771                                else {
1772                                        error_msg __("No previous hunk\n");
1773                                }
1774                                next;
1775                        }
1776                        elsif ($line =~ /^J/) {
1777                                if ($other =~ /J/) {
1778                                        $ix++;
1779                                }
1780                                else {
1781                                        error_msg __("No next hunk\n");
1782                                }
1783                                next;
1784                        }
1785                        elsif ($line =~ /^k/) {
1786                                if ($other =~ /k/) {
1787                                        while (1) {
1788                                                $ix--;
1789                                                last if (!$ix ||
1790                                                         !defined $hunk[$ix]{USE});
1791                                        }
1792                                }
1793                                else {
1794                                        error_msg __("No previous hunk\n");
1795                                }
1796                                next;
1797                        }
1798                        elsif ($line =~ /^j/) {
1799                                if ($other !~ /j/) {
1800                                        error_msg __("No next hunk\n");
1801                                        next;
1802                                }
1803                        }
1804                        elsif ($line =~ /^l/) {
1805                                unless ($other =~ /l/) {
1806                                        error_msg __("Cannot select line by line\n");
1807                                        next;
1808                                }
1809                                my $newhunk = select_lines_loop($hunk[$ix]);
1810                                if ($newhunk) {
1811                                        splice @hunk, $ix, 1, $newhunk;
1812                                } else {
1813                                        next;
1814                                }
1815                        }
1816                        elsif ($line =~ /^s/) {
1817                                unless ($other =~ /s/) {
1818                                        error_msg __("Sorry, cannot split this hunk\n");
1819                                        next;
1820                                }
1821                                my @split = split_hunk($hunk[$ix]{TEXT}, $hunk[$ix]{DISPLAY});
1822                                if (1 < @split) {
1823                                        print colored $header_color, sprintf(
1824                                                __n("Split into %d hunk.\n",
1825                                                    "Split into %d hunks.\n",
1826                                                    scalar(@split)), scalar(@split));
1827                                }
1828                                splice (@hunk, $ix, 1, @split);
1829                                $num = scalar @hunk;
1830                                next;
1831                        }
1832                        elsif ($line =~ /^e/) {
1833                                unless ($other =~ /e/) {
1834                                        error_msg __("Sorry, cannot edit this hunk\n");
1835                                        next;
1836                                }
1837                                my $newhunk = edit_hunk_loop($head, \@hunk, $ix);
1838                                if (defined $newhunk) {
1839                                        splice @hunk, $ix, 1, $newhunk;
1840                                }
1841                        }
1842                        else {
1843                                help_patch_cmd($other);
1844                                next;
1845                        }
1846                        # soft increment
1847                        while (1) {
1848                                $ix++;
1849                                last if ($ix >= $num ||
1850                                         !defined $hunk[$ix]{USE});
1851                        }
1852                }
1853        }
1854
1855        @hunk = coalesce_overlapping_hunks(@hunk);
1856
1857        my $n_lofs = 0;
1858        my @result = ();
1859        for (@hunk) {
1860                if ($_->{USE}) {
1861                        push @result, @{$_->{TEXT}};
1862                }
1863        }
1864
1865        if (@result) {
1866                my @patch = reassemble_patch($head->{TEXT}, @result);
1867                my $apply_routine = $patch_mode_flavour{APPLY};
1868                &$apply_routine(@patch);
1869                refresh();
1870        }
1871
1872        print "\n";
1873        return $quit;
1874}
1875
1876sub diff_cmd {
1877        my @mods = list_modified('index-only');
1878        @mods = grep { !($_->{BINARY}) } @mods;
1879        return if (!@mods);
1880        my (@them) = list_and_choose({ PROMPT => __('Review diff'),
1881                                     IMMEDIATE => 1,
1882                                     HEADER => $status_head, },
1883                                   @mods);
1884        return if (!@them);
1885        my $reference = (is_initial_commit()) ? get_empty_tree() : 'HEAD';
1886        system(qw(git diff -p --cached), $reference, '--',
1887                map { $_->{VALUE} } @them);
1888}
1889
1890sub quit_cmd {
1891        print __("Bye.\n");
1892        exit(0);
1893}
1894
1895sub help_cmd {
1896# TRANSLATORS: please do not translate the command names
1897# 'status', 'update', 'revert', etc.
1898        print colored $help_color, __ <<'EOF' ;
1899status        - show paths with changes
1900update        - add working tree state to the staged set of changes
1901revert        - revert staged set of changes back to the HEAD version
1902patch         - pick hunks and update selectively
1903diff          - view diff between HEAD and index
1904add untracked - add contents of untracked files to the staged set of changes
1905EOF
1906}
1907
1908sub process_args {
1909        return unless @ARGV;
1910        my $arg = shift @ARGV;
1911        if ($arg =~ /--patch(?:=(.*))?/) {
1912                if (defined $1) {
1913                        if ($1 eq 'reset') {
1914                                $patch_mode = 'reset_head';
1915                                $patch_mode_revision = 'HEAD';
1916                                $arg = shift @ARGV or die __("missing --");
1917                                if ($arg ne '--') {
1918                                        $patch_mode_revision = $arg;
1919                                        $patch_mode = ($arg eq 'HEAD' ?
1920                                                       'reset_head' : 'reset_nothead');
1921                                        $arg = shift @ARGV or die __("missing --");
1922                                }
1923                        } elsif ($1 eq 'checkout') {
1924                                $arg = shift @ARGV or die __("missing --");
1925                                if ($arg eq '--') {
1926                                        $patch_mode = 'checkout_index';
1927                                } else {
1928                                        $patch_mode_revision = $arg;
1929                                        $patch_mode = ($arg eq 'HEAD' ?
1930                                                       'checkout_head' : 'checkout_nothead');
1931                                        $arg = shift @ARGV or die __("missing --");
1932                                }
1933                        } elsif ($1 eq 'stage' or $1 eq 'stash') {
1934                                $patch_mode = $1;
1935                                $arg = shift @ARGV or die __("missing --");
1936                        } else {
1937                                die sprintf(__("unknown --patch mode: %s"), $1);
1938                        }
1939                } else {
1940                        $patch_mode = 'stage';
1941                        $arg = shift @ARGV or die __("missing --");
1942                }
1943                die sprintf(__("invalid argument %s, expecting --"),
1944                               $arg) unless $arg eq "--";
1945                %patch_mode_flavour = %{$patch_modes{$patch_mode}};
1946                $patch_mode_only = 1;
1947        }
1948        elsif ($arg ne "--") {
1949                die sprintf(__("invalid argument %s, expecting --"), $arg);
1950        }
1951}
1952
1953sub main_loop {
1954        my @cmd = ([ 'status', \&status_cmd, ],
1955                   [ 'update', \&update_cmd, ],
1956                   [ 'revert', \&revert_cmd, ],
1957                   [ 'add untracked', \&add_untracked_cmd, ],
1958                   [ 'patch', \&patch_update_cmd, ],
1959                   [ 'diff', \&diff_cmd, ],
1960                   [ 'quit', \&quit_cmd, ],
1961                   [ 'help', \&help_cmd, ],
1962        );
1963        while (1) {
1964                my ($it) = list_and_choose({ PROMPT => __('What now'),
1965                                             SINGLETON => 1,
1966                                             LIST_FLAT => 4,
1967                                             HEADER => __('*** Commands ***'),
1968                                             ON_EOF => \&quit_cmd,
1969                                             IMMEDIATE => 1 }, @cmd);
1970                if ($it) {
1971                        eval {
1972                                $it->[1]->();
1973                        };
1974                        if ($@) {
1975                                print "$@";
1976                        }
1977                }
1978        }
1979}
1980
1981process_args();
1982refresh();
1983if ($patch_mode_only) {
1984        patch_update_cmd();
1985}
1986else {
1987        status_cmd();
1988        main_loop();
1989}