git-add--interactive: remove hunk coalescing
[git/trast.git] / git-add--interactive.perl
bloba4234d39e94bc0fdf85ac93cfb696828d3644e5b
1 #!/usr/bin/perl -w
3 use strict;
4 use Git;
6 my $repo = Git->repository();
8 my $menu_use_color = $repo->get_colorbool('color.interactive');
9 my ($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 ) : ();
16 my $diff_use_color = $repo->get_colorbool('color.diff');
17 my ($fraginfo_color) =
18 $diff_use_color ? (
19 $repo->get_color('color.diff.frag', 'cyan'),
20 ) : ();
22 my $normal_color = $repo->get_color("", "reset");
24 sub colored {
25 my $color = shift;
26 my $string = join("", @_);
28 if (defined $color) {
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$/;
38 return $string;
41 # command line options
42 my $patch_mode;
44 sub run_cmd_pipe {
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>;
57 my ($GIT_DIR) = run_cmd_pipe(qw(git rev-parse --git-dir));
59 if (!defined $GIT_DIR) {
60 exit(1); # rev-parse would have already said "not a git repo"
62 chomp($GIT_DIR);
64 sub refresh {
65 my $fh;
66 open $fh, 'git update-index --refresh |'
67 or die;
68 while (<$fh>) {
69 ;# ignore 'needs update'
71 close $fh;
74 sub list_untracked {
75 map {
76 chomp $_;
77 $_;
79 run_cmd_pipe(qw(git ls-files --others --exclude-standard --), @ARGV);
82 my $status_fmt = '%12s %12s %s';
83 my $status_head = sprintf($status_fmt, 'staged', 'unstaged', 'path');
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;
94 sub get_empty_tree {
95 return '4b825dc642cb6eb9a060e54bf8d69288fbee4904';
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?
106 sub list_modified {
107 my ($only) = @_;
108 my (%data, @return);
109 my ($add, $del, $adddel, $file);
110 my @tracked = ();
112 if (@ARGV) {
113 @tracked = map {
114 chomp $_; $_;
115 } run_cmd_pipe(qw(git ls-files --exclude-standard --), @ARGV);
116 return if (!@tracked);
119 my $reference = is_initial_commit() ? get_empty_tree() : 'HEAD';
120 for (run_cmd_pipe(qw(git diff-index --cached
121 --numstat --summary), $reference,
122 '--', @tracked)) {
123 if (($add, $del, $file) =
124 /^([-\d]+) ([-\d]+) (.*)/) {
125 my ($change, $bin);
126 if ($add eq '-' && $del eq '-') {
127 $change = 'binary';
128 $bin = 1;
130 else {
131 $change = "+$add/-$del";
133 $data{$file} = {
134 INDEX => $change,
135 BINARY => $bin,
136 FILE => 'nothing',
139 elsif (($adddel, $file) =
140 /^ (create|delete) mode [0-7]+ (.*)$/) {
141 $data{$file}{INDEX_ADDDEL} = $adddel;
145 for (run_cmd_pipe(qw(git diff-files --numstat --summary --), @tracked)) {
146 if (($add, $del, $file) =
147 /^([-\d]+) ([-\d]+) (.*)/) {
148 if (!exists $data{$file}) {
149 $data{$file} = +{
150 INDEX => 'unchanged',
151 BINARY => 0,
154 my ($change, $bin);
155 if ($add eq '-' && $del eq '-') {
156 $change = 'binary';
157 $bin = 1;
159 else {
160 $change = "+$add/-$del";
162 $data{$file}{FILE} = $change;
163 if ($bin) {
164 $data{$file}{BINARY} = 1;
167 elsif (($adddel, $file) =
168 /^ (create|delete) mode [0-7]+ (.*)$/) {
169 $data{$file}{FILE_ADDDEL} = $adddel;
173 for (sort keys %data) {
174 my $it = $data{$_};
176 if ($only) {
177 if ($only eq 'index-only') {
178 next if ($it->{INDEX} eq 'unchanged');
180 if ($only eq 'file-only') {
181 next if ($it->{FILE} eq 'nothing');
184 push @return, +{
185 VALUE => $_,
186 %$it,
189 return @return;
192 sub 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];
202 else {
203 $it = $it->{VALUE};
206 eval {
207 if ($it =~ /^$string/) {
208 $hit = 1;
211 if (defined $hit && defined $found) {
212 return undef;
214 if ($hit) {
215 $found = $i + 1;
218 return $found;
221 # inserts string into trie and updates count for each character
222 sub update_trie {
223 my ($trie, $string) = @_;
224 foreach (split //, $string) {
225 $trie = $trie->{$_} ||= {COUNT => 0};
226 $trie->{COUNT}++;
230 # returns an array of tuples (prefix, remainder)
231 sub find_unique_prefixes {
232 my @stuff = @_;
233 my @return = ();
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;
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];
247 elsif ((ref $print) eq 'HASH') {
248 $print = $print->{VALUE};
250 update_trie(\%trie, $print);
251 push @return, $print;
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;
268 else {
269 my $prefix = substr $ret, 0, $j;
270 return ()
271 if ($hard_limit && $j + 1 > $hard_limit);
273 %search = %{$search{$letter}};
275 if ($soft_limit && $j + 1 > $soft_limit) {
276 $prefix = undef;
277 $remainder = $ret;
279 $return[$i] = [$prefix, $remainder];
281 return @return;
284 # filters out prefixes which have special meaning to list_and_choose()
285 sub is_valid_prefix {
286 my $prefix = shift;
287 return (defined $prefix) &&
288 !($prefix =~ /[\s,]/) && # separators
289 !($prefix =~ /^-/) && # deselection
290 !($prefix =~ /^\d+/) && # selection
291 ($prefix ne '*') && # "all" wildcard
292 ($prefix ne '?'); # prompt help
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)
297 sub highlight_prefix {
298 my $prefix = shift;
299 my $remainder = shift;
301 if (!defined $prefix) {
302 return $remainder;
305 if (!is_valid_prefix($prefix)) {
306 return "$prefix$remainder";
309 if (!$menu_use_color) {
310 return "[$prefix]$remainder";
313 return "$prompt_color$prefix$normal_color$remainder";
316 sub list_and_choose {
317 my ($opts, @stuff) = @_;
318 my (@chosen, @return);
319 my $i;
320 my @prefixes = find_unique_prefixes(@stuff) unless $opts->{LIST_ONLY};
322 TOPLOOP:
323 while (1) {
324 my $last_lf = 0;
326 if ($opts->{HEADER}) {
327 if (!$opts->{LIST_FLAT}) {
328 print " ";
330 print colored $header_color, "$opts->{HEADER}\n";
332 for ($i = 0; $i < @stuff; $i++) {
333 my $chosen = $chosen[$i] ? '*' : ' ';
334 my $print = $stuff[$i];
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];
341 elsif ($ref eq 'HASH') {
342 my $value = $highlighted || $print->{VALUE};
343 $print = sprintf($status_fmt,
344 $print->{INDEX},
345 $print->{FILE},
346 $value);
348 else {
349 $print = $highlighted || $print;
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;
357 else {
358 print "\n";
359 $last_lf = 1;
362 if (!$last_lf) {
363 print "\n";
366 return if ($opts->{LIST_ONLY});
368 print colored $prompt_color, $opts->{PROMPT};
369 if ($opts->{SINGLETON}) {
370 print "> ";
372 else {
373 print ">> ";
375 my $line = <STDIN>;
376 if (!$line) {
377 print "\n";
378 $opts->{ON_EOF}->() if $opts->{ON_EOF};
379 last;
381 chomp $line;
382 last if $line eq '';
383 if ($line eq '?') {
384 $opts->{SINGLETON} ?
385 singleton_prompt_help_cmd() :
386 prompt_help_cmd();
387 next TOPLOOP;
389 for my $choice (split(/[\s,]+/, $line)) {
390 my $choose = 1;
391 my ($bottom, $top);
393 # Input that begins with '-'; unchoose
394 if ($choice =~ s/^-//) {
395 $choose = 0;
397 # A range can be specified like 5-7
398 if ($choice =~ /^(\d+)-(\d+)$/) {
399 ($bottom, $top) = ($1, $2);
401 elsif ($choice =~ /^\d+$/) {
402 $bottom = $top = $choice;
404 elsif ($choice eq '*') {
405 $bottom = 1;
406 $top = 1 + @stuff;
408 else {
409 $bottom = $top = find_unique($choice, @stuff);
410 if (!defined $bottom) {
411 print "Huh ($choice)?\n";
412 next TOPLOOP;
415 if ($opts->{SINGLETON} && $bottom != $top) {
416 print "Huh ($choice)?\n";
417 next TOPLOOP;
419 for ($i = $bottom-1; $i <= $top-1; $i++) {
420 next if (@stuff <= $i || $i < 0);
421 $chosen[$i] = $choose;
424 last if ($opts->{IMMEDIATE} || $line eq '*');
426 for ($i = 0; $i < @stuff; $i++) {
427 if ($chosen[$i]) {
428 push @return, $stuff[$i];
431 return @return;
434 sub singleton_prompt_help_cmd {
435 print colored $help_color, <<\EOF ;
436 Prompt help:
437 1 - select a numbered item
438 foo - select item based on unique prefix
439 - (empty) select nothing
443 sub prompt_help_cmd {
444 print colored $help_color, <<\EOF ;
445 Prompt help:
446 1 - select a single item
447 3-5 - select a range of items
448 2-3,6-9 - select multiple ranges
449 foo - select item based on unique prefix
450 -... - unselect specified items
451 * - choose all items
452 - (empty) finish selecting
456 sub status_cmd {
457 list_and_choose({ LIST_ONLY => 1, HEADER => $status_head },
458 list_modified());
459 print "\n";
462 sub say_n_paths {
463 my $did = shift @_;
464 my $cnt = scalar @_;
465 print "$did ";
466 if (1 < $cnt) {
467 print "$cnt paths\n";
469 else {
470 print "one path\n";
474 sub update_cmd {
475 my @mods = list_modified('file-only');
476 return if (!@mods);
478 my @update = list_and_choose({ PROMPT => 'Update',
479 HEADER => $status_head, },
480 @mods);
481 if (@update) {
482 system(qw(git update-index --add --remove --),
483 map { $_->{VALUE} } @update);
484 say_n_paths('updated', @update);
486 print "\n";
489 sub revert_cmd {
490 my @update = list_and_choose({ PROMPT => 'Revert',
491 HEADER => $status_head, },
492 list_modified());
493 if (@update) {
494 if (is_initial_commit()) {
495 system(qw(git rm --cached),
496 map { $_->{VALUE} } @update);
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 $_;
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";
517 refresh();
518 say_n_paths('reverted', @update);
520 print "\n";
523 sub 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);
530 print "\n";
533 sub parse_diff {
534 my ($path) = @_;
535 my @diff = run_cmd_pipe(qw(git diff-files -p --), $path);
536 my @colored = ();
537 if ($diff_use_color) {
538 @colored = run_cmd_pipe(qw(git diff-files -p --color --), $path);
540 my (@hunk) = { TEXT => [], DISPLAY => [] };
542 for (my $i = 0; $i < @diff; $i++) {
543 if ($diff[$i] =~ /^@@ /) {
544 push @hunk, { TEXT => [], DISPLAY => [] };
546 push @{$hunk[-1]{TEXT}}, $diff[$i];
547 push @{$hunk[-1]{DISPLAY}},
548 ($diff_use_color ? $colored[$i] : $diff[$i]);
550 return @hunk;
553 sub parse_diff_header {
554 my $src = shift;
556 my $head = { TEXT => [], DISPLAY => [] };
557 my $mode = { TEXT => [], DISPLAY => [] };
559 for (my $i = 0; $i < @{$src->{TEXT}}; $i++) {
560 my $dest = $src->{TEXT}->[$i] =~ /^(old|new) mode (\d+)$/ ?
561 $mode : $head;
562 push @{$dest->{TEXT}}, $src->{TEXT}->[$i];
563 push @{$dest->{DISPLAY}}, $src->{DISPLAY}->[$i];
565 return ($head, $mode);
568 sub hunk_splittable {
569 my ($text) = @_;
571 my @s = split_hunk($text);
572 return (1 < @s);
575 sub parse_hunk_header {
576 my ($line) = @_;
577 my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
578 $line =~ /^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/;
579 $o_cnt = 1 unless defined $o_cnt;
580 $n_cnt = 1 unless defined $n_cnt;
581 return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
584 sub split_hunk {
585 my ($text, $display) = @_;
586 my @split = ();
587 if (!defined $display) {
588 $display = $text;
590 # If there are context lines in the middle of a hunk,
591 # it can be split, but we would need to take care of
592 # overlaps later.
594 my ($o_ofs, undef, $n_ofs) = parse_hunk_header($text->[0]);
595 my $hunk_start = 1;
597 OUTER:
598 while (1) {
599 my $next_hunk_start = undef;
600 my $i = $hunk_start - 1;
601 my $this = +{
602 TEXT => [],
603 DISPLAY => [],
604 OLD => $o_ofs,
605 NEW => $n_ofs,
606 OCNT => 0,
607 NCNT => 0,
608 ADDDEL => 0,
609 POSTCTX => 0,
610 USE => undef,
613 while (++$i < @$text) {
614 my $line = $text->[$i];
615 my $display = $display->[$i];
616 if ($line =~ /^ /) {
617 if ($this->{ADDDEL} &&
618 !defined $next_hunk_start) {
619 # We have seen leading context and
620 # adds/dels and then here is another
621 # context, which is trailing for this
622 # split hunk and leading for the next
623 # one.
624 $next_hunk_start = $i;
626 push @{$this->{TEXT}}, $line;
627 push @{$this->{DISPLAY}}, $display;
628 $this->{OCNT}++;
629 $this->{NCNT}++;
630 if (defined $next_hunk_start) {
631 $this->{POSTCTX}++;
633 next;
636 # add/del
637 if (defined $next_hunk_start) {
638 # We are done with the current hunk and
639 # this is the first real change for the
640 # next split one.
641 $hunk_start = $next_hunk_start;
642 $o_ofs = $this->{OLD} + $this->{OCNT};
643 $n_ofs = $this->{NEW} + $this->{NCNT};
644 $o_ofs -= $this->{POSTCTX};
645 $n_ofs -= $this->{POSTCTX};
646 push @split, $this;
647 redo OUTER;
649 push @{$this->{TEXT}}, $line;
650 push @{$this->{DISPLAY}}, $display;
651 $this->{ADDDEL}++;
652 if ($line =~ /^-/) {
653 $this->{OCNT}++;
655 else {
656 $this->{NCNT}++;
660 push @split, $this;
661 last;
664 for my $hunk (@split) {
665 $o_ofs = $hunk->{OLD};
666 $n_ofs = $hunk->{NEW};
667 my $o_cnt = $hunk->{OCNT};
668 my $n_cnt = $hunk->{NCNT};
670 my $head = ("@@ -$o_ofs" .
671 (($o_cnt != 1) ? ",$o_cnt" : '') .
672 " +$n_ofs" .
673 (($n_cnt != 1) ? ",$n_cnt" : '') .
674 " @@\n");
675 my $display_head = $head;
676 unshift @{$hunk->{TEXT}}, $head;
677 if ($diff_use_color) {
678 $display_head = colored($fraginfo_color, $head);
680 unshift @{$hunk->{DISPLAY}}, $display_head;
682 return @split;
686 sub help_patch_cmd {
687 print colored $help_color, <<\EOF ;
688 y - stage this hunk
689 n - do not stage this hunk
690 a - stage this and all the remaining hunks in the file
691 d - do not stage this hunk nor any of the remaining hunks in the file
692 j - leave this hunk undecided, see next undecided hunk
693 J - leave this hunk undecided, see next hunk
694 k - leave this hunk undecided, see previous undecided hunk
695 K - leave this hunk undecided, see previous hunk
696 s - split the current hunk into smaller hunks
697 ? - print help
701 sub patch_update_cmd {
702 my @mods = grep { !($_->{BINARY}) } list_modified('file-only');
703 my @them;
705 if (!@mods) {
706 print STDERR "No changes.\n";
707 return 0;
709 if ($patch_mode) {
710 @them = @mods;
712 else {
713 @them = list_and_choose({ PROMPT => 'Patch update',
714 HEADER => $status_head, },
715 @mods);
717 for (@them) {
718 patch_update_file($_->{VALUE});
722 sub patch_update_file {
723 my ($ix, $num);
724 my $path = shift;
725 my ($head, @hunk) = parse_diff($path);
726 ($head, my $mode) = parse_diff_header($head);
727 for (@{$head->{DISPLAY}}) {
728 print;
731 if (@{$mode->{TEXT}}) {
732 while (1) {
733 print @{$mode->{DISPLAY}};
734 print colored $prompt_color,
735 "Stage mode change [y/n/a/d/?]? ";
736 my $line = <STDIN>;
737 if ($line =~ /^y/i) {
738 $mode->{USE} = 1;
739 last;
741 elsif ($line =~ /^n/i) {
742 $mode->{USE} = 0;
743 last;
745 elsif ($line =~ /^a/i) {
746 $_->{USE} = 1 foreach ($mode, @hunk);
747 last;
749 elsif ($line =~ /^d/i) {
750 $_->{USE} = 0 foreach ($mode, @hunk);
751 last;
753 else {
754 help_patch_cmd('');
755 next;
760 $num = scalar @hunk;
761 $ix = 0;
763 while (1) {
764 my ($prev, $next, $other, $undecided, $i);
765 $other = '';
767 if ($num <= $ix) {
768 $ix = 0;
770 for ($i = 0; $i < $ix; $i++) {
771 if (!defined $hunk[$i]{USE}) {
772 $prev = 1;
773 $other .= '/k';
774 last;
777 if ($ix) {
778 $other .= '/K';
780 for ($i = $ix + 1; $i < $num; $i++) {
781 if (!defined $hunk[$i]{USE}) {
782 $next = 1;
783 $other .= '/j';
784 last;
787 if ($ix < $num - 1) {
788 $other .= '/J';
790 for ($i = 0; $i < $num; $i++) {
791 if (!defined $hunk[$i]{USE}) {
792 $undecided = 1;
793 last;
796 last if (!$undecided);
798 if (hunk_splittable($hunk[$ix]{TEXT})) {
799 $other .= '/s';
801 for (@{$hunk[$ix]{DISPLAY}}) {
802 print;
804 print colored $prompt_color, "Stage this hunk [y/n/a/d$other/?]? ";
805 my $line = <STDIN>;
806 if ($line) {
807 if ($line =~ /^y/i) {
808 $hunk[$ix]{USE} = 1;
810 elsif ($line =~ /^n/i) {
811 $hunk[$ix]{USE} = 0;
813 elsif ($line =~ /^a/i) {
814 while ($ix < $num) {
815 if (!defined $hunk[$ix]{USE}) {
816 $hunk[$ix]{USE} = 1;
818 $ix++;
820 next;
822 elsif ($line =~ /^d/i) {
823 while ($ix < $num) {
824 if (!defined $hunk[$ix]{USE}) {
825 $hunk[$ix]{USE} = 0;
827 $ix++;
829 next;
831 elsif ($other =~ /K/ && $line =~ /^K/) {
832 $ix--;
833 next;
835 elsif ($other =~ /J/ && $line =~ /^J/) {
836 $ix++;
837 next;
839 elsif ($other =~ /k/ && $line =~ /^k/) {
840 while (1) {
841 $ix--;
842 last if (!$ix ||
843 !defined $hunk[$ix]{USE});
845 next;
847 elsif ($other =~ /j/ && $line =~ /^j/) {
848 while (1) {
849 $ix++;
850 last if ($ix >= $num ||
851 !defined $hunk[$ix]{USE});
853 next;
855 elsif ($other =~ /s/ && $line =~ /^s/) {
856 my @split = split_hunk($hunk[$ix]{TEXT}, $hunk[$ix]{DISPLAY});
857 if (1 < @split) {
858 print colored $header_color, "Split into ",
859 scalar(@split), " hunks.\n";
861 splice (@hunk, $ix, 1, @split);
862 $num = scalar @hunk;
863 next;
865 else {
866 help_patch_cmd($other);
867 next;
869 # soft increment
870 while (1) {
871 $ix++;
872 last if ($ix >= $num ||
873 !defined $hunk[$ix]{USE});
878 my $n_lofs = 0;
879 my @result = ();
880 if ($mode->{USE}) {
881 push @result, @{$mode->{TEXT}};
883 for (@hunk) {
884 if ($_->{USE}) {
885 push @result, @{$_->{TEXT}};
889 if (@result) {
890 my $fh;
892 open $fh, '| git apply --cached --recount';
893 for (@{$head->{TEXT}}, @result) {
894 print $fh $_;
896 if (!close $fh) {
897 for (@{$head->{TEXT}}, @result) {
898 print STDERR $_;
901 refresh();
904 print "\n";
907 sub diff_cmd {
908 my @mods = list_modified('index-only');
909 @mods = grep { !($_->{BINARY}) } @mods;
910 return if (!@mods);
911 my (@them) = list_and_choose({ PROMPT => 'Review diff',
912 IMMEDIATE => 1,
913 HEADER => $status_head, },
914 @mods);
915 return if (!@them);
916 my $reference = is_initial_commit() ? get_empty_tree() : 'HEAD';
917 system(qw(git diff -p --cached), $reference, '--',
918 map { $_->{VALUE} } @them);
921 sub quit_cmd {
922 print "Bye.\n";
923 exit(0);
926 sub help_cmd {
927 print colored $help_color, <<\EOF ;
928 status - show paths with changes
929 update - add working tree state to the staged set of changes
930 revert - revert staged set of changes back to the HEAD version
931 patch - pick hunks and update selectively
932 diff - view diff between HEAD and index
933 add untracked - add contents of untracked files to the staged set of changes
937 sub process_args {
938 return unless @ARGV;
939 my $arg = shift @ARGV;
940 if ($arg eq "--patch") {
941 $patch_mode = 1;
942 $arg = shift @ARGV or die "missing --";
943 die "invalid argument $arg, expecting --"
944 unless $arg eq "--";
946 elsif ($arg ne "--") {
947 die "invalid argument $arg, expecting --";
951 sub main_loop {
952 my @cmd = ([ 'status', \&status_cmd, ],
953 [ 'update', \&update_cmd, ],
954 [ 'revert', \&revert_cmd, ],
955 [ 'add untracked', \&add_untracked_cmd, ],
956 [ 'patch', \&patch_update_cmd, ],
957 [ 'diff', \&diff_cmd, ],
958 [ 'quit', \&quit_cmd, ],
959 [ 'help', \&help_cmd, ],
961 while (1) {
962 my ($it) = list_and_choose({ PROMPT => 'What now',
963 SINGLETON => 1,
964 LIST_FLAT => 4,
965 HEADER => '*** Commands ***',
966 ON_EOF => \&quit_cmd,
967 IMMEDIATE => 1 }, @cmd);
968 if ($it) {
969 eval {
970 $it->[1]->();
972 if ($@) {
973 print "$@";
979 process_args();
980 refresh();
981 if ($patch_mode) {
982 patch_update_cmd();
984 else {
985 status_cmd();
986 main_loop();