t4200: skip gc-rerere test on systems with non GNU date.
[git/git.git] / git-add--interactive.perl
CommitLineData
5cde71d6
JH
1#!/usr/bin/perl -w
2
835b2aeb 3
5cde71d6
JH
4use strict;
5
6sub run_cmd_pipe {
7 my $fh = undef;
8 open($fh, '-|', @_) or die;
9 return <$fh>;
10}
11
12my ($GIT_DIR) = run_cmd_pipe(qw(git rev-parse --git-dir));
13
14if (!defined $GIT_DIR) {
15 exit(1); # rev-parse would have already said "not a git repo"
16}
17chomp($GIT_DIR);
18
19sub refresh {
20 my $fh;
21 open $fh, '-|', qw(git update-index --refresh)
22 or die;
23 while (<$fh>) {
24 ;# ignore 'needs update'
25 }
26 close $fh;
27}
28
29sub list_untracked {
30 map {
31 chomp $_;
32 $_;
33 }
34 run_cmd_pipe(qw(git ls-files --others
35 --exclude-per-directory=.gitignore),
36 "--exclude-from=$GIT_DIR/info/exclude",
37 '--', @_);
38}
39
40my $status_fmt = '%12s %12s %s';
41my $status_head = sprintf($status_fmt, 'staged', 'unstaged', 'path');
42
43# Returns list of hashes, contents of each of which are:
44# PRINT: print message
45# VALUE: pathname
46# BINARY: is a binary path
47# INDEX: is index different from HEAD?
48# FILE: is file different from index?
49# INDEX_ADDDEL: is it add/delete between HEAD and index?
50# FILE_ADDDEL: is it add/delete between index and file?
51
52sub list_modified {
53 my ($only) = @_;
54 my (%data, @return);
55 my ($add, $del, $adddel, $file);
56
57 for (run_cmd_pipe(qw(git diff-index --cached
58 --numstat --summary HEAD))) {
59 if (($add, $del, $file) =
60 /^([-\d]+) ([-\d]+) (.*)/) {
61 my ($change, $bin);
62 if ($add eq '-' && $del eq '-') {
63 $change = 'binary';
64 $bin = 1;
65 }
66 else {
67 $change = "+$add/-$del";
68 }
69 $data{$file} = {
70 INDEX => $change,
71 BINARY => $bin,
72 FILE => 'nothing',
73 }
74 }
75 elsif (($adddel, $file) =
76 /^ (create|delete) mode [0-7]+ (.*)$/) {
77 $data{$file}{INDEX_ADDDEL} = $adddel;
78 }
79 }
80
81 for (run_cmd_pipe(qw(git diff-files --numstat --summary))) {
82 if (($add, $del, $file) =
83 /^([-\d]+) ([-\d]+) (.*)/) {
84 if (!exists $data{$file}) {
85 $data{$file} = +{
86 INDEX => 'unchanged',
87 BINARY => 0,
88 };
89 }
90 my ($change, $bin);
91 if ($add eq '-' && $del eq '-') {
92 $change = 'binary';
93 $bin = 1;
94 }
95 else {
96 $change = "+$add/-$del";
97 }
98 $data{$file}{FILE} = $change;
99 if ($bin) {
100 $data{$file}{BINARY} = 1;
101 }
102 }
103 elsif (($adddel, $file) =
104 /^ (create|delete) mode [0-7]+ (.*)$/) {
105 $data{$file}{FILE_ADDDEL} = $adddel;
106 }
107 }
108
109 for (sort keys %data) {
110 my $it = $data{$_};
111
112 if ($only) {
113 if ($only eq 'index-only') {
114 next if ($it->{INDEX} eq 'unchanged');
115 }
116 if ($only eq 'file-only') {
117 next if ($it->{FILE} eq 'nothing');
118 }
119 }
120 push @return, +{
121 VALUE => $_,
122 PRINT => (sprintf $status_fmt,
123 $it->{INDEX}, $it->{FILE}, $_),
124 %$it,
125 };
126 }
127 return @return;
128}
129
130sub find_unique {
131 my ($string, @stuff) = @_;
132 my $found = undef;
133 for (my $i = 0; $i < @stuff; $i++) {
134 my $it = $stuff[$i];
135 my $hit = undef;
136 if (ref $it) {
137 if ((ref $it) eq 'ARRAY') {
138 $it = $it->[0];
139 }
140 else {
141 $it = $it->{VALUE};
142 }
143 }
144 eval {
145 if ($it =~ /^$string/) {
146 $hit = 1;
147 };
148 };
149 if (defined $hit && defined $found) {
150 return undef;
151 }
152 if ($hit) {
153 $found = $i + 1;
154 }
155 }
156 return $found;
157}
158
159sub list_and_choose {
160 my ($opts, @stuff) = @_;
161 my (@chosen, @return);
162 my $i;
163
164 TOPLOOP:
165 while (1) {
166 my $last_lf = 0;
167
168 if ($opts->{HEADER}) {
169 if (!$opts->{LIST_FLAT}) {
170 print " ";
171 }
172 print "$opts->{HEADER}\n";
173 }
174 for ($i = 0; $i < @stuff; $i++) {
175 my $chosen = $chosen[$i] ? '*' : ' ';
176 my $print = $stuff[$i];
177 if (ref $print) {
178 if ((ref $print) eq 'ARRAY') {
179 $print = $print->[0];
180 }
181 else {
182 $print = $print->{PRINT};
183 }
184 }
185 printf("%s%2d: %s", $chosen, $i+1, $print);
186 if (($opts->{LIST_FLAT}) &&
187 (($i + 1) % ($opts->{LIST_FLAT}))) {
188 print "\t";
189 $last_lf = 0;
190 }
191 else {
192 print "\n";
193 $last_lf = 1;
194 }
195 }
196 if (!$last_lf) {
197 print "\n";
198 }
199
200 return if ($opts->{LIST_ONLY});
201
202 print $opts->{PROMPT};
203 if ($opts->{SINGLETON}) {
204 print "> ";
205 }
206 else {
207 print ">> ";
208 }
209 my $line = <STDIN>;
210 last if (!$line);
211 chomp $line;
212 my $donesomething = 0;
213 for my $choice (split(/[\s,]+/, $line)) {
214 my $choose = 1;
215 my ($bottom, $top);
216
217 # Input that begins with '-'; unchoose
218 if ($choice =~ s/^-//) {
219 $choose = 0;
220 }
221 # A range can be specified like 5-7
222 if ($choice =~ /^(\d+)-(\d+)$/) {
223 ($bottom, $top) = ($1, $2);
224 }
225 elsif ($choice =~ /^\d+$/) {
226 $bottom = $top = $choice;
227 }
228 elsif ($choice eq '*') {
229 $bottom = 1;
230 $top = 1 + @stuff;
231 }
232 else {
233 $bottom = $top = find_unique($choice, @stuff);
234 if (!defined $bottom) {
235 print "Huh ($choice)?\n";
236 next TOPLOOP;
237 }
238 }
239 if ($opts->{SINGLETON} && $bottom != $top) {
240 print "Huh ($choice)?\n";
241 next TOPLOOP;
242 }
243 for ($i = $bottom-1; $i <= $top-1; $i++) {
244 next if (@stuff <= $i);
245 $chosen[$i] = $choose;
246 $donesomething++;
247 }
248 }
249 last if (!$donesomething || $opts->{IMMEDIATE});
250 }
251 for ($i = 0; $i < @stuff; $i++) {
252 if ($chosen[$i]) {
253 push @return, $stuff[$i];
254 }
255 }
256 return @return;
257}
258
259sub status_cmd {
260 list_and_choose({ LIST_ONLY => 1, HEADER => $status_head },
261 list_modified());
262 print "\n";
263}
264
265sub say_n_paths {
266 my $did = shift @_;
267 my $cnt = scalar @_;
268 print "$did ";
269 if (1 < $cnt) {
270 print "$cnt paths\n";
271 }
272 else {
273 print "one path\n";
274 }
275}
276
277sub update_cmd {
278 my @mods = list_modified('file-only');
279 return if (!@mods);
280
281 my @update = list_and_choose({ PROMPT => 'Update',
282 HEADER => $status_head, },
283 @mods);
284 if (@update) {
285 system(qw(git update-index --add --),
286 map { $_->{VALUE} } @update);
287 say_n_paths('updated', @update);
288 }
289 print "\n";
290}
291
292sub revert_cmd {
293 my @update = list_and_choose({ PROMPT => 'Revert',
294 HEADER => $status_head, },
295 list_modified());
296 if (@update) {
297 my @lines = run_cmd_pipe(qw(git ls-tree HEAD --),
298 map { $_->{VALUE} } @update);
299 my $fh;
300 open $fh, '|-', qw(git update-index --index-info)
301 or die;
302 for (@lines) {
303 print $fh $_;
304 }
305 close($fh);
306 for (@update) {
307 if ($_->{INDEX_ADDDEL} &&
308 $_->{INDEX_ADDDEL} eq 'create') {
309 system(qw(git update-index --force-remove --),
310 $_->{VALUE});
311 print "note: $_->{VALUE} is untracked now.\n";
312 }
313 }
314 refresh();
315 say_n_paths('reverted', @update);
316 }
317 print "\n";
318}
319
320sub add_untracked_cmd {
321 my @add = list_and_choose({ PROMPT => 'Add untracked' },
322 list_untracked());
323 if (@add) {
324 system(qw(git update-index --add --), @add);
325 say_n_paths('added', @add);
326 }
327 print "\n";
328}
329
330sub parse_diff {
331 my ($path) = @_;
332 my @diff = run_cmd_pipe(qw(git diff-files -p --), $path);
333 my (@hunk) = { TEXT => [] };
334
335 for (@diff) {
336 if (/^@@ /) {
337 push @hunk, { TEXT => [] };
338 }
339 push @{$hunk[-1]{TEXT}}, $_;
340 }
341 return @hunk;
342}
343
835b2aeb
JH
344sub hunk_splittable {
345 my ($text) = @_;
346
347 my @s = split_hunk($text);
348 return (1 < @s);
349}
350
351sub parse_hunk_header {
352 my ($line) = @_;
353 my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
354 $line =~ /^@@ -(\d+)(?:,(\d+)) \+(\d+)(?:,(\d+)) @@/;
355 return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
356}
357
358sub split_hunk {
359 my ($text) = @_;
360 my @split = ();
361
362 # If there are context lines in the middle of a hunk,
363 # it can be split, but we would need to take care of
364 # overlaps later.
365
366 my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) = parse_hunk_header($text->[0]);
367 my $hunk_start = 1;
368 my $next_hunk_start;
369
370 OUTER:
371 while (1) {
372 my $next_hunk_start = undef;
373 my $i = $hunk_start - 1;
374 my $this = +{
375 TEXT => [],
376 OLD => $o_ofs,
377 NEW => $n_ofs,
378 OCNT => 0,
379 NCNT => 0,
380 ADDDEL => 0,
381 POSTCTX => 0,
382 };
383
384 while (++$i < @$text) {
385 my $line = $text->[$i];
386 if ($line =~ /^ /) {
387 if ($this->{ADDDEL} &&
388 !defined $next_hunk_start) {
389 # We have seen leading context and
390 # adds/dels and then here is another
391 # context, which is trailing for this
392 # split hunk and leading for the next
393 # one.
394 $next_hunk_start = $i;
395 }
396 push @{$this->{TEXT}}, $line;
397 $this->{OCNT}++;
398 $this->{NCNT}++;
399 if (defined $next_hunk_start) {
400 $this->{POSTCTX}++;
401 }
402 next;
403 }
404
405 # add/del
406 if (defined $next_hunk_start) {
407 # We are done with the current hunk and
408 # this is the first real change for the
409 # next split one.
410 $hunk_start = $next_hunk_start;
411 $o_ofs = $this->{OLD} + $this->{OCNT};
412 $n_ofs = $this->{NEW} + $this->{NCNT};
413 $o_ofs -= $this->{POSTCTX};
414 $n_ofs -= $this->{POSTCTX};
415 push @split, $this;
416 redo OUTER;
417 }
418 push @{$this->{TEXT}}, $line;
419 $this->{ADDDEL}++;
420 if ($line =~ /^-/) {
421 $this->{OCNT}++;
422 }
423 else {
424 $this->{NCNT}++;
425 }
426 }
427
428 push @split, $this;
429 last;
430 }
431
432 for my $hunk (@split) {
433 $o_ofs = $hunk->{OLD};
434 $n_ofs = $hunk->{NEW};
435 $o_cnt = $hunk->{OCNT};
436 $n_cnt = $hunk->{NCNT};
437
438 my $head = ("@@ -$o_ofs" .
439 (($o_cnt != 1) ? ",$o_cnt" : '') .
440 " +$n_ofs" .
441 (($n_cnt != 1) ? ",$n_cnt" : '') .
442 " @@\n");
443 unshift @{$hunk->{TEXT}}, $head;
444 }
445 return map { $_->{TEXT} } @split;
446}
447
448sub find_last_o_ctx {
449 my ($it) = @_;
450 my $text = $it->{TEXT};
451 my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) = parse_hunk_header($text->[0]);
452 my $i = @{$text};
453 my $last_o_ctx = $o_ofs + $o_cnt;
454 while (0 < --$i) {
455 my $line = $text->[$i];
456 if ($line =~ /^ /) {
457 $last_o_ctx--;
458 next;
459 }
460 last;
461 }
462 return $last_o_ctx;
463}
464
465sub merge_hunk {
466 my ($prev, $this) = @_;
467 my ($o0_ofs, $o0_cnt, $n0_ofs, $n0_cnt) =
468 parse_hunk_header($prev->{TEXT}[0]);
469 my ($o1_ofs, $o1_cnt, $n1_ofs, $n1_cnt) =
470 parse_hunk_header($this->{TEXT}[0]);
471
472 my (@line, $i, $ofs, $o_cnt, $n_cnt);
473 $ofs = $o0_ofs;
474 $o_cnt = $n_cnt = 0;
475 for ($i = 1; $i < @{$prev->{TEXT}}; $i++) {
476 my $line = $prev->{TEXT}[$i];
477 if ($line =~ /^\+/) {
478 $n_cnt++;
479 push @line, $line;
480 next;
481 }
482
483 last if ($o1_ofs <= $ofs);
484
485 $o_cnt++;
486 $ofs++;
487 if ($line =~ /^ /) {
488 $n_cnt++;
489 }
490 push @line, $line;
491 }
492
493 for ($i = 1; $i < @{$this->{TEXT}}; $i++) {
494 my $line = $this->{TEXT}[$i];
495 if ($line =~ /^\+/) {
496 $n_cnt++;
497 push @line, $line;
498 next;
499 }
500 $ofs++;
501 $o_cnt++;
502 if ($line =~ /^ /) {
503 $n_cnt++;
504 }
505 push @line, $line;
506 }
507 my $head = ("@@ -$o0_ofs" .
508 (($o_cnt != 1) ? ",$o_cnt" : '') .
509 " +$n0_ofs" .
510 (($n_cnt != 1) ? ",$n_cnt" : '') .
511 " @@\n");
512 @{$prev->{TEXT}} = ($head, @line);
513}
514
515sub coalesce_overlapping_hunks {
516 my (@in) = @_;
517 my @out = ();
518
519 my ($last_o_ctx);
520
521 for (grep { $_->{USE} } @in) {
522 my $text = $_->{TEXT};
523 my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
524 parse_hunk_header($text->[0]);
525 if (defined $last_o_ctx &&
526 $o_ofs <= $last_o_ctx) {
527 merge_hunk($out[-1], $_);
528 }
529 else {
530 push @out, $_;
531 }
532 $last_o_ctx = find_last_o_ctx($out[-1]);
533 }
534 return @out;
535}
536
5cde71d6
JH
537sub help_patch_cmd {
538 print <<\EOF ;
539y - stage this hunk
540n - do not stage this hunk
541a - stage this and all the remaining hunks
542d - do not stage this hunk nor any of the remaining hunks
543j - leave this hunk undecided, see next undecided hunk
544J - leave this hunk undecided, see next hunk
545k - leave this hunk undecided, see previous undecided hunk
546K - leave this hunk undecided, see previous hunk
835b2aeb 547s - split the current hunk into smaller hunks
5cde71d6
JH
548EOF
549}
550
551sub patch_update_cmd {
552 my @mods = list_modified('file-only');
553 @mods = grep { !($_->{BINARY}) } @mods;
554 return if (!@mods);
555
556 my ($it) = list_and_choose({ PROMPT => 'Patch update',
557 SINGLETON => 1,
558 IMMEDIATE => 1,
559 HEADER => $status_head, },
560 @mods);
561 return if (!$it);
562
563 my ($ix, $num);
564 my $path = $it->{VALUE};
565 my ($head, @hunk) = parse_diff($path);
566 for (@{$head->{TEXT}}) {
567 print;
568 }
569 $num = scalar @hunk;
570 $ix = 0;
571
572 while (1) {
835b2aeb 573 my ($prev, $next, $other, $undecided, $i);
5cde71d6
JH
574 $other = '';
575
576 if ($num <= $ix) {
577 $ix = 0;
578 }
835b2aeb 579 for ($i = 0; $i < $ix; $i++) {
5cde71d6
JH
580 if (!defined $hunk[$i]{USE}) {
581 $prev = 1;
582 $other .= '/k';
583 last;
584 }
585 }
586 if ($ix) {
587 $other .= '/K';
588 }
835b2aeb 589 for ($i = $ix + 1; $i < $num; $i++) {
5cde71d6
JH
590 if (!defined $hunk[$i]{USE}) {
591 $next = 1;
592 $other .= '/j';
593 last;
594 }
595 }
596 if ($ix < $num - 1) {
597 $other .= '/J';
598 }
835b2aeb 599 for ($i = 0; $i < $num; $i++) {
5cde71d6
JH
600 if (!defined $hunk[$i]{USE}) {
601 $undecided = 1;
602 last;
603 }
604 }
605 last if (!$undecided);
606
835b2aeb
JH
607 if (hunk_splittable($hunk[$ix]{TEXT})) {
608 $other .= '/s';
609 }
5cde71d6
JH
610 for (@{$hunk[$ix]{TEXT}}) {
611 print;
612 }
613 print "Stage this hunk [y/n/a/d$other/?]? ";
614 my $line = <STDIN>;
615 if ($line) {
616 if ($line =~ /^y/i) {
617 $hunk[$ix]{USE} = 1;
618 }
619 elsif ($line =~ /^n/i) {
620 $hunk[$ix]{USE} = 0;
621 }
622 elsif ($line =~ /^a/i) {
623 while ($ix < $num) {
624 if (!defined $hunk[$ix]{USE}) {
625 $hunk[$ix]{USE} = 1;
626 }
627 $ix++;
628 }
629 next;
630 }
631 elsif ($line =~ /^d/i) {
632 while ($ix < $num) {
633 if (!defined $hunk[$ix]{USE}) {
634 $hunk[$ix]{USE} = 0;
635 }
636 $ix++;
637 }
638 next;
639 }
640 elsif ($other =~ /K/ && $line =~ /^K/) {
641 $ix--;
642 next;
643 }
644 elsif ($other =~ /J/ && $line =~ /^J/) {
645 $ix++;
646 next;
647 }
648 elsif ($other =~ /k/ && $line =~ /^k/) {
649 while (1) {
650 $ix--;
651 last if (!$ix ||
652 !defined $hunk[$ix]{USE});
653 }
654 next;
655 }
656 elsif ($other =~ /j/ && $line =~ /^j/) {
657 while (1) {
658 $ix++;
659 last if ($ix >= $num ||
660 !defined $hunk[$ix]{USE});
661 }
662 next;
663 }
835b2aeb
JH
664 elsif ($other =~ /s/ && $line =~ /^s/) {
665 my @split = split_hunk($hunk[$ix]{TEXT});
666 if (1 < @split) {
667 print "Split into ",
668 scalar(@split), " hunks.\n";
669 }
670 splice(@hunk, $ix, 1,
671 map { +{ TEXT => $_, USE => undef } }
672 @split);
673 $num = scalar @hunk;
674 next;
675 }
5cde71d6
JH
676 else {
677 help_patch_cmd($other);
678 next;
679 }
680 # soft increment
681 while (1) {
682 $ix++;
683 last if ($ix >= $num ||
684 !defined $hunk[$ix]{USE});
685 }
686 }
687 }
688
835b2aeb
JH
689 @hunk = coalesce_overlapping_hunks(@hunk);
690
691 my ($o_lofs, $n_lofs) = (0, 0);
5cde71d6
JH
692 my @result = ();
693 for (@hunk) {
694 my $text = $_->{TEXT};
695 my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
835b2aeb
JH
696 parse_hunk_header($text->[0]);
697
5cde71d6 698 if (!$_->{USE}) {
835b2aeb
JH
699 if (!defined $o_cnt) { $o_cnt = 1; }
700 if (!defined $n_cnt) { $n_cnt = 1; }
701
702 # We would have added ($n_cnt - $o_cnt) lines
703 # to the postimage if we were to use this hunk,
704 # but we didn't. So the line number that the next
705 # hunk starts at would be shifted by that much.
706 $n_lofs -= ($n_cnt - $o_cnt);
5cde71d6
JH
707 next;
708 }
709 else {
835b2aeb
JH
710 if ($n_lofs) {
711 $n_ofs += $n_lofs;
712 $text->[0] = ("@@ -$o_ofs" .
713 ((defined $o_cnt)
714 ? ",$o_cnt" : '') .
715 " +$n_ofs" .
716 ((defined $n_cnt)
717 ? ",$n_cnt" : '') .
718 " @@\n");
719 }
5cde71d6
JH
720 for (@$text) {
721 push @result, $_;
722 }
723 }
724 }
725
726 if (@result) {
727 my $fh;
728
729 open $fh, '|-', qw(git apply --cached);
730 for (@{$head->{TEXT}}, @result) {
731 print $fh $_;
732 }
835b2aeb
JH
733 if (!close $fh) {
734 for (@{$head->{TEXT}}, @result) {
735 print STDERR $_;
736 }
737 }
5cde71d6
JH
738 refresh();
739 }
740
741 print "\n";
742}
743
744sub diff_cmd {
745 my @mods = list_modified('index-only');
746 @mods = grep { !($_->{BINARY}) } @mods;
747 return if (!@mods);
748 my (@them) = list_and_choose({ PROMPT => 'Review diff',
749 IMMEDIATE => 1,
750 HEADER => $status_head, },
751 @mods);
752 return if (!@them);
753 system(qw(git diff-index -p --cached HEAD --),
754 map { $_->{VALUE} } @them);
755}
756
757sub quit_cmd {
758 print "Bye.\n";
759 exit(0);
760}
761
762sub help_cmd {
763 print <<\EOF ;
764status - show paths with changes
765update - add working tree state to the staged set of changes
766revert - revert staged set of changes back to the HEAD version
767patch - pick hunks and update selectively
768diff - view diff between HEAD and index
769add untracked - add contents of untracked files to the staged set of changes
770EOF
771}
772
773sub main_loop {
774 my @cmd = ([ 'status', \&status_cmd, ],
775 [ 'update', \&update_cmd, ],
776 [ 'revert', \&revert_cmd, ],
777 [ 'add untracked', \&add_untracked_cmd, ],
778 [ 'patch', \&patch_update_cmd, ],
779 [ 'diff', \&diff_cmd, ],
780 [ 'quit', \&quit_cmd, ],
781 [ 'help', \&help_cmd, ],
782 );
783 while (1) {
784 my ($it) = list_and_choose({ PROMPT => 'What now',
785 SINGLETON => 1,
786 LIST_FLAT => 4,
787 HEADER => '*** Commands ***',
788 IMMEDIATE => 1 }, @cmd);
789 if ($it) {
790 eval {
791 $it->[1]->();
792 };
793 if ($@) {
794 print "$@";
795 }
796 }
797 }
798}
799
800my @z;
801
802refresh();
803status_cmd();
804main_loop();