Andrew's git / gitweb.git / git-add--interactive.perl
?
git-add--interactive.perlon commit Fix random sha1 in error message in http-fetch and http-push (a096bb1)
   1#!/usr/bin/perl -w
   2
   3use strict;
   4use Git;
   5
   6# Prompt colors:
   7my ($prompt_color, $header_color, $help_color, $normal_color);
   8# Diff colors:
   9my ($new_color, $old_color, $fraginfo_color, $metainfo_color, $whitespace_color);
  10
  11my ($use_color, $diff_use_color);
  12my $repo = Git->repository();
  13
  14$use_color = $repo->get_colorbool('color.interactive');
  15
  16if ($use_color) {
  17        # Set interactive colors:
  18
  19        # Grab the 3 main colors in git color string format, with sane
  20        # (visible) defaults:
  21        $prompt_color = $repo->get_color("color.interactive.prompt", "bold blue");
  22        $header_color = $repo->get_color("color.interactive.header", "bold");
  23        $help_color = $repo->get_color("color.interactive.help", "red bold");
  24        $normal_color = $repo->get_color("", "reset");
  25
  26        # Do we also set diff colors?
  27        $diff_use_color = $repo->get_colorbool('color.diff');
  28        if ($diff_use_color) {
  29                $new_color = $repo->get_color("color.diff.new", "green");
  30                $old_color = $repo->get_color("color.diff.old", "red");
  31                $fraginfo_color = $repo->get_color("color.diff.frag", "cyan");
  32                $metainfo_color = $repo->get_color("color.diff.meta", "bold");
  33                $whitespace_color = $repo->get_color("color.diff.whitespace", "normal red");
  34        }
  35}
  36
  37sub colored {
  38        my $color = shift;
  39        my $string = join("", @_);
  40
  41        if ($use_color) {
  42                # Put a color code at the beginning of each line, a reset at the end
  43                # color after newlines that are not at the end of the string
  44                $string =~ s/(\n+)(.)/$1$color$2/g;
  45                # reset before newlines
  46                $string =~ s/(\n+)/$normal_color$1/g;
  47                # codes at beginning and end (if necessary):
  48                $string =~ s/^/$color/;
  49                $string =~ s/$/$normal_color/ unless $string =~ /\n$/;
  50        }
  51        return $string;
  52}
  53
  54# command line options
  55my $patch_mode;
  56
  57sub run_cmd_pipe {
  58        if ($^O eq 'MSWin32') {
  59                my @invalid = grep {m/[":*]/} @_;
  60                die "$^O does not support: @invalid\n" if @invalid;
  61                my @args = map { m/ /o ? "\"$_\"": $_ } @_;
  62                return qx{@args};
  63        } else {
  64                my $fh = undef;
  65                open($fh, '-|', @_) or die;
  66                return <$fh>;
  67        }
  68}
  69
  70my ($GIT_DIR) = run_cmd_pipe(qw(git rev-parse --git-dir));
  71
  72if (!defined $GIT_DIR) {
  73        exit(1); # rev-parse would have already said "not a git repo"
  74}
  75chomp($GIT_DIR);
  76
  77sub refresh {
  78        my $fh;
  79        open $fh, 'git update-index --refresh |'
  80            or die;
  81        while (<$fh>) {
  82                ;# ignore 'needs update'
  83        }
  84        close $fh;
  85}
  86
  87sub list_untracked {
  88        map {
  89                chomp $_;
  90                $_;
  91        }
  92        run_cmd_pipe(qw(git ls-files --others --exclude-standard --), @ARGV);
  93}
  94
  95my $status_fmt = '%12s %12s %s';
  96my $status_head = sprintf($status_fmt, 'staged', 'unstaged', 'path');
  97
  98# Returns list of hashes, contents of each of which are:
  99# VALUE:        pathname
 100# BINARY:       is a binary path
 101# INDEX:        is index different from HEAD?
 102# FILE:         is file different from index?
 103# INDEX_ADDDEL: is it add/delete between HEAD and index?
 104# FILE_ADDDEL:  is it add/delete between index and file?
 105
 106sub list_modified {
 107        my ($only) = @_;
 108        my (%data, @return);
 109        my ($add, $del, $adddel, $file);
 110        my @tracked = ();
 111
 112        if (@ARGV) {
 113                @tracked = map {
 114                        chomp $_; $_;
 115                } run_cmd_pipe(qw(git ls-files --exclude-standard --), @ARGV);
 116                return if (!@tracked);
 117        }
 118
 119        for (run_cmd_pipe(qw(git diff-index --cached
 120                             --numstat --summary HEAD --), @tracked)) {
 121                if (($add, $del, $file) =
 122                    /^([-\d]+)  ([-\d]+)        (.*)/) {
 123                        my ($change, $bin);
 124                        if ($add eq '-' && $del eq '-') {
 125                                $change = 'binary';
 126                                $bin = 1;
 127                        }
 128                        else {
 129                                $change = "+$add/-$del";
 130                        }
 131                        $data{$file} = {
 132                                INDEX => $change,
 133                                BINARY => $bin,
 134                                FILE => 'nothing',
 135                        }
 136                }
 137                elsif (($adddel, $file) =
 138                       /^ (create|delete) mode [0-7]+ (.*)$/) {
 139                        $data{$file}{INDEX_ADDDEL} = $adddel;
 140                }
 141        }
 142
 143        for (run_cmd_pipe(qw(git diff-files --numstat --summary --), @tracked)) {
 144                if (($add, $del, $file) =
 145                    /^([-\d]+)  ([-\d]+)        (.*)/) {
 146                        if (!exists $data{$file}) {
 147                                $data{$file} = +{
 148                                        INDEX => 'unchanged',
 149                                        BINARY => 0,
 150                                };
 151                        }
 152                        my ($change, $bin);
 153                        if ($add eq '-' && $del eq '-') {
 154                                $change = 'binary';
 155                                $bin = 1;
 156                        }
 157                        else {
 158                                $change = "+$add/-$del";
 159                        }
 160                        $data{$file}{FILE} = $change;
 161                        if ($bin) {
 162                                $data{$file}{BINARY} = 1;
 163                        }
 164                }
 165                elsif (($adddel, $file) =
 166                       /^ (create|delete) mode [0-7]+ (.*)$/) {
 167                        $data{$file}{FILE_ADDDEL} = $adddel;
 168                }
 169        }
 170
 171        for (sort keys %data) {
 172                my $it = $data{$_};
 173
 174                if ($only) {
 175                        if ($only eq 'index-only') {
 176                                next if ($it->{INDEX} eq 'unchanged');
 177                        }
 178                        if ($only eq 'file-only') {
 179                                next if ($it->{FILE} eq 'nothing');
 180                        }
 181                }
 182                push @return, +{
 183                        VALUE => $_,
 184                        %$it,
 185                };
 186        }
 187        return @return;
 188}
 189
 190sub find_unique {
 191        my ($string, @stuff) = @_;
 192        my $found = undef;
 193        for (my $i = 0; $i < @stuff; $i++) {
 194                my $it = $stuff[$i];
 195                my $hit = undef;
 196                if (ref $it) {
 197                        if ((ref $it) eq 'ARRAY') {
 198                                $it = $it->[0];
 199                        }
 200                        else {
 201                                $it = $it->{VALUE};
 202                        }
 203                }
 204                eval {
 205                        if ($it =~ /^$string/) {
 206                                $hit = 1;
 207                        };
 208                };
 209                if (defined $hit && defined $found) {
 210                        return undef;
 211                }
 212                if ($hit) {
 213                        $found = $i + 1;
 214                }
 215        }
 216        return $found;
 217}
 218
 219# inserts string into trie and updates count for each character
 220sub update_trie {
 221        my ($trie, $string) = @_;
 222        foreach (split //, $string) {
 223                $trie = $trie->{$_} ||= {COUNT => 0};
 224                $trie->{COUNT}++;
 225        }
 226}
 227
 228# returns an array of tuples (prefix, remainder)
 229sub find_unique_prefixes {
 230        my @stuff = @_;
 231        my @return = ();
 232
 233        # any single prefix exceeding the soft limit is omitted
 234        # if any prefix exceeds the hard limit all are omitted
 235        # 0 indicates no limit
 236        my $soft_limit = 0;
 237        my $hard_limit = 3;
 238
 239        # build a trie modelling all possible options
 240        my %trie;
 241        foreach my $print (@stuff) {
 242                if ((ref $print) eq 'ARRAY') {
 243                        $print = $print->[0];
 244                }
 245                elsif ((ref $print) eq 'HASH') {
 246                        $print = $print->{VALUE};
 247                }
 248                update_trie(\%trie, $print);
 249                push @return, $print;
 250        }
 251
 252        # use the trie to find the unique prefixes
 253        for (my $i = 0; $i < @return; $i++) {
 254                my $ret = $return[$i];
 255                my @letters = split //, $ret;
 256                my %search = %trie;
 257                my ($prefix, $remainder);
 258                my $j;
 259                for ($j = 0; $j < @letters; $j++) {
 260                        my $letter = $letters[$j];
 261                        if ($search{$letter}{COUNT} == 1) {
 262                                $prefix = substr $ret, 0, $j + 1;
 263                                $remainder = substr $ret, $j + 1;
 264                                last;
 265                        }
 266                        else {
 267                                my $prefix = substr $ret, 0, $j;
 268                                return ()
 269                                    if ($hard_limit && $j + 1 > $hard_limit);
 270                        }
 271                        %search = %{$search{$letter}};
 272                }
 273                if ($soft_limit && $j + 1 > $soft_limit) {
 274                        $prefix = undef;
 275                        $remainder = $ret;
 276                }
 277                $return[$i] = [$prefix, $remainder];
 278        }
 279        return @return;
 280}
 281
 282# filters out prefixes which have special meaning to list_and_choose()
 283sub is_valid_prefix {
 284        my $prefix = shift;
 285        return (defined $prefix) &&
 286            !($prefix =~ /[\s,]/) && # separators
 287            !($prefix =~ /^-/) &&    # deselection
 288            !($prefix =~ /^\d+/) &&  # selection
 289            ($prefix ne '*') &&      # "all" wildcard
 290            ($prefix ne '?');        # prompt help
 291}
 292
 293# given a prefix/remainder tuple return a string with the prefix highlighted
 294# for now use square brackets; later might use ANSI colors (underline, bold)
 295sub highlight_prefix {
 296        my $prefix = shift;
 297        my $remainder = shift;
 298
 299        if (!defined $prefix) {
 300                return $remainder;
 301        }
 302
 303        if (!is_valid_prefix($prefix)) {
 304                return "$prefix$remainder";
 305        }
 306
 307        if (!$use_color) {
 308                return "[$prefix]$remainder";
 309        }
 310
 311        return "$prompt_color$prefix$normal_color$remainder";
 312}
 313
 314sub list_and_choose {
 315        my ($opts, @stuff) = @_;
 316        my (@chosen, @return);
 317        my $i;
 318        my @prefixes = find_unique_prefixes(@stuff) unless $opts->{LIST_ONLY};
 319
 320      TOPLOOP:
 321        while (1) {
 322                my $last_lf = 0;
 323
 324                if ($opts->{HEADER}) {
 325                        if (!$opts->{LIST_FLAT}) {
 326                                print "     ";
 327                        }
 328                        print colored $header_color, "$opts->{HEADER}\n";
 329                }
 330                for ($i = 0; $i < @stuff; $i++) {
 331                        my $chosen = $chosen[$i] ? '*' : ' ';
 332                        my $print = $stuff[$i];
 333                        my $ref = ref $print;
 334                        my $highlighted = highlight_prefix(@{$prefixes[$i]})
 335                            if @prefixes;
 336                        if ($ref eq 'ARRAY') {
 337                                $print = $highlighted || $print->[0];
 338                        }
 339                        elsif ($ref eq 'HASH') {
 340                                my $value = $highlighted || $print->{VALUE};
 341                                $print = sprintf($status_fmt,
 342                                    $print->{INDEX},
 343                                    $print->{FILE},
 344                                    $value);
 345                        }
 346                        else {
 347                                $print = $highlighted || $print;
 348                        }
 349                        printf("%s%2d: %s", $chosen, $i+1, $print);
 350                        if (($opts->{LIST_FLAT}) &&
 351                            (($i + 1) % ($opts->{LIST_FLAT}))) {
 352                                print "\t";
 353                                $last_lf = 0;
 354                        }
 355                        else {
 356                                print "\n";
 357                                $last_lf = 1;
 358                        }
 359                }
 360                if (!$last_lf) {
 361                        print "\n";
 362                }
 363
 364                return if ($opts->{LIST_ONLY});
 365
 366                print colored $prompt_color, $opts->{PROMPT};
 367                if ($opts->{SINGLETON}) {
 368                        print "> ";
 369                }
 370                else {
 371                        print ">> ";
 372                }
 373                my $line = <STDIN>;
 374                if (!$line) {
 375                        print "\n";
 376                        $opts->{ON_EOF}->() if $opts->{ON_EOF};
 377                        last;
 378                }
 379                chomp $line;
 380                last if $line eq '';
 381                if ($line eq '?') {
 382                        $opts->{SINGLETON} ?
 383                            singleton_prompt_help_cmd() :
 384                            prompt_help_cmd();
 385                        next TOPLOOP;
 386                }
 387                for my $choice (split(/[\s,]+/, $line)) {
 388                        my $choose = 1;
 389                        my ($bottom, $top);
 390
 391                        # Input that begins with '-'; unchoose
 392                        if ($choice =~ s/^-//) {
 393                                $choose = 0;
 394                        }
 395                        # A range can be specified like 5-7
 396                        if ($choice =~ /^(\d+)-(\d+)$/) {
 397                                ($bottom, $top) = ($1, $2);
 398                        }
 399                        elsif ($choice =~ /^\d+$/) {
 400                                $bottom = $top = $choice;
 401                        }
 402                        elsif ($choice eq '*') {
 403                                $bottom = 1;
 404                                $top = 1 + @stuff;
 405                        }
 406                        else {
 407                                $bottom = $top = find_unique($choice, @stuff);
 408                                if (!defined $bottom) {
 409                                        print "Huh ($choice)?\n";
 410                                        next TOPLOOP;
 411                                }
 412                        }
 413                        if ($opts->{SINGLETON} && $bottom != $top) {
 414                                print "Huh ($choice)?\n";
 415                                next TOPLOOP;
 416                        }
 417                        for ($i = $bottom-1; $i <= $top-1; $i++) {
 418                                next if (@stuff <= $i || $i < 0);
 419                                $chosen[$i] = $choose;
 420                        }
 421                }
 422                last if ($opts->{IMMEDIATE} || $line eq '*');
 423        }
 424        for ($i = 0; $i < @stuff; $i++) {
 425                if ($chosen[$i]) {
 426                        push @return, $stuff[$i];
 427                }
 428        }
 429        return @return;
 430}
 431
 432sub singleton_prompt_help_cmd {
 433        print colored $help_color, <<\EOF ;
 434Prompt help:
 4351          - select a numbered item
 436foo        - select item based on unique prefix
 437           - (empty) select nothing
 438EOF
 439}
 440
 441sub prompt_help_cmd {
 442        print colored $help_color, <<\EOF ;
 443Prompt help:
 4441          - select a single item
 4453-5        - select a range of items
 4462-3,6-9    - select multiple ranges
 447foo        - select item based on unique prefix
 448-...       - unselect specified items
 449*          - choose all items
 450           - (empty) finish selecting
 451EOF
 452}
 453
 454sub status_cmd {
 455        list_and_choose({ LIST_ONLY => 1, HEADER => $status_head },
 456                        list_modified());
 457        print "\n";
 458}
 459
 460sub say_n_paths {
 461        my $did = shift @_;
 462        my $cnt = scalar @_;
 463        print "$did ";
 464        if (1 < $cnt) {
 465                print "$cnt paths\n";
 466        }
 467        else {
 468                print "one path\n";
 469        }
 470}
 471
 472sub update_cmd {
 473        my @mods = list_modified('file-only');
 474        return if (!@mods);
 475
 476        my @update = list_and_choose({ PROMPT => 'Update',
 477                                       HEADER => $status_head, },
 478                                     @mods);
 479        if (@update) {
 480                system(qw(git update-index --add --remove --),
 481                       map { $_->{VALUE} } @update);
 482                say_n_paths('updated', @update);
 483        }
 484        print "\n";
 485}
 486
 487sub revert_cmd {
 488        my @update = list_and_choose({ PROMPT => 'Revert',
 489                                       HEADER => $status_head, },
 490                                     list_modified());
 491        if (@update) {
 492                my @lines = run_cmd_pipe(qw(git ls-tree HEAD --),
 493                                         map { $_->{VALUE} } @update);
 494                my $fh;
 495                open $fh, '| git update-index --index-info'
 496                    or die;
 497                for (@lines) {
 498                        print $fh $_;
 499                }
 500                close($fh);
 501                for (@update) {
 502                        if ($_->{INDEX_ADDDEL} &&
 503                            $_->{INDEX_ADDDEL} eq 'create') {
 504                                system(qw(git update-index --force-remove --),
 505                                       $_->{VALUE});
 506                                print "note: $_->{VALUE} is untracked now.\n";
 507                        }
 508                }
 509                refresh();
 510                say_n_paths('reverted', @update);
 511        }
 512        print "\n";
 513}
 514
 515sub add_untracked_cmd {
 516        my @add = list_and_choose({ PROMPT => 'Add untracked' },
 517                                  list_untracked());
 518        if (@add) {
 519                system(qw(git update-index --add --), @add);
 520                say_n_paths('added', @add);
 521        }
 522        print "\n";
 523}
 524
 525sub parse_diff {
 526        my ($path) = @_;
 527        my @diff = run_cmd_pipe(qw(git diff-files -p --), $path);
 528        my @colored = ();
 529        if ($diff_use_color) {
 530                @colored = run_cmd_pipe(qw(git diff-files -p --color --), $path);
 531        }
 532        my (@hunk) = { TEXT => [], DISPLAY => [] };
 533
 534        for (my $i = 0; $i < @diff; $i++) {
 535                if ($diff[$i] =~ /^@@ /) {
 536                        push @hunk, { TEXT => [], DISPLAY => [] };
 537                }
 538                push @{$hunk[-1]{TEXT}}, $diff[$i];
 539                push @{$hunk[-1]{DISPLAY}},
 540                        ($diff_use_color ? $colored[$i] : $diff[$i]);
 541        }
 542        return @hunk;
 543}
 544
 545sub hunk_splittable {
 546        my ($text) = @_;
 547
 548        my @s = split_hunk($text);
 549        return (1 < @s);
 550}
 551
 552sub parse_hunk_header {
 553        my ($line) = @_;
 554        my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
 555            $line =~ /^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/;
 556        $o_cnt = 1 unless defined $o_cnt;
 557        $n_cnt = 1 unless defined $n_cnt;
 558        return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
 559}
 560
 561sub split_hunk {
 562        my ($text, $display) = @_;
 563        my @split = ();
 564        if (!defined $display) {
 565                $display = $text;
 566        }
 567        # If there are context lines in the middle of a hunk,
 568        # it can be split, but we would need to take care of
 569        # overlaps later.
 570
 571        my ($o_ofs, undef, $n_ofs) = parse_hunk_header($text->[0]);
 572        my $hunk_start = 1;
 573
 574      OUTER:
 575        while (1) {
 576                my $next_hunk_start = undef;
 577                my $i = $hunk_start - 1;
 578                my $this = +{
 579                        TEXT => [],
 580                        DISPLAY => [],
 581                        OLD => $o_ofs,
 582                        NEW => $n_ofs,
 583                        OCNT => 0,
 584                        NCNT => 0,
 585                        ADDDEL => 0,
 586                        POSTCTX => 0,
 587                        USE => undef,
 588                };
 589
 590                while (++$i < @$text) {
 591                        my $line = $text->[$i];
 592                        my $display = $display->[$i];
 593                        if ($line =~ /^ /) {
 594                                if ($this->{ADDDEL} &&
 595                                    !defined $next_hunk_start) {
 596                                        # We have seen leading context and
 597                                        # adds/dels and then here is another
 598                                        # context, which is trailing for this
 599                                        # split hunk and leading for the next
 600                                        # one.
 601                                        $next_hunk_start = $i;
 602                                }
 603                                push @{$this->{TEXT}}, $line;
 604                                push @{$this->{DISPLAY}}, $display;
 605                                $this->{OCNT}++;
 606                                $this->{NCNT}++;
 607                                if (defined $next_hunk_start) {
 608                                        $this->{POSTCTX}++;
 609                                }
 610                                next;
 611                        }
 612
 613                        # add/del
 614                        if (defined $next_hunk_start) {
 615                                # We are done with the current hunk and
 616                                # this is the first real change for the
 617                                # next split one.
 618                                $hunk_start = $next_hunk_start;
 619                                $o_ofs = $this->{OLD} + $this->{OCNT};
 620                                $n_ofs = $this->{NEW} + $this->{NCNT};
 621                                $o_ofs -= $this->{POSTCTX};
 622                                $n_ofs -= $this->{POSTCTX};
 623                                push @split, $this;
 624                                redo OUTER;
 625                        }
 626                        push @{$this->{TEXT}}, $line;
 627                        push @{$this->{DISPLAY}}, $display;
 628                        $this->{ADDDEL}++;
 629                        if ($line =~ /^-/) {
 630                                $this->{OCNT}++;
 631                        }
 632                        else {
 633                                $this->{NCNT}++;
 634                        }
 635                }
 636
 637                push @split, $this;
 638                last;
 639        }
 640
 641        for my $hunk (@split) {
 642                $o_ofs = $hunk->{OLD};
 643                $n_ofs = $hunk->{NEW};
 644                my $o_cnt = $hunk->{OCNT};
 645                my $n_cnt = $hunk->{NCNT};
 646
 647                my $head = ("@@ -$o_ofs" .
 648                            (($o_cnt != 1) ? ",$o_cnt" : '') .
 649                            " +$n_ofs" .
 650                            (($n_cnt != 1) ? ",$n_cnt" : '') .
 651                            " @@\n");
 652                my $display_head = $head;
 653                unshift @{$hunk->{TEXT}}, $head;
 654                if ($diff_use_color) {
 655                        $display_head = colored($fraginfo_color, $head);
 656                }
 657                unshift @{$hunk->{DISPLAY}}, $display_head;
 658        }
 659        return @split;
 660}
 661
 662sub find_last_o_ctx {
 663        my ($it) = @_;
 664        my $text = $it->{TEXT};
 665        my ($o_ofs, $o_cnt) = parse_hunk_header($text->[0]);
 666        my $i = @{$text};
 667        my $last_o_ctx = $o_ofs + $o_cnt;
 668        while (0 < --$i) {
 669                my $line = $text->[$i];
 670                if ($line =~ /^ /) {
 671                        $last_o_ctx--;
 672                        next;
 673                }
 674                last;
 675        }
 676        return $last_o_ctx;
 677}
 678
 679sub merge_hunk {
 680        my ($prev, $this) = @_;
 681        my ($o0_ofs, $o0_cnt, $n0_ofs, $n0_cnt) =
 682            parse_hunk_header($prev->{TEXT}[0]);
 683        my ($o1_ofs, $o1_cnt, $n1_ofs, $n1_cnt) =
 684            parse_hunk_header($this->{TEXT}[0]);
 685
 686        my (@line, $i, $ofs, $o_cnt, $n_cnt);
 687        $ofs = $o0_ofs;
 688        $o_cnt = $n_cnt = 0;
 689        for ($i = 1; $i < @{$prev->{TEXT}}; $i++) {
 690                my $line = $prev->{TEXT}[$i];
 691                if ($line =~ /^\+/) {
 692                        $n_cnt++;
 693                        push @line, $line;
 694                        next;
 695                }
 696
 697                last if ($o1_ofs <= $ofs);
 698
 699                $o_cnt++;
 700                $ofs++;
 701                if ($line =~ /^ /) {
 702                        $n_cnt++;
 703                }
 704                push @line, $line;
 705        }
 706
 707        for ($i = 1; $i < @{$this->{TEXT}}; $i++) {
 708                my $line = $this->{TEXT}[$i];
 709                if ($line =~ /^\+/) {
 710                        $n_cnt++;
 711                        push @line, $line;
 712                        next;
 713                }
 714                $ofs++;
 715                $o_cnt++;
 716                if ($line =~ /^ /) {
 717                        $n_cnt++;
 718                }
 719                push @line, $line;
 720        }
 721        my $head = ("@@ -$o0_ofs" .
 722                    (($o_cnt != 1) ? ",$o_cnt" : '') .
 723                    " +$n0_ofs" .
 724                    (($n_cnt != 1) ? ",$n_cnt" : '') .
 725                    " @@\n");
 726        @{$prev->{TEXT}} = ($head, @line);
 727}
 728
 729sub coalesce_overlapping_hunks {
 730        my (@in) = @_;
 731        my @out = ();
 732
 733        my ($last_o_ctx);
 734
 735        for (grep { $_->{USE} } @in) {
 736                my $text = $_->{TEXT};
 737                my ($o_ofs) = parse_hunk_header($text->[0]);
 738                if (defined $last_o_ctx &&
 739                    $o_ofs <= $last_o_ctx) {
 740                        merge_hunk($out[-1], $_);
 741                }
 742                else {
 743                        push @out, $_;
 744                }
 745                $last_o_ctx = find_last_o_ctx($out[-1]);
 746        }
 747        return @out;
 748}
 749
 750sub help_patch_cmd {
 751        print colored $help_color, <<\EOF ;
 752y - stage this hunk
 753n - do not stage this hunk
 754a - stage this and all the remaining hunks in the file
 755d - do not stage this hunk nor any of the remaining hunks in the file
 756j - leave this hunk undecided, see next undecided hunk
 757J - leave this hunk undecided, see next hunk
 758k - leave this hunk undecided, see previous undecided hunk
 759K - leave this hunk undecided, see previous hunk
 760s - split the current hunk into smaller hunks
 761? - print help
 762EOF
 763}
 764
 765sub patch_update_cmd {
 766        my @mods = grep { !($_->{BINARY}) } list_modified('file-only');
 767        my @them;
 768
 769        if (!@mods) {
 770                print STDERR "No changes.\n";
 771                return 0;
 772        }
 773        if ($patch_mode) {
 774                @them = @mods;
 775        }
 776        else {
 777                @them = list_and_choose({ PROMPT => 'Patch update',
 778                                          HEADER => $status_head, },
 779                                        @mods);
 780        }
 781        for (@them) {
 782                patch_update_file($_->{VALUE});
 783        }
 784}
 785
 786sub patch_update_file {
 787        my ($ix, $num);
 788        my $path = shift;
 789        my ($head, @hunk) = parse_diff($path);
 790        for (@{$head->{DISPLAY}}) {
 791                print;
 792        }
 793        $num = scalar @hunk;
 794        $ix = 0;
 795
 796        while (1) {
 797                my ($prev, $next, $other, $undecided, $i);
 798                $other = '';
 799
 800                if ($num <= $ix) {
 801                        $ix = 0;
 802                }
 803                for ($i = 0; $i < $ix; $i++) {
 804                        if (!defined $hunk[$i]{USE}) {
 805                                $prev = 1;
 806                                $other .= '/k';
 807                                last;
 808                        }
 809                }
 810                if ($ix) {
 811                        $other .= '/K';
 812                }
 813                for ($i = $ix + 1; $i < $num; $i++) {
 814                        if (!defined $hunk[$i]{USE}) {
 815                                $next = 1;
 816                                $other .= '/j';
 817                                last;
 818                        }
 819                }
 820                if ($ix < $num - 1) {
 821                        $other .= '/J';
 822                }
 823                for ($i = 0; $i < $num; $i++) {
 824                        if (!defined $hunk[$i]{USE}) {
 825                                $undecided = 1;
 826                                last;
 827                        }
 828                }
 829                last if (!$undecided);
 830
 831                if (hunk_splittable($hunk[$ix]{TEXT})) {
 832                        $other .= '/s';
 833                }
 834                for (@{$hunk[$ix]{DISPLAY}}) {
 835                        print;
 836                }
 837                print colored $prompt_color, "Stage this hunk [y/n/a/d$other/?]? ";
 838                my $line = <STDIN>;
 839                if ($line) {
 840                        if ($line =~ /^y/i) {
 841                                $hunk[$ix]{USE} = 1;
 842                        }
 843                        elsif ($line =~ /^n/i) {
 844                                $hunk[$ix]{USE} = 0;
 845                        }
 846                        elsif ($line =~ /^a/i) {
 847                                while ($ix < $num) {
 848                                        if (!defined $hunk[$ix]{USE}) {
 849                                                $hunk[$ix]{USE} = 1;
 850                                        }
 851                                        $ix++;
 852                                }
 853                                next;
 854                        }
 855                        elsif ($line =~ /^d/i) {
 856                                while ($ix < $num) {
 857                                        if (!defined $hunk[$ix]{USE}) {
 858                                                $hunk[$ix]{USE} = 0;
 859                                        }
 860                                        $ix++;
 861                                }
 862                                next;
 863                        }
 864                        elsif ($other =~ /K/ && $line =~ /^K/) {
 865                                $ix--;
 866                                next;
 867                        }
 868                        elsif ($other =~ /J/ && $line =~ /^J/) {
 869                                $ix++;
 870                                next;
 871                        }
 872                        elsif ($other =~ /k/ && $line =~ /^k/) {
 873                                while (1) {
 874                                        $ix--;
 875                                        last if (!$ix ||
 876                                                 !defined $hunk[$ix]{USE});
 877                                }
 878                                next;
 879                        }
 880                        elsif ($other =~ /j/ && $line =~ /^j/) {
 881                                while (1) {
 882                                        $ix++;
 883                                        last if ($ix >= $num ||
 884                                                 !defined $hunk[$ix]{USE});
 885                                }
 886                                next;
 887                        }
 888                        elsif ($other =~ /s/ && $line =~ /^s/) {
 889                                my @split = split_hunk($hunk[$ix]{TEXT}, $hunk[$ix]{DISPLAY});
 890                                if (1 < @split) {
 891                                        print colored $header_color, "Split into ",
 892                                        scalar(@split), " hunks.\n";
 893                                }
 894                                splice (@hunk, $ix, 1, @split);
 895                                $num = scalar @hunk;
 896                                next;
 897                        }
 898                        else {
 899                                help_patch_cmd($other);
 900                                next;
 901                        }
 902                        # soft increment
 903                        while (1) {
 904                                $ix++;
 905                                last if ($ix >= $num ||
 906                                         !defined $hunk[$ix]{USE});
 907                        }
 908                }
 909        }
 910
 911        @hunk = coalesce_overlapping_hunks(@hunk);
 912
 913        my $n_lofs = 0;
 914        my @result = ();
 915        for (@hunk) {
 916                my $text = $_->{TEXT};
 917                my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
 918                    parse_hunk_header($text->[0]);
 919
 920                if (!$_->{USE}) {
 921                        # We would have added ($n_cnt - $o_cnt) lines
 922                        # to the postimage if we were to use this hunk,
 923                        # but we didn't.  So the line number that the next
 924                        # hunk starts at would be shifted by that much.
 925                        $n_lofs -= ($n_cnt - $o_cnt);
 926                        next;
 927                }
 928                else {
 929                        if ($n_lofs) {
 930                                $n_ofs += $n_lofs;
 931                                $text->[0] = ("@@ -$o_ofs" .
 932                                              (($o_cnt != 1)
 933                                               ? ",$o_cnt" : '') .
 934                                              " +$n_ofs" .
 935                                              (($n_cnt != 1)
 936                                               ? ",$n_cnt" : '') .
 937                                              " @@\n");
 938                        }
 939                        for (@$text) {
 940                                push @result, $_;
 941                        }
 942                }
 943        }
 944
 945        if (@result) {
 946                my $fh;
 947
 948                open $fh, '| git apply --cached';
 949                for (@{$head->{TEXT}}, @result) {
 950                        print $fh $_;
 951                }
 952                if (!close $fh) {
 953                        for (@{$head->{TEXT}}, @result) {
 954                                print STDERR $_;
 955                        }
 956                }
 957                refresh();
 958        }
 959
 960        print "\n";
 961}
 962
 963sub diff_cmd {
 964        my @mods = list_modified('index-only');
 965        @mods = grep { !($_->{BINARY}) } @mods;
 966        return if (!@mods);
 967        my (@them) = list_and_choose({ PROMPT => 'Review diff',
 968                                     IMMEDIATE => 1,
 969                                     HEADER => $status_head, },
 970                                   @mods);
 971        return if (!@them);
 972        system(qw(git diff -p --cached HEAD --), map { $_->{VALUE} } @them);
 973}
 974
 975sub quit_cmd {
 976        print "Bye.\n";
 977        exit(0);
 978}
 979
 980sub help_cmd {
 981        print colored $help_color, <<\EOF ;
 982status        - show paths with changes
 983update        - add working tree state to the staged set of changes
 984revert        - revert staged set of changes back to the HEAD version
 985patch         - pick hunks and update selectively
 986diff          - view diff between HEAD and index
 987add untracked - add contents of untracked files to the staged set of changes
 988EOF
 989}
 990
 991sub process_args {
 992        return unless @ARGV;
 993        my $arg = shift @ARGV;
 994        if ($arg eq "--patch") {
 995                $patch_mode = 1;
 996                $arg = shift @ARGV or die "missing --";
 997                die "invalid argument $arg, expecting --"
 998                    unless $arg eq "--";
 999        }
1000        elsif ($arg ne "--") {
1001                die "invalid argument $arg, expecting --";
1002        }
1003}
1004
1005sub main_loop {
1006        my @cmd = ([ 'status', \&status_cmd, ],
1007                   [ 'update', \&update_cmd, ],
1008                   [ 'revert', \&revert_cmd, ],
1009                   [ 'add untracked', \&add_untracked_cmd, ],
1010                   [ 'patch', \&patch_update_cmd, ],
1011                   [ 'diff', \&diff_cmd, ],
1012                   [ 'quit', \&quit_cmd, ],
1013                   [ 'help', \&help_cmd, ],
1014        );
1015        while (1) {
1016                my ($it) = list_and_choose({ PROMPT => 'What now',
1017                                             SINGLETON => 1,
1018                                             LIST_FLAT => 4,
1019                                             HEADER => '*** Commands ***',
1020                                             ON_EOF => \&quit_cmd,
1021                                             IMMEDIATE => 1 }, @cmd);
1022                if ($it) {
1023                        eval {
1024                                $it->[1]->();
1025                        };
1026                        if ($@) {
1027                                print "$@";
1028                        }
1029                }
1030        }
1031}
1032
1033process_args();
1034refresh();
1035if ($patch_mode) {
1036        patch_update_cmd();
1037}
1038else {
1039        status_cmd();
1040        main_loop();
1041}