1#!/usr/bin/perl -w
2use strict;
4# command line options
6my $patch_mode;
7sub 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}
20my ($GIT_DIR) = run_cmd_pipe(qw(git rev-parse --git-dir));
22if (!defined $GIT_DIR) {
24 exit(1); # rev-parse would have already said "not a git repo"
25}
26chomp($GIT_DIR);
27sub 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}
37sub list_untracked {
39 map {
40 chomp $_;
41 $_;
42 }
43 run_cmd_pipe(qw(git ls-files --others --exclude-standard --), @ARGV);
44}
45my $status_fmt = '%12s %12s %s';
47my $status_head = sprintf($status_fmt, 'staged', 'unstaged', 'path');
48# 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?
56sub list_modified {
58 my ($only) = @_;
59 my (%data, @return);
60 my ($add, $del, $adddel, $file);
61 my @tracked = ();
62 if (@ARGV) {
64 @tracked = map {
65 chomp $_; $_;
66 } run_cmd_pipe(qw(git ls-files --exclude-standard --), @ARGV);
67 return if (!@tracked);
68 }
69 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 }
93 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 }
121 for (sort keys %data) {
123 my $it = $data{$_};
124 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}
140sub 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}
169# inserts string into trie and updates count for each character
171sub update_trie {
172 my ($trie, $string) = @_;
173 foreach (split //, $string) {
174 $trie = $trie->{$_} ||= {COUNT => 0};
175 $trie->{COUNT}++;
176 }
177}
178# returns an array of tuples (prefix, remainder)
180sub find_unique_prefixes {
181 my @stuff = @_;
182 my @return = ();
183 # 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;
189 # 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 }
202 # 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}
232# filters out prefixes which have special meaning to list_and_choose()
234sub 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 ($prefix ne '?'); # prompt help
242}
243# given a prefix/remainder tuple return a string with the prefix highlighted
245# for now use square brackets; later might use ANSI colors (underline, bold)
246sub highlight_prefix {
247 my $prefix = shift;
248 my $remainder = shift;
249 return $remainder unless defined $prefix;
250 return is_valid_prefix($prefix) ?
251 "[$prefix]$remainder" :
252 "$prefix$remainder";
253}
254sub list_and_choose {
256 my ($opts, @stuff) = @_;
257 my (@chosen, @return);
258 my $i;
259 my @prefixes = find_unique_prefixes(@stuff) unless $opts->{LIST_ONLY};
260 TOPLOOP:
262 while (1) {
263 my $last_lf = 0;
264 if ($opts->{HEADER}) {
266 if (!$opts->{LIST_FLAT}) {
267 print " ";
268 }
269 print "$opts->{HEADER}\n";
270 }
271 for ($i = 0; $i < @stuff; $i++) {
272 my $chosen = $chosen[$i] ? '*' : ' ';
273 my $print = $stuff[$i];
274 my $ref = ref $print;
275 my $highlighted = highlight_prefix(@{$prefixes[$i]})
276 if @prefixes;
277 if ($ref eq 'ARRAY') {
278 $print = $highlighted || $print->[0];
279 }
280 elsif ($ref eq 'HASH') {
281 my $value = $highlighted || $print->{VALUE};
282 $print = sprintf($status_fmt,
283 $print->{INDEX},
284 $print->{FILE},
285 $value);
286 }
287 else {
288 $print = $highlighted || $print;
289 }
290 printf("%s%2d: %s", $chosen, $i+1, $print);
291 if (($opts->{LIST_FLAT}) &&
292 (($i + 1) % ($opts->{LIST_FLAT}))) {
293 print "\t";
294 $last_lf = 0;
295 }
296 else {
297 print "\n";
298 $last_lf = 1;
299 }
300 }
301 if (!$last_lf) {
302 print "\n";
303 }
304 return if ($opts->{LIST_ONLY});
306 print $opts->{PROMPT};
308 if ($opts->{SINGLETON}) {
309 print "> ";
310 }
311 else {
312 print ">> ";
313 }
314 my $line = <STDIN>;
315 if (!$line) {
316 print "\n";
317 $opts->{ON_EOF}->() if $opts->{ON_EOF};
318 last;
319 }
320 chomp $line;
321 last if $line eq '';
322 if ($line eq '?') {
323 $opts->{SINGLETON} ?
324 singleton_prompt_help_cmd() :
325 prompt_help_cmd();
326 next TOPLOOP;
327 }
328 for my $choice (split(/[\s,]+/, $line)) {
329 my $choose = 1;
330 my ($bottom, $top);
331 # Input that begins with '-'; unchoose
333 if ($choice =~ s/^-//) {
334 $choose = 0;
335 }
336 # A range can be specified like 5-7
337 if ($choice =~ /^(\d+)-(\d+)$/) {
338 ($bottom, $top) = ($1, $2);
339 }
340 elsif ($choice =~ /^\d+$/) {
341 $bottom = $top = $choice;
342 }
343 elsif ($choice eq '*') {
344 $bottom = 1;
345 $top = 1 + @stuff;
346 }
347 else {
348 $bottom = $top = find_unique($choice, @stuff);
349 if (!defined $bottom) {
350 print "Huh ($choice)?\n";
351 next TOPLOOP;
352 }
353 }
354 if ($opts->{SINGLETON} && $bottom != $top) {
355 print "Huh ($choice)?\n";
356 next TOPLOOP;
357 }
358 for ($i = $bottom-1; $i <= $top-1; $i++) {
359 next if (@stuff <= $i || $i < 0);
360 $chosen[$i] = $choose;
361 }
362 }
363 last if ($opts->{IMMEDIATE} || $line eq '*');
364 }
365 for ($i = 0; $i < @stuff; $i++) {
366 if ($chosen[$i]) {
367 push @return, $stuff[$i];
368 }
369 }
370 return @return;
371}
372sub singleton_prompt_help_cmd {
374 print <<\EOF ;
375Prompt help:
3761 - select a numbered item
377foo - select item based on unique prefix
378 - (empty) select nothing
379EOF
380}
381sub prompt_help_cmd {
383 print <<\EOF ;
384Prompt help:
3851 - select a single item
3863-5 - select a range of items
3872-3,6-9 - select multiple ranges
388foo - select item based on unique prefix
389-... - unselect specified items
390* - choose all items
391 - (empty) finish selecting
392EOF
393}
394sub status_cmd {
396 list_and_choose({ LIST_ONLY => 1, HEADER => $status_head },
397 list_modified());
398 print "\n";
399}
400sub say_n_paths {
402 my $did = shift @_;
403 my $cnt = scalar @_;
404 print "$did ";
405 if (1 < $cnt) {
406 print "$cnt paths\n";
407 }
408 else {
409 print "one path\n";
410 }
411}
412sub update_cmd {
414 my @mods = list_modified('file-only');
415 return if (!@mods);
416 my @update = list_and_choose({ PROMPT => 'Update',
418 HEADER => $status_head, },
419 @mods);
420 if (@update) {
421 system(qw(git update-index --add --remove --),
422 map { $_->{VALUE} } @update);
423 say_n_paths('updated', @update);
424 }
425 print "\n";
426}
427sub revert_cmd {
429 my @update = list_and_choose({ PROMPT => 'Revert',
430 HEADER => $status_head, },
431 list_modified());
432 if (@update) {
433 my @lines = run_cmd_pipe(qw(git ls-tree HEAD --),
434 map { $_->{VALUE} } @update);
435 my $fh;
436 open $fh, '| git update-index --index-info'
437 or die;
438 for (@lines) {
439 print $fh $_;
440 }
441 close($fh);
442 for (@update) {
443 if ($_->{INDEX_ADDDEL} &&
444 $_->{INDEX_ADDDEL} eq 'create') {
445 system(qw(git update-index --force-remove --),
446 $_->{VALUE});
447 print "note: $_->{VALUE} is untracked now.\n";
448 }
449 }
450 refresh();
451 say_n_paths('reverted', @update);
452 }
453 print "\n";
454}
455sub add_untracked_cmd {
457 my @add = list_and_choose({ PROMPT => 'Add untracked' },
458 list_untracked());
459 if (@add) {
460 system(qw(git update-index --add --), @add);
461 say_n_paths('added', @add);
462 }
463 print "\n";
464}
465sub parse_diff {
467 my ($path) = @_;
468 my @diff = run_cmd_pipe(qw(git diff-files -p --), $path);
469 my (@hunk) = { TEXT => [] };
470 for (@diff) {
472 if (/^@@ /) {
473 push @hunk, { TEXT => [] };
474 }
475 push @{$hunk[-1]{TEXT}}, $_;
476 }
477 return @hunk;
478}
479sub hunk_splittable {
481 my ($text) = @_;
482 my @s = split_hunk($text);
484 return (1 < @s);
485}
486sub parse_hunk_header {
488 my ($line) = @_;
489 my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
490 $line =~ /^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/;
491 $o_cnt = 1 unless defined $o_cnt;
492 $n_cnt = 1 unless defined $n_cnt;
493 return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
494}
495sub split_hunk {
497 my ($text) = @_;
498 my @split = ();
499 # If there are context lines in the middle of a hunk,
501 # it can be split, but we would need to take care of
502 # overlaps later.
503 my ($o_ofs, undef, $n_ofs) = parse_hunk_header($text->[0]);
505 my $hunk_start = 1;
506 OUTER:
508 while (1) {
509 my $next_hunk_start = undef;
510 my $i = $hunk_start - 1;
511 my $this = +{
512 TEXT => [],
513 OLD => $o_ofs,
514 NEW => $n_ofs,
515 OCNT => 0,
516 NCNT => 0,
517 ADDDEL => 0,
518 POSTCTX => 0,
519 };
520 while (++$i < @$text) {
522 my $line = $text->[$i];
523 if ($line =~ /^ /) {
524 if ($this->{ADDDEL} &&
525 !defined $next_hunk_start) {
526 # We have seen leading context and
527 # adds/dels and then here is another
528 # context, which is trailing for this
529 # split hunk and leading for the next
530 # one.
531 $next_hunk_start = $i;
532 }
533 push @{$this->{TEXT}}, $line;
534 $this->{OCNT}++;
535 $this->{NCNT}++;
536 if (defined $next_hunk_start) {
537 $this->{POSTCTX}++;
538 }
539 next;
540 }
541 # add/del
543 if (defined $next_hunk_start) {
544 # We are done with the current hunk and
545 # this is the first real change for the
546 # next split one.
547 $hunk_start = $next_hunk_start;
548 $o_ofs = $this->{OLD} + $this->{OCNT};
549 $n_ofs = $this->{NEW} + $this->{NCNT};
550 $o_ofs -= $this->{POSTCTX};
551 $n_ofs -= $this->{POSTCTX};
552 push @split, $this;
553 redo OUTER;
554 }
555 push @{$this->{TEXT}}, $line;
556 $this->{ADDDEL}++;
557 if ($line =~ /^-/) {
558 $this->{OCNT}++;
559 }
560 else {
561 $this->{NCNT}++;
562 }
563 }
564 push @split, $this;
566 last;
567 }
568 for my $hunk (@split) {
570 $o_ofs = $hunk->{OLD};
571 $n_ofs = $hunk->{NEW};
572 my $o_cnt = $hunk->{OCNT};
573 my $n_cnt = $hunk->{NCNT};
574 my $head = ("@@ -$o_ofs" .
576 (($o_cnt != 1) ? ",$o_cnt" : '') .
577 " +$n_ofs" .
578 (($n_cnt != 1) ? ",$n_cnt" : '') .
579 " @@\n");
580 unshift @{$hunk->{TEXT}}, $head;
581 }
582 return map { $_->{TEXT} } @split;
583}
584sub find_last_o_ctx {
586 my ($it) = @_;
587 my $text = $it->{TEXT};
588 my ($o_ofs, $o_cnt) = parse_hunk_header($text->[0]);
589 my $i = @{$text};
590 my $last_o_ctx = $o_ofs + $o_cnt;
591 while (0 < --$i) {
592 my $line = $text->[$i];
593 if ($line =~ /^ /) {
594 $last_o_ctx--;
595 next;
596 }
597 last;
598 }
599 return $last_o_ctx;
600}
601sub merge_hunk {
603 my ($prev, $this) = @_;
604 my ($o0_ofs, $o0_cnt, $n0_ofs, $n0_cnt) =
605 parse_hunk_header($prev->{TEXT}[0]);
606 my ($o1_ofs, $o1_cnt, $n1_ofs, $n1_cnt) =
607 parse_hunk_header($this->{TEXT}[0]);
608 my (@line, $i, $ofs, $o_cnt, $n_cnt);
610 $ofs = $o0_ofs;
611 $o_cnt = $n_cnt = 0;
612 for ($i = 1; $i < @{$prev->{TEXT}}; $i++) {
613 my $line = $prev->{TEXT}[$i];
614 if ($line =~ /^\+/) {
615 $n_cnt++;
616 push @line, $line;
617 next;
618 }
619 last if ($o1_ofs <= $ofs);
621 $o_cnt++;
623 $ofs++;
624 if ($line =~ /^ /) {
625 $n_cnt++;
626 }
627 push @line, $line;
628 }
629 for ($i = 1; $i < @{$this->{TEXT}}; $i++) {
631 my $line = $this->{TEXT}[$i];
632 if ($line =~ /^\+/) {
633 $n_cnt++;
634 push @line, $line;
635 next;
636 }
637 $ofs++;
638 $o_cnt++;
639 if ($line =~ /^ /) {
640 $n_cnt++;
641 }
642 push @line, $line;
643 }
644 my $head = ("@@ -$o0_ofs" .
645 (($o_cnt != 1) ? ",$o_cnt" : '') .
646 " +$n0_ofs" .
647 (($n_cnt != 1) ? ",$n_cnt" : '') .
648 " @@\n");
649 @{$prev->{TEXT}} = ($head, @line);
650}
651sub coalesce_overlapping_hunks {
653 my (@in) = @_;
654 my @out = ();
655 my ($last_o_ctx);
657 for (grep { $_->{USE} } @in) {
659 my $text = $_->{TEXT};
660 my ($o_ofs) = parse_hunk_header($text->[0]);
661 if (defined $last_o_ctx &&
662 $o_ofs <= $last_o_ctx) {
663 merge_hunk($out[-1], $_);
664 }
665 else {
666 push @out, $_;
667 }
668 $last_o_ctx = find_last_o_ctx($out[-1]);
669 }
670 return @out;
671}
672sub help_patch_cmd {
674 print <<\EOF ;
675y - stage this hunk
676n - do not stage this hunk
677a - stage this and all the remaining hunks in the file
678d - do not stage this hunk nor any of the remaining hunks in the file
679j - leave this hunk undecided, see next undecided hunk
680J - leave this hunk undecided, see next hunk
681k - leave this hunk undecided, see previous undecided hunk
682K - leave this hunk undecided, see previous hunk
683s - split the current hunk into smaller hunks
684? - print help
685EOF
686}
687sub patch_update_cmd {
689 my @mods = grep { !($_->{BINARY}) } list_modified('file-only');
690 my @them;
691 if (!@mods) {
693 print STDERR "No changes.\n";
694 return 0;
695 }
696 if ($patch_mode) {
697 @them = @mods;
698 }
699 else {
700 @them = list_and_choose({ PROMPT => 'Patch update',
701 HEADER => $status_head, },
702 @mods);
703 }
704 for (@them) {
705 patch_update_file($_->{VALUE});
706 }
707}
708sub patch_update_file {
710 my ($ix, $num);
711 my $path = shift;
712 my ($head, @hunk) = parse_diff($path);
713 for (@{$head->{TEXT}}) {
714 print;
715 }
716 $num = scalar @hunk;
717 $ix = 0;
718 while (1) {
720 my ($prev, $next, $other, $undecided, $i);
721 $other = '';
722 if ($num <= $ix) {
724 $ix = 0;
725 }
726 for ($i = 0; $i < $ix; $i++) {
727 if (!defined $hunk[$i]{USE}) {
728 $prev = 1;
729 $other .= '/k';
730 last;
731 }
732 }
733 if ($ix) {
734 $other .= '/K';
735 }
736 for ($i = $ix + 1; $i < $num; $i++) {
737 if (!defined $hunk[$i]{USE}) {
738 $next = 1;
739 $other .= '/j';
740 last;
741 }
742 }
743 if ($ix < $num - 1) {
744 $other .= '/J';
745 }
746 for ($i = 0; $i < $num; $i++) {
747 if (!defined $hunk[$i]{USE}) {
748 $undecided = 1;
749 last;
750 }
751 }
752 last if (!$undecided);
753 if (hunk_splittable($hunk[$ix]{TEXT})) {
755 $other .= '/s';
756 }
757 for (@{$hunk[$ix]{TEXT}}) {
758 print;
759 }
760 print "Stage this hunk [y/n/a/d$other/?]? ";
761 my $line = <STDIN>;
762 if ($line) {
763 if ($line =~ /^y/i) {
764 $hunk[$ix]{USE} = 1;
765 }
766 elsif ($line =~ /^n/i) {
767 $hunk[$ix]{USE} = 0;
768 }
769 elsif ($line =~ /^a/i) {
770 while ($ix < $num) {
771 if (!defined $hunk[$ix]{USE}) {
772 $hunk[$ix]{USE} = 1;
773 }
774 $ix++;
775 }
776 next;
777 }
778 elsif ($line =~ /^d/i) {
779 while ($ix < $num) {
780 if (!defined $hunk[$ix]{USE}) {
781 $hunk[$ix]{USE} = 0;
782 }
783 $ix++;
784 }
785 next;
786 }
787 elsif ($other =~ /K/ && $line =~ /^K/) {
788 $ix--;
789 next;
790 }
791 elsif ($other =~ /J/ && $line =~ /^J/) {
792 $ix++;
793 next;
794 }
795 elsif ($other =~ /k/ && $line =~ /^k/) {
796 while (1) {
797 $ix--;
798 last if (!$ix ||
799 !defined $hunk[$ix]{USE});
800 }
801 next;
802 }
803 elsif ($other =~ /j/ && $line =~ /^j/) {
804 while (1) {
805 $ix++;
806 last if ($ix >= $num ||
807 !defined $hunk[$ix]{USE});
808 }
809 next;
810 }
811 elsif ($other =~ /s/ && $line =~ /^s/) {
812 my @split = split_hunk($hunk[$ix]{TEXT});
813 if (1 < @split) {
814 print "Split into ",
815 scalar(@split), " hunks.\n";
816 }
817 splice(@hunk, $ix, 1,
818 map { +{ TEXT => $_, USE => undef } }
819 @split);
820 $num = scalar @hunk;
821 next;
822 }
823 else {
824 help_patch_cmd($other);
825 next;
826 }
827 # soft increment
828 while (1) {
829 $ix++;
830 last if ($ix >= $num ||
831 !defined $hunk[$ix]{USE});
832 }
833 }
834 }
835 @hunk = coalesce_overlapping_hunks(@hunk);
837 my $n_lofs = 0;
839 my @result = ();
840 for (@hunk) {
841 my $text = $_->{TEXT};
842 my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
843 parse_hunk_header($text->[0]);
844 if (!$_->{USE}) {
846 # We would have added ($n_cnt - $o_cnt) lines
847 # to the postimage if we were to use this hunk,
848 # but we didn't. So the line number that the next
849 # hunk starts at would be shifted by that much.
850 $n_lofs -= ($n_cnt - $o_cnt);
851 next;
852 }
853 else {
854 if ($n_lofs) {
855 $n_ofs += $n_lofs;
856 $text->[0] = ("@@ -$o_ofs" .
857 (($o_cnt != 1)
858 ? ",$o_cnt" : '') .
859 " +$n_ofs" .
860 (($n_cnt != 1)
861 ? ",$n_cnt" : '') .
862 " @@\n");
863 }
864 for (@$text) {
865 push @result, $_;
866 }
867 }
868 }
869 if (@result) {
871 my $fh;
872 open $fh, '| git apply --cached';
874 for (@{$head->{TEXT}}, @result) {
875 print $fh $_;
876 }
877 if (!close $fh) {
878 for (@{$head->{TEXT}}, @result) {
879 print STDERR $_;
880 }
881 }
882 refresh();
883 }
884 print "\n";
886}
887sub diff_cmd {
889 my @mods = list_modified('index-only');
890 @mods = grep { !($_->{BINARY}) } @mods;
891 return if (!@mods);
892 my (@them) = list_and_choose({ PROMPT => 'Review diff',
893 IMMEDIATE => 1,
894 HEADER => $status_head, },
895 @mods);
896 return if (!@them);
897 system(qw(git diff-index -p --cached HEAD --),
898 map { $_->{VALUE} } @them);
899}
900sub quit_cmd {
902 print "Bye.\n";
903 exit(0);
904}
905sub help_cmd {
907 print <<\EOF ;
908status - show paths with changes
909update - add working tree state to the staged set of changes
910revert - revert staged set of changes back to the HEAD version
911patch - pick hunks and update selectively
912diff - view diff between HEAD and index
913add untracked - add contents of untracked files to the staged set of changes
914EOF
915}
916sub process_args {
918 return unless @ARGV;
919 my $arg = shift @ARGV;
920 if ($arg eq "--patch") {
921 $patch_mode = 1;
922 $arg = shift @ARGV or die "missing --";
923 die "invalid argument $arg, expecting --"
924 unless $arg eq "--";
925 }
926 elsif ($arg ne "--") {
927 die "invalid argument $arg, expecting --";
928 }
929}
930sub main_loop {
932 my @cmd = ([ 'status', \&status_cmd, ],
933 [ 'update', \&update_cmd, ],
934 [ 'revert', \&revert_cmd, ],
935 [ 'add untracked', \&add_untracked_cmd, ],
936 [ 'patch', \&patch_update_cmd, ],
937 [ 'diff', \&diff_cmd, ],
938 [ 'quit', \&quit_cmd, ],
939 [ 'help', \&help_cmd, ],
940 );
941 while (1) {
942 my ($it) = list_and_choose({ PROMPT => 'What now',
943 SINGLETON => 1,
944 LIST_FLAT => 4,
945 HEADER => '*** Commands ***',
946 ON_EOF => \&quit_cmd,
947 IMMEDIATE => 1 }, @cmd);
948 if ($it) {
949 eval {
950 $it->[1]->();
951 };
952 if ($@) {
953 print "$@";
954 }
955 }
956 }
957}
958process_args();
960refresh();
961if ($patch_mode) {
962 patch_update_cmd();
963}
964else {
965 status_cmd();
966 main_loop();
967}