git-add--interactive.perlon commit add-interactive: fix bogus diff header line ordering (e1327ed)
   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        my $editor = $ENV{GIT_EDITOR} || $repo->config("core.editor")
1016                || $ENV{VISUAL} || $ENV{EDITOR} || "vi";
1017        system('sh', '-c', $editor.' "$@"', $editor, $hunkfile);
1018
1019        if ($? != 0) {
1020                return undef;
1021        }
1022
1023        open $fh, '<', $hunkfile
1024                or die "failed to open hunk edit file for reading: " . $!;
1025        my @newtext = grep { !/^#/ } <$fh>;
1026        close $fh;
1027        unlink $hunkfile;
1028
1029        # Abort if nothing remains
1030        if (!grep { /\S/ } @newtext) {
1031                return undef;
1032        }
1033
1034        # Reinsert the first hunk header if the user accidentally deleted it
1035        if ($newtext[0] !~ /^@/) {
1036                unshift @newtext, $oldtext->[0];
1037        }
1038        return \@newtext;
1039}
1040
1041sub diff_applies {
1042        my $fh;
1043        return run_git_apply($patch_mode_flavour{APPLY_CHECK} . ' --recount --check',
1044                             map { @{$_->{TEXT}} } @_);
1045}
1046
1047sub _restore_terminal_and_die {
1048        ReadMode 'restore';
1049        print "\n";
1050        exit 1;
1051}
1052
1053sub prompt_single_character {
1054        if ($use_readkey) {
1055                local $SIG{TERM} = \&_restore_terminal_and_die;
1056                local $SIG{INT} = \&_restore_terminal_and_die;
1057                ReadMode 'cbreak';
1058                my $key = ReadKey 0;
1059                ReadMode 'restore';
1060                print "$key" if defined $key;
1061                print "\n";
1062                return $key;
1063        } else {
1064                return <STDIN>;
1065        }
1066}
1067
1068sub prompt_yesno {
1069        my ($prompt) = @_;
1070        while (1) {
1071                print colored $prompt_color, $prompt;
1072                my $line = prompt_single_character;
1073                return 0 if $line =~ /^n/i;
1074                return 1 if $line =~ /^y/i;
1075        }
1076}
1077
1078sub edit_hunk_loop {
1079        my ($head, $hunk, $ix) = @_;
1080        my $text = $hunk->[$ix]->{TEXT};
1081
1082        while (1) {
1083                $text = edit_hunk_manually($text);
1084                if (!defined $text) {
1085                        return undef;
1086                }
1087                my $newhunk = {
1088                        TEXT => $text,
1089                        TYPE => $hunk->[$ix]->{TYPE},
1090                        USE => 1,
1091                        DIRTY => 1,
1092                };
1093                if (diff_applies($head,
1094                                 @{$hunk}[0..$ix-1],
1095                                 $newhunk,
1096                                 @{$hunk}[$ix+1..$#{$hunk}])) {
1097                        $newhunk->{DISPLAY} = [color_diff(@{$text})];
1098                        return $newhunk;
1099                }
1100                else {
1101                        prompt_yesno(
1102                                'Your edited hunk does not apply. Edit again '
1103                                . '(saying "no" discards!) [y/n]? '
1104                                ) or return undef;
1105                }
1106        }
1107}
1108
1109sub help_patch_cmd {
1110        my $verb = lc $patch_mode_flavour{VERB};
1111        my $target = $patch_mode_flavour{TARGET};
1112        print colored $help_color, <<EOF ;
1113y - $verb this hunk$target
1114n - do not $verb this hunk$target
1115q - quit, do not $verb this hunk nor any of the remaining ones
1116a - $verb this and all the remaining hunks in the file
1117d - do not $verb this hunk nor any of the remaining hunks in the file
1118g - select a hunk to go to
1119/ - search for a hunk matching the given regex
1120j - leave this hunk undecided, see next undecided hunk
1121J - leave this hunk undecided, see next hunk
1122k - leave this hunk undecided, see previous undecided hunk
1123K - leave this hunk undecided, see previous hunk
1124s - split the current hunk into smaller hunks
1125e - manually edit the current hunk
1126? - print help
1127EOF
1128}
1129
1130sub apply_patch {
1131        my $cmd = shift;
1132        my $ret = run_git_apply $cmd . ' --recount', @_;
1133        if (!$ret) {
1134                print STDERR @_;
1135        }
1136        return $ret;
1137}
1138
1139sub apply_patch_for_checkout_commit {
1140        my $reverse = shift;
1141        my $applies_index = run_git_apply 'apply '.$reverse.' --cached --recount --check', @_;
1142        my $applies_worktree = run_git_apply 'apply '.$reverse.' --recount --check', @_;
1143
1144        if ($applies_worktree && $applies_index) {
1145                run_git_apply 'apply '.$reverse.' --cached --recount', @_;
1146                run_git_apply 'apply '.$reverse.' --recount', @_;
1147                return 1;
1148        } elsif (!$applies_index) {
1149                print colored $error_color, "The selected hunks do not apply to the index!\n";
1150                if (prompt_yesno "Apply them to the worktree anyway? ") {
1151                        return run_git_apply 'apply '.$reverse.' --recount', @_;
1152                } else {
1153                        print colored $error_color, "Nothing was applied.\n";
1154                        return 0;
1155                }
1156        } else {
1157                print STDERR @_;
1158                return 0;
1159        }
1160}
1161
1162sub patch_update_cmd {
1163        my @all_mods = list_modified($patch_mode_flavour{FILTER});
1164        my @mods = grep { !($_->{BINARY}) } @all_mods;
1165        my @them;
1166
1167        if (!@mods) {
1168                if (@all_mods) {
1169                        print STDERR "Only binary files changed.\n";
1170                } else {
1171                        print STDERR "No changes.\n";
1172                }
1173                return 0;
1174        }
1175        if ($patch_mode) {
1176                @them = @mods;
1177        }
1178        else {
1179                @them = list_and_choose({ PROMPT => 'Patch update',
1180                                          HEADER => $status_head, },
1181                                        @mods);
1182        }
1183        for (@them) {
1184                return 0 if patch_update_file($_->{VALUE});
1185        }
1186}
1187
1188# Generate a one line summary of a hunk.
1189sub summarize_hunk {
1190        my $rhunk = shift;
1191        my $summary = $rhunk->{TEXT}[0];
1192
1193        # Keep the line numbers, discard extra context.
1194        $summary =~ s/@@(.*?)@@.*/$1 /s;
1195        $summary .= " " x (20 - length $summary);
1196
1197        # Add some user context.
1198        for my $line (@{$rhunk->{TEXT}}) {
1199                if ($line =~ m/^[+-].*\w/) {
1200                        $summary .= $line;
1201                        last;
1202                }
1203        }
1204
1205        chomp $summary;
1206        return substr($summary, 0, 80) . "\n";
1207}
1208
1209
1210# Print a one-line summary of each hunk in the array ref in
1211# the first argument, starting wih the index in the 2nd.
1212sub display_hunks {
1213        my ($hunks, $i) = @_;
1214        my $ctr = 0;
1215        $i ||= 0;
1216        for (; $i < @$hunks && $ctr < 20; $i++, $ctr++) {
1217                my $status = " ";
1218                if (defined $hunks->[$i]{USE}) {
1219                        $status = $hunks->[$i]{USE} ? "+" : "-";
1220                }
1221                printf "%s%2d: %s",
1222                        $status,
1223                        $i + 1,
1224                        summarize_hunk($hunks->[$i]);
1225        }
1226        return $i;
1227}
1228
1229sub patch_update_file {
1230        my $quit = 0;
1231        my ($ix, $num);
1232        my $path = shift;
1233        my ($head, @hunk) = parse_diff($path);
1234        ($head, my $mode, my $deletion) = parse_diff_header($head);
1235        for (@{$head->{DISPLAY}}) {
1236                print;
1237        }
1238
1239        if (@{$mode->{TEXT}}) {
1240                unshift @hunk, $mode;
1241        }
1242        if (@{$deletion->{TEXT}}) {
1243                foreach my $hunk (@hunk) {
1244                        push @{$deletion->{TEXT}}, @{$hunk->{TEXT}};
1245                        push @{$deletion->{DISPLAY}}, @{$hunk->{DISPLAY}};
1246                }
1247                @hunk = ($deletion);
1248        }
1249
1250        $num = scalar @hunk;
1251        $ix = 0;
1252
1253        while (1) {
1254                my ($prev, $next, $other, $undecided, $i);
1255                $other = '';
1256
1257                if ($num <= $ix) {
1258                        $ix = 0;
1259                }
1260                for ($i = 0; $i < $ix; $i++) {
1261                        if (!defined $hunk[$i]{USE}) {
1262                                $prev = 1;
1263                                $other .= ',k';
1264                                last;
1265                        }
1266                }
1267                if ($ix) {
1268                        $other .= ',K';
1269                }
1270                for ($i = $ix + 1; $i < $num; $i++) {
1271                        if (!defined $hunk[$i]{USE}) {
1272                                $next = 1;
1273                                $other .= ',j';
1274                                last;
1275                        }
1276                }
1277                if ($ix < $num - 1) {
1278                        $other .= ',J';
1279                }
1280                if ($num > 1) {
1281                        $other .= ',g';
1282                }
1283                for ($i = 0; $i < $num; $i++) {
1284                        if (!defined $hunk[$i]{USE}) {
1285                                $undecided = 1;
1286                                last;
1287                        }
1288                }
1289                last if (!$undecided);
1290
1291                if ($hunk[$ix]{TYPE} eq 'hunk' &&
1292                    hunk_splittable($hunk[$ix]{TEXT})) {
1293                        $other .= ',s';
1294                }
1295                if ($hunk[$ix]{TYPE} eq 'hunk') {
1296                        $other .= ',e';
1297                }
1298                for (@{$hunk[$ix]{DISPLAY}}) {
1299                        print;
1300                }
1301                print colored $prompt_color, $patch_mode_flavour{VERB},
1302                  ($hunk[$ix]{TYPE} eq 'mode' ? ' mode change' :
1303                   $hunk[$ix]{TYPE} eq 'deletion' ? ' deletion' :
1304                   ' this hunk'),
1305                  $patch_mode_flavour{TARGET},
1306                  " [y,n,q,a,d,/$other,?]? ";
1307                my $line = prompt_single_character;
1308                if ($line) {
1309                        if ($line =~ /^y/i) {
1310                                $hunk[$ix]{USE} = 1;
1311                        }
1312                        elsif ($line =~ /^n/i) {
1313                                $hunk[$ix]{USE} = 0;
1314                        }
1315                        elsif ($line =~ /^a/i) {
1316                                while ($ix < $num) {
1317                                        if (!defined $hunk[$ix]{USE}) {
1318                                                $hunk[$ix]{USE} = 1;
1319                                        }
1320                                        $ix++;
1321                                }
1322                                next;
1323                        }
1324                        elsif ($other =~ /g/ && $line =~ /^g(.*)/) {
1325                                my $response = $1;
1326                                my $no = $ix > 10 ? $ix - 10 : 0;
1327                                while ($response eq '') {
1328                                        my $extra = "";
1329                                        $no = display_hunks(\@hunk, $no);
1330                                        if ($no < $num) {
1331                                                $extra = " (<ret> to see more)";
1332                                        }
1333                                        print "go to which hunk$extra? ";
1334                                        $response = <STDIN>;
1335                                        if (!defined $response) {
1336                                                $response = '';
1337                                        }
1338                                        chomp $response;
1339                                }
1340                                if ($response !~ /^\s*\d+\s*$/) {
1341                                        error_msg "Invalid number: '$response'\n";
1342                                } elsif (0 < $response && $response <= $num) {
1343                                        $ix = $response - 1;
1344                                } else {
1345                                        error_msg "Sorry, only $num hunks available.\n";
1346                                }
1347                                next;
1348                        }
1349                        elsif ($line =~ /^d/i) {
1350                                while ($ix < $num) {
1351                                        if (!defined $hunk[$ix]{USE}) {
1352                                                $hunk[$ix]{USE} = 0;
1353                                        }
1354                                        $ix++;
1355                                }
1356                                next;
1357                        }
1358                        elsif ($line =~ /^q/i) {
1359                                while ($ix < $num) {
1360                                        if (!defined $hunk[$ix]{USE}) {
1361                                                $hunk[$ix]{USE} = 0;
1362                                        }
1363                                        $ix++;
1364                                }
1365                                $quit = 1;
1366                                next;
1367                        }
1368                        elsif ($line =~ m|^/(.*)|) {
1369                                my $regex = $1;
1370                                if ($1 eq "") {
1371                                        print colored $prompt_color, "search for regex? ";
1372                                        $regex = <STDIN>;
1373                                        if (defined $regex) {
1374                                                chomp $regex;
1375                                        }
1376                                }
1377                                my $search_string;
1378                                eval {
1379                                        $search_string = qr{$regex}m;
1380                                };
1381                                if ($@) {
1382                                        my ($err,$exp) = ($@, $1);
1383                                        $err =~ s/ at .*git-add--interactive line \d+, <STDIN> line \d+.*$//;
1384                                        error_msg "Malformed search regexp $exp: $err\n";
1385                                        next;
1386                                }
1387                                my $iy = $ix;
1388                                while (1) {
1389                                        my $text = join ("", @{$hunk[$iy]{TEXT}});
1390                                        last if ($text =~ $search_string);
1391                                        $iy++;
1392                                        $iy = 0 if ($iy >= $num);
1393                                        if ($ix == $iy) {
1394                                                error_msg "No hunk matches the given pattern\n";
1395                                                last;
1396                                        }
1397                                }
1398                                $ix = $iy;
1399                                next;
1400                        }
1401                        elsif ($line =~ /^K/) {
1402                                if ($other =~ /K/) {
1403                                        $ix--;
1404                                }
1405                                else {
1406                                        error_msg "No previous hunk\n";
1407                                }
1408                                next;
1409                        }
1410                        elsif ($line =~ /^J/) {
1411                                if ($other =~ /J/) {
1412                                        $ix++;
1413                                }
1414                                else {
1415                                        error_msg "No next hunk\n";
1416                                }
1417                                next;
1418                        }
1419                        elsif ($line =~ /^k/) {
1420                                if ($other =~ /k/) {
1421                                        while (1) {
1422                                                $ix--;
1423                                                last if (!$ix ||
1424                                                         !defined $hunk[$ix]{USE});
1425                                        }
1426                                }
1427                                else {
1428                                        error_msg "No previous hunk\n";
1429                                }
1430                                next;
1431                        }
1432                        elsif ($line =~ /^j/) {
1433                                if ($other !~ /j/) {
1434                                        error_msg "No next hunk\n";
1435                                        next;
1436                                }
1437                        }
1438                        elsif ($other =~ /s/ && $line =~ /^s/) {
1439                                my @split = split_hunk($hunk[$ix]{TEXT}, $hunk[$ix]{DISPLAY});
1440                                if (1 < @split) {
1441                                        print colored $header_color, "Split into ",
1442                                        scalar(@split), " hunks.\n";
1443                                }
1444                                splice (@hunk, $ix, 1, @split);
1445                                $num = scalar @hunk;
1446                                next;
1447                        }
1448                        elsif ($other =~ /e/ && $line =~ /^e/) {
1449                                my $newhunk = edit_hunk_loop($head, \@hunk, $ix);
1450                                if (defined $newhunk) {
1451                                        splice @hunk, $ix, 1, $newhunk;
1452                                }
1453                        }
1454                        else {
1455                                help_patch_cmd($other);
1456                                next;
1457                        }
1458                        # soft increment
1459                        while (1) {
1460                                $ix++;
1461                                last if ($ix >= $num ||
1462                                         !defined $hunk[$ix]{USE});
1463                        }
1464                }
1465        }
1466
1467        @hunk = coalesce_overlapping_hunks(@hunk);
1468
1469        my $n_lofs = 0;
1470        my @result = ();
1471        for (@hunk) {
1472                if ($_->{USE}) {
1473                        push @result, @{$_->{TEXT}};
1474                }
1475        }
1476
1477        if (@result) {
1478                my $fh;
1479                my @patch = reassemble_patch($head->{TEXT}, @result);
1480                my $apply_routine = $patch_mode_flavour{APPLY};
1481                &$apply_routine(@patch);
1482                refresh();
1483        }
1484
1485        print "\n";
1486        return $quit;
1487}
1488
1489sub diff_cmd {
1490        my @mods = list_modified('index-only');
1491        @mods = grep { !($_->{BINARY}) } @mods;
1492        return if (!@mods);
1493        my (@them) = list_and_choose({ PROMPT => 'Review diff',
1494                                     IMMEDIATE => 1,
1495                                     HEADER => $status_head, },
1496                                   @mods);
1497        return if (!@them);
1498        my $reference = is_initial_commit() ? get_empty_tree() : 'HEAD';
1499        system(qw(git diff -p --cached), $reference, '--',
1500                map { $_->{VALUE} } @them);
1501}
1502
1503sub quit_cmd {
1504        print "Bye.\n";
1505        exit(0);
1506}
1507
1508sub help_cmd {
1509        print colored $help_color, <<\EOF ;
1510status        - show paths with changes
1511update        - add working tree state to the staged set of changes
1512revert        - revert staged set of changes back to the HEAD version
1513patch         - pick hunks and update selectively
1514diff          - view diff between HEAD and index
1515add untracked - add contents of untracked files to the staged set of changes
1516EOF
1517}
1518
1519sub process_args {
1520        return unless @ARGV;
1521        my $arg = shift @ARGV;
1522        if ($arg =~ /--patch(?:=(.*))?/) {
1523                if (defined $1) {
1524                        if ($1 eq 'reset') {
1525                                $patch_mode = 'reset_head';
1526                                $patch_mode_revision = 'HEAD';
1527                                $arg = shift @ARGV or die "missing --";
1528                                if ($arg ne '--') {
1529                                        $patch_mode_revision = $arg;
1530                                        $patch_mode = ($arg eq 'HEAD' ?
1531                                                       'reset_head' : 'reset_nothead');
1532                                        $arg = shift @ARGV or die "missing --";
1533                                }
1534                        } elsif ($1 eq 'checkout') {
1535                                $arg = shift @ARGV or die "missing --";
1536                                if ($arg eq '--') {
1537                                        $patch_mode = 'checkout_index';
1538                                } else {
1539                                        $patch_mode_revision = $arg;
1540                                        $patch_mode = ($arg eq 'HEAD' ?
1541                                                       'checkout_head' : 'checkout_nothead');
1542                                        $arg = shift @ARGV or die "missing --";
1543                                }
1544                        } elsif ($1 eq 'stage' or $1 eq 'stash') {
1545                                $patch_mode = $1;
1546                                $arg = shift @ARGV or die "missing --";
1547                        } else {
1548                                die "unknown --patch mode: $1";
1549                        }
1550                } else {
1551                        $patch_mode = 'stage';
1552                        $arg = shift @ARGV or die "missing --";
1553                }
1554                die "invalid argument $arg, expecting --"
1555                    unless $arg eq "--";
1556                %patch_mode_flavour = %{$patch_modes{$patch_mode}};
1557        }
1558        elsif ($arg ne "--") {
1559                die "invalid argument $arg, expecting --";
1560        }
1561}
1562
1563sub main_loop {
1564        my @cmd = ([ 'status', \&status_cmd, ],
1565                   [ 'update', \&update_cmd, ],
1566                   [ 'revert', \&revert_cmd, ],
1567                   [ 'add untracked', \&add_untracked_cmd, ],
1568                   [ 'patch', \&patch_update_cmd, ],
1569                   [ 'diff', \&diff_cmd, ],
1570                   [ 'quit', \&quit_cmd, ],
1571                   [ 'help', \&help_cmd, ],
1572        );
1573        while (1) {
1574                my ($it) = list_and_choose({ PROMPT => 'What now',
1575                                             SINGLETON => 1,
1576                                             LIST_FLAT => 4,
1577                                             HEADER => '*** Commands ***',
1578                                             ON_EOF => \&quit_cmd,
1579                                             IMMEDIATE => 1 }, @cmd);
1580                if ($it) {
1581                        eval {
1582                                $it->[1]->();
1583                        };
1584                        if ($@) {
1585                                print "$@";
1586                        }
1587                }
1588        }
1589}
1590
1591process_args();
1592refresh();
1593if ($patch_mode) {
1594        patch_update_cmd();
1595}
1596else {
1597        status_cmd();
1598        main_loop();
1599}