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