git.oblomov.eu Git - git/blob - git-add--interactive.perl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Git;
   5
   6 # Prompt colors:
   7 my ($prompt_color, $header_color, $help_color, $normal_color);
   8 # Diff colors:
   9 my ($new_color, $old_color, $fraginfo_color, $metainfo_color, $whitespace_color);
  10
  11 my ($use_color, $diff_use_color);
  12 my $repo = Git->repository();
  13
  14 $use_color = $repo->get_colorbool('color.interactive');
  15
  16 if ($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
  37 sub 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
  55 my $patch_mode;
  56
  57 sub 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
  70 my ($GIT_DIR) = run_cmd_pipe(qw(git rev-parse --git-dir));
  71
  72 if (!defined $GIT_DIR) {
  73         exit(1); # rev-parse would have already said "not a git repo"
  74 }
  75 chomp($GIT_DIR);
  76
  77 sub 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
  87 sub list_untracked {
  88         map {
  89                 chomp $_;
  90                 $_;
  91         }
  92         run_cmd_pipe(qw(git ls-files --others --exclude-standard --), @ARGV);
  93 }
  94
  95 my $status_fmt = '%12s %12s %s';
  96 my $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
 106 sub 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
 190 sub 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
 220 sub 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)
 229 sub 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()
 283 sub 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)
 295 sub 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
 314 sub 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
 432 sub singleton_prompt_help_cmd {
 433         print colored $help_color, <<\EOF ;
 434 Prompt help:
 435 1          - select a numbered item
 436 foo        - select item based on unique prefix
 437            - (empty) select nothing
 438 EOF
 439 }
 440
 441 sub prompt_help_cmd {
 442         print colored $help_color, <<\EOF ;
 443 Prompt help:
 444 1          - select a single item
 445 3-5        - select a range of items
 446 2-3,6-9    - select multiple ranges
 447 foo        - select item based on unique prefix
 448 -...       - unselect specified items
 449 *          - choose all items
 450            - (empty) finish selecting
 451 EOF
 452 }
 453
 454 sub status_cmd {
 455         list_and_choose({ LIST_ONLY => 1, HEADER => $status_head },
 456                         list_modified());
 457         print "\n";
 458 }
 459
 460 sub 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
 472 sub 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
 487 sub 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
 515 sub 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
 525 sub 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
 545 sub hunk_splittable {
 546         my ($text) = @_;
 547
 548         my @s = split_hunk($text);
 549         return (1 < @s);
 550 }
 551
 552 sub 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
 561 sub 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
 662 sub 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
 679 sub 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
 729 sub 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
 750 sub help_patch_cmd {
 751         print colored $help_color, <<\EOF ;
 752 y - stage this hunk
 753 n - do not stage this hunk
 754 a - stage this and all the remaining hunks in the file
 755 d - do not stage this hunk nor any of the remaining hunks in the file
 756 j - leave this hunk undecided, see next undecided hunk
 757 J - leave this hunk undecided, see next hunk
 758 k - leave this hunk undecided, see previous undecided hunk
 759 K - leave this hunk undecided, see previous hunk
 760 s - split the current hunk into smaller hunks
 761 ? - print help
 762 EOF
 763 }
 764
 765 sub 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
 786 sub 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
 963 sub 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
 975 sub quit_cmd {
 976         print "Bye.\n";
 977         exit(0);
 978 }
 979
 980 sub help_cmd {
 981         print colored $help_color, <<\EOF ;
 982 status        - show paths with changes
 983 update        - add working tree state to the staged set of changes
 984 revert        - revert staged set of changes back to the HEAD version
 985 patch         - pick hunks and update selectively
 986 diff          - view diff between HEAD and index
 987 add untracked - add contents of untracked files to the staged set of changes
 988 EOF
 989 }
 990
 991 sub 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
1005 sub 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
1033 process_args();
1034 refresh();
1035 if ($patch_mode) {
1036         patch_update_cmd();
1037 }
1038 else {
1039         status_cmd();
1040         main_loop();
1041 }