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