1#!/usr/bin/perl -w
2
3use strict;
4use Git;
5
6my $repo = Git->repository();
7
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 ) : ();
15my $error_color = ();
16if ($menu_use_color) {
17 my $help_color_spec = $repo->config('color.interactive.help');
18 $error_color = $repo->get_color('color.interactive.error',
19 $help_color_spec);
20}
21
22my $diff_use_color = $repo->get_colorbool('color.diff');
23my ($fraginfo_color) =
24 $diff_use_color ? (
25 $repo->get_color('color.diff.frag', 'cyan'),
26 ) : ();
27my ($diff_plain_color) =
28 $diff_use_color ? (
29 $repo->get_color('color.diff.plain', ''),
30 ) : ();
31my ($diff_old_color) =
32 $diff_use_color ? (
33 $repo->get_color('color.diff.old', 'red'),
34 ) : ();
35my ($diff_new_color) =
36 $diff_use_color ? (
37 $repo->get_color('color.diff.new', 'green'),
38 ) : ();
39
40my $normal_color = $repo->get_color("", "reset");
41
42my $use_readkey = 0;
43sub ReadMode;
44sub ReadKey;
45if ($repo->config_bool("interactive.singlekey")) {
46 eval {
47 require Term::ReadKey;
48 Term::ReadKey->import;
49 $use_readkey = 1;
50 };
51}
52
53sub colored {
54 my $color = shift;
55 my $string = join("", @_);
56
57 if (defined $color) {
58 # Put a color code at the beginning of each line, a reset at the end
59 # color after newlines that are not at the end of the string
60 $string =~ s/(\n+)(.)/$1$color$2/g;
61 # reset before newlines
62 $string =~ s/(\n+)/$normal_color$1/g;
63 # codes at beginning and end (if necessary):
64 $string =~ s/^/$color/;
65 $string =~ s/$/$normal_color/ unless $string =~ /\n$/;
66 }
67 return $string;
68}
69
70# command line options
71my $patch_mode;
72
73sub run_cmd_pipe {
74 if ($^O eq 'MSWin32' || $^O eq 'msys') {
75 my @invalid = grep {m/[":*]/} @_;
76 die "$^O does not support: @invalid\n" if @invalid;
77 my @args = map { m/ /o ? "\"$_\"": $_ } @_;
78 return qx{@args};
79 } else {
80 my $fh = undef;
81 open($fh, '-|', @_) or die;
82 return <$fh>;
83 }
84}
85
86my ($GIT_DIR) = run_cmd_pipe(qw(git rev-parse --git-dir));
87
88if (!defined $GIT_DIR) {
89 exit(1); # rev-parse would have already said "not a git repo"
90}
91chomp($GIT_DIR);
92
93sub refresh {
94 my $fh;
95 open $fh, 'git update-index --refresh |'
96 or die;
97 while (<$fh>) {
98 ;# ignore 'needs update'
99 }
100 close $fh;
101}
102
103sub list_untracked {
104 map {
105 chomp $_;
106 $_;
107 }
108 run_cmd_pipe(qw(git ls-files --others --exclude-standard --), @ARGV);
109}
110
111my $status_fmt = '%12s %12s %s';
112my $status_head = sprintf($status_fmt, 'staged', 'unstaged', 'path');
113
114{
115 my $initial;
116 sub is_initial_commit {
117 $initial = system('git rev-parse HEAD -- >/dev/null 2>&1') != 0
118 unless defined $initial;
119 return $initial;
120 }
121}
122
123sub get_empty_tree {
124 return '4b825dc642cb6eb9a060e54bf8d69288fbee4904';
125}
126
127# Returns list of hashes, contents of each of which are:
128# VALUE: pathname
129# BINARY: is a binary path
130# INDEX: is index different from HEAD?
131# FILE: is file different from index?
132# INDEX_ADDDEL: is it add/delete between HEAD and index?
133# FILE_ADDDEL: is it add/delete between index and file?
134
135sub list_modified {
136 my ($only) = @_;
137 my (%data, @return);
138 my ($add, $del, $adddel, $file);
139 my @tracked = ();
140
141 if (@ARGV) {
142 @tracked = map {
143 chomp $_; $_;
144 } run_cmd_pipe(qw(git ls-files --exclude-standard --), @ARGV);
145 return if (!@tracked);
146 }
147
148 my $reference = is_initial_commit() ? get_empty_tree() : 'HEAD';
149 for (run_cmd_pipe(qw(git diff-index --cached
150 --numstat --summary), $reference,
151 '--', @tracked)) {
152 if (($add, $del, $file) =
153 /^([-\d]+) ([-\d]+) (.*)/) {
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} = {
163 INDEX => $change,
164 BINARY => $bin,
165 FILE => 'nothing',
166 }
167 }
168 elsif (($adddel, $file) =
169 /^ (create|delete) mode [0-7]+ (.*)$/) {
170 $data{$file}{INDEX_ADDDEL} = $adddel;
171 }
172 }
173
174 for (run_cmd_pipe(qw(git diff-files --numstat --summary --), @tracked)) {
175 if (($add, $del, $file) =
176 /^([-\d]+) ([-\d]+) (.*)/) {
177 if (!exists $data{$file}) {
178 $data{$file} = +{
179 INDEX => 'unchanged',
180 BINARY => 0,
181 };
182 }
183 my ($change, $bin);
184 if ($add eq '-' && $del eq '-') {
185 $change = 'binary';
186 $bin = 1;
187 }
188 else {
189 $change = "+$add/-$del";
190 }
191 $data{$file}{FILE} = $change;
192 if ($bin) {
193 $data{$file}{BINARY} = 1;
194 }
195 }
196 elsif (($adddel, $file) =
197 /^ (create|delete) mode [0-7]+ (.*)$/) {
198 $data{$file}{FILE_ADDDEL} = $adddel;
199 }
200 }
201
202 for (sort keys %data) {
203 my $it = $data{$_};
204
205 if ($only) {
206 if ($only eq 'index-only') {
207 next if ($it->{INDEX} eq 'unchanged');
208 }
209 if ($only eq 'file-only') {
210 next if ($it->{FILE} eq 'nothing');
211 }
212 }
213 push @return, +{
214 VALUE => $_,
215 %$it,
216 };
217 }
218 return @return;
219}
220
221sub find_unique {
222 my ($string, @stuff) = @_;
223 my $found = undef;
224 for (my $i = 0; $i < @stuff; $i++) {
225 my $it = $stuff[$i];
226 my $hit = undef;
227 if (ref $it) {
228 if ((ref $it) eq 'ARRAY') {
229 $it = $it->[0];
230 }
231 else {
232 $it = $it->{VALUE};
233 }
234 }
235 eval {
236 if ($it =~ /^$string/) {
237 $hit = 1;
238 };
239 };
240 if (defined $hit && defined $found) {
241 return undef;
242 }
243 if ($hit) {
244 $found = $i + 1;
245 }
246 }
247 return $found;
248}
249
250# inserts string into trie and updates count for each character
251sub update_trie {
252 my ($trie, $string) = @_;
253 foreach (split //, $string) {
254 $trie = $trie->{$_} ||= {COUNT => 0};
255 $trie->{COUNT}++;
256 }
257}
258
259# returns an array of tuples (prefix, remainder)
260sub find_unique_prefixes {
261 my @stuff = @_;
262 my @return = ();
263
264 # any single prefix exceeding the soft limit is omitted
265 # if any prefix exceeds the hard limit all are omitted
266 # 0 indicates no limit
267 my $soft_limit = 0;
268 my $hard_limit = 3;
269
270 # build a trie modelling all possible options
271 my %trie;
272 foreach my $print (@stuff) {
273 if ((ref $print) eq 'ARRAY') {
274 $print = $print->[0];
275 }
276 elsif ((ref $print) eq 'HASH') {
277 $print = $print->{VALUE};
278 }
279 update_trie(\%trie, $print);
280 push @return, $print;
281 }
282
283 # use the trie to find the unique prefixes
284 for (my $i = 0; $i < @return; $i++) {
285 my $ret = $return[$i];
286 my @letters = split //, $ret;
287 my %search = %trie;
288 my ($prefix, $remainder);
289 my $j;
290 for ($j = 0; $j < @letters; $j++) {
291 my $letter = $letters[$j];
292 if ($search{$letter}{COUNT} == 1) {
293 $prefix = substr $ret, 0, $j + 1;
294 $remainder = substr $ret, $j + 1;
295 last;
296 }
297 else {
298 my $prefix = substr $ret, 0, $j;
299 return ()
300 if ($hard_limit && $j + 1 > $hard_limit);
301 }
302 %search = %{$search{$letter}};
303 }
304 if ($soft_limit && $j + 1 > $soft_limit) {
305 $prefix = undef;
306 $remainder = $ret;
307 }
308 $return[$i] = [$prefix, $remainder];
309 }
310 return @return;
311}
312
313# filters out prefixes which have special meaning to list_and_choose()
314sub is_valid_prefix {
315 my $prefix = shift;
316 return (defined $prefix) &&
317 !($prefix =~ /[\s,]/) && # separators
318 !($prefix =~ /^-/) && # deselection
319 !($prefix =~ /^\d+/) && # selection
320 ($prefix ne '*') && # "all" wildcard
321 ($prefix ne '?'); # prompt help
322}
323
324# given a prefix/remainder tuple return a string with the prefix highlighted
325# for now use square brackets; later might use ANSI colors (underline, bold)
326sub highlight_prefix {
327 my $prefix = shift;
328 my $remainder = shift;
329
330 if (!defined $prefix) {
331 return $remainder;
332 }
333
334 if (!is_valid_prefix($prefix)) {
335 return "$prefix$remainder";
336 }
337
338 if (!$menu_use_color) {
339 return "[$prefix]$remainder";
340 }
341
342 return "$prompt_color$prefix$normal_color$remainder";
343}
344
345sub error_msg {
346 print STDERR colored $error_color, @_;
347}
348
349sub list_and_choose {
350 my ($opts, @stuff) = @_;
351 my (@chosen, @return);
352 my $i;
353 my @prefixes = find_unique_prefixes(@stuff) unless $opts->{LIST_ONLY};
354
355 TOPLOOP:
356 while (1) {
357 my $last_lf = 0;
358
359 if ($opts->{HEADER}) {
360 if (!$opts->{LIST_FLAT}) {
361 print " ";
362 }
363 print colored $header_color, "$opts->{HEADER}\n";
364 }
365 for ($i = 0; $i < @stuff; $i++) {
366 my $chosen = $chosen[$i] ? '*' : ' ';
367 my $print = $stuff[$i];
368 my $ref = ref $print;
369 my $highlighted = highlight_prefix(@{$prefixes[$i]})
370 if @prefixes;
371 if ($ref eq 'ARRAY') {
372 $print = $highlighted || $print->[0];
373 }
374 elsif ($ref eq 'HASH') {
375 my $value = $highlighted || $print->{VALUE};
376 $print = sprintf($status_fmt,
377 $print->{INDEX},
378 $print->{FILE},
379 $value);
380 }
381 else {
382 $print = $highlighted || $print;
383 }
384 printf("%s%2d: %s", $chosen, $i+1, $print);
385 if (($opts->{LIST_FLAT}) &&
386 (($i + 1) % ($opts->{LIST_FLAT}))) {
387 print "\t";
388 $last_lf = 0;
389 }
390 else {
391 print "\n";
392 $last_lf = 1;
393 }
394 }
395 if (!$last_lf) {
396 print "\n";
397 }
398
399 return if ($opts->{LIST_ONLY});
400
401 print colored $prompt_color, $opts->{PROMPT};
402 if ($opts->{SINGLETON}) {
403 print "> ";
404 }
405 else {
406 print ">> ";
407 }
408 my $line = <STDIN>;
409 if (!$line) {
410 print "\n";
411 $opts->{ON_EOF}->() if $opts->{ON_EOF};
412 last;
413 }
414 chomp $line;
415 last if $line eq '';
416 if ($line eq '?') {
417 $opts->{SINGLETON} ?
418 singleton_prompt_help_cmd() :
419 prompt_help_cmd();
420 next TOPLOOP;
421 }
422 for my $choice (split(/[\s,]+/, $line)) {
423 my $choose = 1;
424 my ($bottom, $top);
425
426 # Input that begins with '-'; unchoose
427 if ($choice =~ s/^-//) {
428 $choose = 0;
429 }
430 # A range can be specified like 5-7 or 5-.
431 if ($choice =~ /^(\d+)-(\d*)$/) {
432 ($bottom, $top) = ($1, length($2) ? $2 : 1 + @stuff);
433 }
434 elsif ($choice =~ /^\d+$/) {
435 $bottom = $top = $choice;
436 }
437 elsif ($choice eq '*') {
438 $bottom = 1;
439 $top = 1 + @stuff;
440 }
441 else {
442 $bottom = $top = find_unique($choice, @stuff);
443 if (!defined $bottom) {
444 error_msg "Huh ($choice)?\n";
445 next TOPLOOP;
446 }
447 }
448 if ($opts->{SINGLETON} && $bottom != $top) {
449 error_msg "Huh ($choice)?\n";
450 next TOPLOOP;
451 }
452 for ($i = $bottom-1; $i <= $top-1; $i++) {
453 next if (@stuff <= $i || $i < 0);
454 $chosen[$i] = $choose;
455 }
456 }
457 last if ($opts->{IMMEDIATE} || $line eq '*');
458 }
459 for ($i = 0; $i < @stuff; $i++) {
460 if ($chosen[$i]) {
461 push @return, $stuff[$i];
462 }
463 }
464 return @return;
465}
466
467sub singleton_prompt_help_cmd {
468 print colored $help_color, <<\EOF ;
469Prompt help:
4701 - select a numbered item
471foo - select item based on unique prefix
472 - (empty) select nothing
473EOF
474}
475
476sub prompt_help_cmd {
477 print colored $help_color, <<\EOF ;
478Prompt help:
4791 - select a single item
4803-5 - select a range of items
4812-3,6-9 - select multiple ranges
482foo - select item based on unique prefix
483-... - unselect specified items
484* - choose all items
485 - (empty) finish selecting
486EOF
487}
488
489sub status_cmd {
490 list_and_choose({ LIST_ONLY => 1, HEADER => $status_head },
491 list_modified());
492 print "\n";
493}
494
495sub say_n_paths {
496 my $did = shift @_;
497 my $cnt = scalar @_;
498 print "$did ";
499 if (1 < $cnt) {
500 print "$cnt paths\n";
501 }
502 else {
503 print "one path\n";
504 }
505}
506
507sub update_cmd {
508 my @mods = list_modified('file-only');
509 return if (!@mods);
510
511 my @update = list_and_choose({ PROMPT => 'Update',
512 HEADER => $status_head, },
513 @mods);
514 if (@update) {
515 system(qw(git update-index --add --remove --),
516 map { $_->{VALUE} } @update);
517 say_n_paths('updated', @update);
518 }
519 print "\n";
520}
521
522sub revert_cmd {
523 my @update = list_and_choose({ PROMPT => 'Revert',
524 HEADER => $status_head, },
525 list_modified());
526 if (@update) {
527 if (is_initial_commit()) {
528 system(qw(git rm --cached),
529 map { $_->{VALUE} } @update);
530 }
531 else {
532 my @lines = run_cmd_pipe(qw(git ls-tree HEAD --),
533 map { $_->{VALUE} } @update);
534 my $fh;
535 open $fh, '| git update-index --index-info'
536 or die;
537 for (@lines) {
538 print $fh $_;
539 }
540 close($fh);
541 for (@update) {
542 if ($_->{INDEX_ADDDEL} &&
543 $_->{INDEX_ADDDEL} eq 'create') {
544 system(qw(git update-index --force-remove --),
545 $_->{VALUE});
546 print "note: $_->{VALUE} is untracked now.\n";
547 }
548 }
549 }
550 refresh();
551 say_n_paths('reverted', @update);
552 }
553 print "\n";
554}
555
556sub add_untracked_cmd {
557 my @add = list_and_choose({ PROMPT => 'Add untracked' },
558 list_untracked());
559 if (@add) {
560 system(qw(git update-index --add --), @add);
561 say_n_paths('added', @add);
562 }
563 print "\n";
564}
565
566sub parse_diff {
567 my ($path) = @_;
568 my @diff = run_cmd_pipe(qw(git diff-files -p --), $path);
569 my @colored = ();
570 if ($diff_use_color) {
571 @colored = run_cmd_pipe(qw(git diff-files -p --color --), $path);
572 }
573 my (@hunk) = { TEXT => [], DISPLAY => [] };
574
575 for (my $i = 0; $i < @diff; $i++) {
576 if ($diff[$i] =~ /^@@ /) {
577 push @hunk, { TEXT => [], DISPLAY => [] };
578 }
579 push @{$hunk[-1]{TEXT}}, $diff[$i];
580 push @{$hunk[-1]{DISPLAY}},
581 ($diff_use_color ? $colored[$i] : $diff[$i]);
582 }
583 return @hunk;
584}
585
586sub parse_diff_header {
587 my $src = shift;
588
589 my $head = { TEXT => [], DISPLAY => [] };
590 my $mode = { TEXT => [], DISPLAY => [] };
591
592 for (my $i = 0; $i < @{$src->{TEXT}}; $i++) {
593 my $dest = $src->{TEXT}->[$i] =~ /^(old|new) mode (\d+)$/ ?
594 $mode : $head;
595 push @{$dest->{TEXT}}, $src->{TEXT}->[$i];
596 push @{$dest->{DISPLAY}}, $src->{DISPLAY}->[$i];
597 }
598 return ($head, $mode);
599}
600
601sub hunk_splittable {
602 my ($text) = @_;
603
604 my @s = split_hunk($text);
605 return (1 < @s);
606}
607
608sub parse_hunk_header {
609 my ($line) = @_;
610 my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
611 $line =~ /^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/;
612 $o_cnt = 1 unless defined $o_cnt;
613 $n_cnt = 1 unless defined $n_cnt;
614 return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
615}
616
617sub split_hunk {
618 my ($text, $display) = @_;
619 my @split = ();
620 if (!defined $display) {
621 $display = $text;
622 }
623 # If there are context lines in the middle of a hunk,
624 # it can be split, but we would need to take care of
625 # overlaps later.
626
627 my ($o_ofs, undef, $n_ofs) = parse_hunk_header($text->[0]);
628 my $hunk_start = 1;
629
630 OUTER:
631 while (1) {
632 my $next_hunk_start = undef;
633 my $i = $hunk_start - 1;
634 my $this = +{
635 TEXT => [],
636 DISPLAY => [],
637 OLD => $o_ofs,
638 NEW => $n_ofs,
639 OCNT => 0,
640 NCNT => 0,
641 ADDDEL => 0,
642 POSTCTX => 0,
643 USE => undef,
644 };
645
646 while (++$i < @$text) {
647 my $line = $text->[$i];
648 my $display = $display->[$i];
649 if ($line =~ /^ /) {
650 if ($this->{ADDDEL} &&
651 !defined $next_hunk_start) {
652 # We have seen leading context and
653 # adds/dels and then here is another
654 # context, which is trailing for this
655 # split hunk and leading for the next
656 # one.
657 $next_hunk_start = $i;
658 }
659 push @{$this->{TEXT}}, $line;
660 push @{$this->{DISPLAY}}, $display;
661 $this->{OCNT}++;
662 $this->{NCNT}++;
663 if (defined $next_hunk_start) {
664 $this->{POSTCTX}++;
665 }
666 next;
667 }
668
669 # add/del
670 if (defined $next_hunk_start) {
671 # We are done with the current hunk and
672 # this is the first real change for the
673 # next split one.
674 $hunk_start = $next_hunk_start;
675 $o_ofs = $this->{OLD} + $this->{OCNT};
676 $n_ofs = $this->{NEW} + $this->{NCNT};
677 $o_ofs -= $this->{POSTCTX};
678 $n_ofs -= $this->{POSTCTX};
679 push @split, $this;
680 redo OUTER;
681 }
682 push @{$this->{TEXT}}, $line;
683 push @{$this->{DISPLAY}}, $display;
684 $this->{ADDDEL}++;
685 if ($line =~ /^-/) {
686 $this->{OCNT}++;
687 }
688 else {
689 $this->{NCNT}++;
690 }
691 }
692
693 push @split, $this;
694 last;
695 }
696
697 for my $hunk (@split) {
698 $o_ofs = $hunk->{OLD};
699 $n_ofs = $hunk->{NEW};
700 my $o_cnt = $hunk->{OCNT};
701 my $n_cnt = $hunk->{NCNT};
702
703 my $head = ("@@ -$o_ofs" .
704 (($o_cnt != 1) ? ",$o_cnt" : '') .
705 " +$n_ofs" .
706 (($n_cnt != 1) ? ",$n_cnt" : '') .
707 " @@\n");
708 my $display_head = $head;
709 unshift @{$hunk->{TEXT}}, $head;
710 if ($diff_use_color) {
711 $display_head = colored($fraginfo_color, $head);
712 }
713 unshift @{$hunk->{DISPLAY}}, $display_head;
714 }
715 return @split;
716}
717
718
719sub color_diff {
720 return map {
721 colored((/^@/ ? $fraginfo_color :
722 /^\+/ ? $diff_new_color :
723 /^-/ ? $diff_old_color :
724 $diff_plain_color),
725 $_);
726 } @_;
727}
728
729sub edit_hunk_manually {
730 my ($oldtext) = @_;
731
732 my $hunkfile = $repo->repo_path . "/addp-hunk-edit.diff";
733 my $fh;
734 open $fh, '>', $hunkfile
735 or die "failed to open hunk edit file for writing: " . $!;
736 print $fh "# Manual hunk edit mode -- see bottom for a quick guide\n";
737 print $fh @$oldtext;
738 print $fh <<EOF;
739# ---
740# To remove '-' lines, make them ' ' lines (context).
741# To remove '+' lines, delete them.
742# Lines starting with # will be removed.
743#
744# If the patch applies cleanly, the edited hunk will immediately be
745# marked for staging. If it does not apply cleanly, you will be given
746# an opportunity to edit again. If all lines of the hunk are removed,
747# then the edit is aborted and the hunk is left unchanged.
748EOF
749 close $fh;
750
751 my $editor = $ENV{GIT_EDITOR} || $repo->config("core.editor")
752 || $ENV{VISUAL} || $ENV{EDITOR} || "vi";
753 system('sh', '-c', $editor.' "$@"', $editor, $hunkfile);
754
755 open $fh, '<', $hunkfile
756 or die "failed to open hunk edit file for reading: " . $!;
757 my @newtext = grep { !/^#/ } <$fh>;
758 close $fh;
759 unlink $hunkfile;
760
761 # Abort if nothing remains
762 if (!grep { /\S/ } @newtext) {
763 return undef;
764 }
765
766 # Reinsert the first hunk header if the user accidentally deleted it
767 if ($newtext[0] !~ /^@/) {
768 unshift @newtext, $oldtext->[0];
769 }
770 return \@newtext;
771}
772
773sub diff_applies {
774 my $fh;
775 open $fh, '| git apply --recount --cached --check';
776 for my $h (@_) {
777 print $fh @{$h->{TEXT}};
778 }
779 return close $fh;
780}
781
782sub _restore_terminal_and_die {
783 ReadMode 'restore';
784 print "\n";
785 exit 1;
786}
787
788sub prompt_single_character {
789 if ($use_readkey) {
790 local $SIG{TERM} = \&_restore_terminal_and_die;
791 local $SIG{INT} = \&_restore_terminal_and_die;
792 ReadMode 'cbreak';
793 my $key = ReadKey 0;
794 ReadMode 'restore';
795 print "$key" if defined $key;
796 print "\n";
797 return $key;
798 } else {
799 return <STDIN>;
800 }
801}
802
803sub prompt_yesno {
804 my ($prompt) = @_;
805 while (1) {
806 print colored $prompt_color, $prompt;
807 my $line = prompt_single_character;
808 return 0 if $line =~ /^n/i;
809 return 1 if $line =~ /^y/i;
810 }
811}
812
813sub edit_hunk_loop {
814 my ($head, $hunk, $ix) = @_;
815 my $text = $hunk->[$ix]->{TEXT};
816
817 while (1) {
818 $text = edit_hunk_manually($text);
819 if (!defined $text) {
820 return undef;
821 }
822 my $newhunk = { TEXT => $text, USE => 1 };
823 if (diff_applies($head,
824 @{$hunk}[0..$ix-1],
825 $newhunk,
826 @{$hunk}[$ix+1..$#{$hunk}])) {
827 $newhunk->{DISPLAY} = [color_diff(@{$text})];
828 return $newhunk;
829 }
830 else {
831 prompt_yesno(
832 'Your edited hunk does not apply. Edit again '
833 . '(saying "no" discards!) [y/n]? '
834 ) or return undef;
835 }
836 }
837}
838
839sub help_patch_cmd {
840 print colored $help_color, <<\EOF ;
841y - stage this hunk
842n - do not stage this hunk
843a - stage this and all the remaining hunks in the file
844d - do not stage this hunk nor any of the remaining hunks in the file
845g - select a hunk to go to
846/ - search for a hunk matching the given regex
847j - leave this hunk undecided, see next undecided hunk
848J - leave this hunk undecided, see next hunk
849k - leave this hunk undecided, see previous undecided hunk
850K - leave this hunk undecided, see previous hunk
851s - split the current hunk into smaller hunks
852e - manually edit the current hunk
853? - print help
854EOF
855}
856
857sub patch_update_cmd {
858 my @all_mods = list_modified('file-only');
859 my @mods = grep { !($_->{BINARY}) } @all_mods;
860 my @them;
861
862 if (!@mods) {
863 if (@all_mods) {
864 print STDERR "Only binary files changed.\n";
865 } else {
866 print STDERR "No changes.\n";
867 }
868 return 0;
869 }
870 if ($patch_mode) {
871 @them = @mods;
872 }
873 else {
874 @them = list_and_choose({ PROMPT => 'Patch update',
875 HEADER => $status_head, },
876 @mods);
877 }
878 for (@them) {
879 patch_update_file($_->{VALUE});
880 }
881}
882
883# Generate a one line summary of a hunk.
884sub summarize_hunk {
885 my $rhunk = shift;
886 my $summary = $rhunk->{TEXT}[0];
887
888 # Keep the line numbers, discard extra context.
889 $summary =~ s/@@(.*?)@@.*/$1 /s;
890 $summary .= " " x (20 - length $summary);
891
892 # Add some user context.
893 for my $line (@{$rhunk->{TEXT}}) {
894 if ($line =~ m/^[+-].*\w/) {
895 $summary .= $line;
896 last;
897 }
898 }
899
900 chomp $summary;
901 return substr($summary, 0, 80) . "\n";
902}
903
904
905# Print a one-line summary of each hunk in the array ref in
906# the first argument, starting wih the index in the 2nd.
907sub display_hunks {
908 my ($hunks, $i) = @_;
909 my $ctr = 0;
910 $i ||= 0;
911 for (; $i < @$hunks && $ctr < 20; $i++, $ctr++) {
912 my $status = " ";
913 if (defined $hunks->[$i]{USE}) {
914 $status = $hunks->[$i]{USE} ? "+" : "-";
915 }
916 printf "%s%2d: %s",
917 $status,
918 $i + 1,
919 summarize_hunk($hunks->[$i]);
920 }
921 return $i;
922}
923
924sub patch_update_file {
925 my ($ix, $num);
926 my $path = shift;
927 my ($head, @hunk) = parse_diff($path);
928 ($head, my $mode) = parse_diff_header($head);
929 for (@{$head->{DISPLAY}}) {
930 print;
931 }
932
933 if (@{$mode->{TEXT}}) {
934 while (1) {
935 print @{$mode->{DISPLAY}};
936 print colored $prompt_color,
937 "Stage mode change [y/n/a/d/?]? ";
938 my $line = prompt_single_character;
939 if ($line =~ /^y/i) {
940 $mode->{USE} = 1;
941 last;
942 }
943 elsif ($line =~ /^n/i) {
944 $mode->{USE} = 0;
945 last;
946 }
947 elsif ($line =~ /^a/i) {
948 $_->{USE} = 1 foreach ($mode, @hunk);
949 last;
950 }
951 elsif ($line =~ /^d/i) {
952 $_->{USE} = 0 foreach ($mode, @hunk);
953 last;
954 }
955 else {
956 help_patch_cmd('');
957 next;
958 }
959 }
960 }
961
962 $num = scalar @hunk;
963 $ix = 0;
964
965 while (1) {
966 my ($prev, $next, $other, $undecided, $i);
967 $other = '';
968
969 if ($num <= $ix) {
970 $ix = 0;
971 }
972 for ($i = 0; $i < $ix; $i++) {
973 if (!defined $hunk[$i]{USE}) {
974 $prev = 1;
975 $other .= ',k';
976 last;
977 }
978 }
979 if ($ix) {
980 $other .= ',K';
981 }
982 for ($i = $ix + 1; $i < $num; $i++) {
983 if (!defined $hunk[$i]{USE}) {
984 $next = 1;
985 $other .= ',j';
986 last;
987 }
988 }
989 if ($ix < $num - 1) {
990 $other .= ',J';
991 }
992 if ($num > 1) {
993 $other .= ',g';
994 }
995 for ($i = 0; $i < $num; $i++) {
996 if (!defined $hunk[$i]{USE}) {
997 $undecided = 1;
998 last;
999 }
1000 }
1001 last if (!$undecided);
1002
1003 if (hunk_splittable($hunk[$ix]{TEXT})) {
1004 $other .= ',s';
1005 }
1006 $other .= ',e';
1007 for (@{$hunk[$ix]{DISPLAY}}) {
1008 print;
1009 }
1010 print colored $prompt_color, "Stage this hunk [y,n,a,d,/$other,?]? ";
1011 my $line = prompt_single_character;
1012 if ($line) {
1013 if ($line =~ /^y/i) {
1014 $hunk[$ix]{USE} = 1;
1015 }
1016 elsif ($line =~ /^n/i) {
1017 $hunk[$ix]{USE} = 0;
1018 }
1019 elsif ($line =~ /^a/i) {
1020 while ($ix < $num) {
1021 if (!defined $hunk[$ix]{USE}) {
1022 $hunk[$ix]{USE} = 1;
1023 }
1024 $ix++;
1025 }
1026 next;
1027 }
1028 elsif ($other =~ /g/ && $line =~ /^g(.*)/) {
1029 my $response = $1;
1030 my $no = $ix > 10 ? $ix - 10 : 0;
1031 while ($response eq '') {
1032 my $extra = "";
1033 $no = display_hunks(\@hunk, $no);
1034 if ($no < $num) {
1035 $extra = " (<ret> to see more)";
1036 }
1037 print "go to which hunk$extra? ";
1038 $response = <STDIN>;
1039 if (!defined $response) {
1040 $response = '';
1041 }
1042 chomp $response;
1043 }
1044 if ($response !~ /^\s*\d+\s*$/) {
1045 error_msg "Invalid number: '$response'\n";
1046 } elsif (0 < $response && $response <= $num) {
1047 $ix = $response - 1;
1048 } else {
1049 error_msg "Sorry, only $num hunks available.\n";
1050 }
1051 next;
1052 }
1053 elsif ($line =~ /^d/i) {
1054 while ($ix < $num) {
1055 if (!defined $hunk[$ix]{USE}) {
1056 $hunk[$ix]{USE} = 0;
1057 }
1058 $ix++;
1059 }
1060 next;
1061 }
1062 elsif ($line =~ m|^/(.*)|) {
1063 my $regex = $1;
1064 if ($1 eq "") {
1065 print colored $prompt_color, "search for regex? ";
1066 $regex = <STDIN>;
1067 if (defined $regex) {
1068 chomp $regex;
1069 }
1070 }
1071 my $search_string;
1072 eval {
1073 $search_string = qr{$regex}m;
1074 };
1075 if ($@) {
1076 my ($err,$exp) = ($@, $1);
1077 $err =~ s/ at .*git-add--interactive line \d+, <STDIN> line \d+.*$//;
1078 error_msg "Malformed search regexp $exp: $err\n";
1079 next;
1080 }
1081 my $iy = $ix;
1082 while (1) {
1083 my $text = join ("", @{$hunk[$iy]{TEXT}});
1084 last if ($text =~ $search_string);
1085 $iy++;
1086 $iy = 0 if ($iy >= $num);
1087 if ($ix == $iy) {
1088 error_msg "No hunk matches the given pattern\n";
1089 last;
1090 }
1091 }
1092 $ix = $iy;
1093 next;
1094 }
1095 elsif ($line =~ /^K/) {
1096 if ($other =~ /K/) {
1097 $ix--;
1098 }
1099 else {
1100 error_msg "No previous hunk\n";
1101 }
1102 next;
1103 }
1104 elsif ($line =~ /^J/) {
1105 if ($other =~ /J/) {
1106 $ix++;
1107 }
1108 else {
1109 error_msg "No next hunk\n";
1110 }
1111 next;
1112 }
1113 elsif ($line =~ /^k/) {
1114 if ($other =~ /k/) {
1115 while (1) {
1116 $ix--;
1117 last if (!$ix ||
1118 !defined $hunk[$ix]{USE});
1119 }
1120 }
1121 else {
1122 error_msg "No previous hunk\n";
1123 }
1124 next;
1125 }
1126 elsif ($line =~ /^j/) {
1127 if ($other !~ /j/) {
1128 error_msg "No next hunk\n";
1129 next;
1130 }
1131 }
1132 elsif ($other =~ /s/ && $line =~ /^s/) {
1133 my @split = split_hunk($hunk[$ix]{TEXT}, $hunk[$ix]{DISPLAY});
1134 if (1 < @split) {
1135 print colored $header_color, "Split into ",
1136 scalar(@split), " hunks.\n";
1137 }
1138 splice (@hunk, $ix, 1, @split);
1139 $num = scalar @hunk;
1140 next;
1141 }
1142 elsif ($line =~ /^e/) {
1143 my $newhunk = edit_hunk_loop($head, \@hunk, $ix);
1144 if (defined $newhunk) {
1145 splice @hunk, $ix, 1, $newhunk;
1146 }
1147 }
1148 else {
1149 help_patch_cmd($other);
1150 next;
1151 }
1152 # soft increment
1153 while (1) {
1154 $ix++;
1155 last if ($ix >= $num ||
1156 !defined $hunk[$ix]{USE});
1157 }
1158 }
1159 }
1160
1161 my $n_lofs = 0;
1162 my @result = ();
1163 if ($mode->{USE}) {
1164 push @result, @{$mode->{TEXT}};
1165 }
1166 for (@hunk) {
1167 if ($_->{USE}) {
1168 push @result, @{$_->{TEXT}};
1169 }
1170 }
1171
1172 if (@result) {
1173 my $fh;
1174
1175 open $fh, '| git apply --cached --recount';
1176 for (@{$head->{TEXT}}, @result) {
1177 print $fh $_;
1178 }
1179 if (!close $fh) {
1180 for (@{$head->{TEXT}}, @result) {
1181 print STDERR $_;
1182 }
1183 }
1184 refresh();
1185 }
1186
1187 print "\n";
1188}
1189
1190sub diff_cmd {
1191 my @mods = list_modified('index-only');
1192 @mods = grep { !($_->{BINARY}) } @mods;
1193 return if (!@mods);
1194 my (@them) = list_and_choose({ PROMPT => 'Review diff',
1195 IMMEDIATE => 1,
1196 HEADER => $status_head, },
1197 @mods);
1198 return if (!@them);
1199 my $reference = is_initial_commit() ? get_empty_tree() : 'HEAD';
1200 system(qw(git diff -p --cached), $reference, '--',
1201 map { $_->{VALUE} } @them);
1202}
1203
1204sub quit_cmd {
1205 print "Bye.\n";
1206 exit(0);
1207}
1208
1209sub help_cmd {
1210 print colored $help_color, <<\EOF ;
1211status - show paths with changes
1212update - add working tree state to the staged set of changes
1213revert - revert staged set of changes back to the HEAD version
1214patch - pick hunks and update selectively
1215diff - view diff between HEAD and index
1216add untracked - add contents of untracked files to the staged set of changes
1217EOF
1218}
1219
1220sub process_args {
1221 return unless @ARGV;
1222 my $arg = shift @ARGV;
1223 if ($arg eq "--patch") {
1224 $patch_mode = 1;
1225 $arg = shift @ARGV or die "missing --";
1226 die "invalid argument $arg, expecting --"
1227 unless $arg eq "--";
1228 }
1229 elsif ($arg ne "--") {
1230 die "invalid argument $arg, expecting --";
1231 }
1232}
1233
1234sub main_loop {
1235 my @cmd = ([ 'status', \&status_cmd, ],
1236 [ 'update', \&update_cmd, ],
1237 [ 'revert', \&revert_cmd, ],
1238 [ 'add untracked', \&add_untracked_cmd, ],
1239 [ 'patch', \&patch_update_cmd, ],
1240 [ 'diff', \&diff_cmd, ],
1241 [ 'quit', \&quit_cmd, ],
1242 [ 'help', \&help_cmd, ],
1243 );
1244 while (1) {
1245 my ($it) = list_and_choose({ PROMPT => 'What now',
1246 SINGLETON => 1,
1247 LIST_FLAT => 4,
1248 HEADER => '*** Commands ***',
1249 ON_EOF => \&quit_cmd,
1250 IMMEDIATE => 1 }, @cmd);
1251 if ($it) {
1252 eval {
1253 $it->[1]->();
1254 };
1255 if ($@) {
1256 print "$@";
1257 }
1258 }
1259 }
1260}
1261
1262process_args();
1263refresh();
1264if ($patch_mode) {
1265 patch_update_cmd();
1266}
1267else {
1268 status_cmd();
1269 main_loop();
1270}