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