tests: optionally skip bin-wrappers/
[git] / git-add--interactive.perl
1 #!/usr/bin/perl
2
3 use 5.008;
4 use strict;
5 use warnings;
6 use Git qw(unquote_path);
7 use Git::I18N;
8
9 binmode(STDOUT, ":raw");
10
11 my $repo = Git->repository();
12
13 my $menu_use_color = $repo->get_colorbool('color.interactive');
14 my ($prompt_color, $header_color, $help_color) =
15         $menu_use_color ? (
16                 $repo->get_color('color.interactive.prompt', 'bold blue'),
17                 $repo->get_color('color.interactive.header', 'bold'),
18                 $repo->get_color('color.interactive.help', 'red bold'),
19         ) : ();
20 my $error_color = ();
21 if ($menu_use_color) {
22         my $help_color_spec = ($repo->config('color.interactive.help') or
23                                 'red bold');
24         $error_color = $repo->get_color('color.interactive.error',
25                                         $help_color_spec);
26 }
27
28 my $diff_use_color = $repo->get_colorbool('color.diff');
29 my ($fraginfo_color) =
30         $diff_use_color ? (
31                 $repo->get_color('color.diff.frag', 'cyan'),
32         ) : ();
33 my ($diff_plain_color) =
34         $diff_use_color ? (
35                 $repo->get_color('color.diff.plain', ''),
36         ) : ();
37 my ($diff_old_color) =
38         $diff_use_color ? (
39                 $repo->get_color('color.diff.old', 'red'),
40         ) : ();
41 my ($diff_new_color) =
42         $diff_use_color ? (
43                 $repo->get_color('color.diff.new', 'green'),
44         ) : ();
45
46 my $normal_color = $repo->get_color("", "reset");
47
48 my $diff_algorithm = $repo->config('diff.algorithm');
49 my $diff_filter = $repo->config('interactive.difffilter');
50
51 my $use_readkey = 0;
52 my $use_termcap = 0;
53 my %term_escapes;
54
55 sub ReadMode;
56 sub ReadKey;
57 if ($repo->config_bool("interactive.singlekey")) {
58         eval {
59                 require Term::ReadKey;
60                 Term::ReadKey->import;
61                 $use_readkey = 1;
62         };
63         if (!$use_readkey) {
64                 print STDERR "missing Term::ReadKey, disabling interactive.singlekey\n";
65         }
66         eval {
67                 require Term::Cap;
68                 my $termcap = Term::Cap->Tgetent;
69                 foreach (values %$termcap) {
70                         $term_escapes{$_} = 1 if /^\e/;
71                 }
72                 $use_termcap = 1;
73         };
74 }
75
76 sub colored {
77         my $color = shift;
78         my $string = join("", @_);
79
80         if (defined $color) {
81                 # Put a color code at the beginning of each line, a reset at the end
82                 # color after newlines that are not at the end of the string
83                 $string =~ s/(\n+)(.)/$1$color$2/g;
84                 # reset before newlines
85                 $string =~ s/(\n+)/$normal_color$1/g;
86                 # codes at beginning and end (if necessary):
87                 $string =~ s/^/$color/;
88                 $string =~ s/$/$normal_color/ unless $string =~ /\n$/;
89         }
90         return $string;
91 }
92
93 # command line options
94 my $patch_mode_only;
95 my $patch_mode;
96 my $patch_mode_revision;
97
98 sub apply_patch;
99 sub apply_patch_for_checkout_commit;
100 sub apply_patch_for_stash;
101
102 my %patch_modes = (
103         'stage' => {
104                 DIFF => 'diff-files -p',
105                 APPLY => sub { apply_patch 'apply --cached', @_; },
106                 APPLY_CHECK => 'apply --cached',
107                 FILTER => 'file-only',
108                 IS_REVERSE => 0,
109         },
110         'stash' => {
111                 DIFF => 'diff-index -p HEAD',
112                 APPLY => sub { apply_patch 'apply --cached', @_; },
113                 APPLY_CHECK => 'apply --cached',
114                 FILTER => undef,
115                 IS_REVERSE => 0,
116         },
117         'reset_head' => {
118                 DIFF => 'diff-index -p --cached',
119                 APPLY => sub { apply_patch 'apply -R --cached', @_; },
120                 APPLY_CHECK => 'apply -R --cached',
121                 FILTER => 'index-only',
122                 IS_REVERSE => 1,
123         },
124         'reset_nothead' => {
125                 DIFF => 'diff-index -R -p --cached',
126                 APPLY => sub { apply_patch 'apply --cached', @_; },
127                 APPLY_CHECK => 'apply --cached',
128                 FILTER => 'index-only',
129                 IS_REVERSE => 0,
130         },
131         'checkout_index' => {
132                 DIFF => 'diff-files -p',
133                 APPLY => sub { apply_patch 'apply -R', @_; },
134                 APPLY_CHECK => 'apply -R',
135                 FILTER => 'file-only',
136                 IS_REVERSE => 1,
137         },
138         'checkout_head' => {
139                 DIFF => 'diff-index -p',
140                 APPLY => sub { apply_patch_for_checkout_commit '-R', @_ },
141                 APPLY_CHECK => 'apply -R',
142                 FILTER => undef,
143                 IS_REVERSE => 1,
144         },
145         'checkout_nothead' => {
146                 DIFF => 'diff-index -R -p',
147                 APPLY => sub { apply_patch_for_checkout_commit '', @_ },
148                 APPLY_CHECK => 'apply',
149                 FILTER => undef,
150                 IS_REVERSE => 0,
151         },
152 );
153
154 $patch_mode = 'stage';
155 my %patch_mode_flavour = %{$patch_modes{$patch_mode}};
156
157 sub run_cmd_pipe {
158         if ($^O eq 'MSWin32') {
159                 my @invalid = grep {m/[":*]/} @_;
160                 die "$^O does not support: @invalid\n" if @invalid;
161                 my @args = map { m/ /o ? "\"$_\"": $_ } @_;
162                 return qx{@args};
163         } else {
164                 my $fh = undef;
165                 open($fh, '-|', @_) or die;
166                 return <$fh>;
167         }
168 }
169
170 my ($GIT_DIR) = run_cmd_pipe(qw(git rev-parse --git-dir));
171
172 if (!defined $GIT_DIR) {
173         exit(1); # rev-parse would have already said "not a git repo"
174 }
175 chomp($GIT_DIR);
176
177 sub refresh {
178         my $fh;
179         open $fh, 'git update-index --refresh |'
180             or die;
181         while (<$fh>) {
182                 ;# ignore 'needs update'
183         }
184         close $fh;
185 }
186
187 sub list_untracked {
188         map {
189                 chomp $_;
190                 unquote_path($_);
191         }
192         run_cmd_pipe(qw(git ls-files --others --exclude-standard --), @ARGV);
193 }
194
195 # TRANSLATORS: you can adjust this to align "git add -i" status menu
196 my $status_fmt = __('%12s %12s %s');
197 my $status_head = sprintf($status_fmt, __('staged'), __('unstaged'), __('path'));
198
199 {
200         my $initial;
201         sub is_initial_commit {
202                 $initial = system('git rev-parse HEAD -- >/dev/null 2>&1') != 0
203                         unless defined $initial;
204                 return $initial;
205         }
206 }
207
208 {
209         my $empty_tree;
210         sub get_empty_tree {
211                 return $empty_tree if defined $empty_tree;
212
213                 $empty_tree = run_cmd_pipe(qw(git hash-object -t tree /dev/null));
214                 chomp $empty_tree;
215                 return $empty_tree;
216         }
217 }
218
219 sub get_diff_reference {
220         my $ref = shift;
221         if (defined $ref and $ref ne 'HEAD') {
222                 return $ref;
223         } elsif (is_initial_commit()) {
224                 return get_empty_tree();
225         } else {
226                 return 'HEAD';
227         }
228 }
229
230 # Returns list of hashes, contents of each of which are:
231 # VALUE:        pathname
232 # BINARY:       is a binary path
233 # INDEX:        is index different from HEAD?
234 # FILE:         is file different from index?
235 # INDEX_ADDDEL: is it add/delete between HEAD and index?
236 # FILE_ADDDEL:  is it add/delete between index and file?
237 # UNMERGED:     is the path unmerged
238
239 sub list_modified {
240         my ($only) = @_;
241         my (%data, @return);
242         my ($add, $del, $adddel, $file);
243
244         my $reference = get_diff_reference($patch_mode_revision);
245         for (run_cmd_pipe(qw(git diff-index --cached
246                              --numstat --summary), $reference,
247                              '--', @ARGV)) {
248                 if (($add, $del, $file) =
249                     /^([-\d]+)  ([-\d]+)        (.*)/) {
250                         my ($change, $bin);
251                         $file = unquote_path($file);
252                         if ($add eq '-' && $del eq '-') {
253                                 $change = __('binary');
254                                 $bin = 1;
255                         }
256                         else {
257                                 $change = "+$add/-$del";
258                         }
259                         $data{$file} = {
260                                 INDEX => $change,
261                                 BINARY => $bin,
262                                 FILE => __('nothing'),
263                         }
264                 }
265                 elsif (($adddel, $file) =
266                        /^ (create|delete) mode [0-7]+ (.*)$/) {
267                         $file = unquote_path($file);
268                         $data{$file}{INDEX_ADDDEL} = $adddel;
269                 }
270         }
271
272         for (run_cmd_pipe(qw(git diff-files --ignore-submodules=dirty --numstat --summary --raw --), @ARGV)) {
273                 if (($add, $del, $file) =
274                     /^([-\d]+)  ([-\d]+)        (.*)/) {
275                         $file = unquote_path($file);
276                         my ($change, $bin);
277                         if ($add eq '-' && $del eq '-') {
278                                 $change = __('binary');
279                                 $bin = 1;
280                         }
281                         else {
282                                 $change = "+$add/-$del";
283                         }
284                         $data{$file}{FILE} = $change;
285                         if ($bin) {
286                                 $data{$file}{BINARY} = 1;
287                         }
288                 }
289                 elsif (($adddel, $file) =
290                        /^ (create|delete) mode [0-7]+ (.*)$/) {
291                         $file = unquote_path($file);
292                         $data{$file}{FILE_ADDDEL} = $adddel;
293                 }
294                 elsif (/^:[0-7]+ [0-7]+ [0-9a-f]+ [0-9a-f]+ (.) (.*)$/) {
295                         $file = unquote_path($2);
296                         if (!exists $data{$file}) {
297                                 $data{$file} = +{
298                                         INDEX => __('unchanged'),
299                                         BINARY => 0,
300                                 };
301                         }
302                         if ($1 eq 'U') {
303                                 $data{$file}{UNMERGED} = 1;
304                         }
305                 }
306         }
307
308         for (sort keys %data) {
309                 my $it = $data{$_};
310
311                 if ($only) {
312                         if ($only eq 'index-only') {
313                                 next if ($it->{INDEX} eq __('unchanged'));
314                         }
315                         if ($only eq 'file-only') {
316                                 next if ($it->{FILE} eq __('nothing'));
317                         }
318                 }
319                 push @return, +{
320                         VALUE => $_,
321                         %$it,
322                 };
323         }
324         return @return;
325 }
326
327 sub find_unique {
328         my ($string, @stuff) = @_;
329         my $found = undef;
330         for (my $i = 0; $i < @stuff; $i++) {
331                 my $it = $stuff[$i];
332                 my $hit = undef;
333                 if (ref $it) {
334                         if ((ref $it) eq 'ARRAY') {
335                                 $it = $it->[0];
336                         }
337                         else {
338                                 $it = $it->{VALUE};
339                         }
340                 }
341                 eval {
342                         if ($it =~ /^$string/) {
343                                 $hit = 1;
344                         };
345                 };
346                 if (defined $hit && defined $found) {
347                         return undef;
348                 }
349                 if ($hit) {
350                         $found = $i + 1;
351                 }
352         }
353         return $found;
354 }
355
356 # inserts string into trie and updates count for each character
357 sub update_trie {
358         my ($trie, $string) = @_;
359         foreach (split //, $string) {
360                 $trie = $trie->{$_} ||= {COUNT => 0};
361                 $trie->{COUNT}++;
362         }
363 }
364
365 # returns an array of tuples (prefix, remainder)
366 sub find_unique_prefixes {
367         my @stuff = @_;
368         my @return = ();
369
370         # any single prefix exceeding the soft limit is omitted
371         # if any prefix exceeds the hard limit all are omitted
372         # 0 indicates no limit
373         my $soft_limit = 0;
374         my $hard_limit = 3;
375
376         # build a trie modelling all possible options
377         my %trie;
378         foreach my $print (@stuff) {
379                 if ((ref $print) eq 'ARRAY') {
380                         $print = $print->[0];
381                 }
382                 elsif ((ref $print) eq 'HASH') {
383                         $print = $print->{VALUE};
384                 }
385                 update_trie(\%trie, $print);
386                 push @return, $print;
387         }
388
389         # use the trie to find the unique prefixes
390         for (my $i = 0; $i < @return; $i++) {
391                 my $ret = $return[$i];
392                 my @letters = split //, $ret;
393                 my %search = %trie;
394                 my ($prefix, $remainder);
395                 my $j;
396                 for ($j = 0; $j < @letters; $j++) {
397                         my $letter = $letters[$j];
398                         if ($search{$letter}{COUNT} == 1) {
399                                 $prefix = substr $ret, 0, $j + 1;
400                                 $remainder = substr $ret, $j + 1;
401                                 last;
402                         }
403                         else {
404                                 my $prefix = substr $ret, 0, $j;
405                                 return ()
406                                     if ($hard_limit && $j + 1 > $hard_limit);
407                         }
408                         %search = %{$search{$letter}};
409                 }
410                 if (ord($letters[0]) > 127 ||
411                     ($soft_limit && $j + 1 > $soft_limit)) {
412                         $prefix = undef;
413                         $remainder = $ret;
414                 }
415                 $return[$i] = [$prefix, $remainder];
416         }
417         return @return;
418 }
419
420 # filters out prefixes which have special meaning to list_and_choose()
421 sub is_valid_prefix {
422         my $prefix = shift;
423         return (defined $prefix) &&
424             !($prefix =~ /[\s,]/) && # separators
425             !($prefix =~ /^-/) &&    # deselection
426             !($prefix =~ /^\d+/) &&  # selection
427             ($prefix ne '*') &&      # "all" wildcard
428             ($prefix ne '?');        # prompt help
429 }
430
431 # given a prefix/remainder tuple return a string with the prefix highlighted
432 # for now use square brackets; later might use ANSI colors (underline, bold)
433 sub highlight_prefix {
434         my $prefix = shift;
435         my $remainder = shift;
436
437         if (!defined $prefix) {
438                 return $remainder;
439         }
440
441         if (!is_valid_prefix($prefix)) {
442                 return "$prefix$remainder";
443         }
444
445         if (!$menu_use_color) {
446                 return "[$prefix]$remainder";
447         }
448
449         return "$prompt_color$prefix$normal_color$remainder";
450 }
451
452 sub error_msg {
453         print STDERR colored $error_color, @_;
454 }
455
456 sub list_and_choose {
457         my ($opts, @stuff) = @_;
458         my (@chosen, @return);
459         if (!@stuff) {
460             return @return;
461         }
462         my $i;
463         my @prefixes = find_unique_prefixes(@stuff) unless $opts->{LIST_ONLY};
464
465       TOPLOOP:
466         while (1) {
467                 my $last_lf = 0;
468
469                 if ($opts->{HEADER}) {
470                         if (!$opts->{LIST_FLAT}) {
471                                 print "     ";
472                         }
473                         print colored $header_color, "$opts->{HEADER}\n";
474                 }
475                 for ($i = 0; $i < @stuff; $i++) {
476                         my $chosen = $chosen[$i] ? '*' : ' ';
477                         my $print = $stuff[$i];
478                         my $ref = ref $print;
479                         my $highlighted = highlight_prefix(@{$prefixes[$i]})
480                             if @prefixes;
481                         if ($ref eq 'ARRAY') {
482                                 $print = $highlighted || $print->[0];
483                         }
484                         elsif ($ref eq 'HASH') {
485                                 my $value = $highlighted || $print->{VALUE};
486                                 $print = sprintf($status_fmt,
487                                     $print->{INDEX},
488                                     $print->{FILE},
489                                     $value);
490                         }
491                         else {
492                                 $print = $highlighted || $print;
493                         }
494                         printf("%s%2d: %s", $chosen, $i+1, $print);
495                         if (($opts->{LIST_FLAT}) &&
496                             (($i + 1) % ($opts->{LIST_FLAT}))) {
497                                 print "\t";
498                                 $last_lf = 0;
499                         }
500                         else {
501                                 print "\n";
502                                 $last_lf = 1;
503                         }
504                 }
505                 if (!$last_lf) {
506                         print "\n";
507                 }
508
509                 return if ($opts->{LIST_ONLY});
510
511                 print colored $prompt_color, $opts->{PROMPT};
512                 if ($opts->{SINGLETON}) {
513                         print "> ";
514                 }
515                 else {
516                         print ">> ";
517                 }
518                 my $line = <STDIN>;
519                 if (!$line) {
520                         print "\n";
521                         $opts->{ON_EOF}->() if $opts->{ON_EOF};
522                         last;
523                 }
524                 chomp $line;
525                 last if $line eq '';
526                 if ($line eq '?') {
527                         $opts->{SINGLETON} ?
528                             singleton_prompt_help_cmd() :
529                             prompt_help_cmd();
530                         next TOPLOOP;
531                 }
532                 for my $choice (split(/[\s,]+/, $line)) {
533                         my $choose = 1;
534                         my ($bottom, $top);
535
536                         # Input that begins with '-'; unchoose
537                         if ($choice =~ s/^-//) {
538                                 $choose = 0;
539                         }
540                         # A range can be specified like 5-7 or 5-.
541                         if ($choice =~ /^(\d+)-(\d*)$/) {
542                                 ($bottom, $top) = ($1, length($2) ? $2 : 1 + @stuff);
543                         }
544                         elsif ($choice =~ /^\d+$/) {
545                                 $bottom = $top = $choice;
546                         }
547                         elsif ($choice eq '*') {
548                                 $bottom = 1;
549                                 $top = 1 + @stuff;
550                         }
551                         else {
552                                 $bottom = $top = find_unique($choice, @stuff);
553                                 if (!defined $bottom) {
554                                         error_msg sprintf(__("Huh (%s)?\n"), $choice);
555                                         next TOPLOOP;
556                                 }
557                         }
558                         if ($opts->{SINGLETON} && $bottom != $top) {
559                                 error_msg sprintf(__("Huh (%s)?\n"), $choice);
560                                 next TOPLOOP;
561                         }
562                         for ($i = $bottom-1; $i <= $top-1; $i++) {
563                                 next if (@stuff <= $i || $i < 0);
564                                 $chosen[$i] = $choose;
565                         }
566                 }
567                 last if ($opts->{IMMEDIATE} || $line eq '*');
568         }
569         for ($i = 0; $i < @stuff; $i++) {
570                 if ($chosen[$i]) {
571                         push @return, $stuff[$i];
572                 }
573         }
574         return @return;
575 }
576
577 sub singleton_prompt_help_cmd {
578         print colored $help_color, __ <<'EOF' ;
579 Prompt help:
580 1          - select a numbered item
581 foo        - select item based on unique prefix
582            - (empty) select nothing
583 EOF
584 }
585
586 sub prompt_help_cmd {
587         print colored $help_color, __ <<'EOF' ;
588 Prompt help:
589 1          - select a single item
590 3-5        - select a range of items
591 2-3,6-9    - select multiple ranges
592 foo        - select item based on unique prefix
593 -...       - unselect specified items
594 *          - choose all items
595            - (empty) finish selecting
596 EOF
597 }
598
599 sub status_cmd {
600         list_and_choose({ LIST_ONLY => 1, HEADER => $status_head },
601                         list_modified());
602         print "\n";
603 }
604
605 sub say_n_paths {
606         my $did = shift @_;
607         my $cnt = scalar @_;
608         if ($did eq 'added') {
609                 printf(__n("added %d path\n", "added %d paths\n",
610                            $cnt), $cnt);
611         } elsif ($did eq 'updated') {
612                 printf(__n("updated %d path\n", "updated %d paths\n",
613                            $cnt), $cnt);
614         } elsif ($did eq 'reverted') {
615                 printf(__n("reverted %d path\n", "reverted %d paths\n",
616                            $cnt), $cnt);
617         } else {
618                 printf(__n("touched %d path\n", "touched %d paths\n",
619                            $cnt), $cnt);
620         }
621 }
622
623 sub update_cmd {
624         my @mods = list_modified('file-only');
625         return if (!@mods);
626
627         my @update = list_and_choose({ PROMPT => __('Update'),
628                                        HEADER => $status_head, },
629                                      @mods);
630         if (@update) {
631                 system(qw(git update-index --add --remove --),
632                        map { $_->{VALUE} } @update);
633                 say_n_paths('updated', @update);
634         }
635         print "\n";
636 }
637
638 sub revert_cmd {
639         my @update = list_and_choose({ PROMPT => __('Revert'),
640                                        HEADER => $status_head, },
641                                      list_modified());
642         if (@update) {
643                 if (is_initial_commit()) {
644                         system(qw(git rm --cached),
645                                 map { $_->{VALUE} } @update);
646                 }
647                 else {
648                         my @lines = run_cmd_pipe(qw(git ls-tree HEAD --),
649                                                  map { $_->{VALUE} } @update);
650                         my $fh;
651                         open $fh, '| git update-index --index-info'
652                             or die;
653                         for (@lines) {
654                                 print $fh $_;
655                         }
656                         close($fh);
657                         for (@update) {
658                                 if ($_->{INDEX_ADDDEL} &&
659                                     $_->{INDEX_ADDDEL} eq 'create') {
660                                         system(qw(git update-index --force-remove --),
661                                                $_->{VALUE});
662                                         printf(__("note: %s is untracked now.\n"), $_->{VALUE});
663                                 }
664                         }
665                 }
666                 refresh();
667                 say_n_paths('reverted', @update);
668         }
669         print "\n";
670 }
671
672 sub add_untracked_cmd {
673         my @add = list_and_choose({ PROMPT => __('Add untracked') },
674                                   list_untracked());
675         if (@add) {
676                 system(qw(git update-index --add --), @add);
677                 say_n_paths('added', @add);
678         } else {
679                 print __("No untracked files.\n");
680         }
681         print "\n";
682 }
683
684 sub run_git_apply {
685         my $cmd = shift;
686         my $fh;
687         open $fh, '| git ' . $cmd . " --allow-overlap";
688         print $fh @_;
689         return close $fh;
690 }
691
692 sub parse_diff {
693         my ($path) = @_;
694         my @diff_cmd = split(" ", $patch_mode_flavour{DIFF});
695         if (defined $diff_algorithm) {
696                 splice @diff_cmd, 1, 0, "--diff-algorithm=${diff_algorithm}";
697         }
698         if (defined $patch_mode_revision) {
699                 push @diff_cmd, get_diff_reference($patch_mode_revision);
700         }
701         my @diff = run_cmd_pipe("git", @diff_cmd, "--", $path);
702         my @colored = ();
703         if ($diff_use_color) {
704                 my @display_cmd = ("git", @diff_cmd, qw(--color --), $path);
705                 if (defined $diff_filter) {
706                         # quotemeta is overkill, but sufficient for shell-quoting
707                         my $diff = join(' ', map { quotemeta } @display_cmd);
708                         @display_cmd = ("$diff | $diff_filter");
709                 }
710
711                 @colored = run_cmd_pipe(@display_cmd);
712         }
713         my (@hunk) = { TEXT => [], DISPLAY => [], TYPE => 'header' };
714
715         if (@colored && @colored != @diff) {
716                 print STDERR
717                   "fatal: mismatched output from interactive.diffFilter\n",
718                   "hint: Your filter must maintain a one-to-one correspondence\n",
719                   "hint: between its input and output lines.\n";
720                 exit 1;
721         }
722
723         for (my $i = 0; $i < @diff; $i++) {
724                 if ($diff[$i] =~ /^@@ /) {
725                         push @hunk, { TEXT => [], DISPLAY => [],
726                                 TYPE => 'hunk' };
727                 }
728                 push @{$hunk[-1]{TEXT}}, $diff[$i];
729                 push @{$hunk[-1]{DISPLAY}},
730                         (@colored ? $colored[$i] : $diff[$i]);
731         }
732         return @hunk;
733 }
734
735 sub parse_diff_header {
736         my $src = shift;
737
738         my $head = { TEXT => [], DISPLAY => [], TYPE => 'header' };
739         my $mode = { TEXT => [], DISPLAY => [], TYPE => 'mode' };
740         my $deletion = { TEXT => [], DISPLAY => [], TYPE => 'deletion' };
741
742         for (my $i = 0; $i < @{$src->{TEXT}}; $i++) {
743                 my $dest =
744                    $src->{TEXT}->[$i] =~ /^(old|new) mode (\d+)$/ ? $mode :
745                    $src->{TEXT}->[$i] =~ /^deleted file/ ? $deletion :
746                    $head;
747                 push @{$dest->{TEXT}}, $src->{TEXT}->[$i];
748                 push @{$dest->{DISPLAY}}, $src->{DISPLAY}->[$i];
749         }
750         return ($head, $mode, $deletion);
751 }
752
753 sub hunk_splittable {
754         my ($text) = @_;
755
756         my @s = split_hunk($text);
757         return (1 < @s);
758 }
759
760 sub parse_hunk_header {
761         my ($line) = @_;
762         my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
763             $line =~ /^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/;
764         $o_cnt = 1 unless defined $o_cnt;
765         $n_cnt = 1 unless defined $n_cnt;
766         return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
767 }
768
769 sub format_hunk_header {
770         my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) = @_;
771         return ("@@ -$o_ofs" .
772                 (($o_cnt != 1) ? ",$o_cnt" : '') .
773                 " +$n_ofs" .
774                 (($n_cnt != 1) ? ",$n_cnt" : '') .
775                 " @@\n");
776 }
777
778 sub split_hunk {
779         my ($text, $display) = @_;
780         my @split = ();
781         if (!defined $display) {
782                 $display = $text;
783         }
784         # If there are context lines in the middle of a hunk,
785         # it can be split, but we would need to take care of
786         # overlaps later.
787
788         my ($o_ofs, undef, $n_ofs) = parse_hunk_header($text->[0]);
789         my $hunk_start = 1;
790
791       OUTER:
792         while (1) {
793                 my $next_hunk_start = undef;
794                 my $i = $hunk_start - 1;
795                 my $this = +{
796                         TEXT => [],
797                         DISPLAY => [],
798                         TYPE => 'hunk',
799                         OLD => $o_ofs,
800                         NEW => $n_ofs,
801                         OCNT => 0,
802                         NCNT => 0,
803                         ADDDEL => 0,
804                         POSTCTX => 0,
805                         USE => undef,
806                 };
807
808                 while (++$i < @$text) {
809                         my $line = $text->[$i];
810                         my $display = $display->[$i];
811                         if ($line =~ /^\\/) {
812                                 push @{$this->{TEXT}}, $line;
813                                 push @{$this->{DISPLAY}}, $display;
814                                 next;
815                         }
816                         if ($line =~ /^ /) {
817                                 if ($this->{ADDDEL} &&
818                                     !defined $next_hunk_start) {
819                                         # We have seen leading context and
820                                         # adds/dels and then here is another
821                                         # context, which is trailing for this
822                                         # split hunk and leading for the next
823                                         # one.
824                                         $next_hunk_start = $i;
825                                 }
826                                 push @{$this->{TEXT}}, $line;
827                                 push @{$this->{DISPLAY}}, $display;
828                                 $this->{OCNT}++;
829                                 $this->{NCNT}++;
830                                 if (defined $next_hunk_start) {
831                                         $this->{POSTCTX}++;
832                                 }
833                                 next;
834                         }
835
836                         # add/del
837                         if (defined $next_hunk_start) {
838                                 # We are done with the current hunk and
839                                 # this is the first real change for the
840                                 # next split one.
841                                 $hunk_start = $next_hunk_start;
842                                 $o_ofs = $this->{OLD} + $this->{OCNT};
843                                 $n_ofs = $this->{NEW} + $this->{NCNT};
844                                 $o_ofs -= $this->{POSTCTX};
845                                 $n_ofs -= $this->{POSTCTX};
846                                 push @split, $this;
847                                 redo OUTER;
848                         }
849                         push @{$this->{TEXT}}, $line;
850                         push @{$this->{DISPLAY}}, $display;
851                         $this->{ADDDEL}++;
852                         if ($line =~ /^-/) {
853                                 $this->{OCNT}++;
854                         }
855                         else {
856                                 $this->{NCNT}++;
857                         }
858                 }
859
860                 push @split, $this;
861                 last;
862         }
863
864         for my $hunk (@split) {
865                 $o_ofs = $hunk->{OLD};
866                 $n_ofs = $hunk->{NEW};
867                 my $o_cnt = $hunk->{OCNT};
868                 my $n_cnt = $hunk->{NCNT};
869
870                 my $head = format_hunk_header($o_ofs, $o_cnt, $n_ofs, $n_cnt);
871                 my $display_head = $head;
872                 unshift @{$hunk->{TEXT}}, $head;
873                 if ($diff_use_color) {
874                         $display_head = colored($fraginfo_color, $head);
875                 }
876                 unshift @{$hunk->{DISPLAY}}, $display_head;
877         }
878         return @split;
879 }
880
881 sub find_last_o_ctx {
882         my ($it) = @_;
883         my $text = $it->{TEXT};
884         my ($o_ofs, $o_cnt) = parse_hunk_header($text->[0]);
885         my $i = @{$text};
886         my $last_o_ctx = $o_ofs + $o_cnt;
887         while (0 < --$i) {
888                 my $line = $text->[$i];
889                 if ($line =~ /^ /) {
890                         $last_o_ctx--;
891                         next;
892                 }
893                 last;
894         }
895         return $last_o_ctx;
896 }
897
898 sub merge_hunk {
899         my ($prev, $this) = @_;
900         my ($o0_ofs, $o0_cnt, $n0_ofs, $n0_cnt) =
901             parse_hunk_header($prev->{TEXT}[0]);
902         my ($o1_ofs, $o1_cnt, $n1_ofs, $n1_cnt) =
903             parse_hunk_header($this->{TEXT}[0]);
904
905         my (@line, $i, $ofs, $o_cnt, $n_cnt);
906         $ofs = $o0_ofs;
907         $o_cnt = $n_cnt = 0;
908         for ($i = 1; $i < @{$prev->{TEXT}}; $i++) {
909                 my $line = $prev->{TEXT}[$i];
910                 if ($line =~ /^\+/) {
911                         $n_cnt++;
912                         push @line, $line;
913                         next;
914                 } elsif ($line =~ /^\\/) {
915                         push @line, $line;
916                         next;
917                 }
918
919                 last if ($o1_ofs <= $ofs);
920
921                 $o_cnt++;
922                 $ofs++;
923                 if ($line =~ /^ /) {
924                         $n_cnt++;
925                 }
926                 push @line, $line;
927         }
928
929         for ($i = 1; $i < @{$this->{TEXT}}; $i++) {
930                 my $line = $this->{TEXT}[$i];
931                 if ($line =~ /^\+/) {
932                         $n_cnt++;
933                         push @line, $line;
934                         next;
935                 } elsif ($line =~ /^\\/) {
936                         push @line, $line;
937                         next;
938                 }
939                 $ofs++;
940                 $o_cnt++;
941                 if ($line =~ /^ /) {
942                         $n_cnt++;
943                 }
944                 push @line, $line;
945         }
946         my $head = format_hunk_header($o0_ofs, $o_cnt, $n0_ofs, $n_cnt);
947         @{$prev->{TEXT}} = ($head, @line);
948 }
949
950 sub coalesce_overlapping_hunks {
951         my (@in) = @_;
952         my @out = ();
953
954         my ($last_o_ctx, $last_was_dirty);
955         my $ofs_delta = 0;
956
957         for (@in) {
958                 if ($_->{TYPE} ne 'hunk') {
959                         push @out, $_;
960                         next;
961                 }
962                 my $text = $_->{TEXT};
963                 my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
964                                                 parse_hunk_header($text->[0]);
965                 unless ($_->{USE}) {
966                         $ofs_delta += $o_cnt - $n_cnt;
967                         # If this hunk has been edited then subtract
968                         # the delta that is due to the edit.
969                         if ($_->{OFS_DELTA}) {
970                                 $ofs_delta -= $_->{OFS_DELTA};
971                         }
972                         next;
973                 }
974                 if ($ofs_delta) {
975                         $n_ofs += $ofs_delta;
976                         $_->{TEXT}->[0] = format_hunk_header($o_ofs, $o_cnt,
977                                                              $n_ofs, $n_cnt);
978                 }
979                 # If this hunk was edited then adjust the offset delta
980                 # to reflect the edit.
981                 if ($_->{OFS_DELTA}) {
982                         $ofs_delta += $_->{OFS_DELTA};
983                 }
984                 if (defined $last_o_ctx &&
985                     $o_ofs <= $last_o_ctx &&
986                     !$_->{DIRTY} &&
987                     !$last_was_dirty) {
988                         merge_hunk($out[-1], $_);
989                 }
990                 else {
991                         push @out, $_;
992                 }
993                 $last_o_ctx = find_last_o_ctx($out[-1]);
994                 $last_was_dirty = $_->{DIRTY};
995         }
996         return @out;
997 }
998
999 sub reassemble_patch {
1000         my $head = shift;
1001         my @patch;
1002
1003         # Include everything in the header except the beginning of the diff.
1004         push @patch, (grep { !/^[-+]{3}/ } @$head);
1005
1006         # Then include any headers from the hunk lines, which must
1007         # come before any actual hunk.
1008         while (@_ && $_[0] !~ /^@/) {
1009                 push @patch, shift;
1010         }
1011
1012         # Then begin the diff.
1013         push @patch, grep { /^[-+]{3}/ } @$head;
1014
1015         # And then the actual hunks.
1016         push @patch, @_;
1017
1018         return @patch;
1019 }
1020
1021 sub color_diff {
1022         return map {
1023                 colored((/^@/  ? $fraginfo_color :
1024                          /^\+/ ? $diff_new_color :
1025                          /^-/  ? $diff_old_color :
1026                          $diff_plain_color),
1027                         $_);
1028         } @_;
1029 }
1030
1031 my %edit_hunk_manually_modes = (
1032         stage => N__(
1033 "If the patch applies cleanly, the edited hunk will immediately be
1034 marked for staging."),
1035         stash => N__(
1036 "If the patch applies cleanly, the edited hunk will immediately be
1037 marked for stashing."),
1038         reset_head => N__(
1039 "If the patch applies cleanly, the edited hunk will immediately be
1040 marked for unstaging."),
1041         reset_nothead => N__(
1042 "If the patch applies cleanly, the edited hunk will immediately be
1043 marked for applying."),
1044         checkout_index => N__(
1045 "If the patch applies cleanly, the edited hunk will immediately be
1046 marked for discarding."),
1047         checkout_head => N__(
1048 "If the patch applies cleanly, the edited hunk will immediately be
1049 marked for discarding."),
1050         checkout_nothead => N__(
1051 "If the patch applies cleanly, the edited hunk will immediately be
1052 marked for applying."),
1053 );
1054
1055 sub recount_edited_hunk {
1056         local $_;
1057         my ($oldtext, $newtext) = @_;
1058         my ($o_cnt, $n_cnt) = (0, 0);
1059         for (@{$newtext}[1..$#{$newtext}]) {
1060                 my $mode = substr($_, 0, 1);
1061                 if ($mode eq '-') {
1062                         $o_cnt++;
1063                 } elsif ($mode eq '+') {
1064                         $n_cnt++;
1065                 } elsif ($mode eq ' ' or $mode eq "\n") {
1066                         $o_cnt++;
1067                         $n_cnt++;
1068                 }
1069         }
1070         my ($o_ofs, undef, $n_ofs, undef) =
1071                                         parse_hunk_header($newtext->[0]);
1072         $newtext->[0] = format_hunk_header($o_ofs, $o_cnt, $n_ofs, $n_cnt);
1073         my (undef, $orig_o_cnt, undef, $orig_n_cnt) =
1074                                         parse_hunk_header($oldtext->[0]);
1075         # Return the change in the number of lines inserted by this hunk
1076         return $orig_o_cnt - $orig_n_cnt - $o_cnt + $n_cnt;
1077 }
1078
1079 sub edit_hunk_manually {
1080         my ($oldtext) = @_;
1081
1082         my $hunkfile = $repo->repo_path . "/addp-hunk-edit.diff";
1083         my $fh;
1084         open $fh, '>', $hunkfile
1085                 or die sprintf(__("failed to open hunk edit file for writing: %s"), $!);
1086         print $fh Git::comment_lines __("Manual hunk edit mode -- see bottom for a quick guide.\n");
1087         print $fh @$oldtext;
1088         my $is_reverse = $patch_mode_flavour{IS_REVERSE};
1089         my ($remove_plus, $remove_minus) = $is_reverse ? ('-', '+') : ('+', '-');
1090         my $comment_line_char = Git::get_comment_line_char;
1091         print $fh Git::comment_lines sprintf(__ <<EOF, $remove_minus, $remove_plus, $comment_line_char),
1092 ---
1093 To remove '%s' lines, make them ' ' lines (context).
1094 To remove '%s' lines, delete them.
1095 Lines starting with %s will be removed.
1096 EOF
1097 __($edit_hunk_manually_modes{$patch_mode}),
1098 # TRANSLATORS: 'it' refers to the patch mentioned in the previous messages.
1099 __ <<EOF2 ;
1100 If it does not apply cleanly, you will be given an opportunity to
1101 edit again.  If all lines of the hunk are removed, then the edit is
1102 aborted and the hunk is left unchanged.
1103 EOF2
1104         close $fh;
1105
1106         chomp(my $editor = run_cmd_pipe(qw(git var GIT_EDITOR)));
1107         system('sh', '-c', $editor.' "$@"', $editor, $hunkfile);
1108
1109         if ($? != 0) {
1110                 return undef;
1111         }
1112
1113         open $fh, '<', $hunkfile
1114                 or die sprintf(__("failed to open hunk edit file for reading: %s"), $!);
1115         my @newtext = grep { !/^\Q$comment_line_char\E/ } <$fh>;
1116         close $fh;
1117         unlink $hunkfile;
1118
1119         # Abort if nothing remains
1120         if (!grep { /\S/ } @newtext) {
1121                 return undef;
1122         }
1123
1124         # Reinsert the first hunk header if the user accidentally deleted it
1125         if ($newtext[0] !~ /^@/) {
1126                 unshift @newtext, $oldtext->[0];
1127         }
1128         return \@newtext;
1129 }
1130
1131 sub diff_applies {
1132         return run_git_apply($patch_mode_flavour{APPLY_CHECK} . ' --check',
1133                              map { @{$_->{TEXT}} } @_);
1134 }
1135
1136 sub _restore_terminal_and_die {
1137         ReadMode 'restore';
1138         print "\n";
1139         exit 1;
1140 }
1141
1142 sub prompt_single_character {
1143         if ($use_readkey) {
1144                 local $SIG{TERM} = \&_restore_terminal_and_die;
1145                 local $SIG{INT} = \&_restore_terminal_and_die;
1146                 ReadMode 'cbreak';
1147                 my $key = ReadKey 0;
1148                 ReadMode 'restore';
1149                 if ($use_termcap and $key eq "\e") {
1150                         while (!defined $term_escapes{$key}) {
1151                                 my $next = ReadKey 0.5;
1152                                 last if (!defined $next);
1153                                 $key .= $next;
1154                         }
1155                         $key =~ s/\e/^[/;
1156                 }
1157                 print "$key" if defined $key;
1158                 print "\n";
1159                 return $key;
1160         } else {
1161                 return <STDIN>;
1162         }
1163 }
1164
1165 sub prompt_yesno {
1166         my ($prompt) = @_;
1167         while (1) {
1168                 print colored $prompt_color, $prompt;
1169                 my $line = prompt_single_character;
1170                 return undef unless defined $line;
1171                 return 0 if $line =~ /^n/i;
1172                 return 1 if $line =~ /^y/i;
1173         }
1174 }
1175
1176 sub edit_hunk_loop {
1177         my ($head, $hunks, $ix) = @_;
1178         my $hunk = $hunks->[$ix];
1179         my $text = $hunk->{TEXT};
1180
1181         while (1) {
1182                 my $newtext = edit_hunk_manually($text);
1183                 if (!defined $newtext) {
1184                         return undef;
1185                 }
1186                 my $newhunk = {
1187                         TEXT => $newtext,
1188                         TYPE => $hunk->{TYPE},
1189                         USE => 1,
1190                         DIRTY => 1,
1191                 };
1192                 $newhunk->{OFS_DELTA} = recount_edited_hunk($text, $newtext);
1193                 # If this hunk has already been edited then add the
1194                 # offset delta of the previous edit to get the real
1195                 # delta from the original unedited hunk.
1196                 $hunk->{OFS_DELTA} and
1197                                 $newhunk->{OFS_DELTA} += $hunk->{OFS_DELTA};
1198                 if (diff_applies($head,
1199                                  @{$hunks}[0..$ix-1],
1200                                  $newhunk,
1201                                  @{$hunks}[$ix+1..$#{$hunks}])) {
1202                         $newhunk->{DISPLAY} = [color_diff(@{$newtext})];
1203                         return $newhunk;
1204                 }
1205                 else {
1206                         prompt_yesno(
1207                                 # TRANSLATORS: do not translate [y/n]
1208                                 # The program will only accept that input
1209                                 # at this point.
1210                                 # Consider translating (saying "no" discards!) as
1211                                 # (saying "n" for "no" discards!) if the translation
1212                                 # of the word "no" does not start with n.
1213                                 __('Your edited hunk does not apply. Edit again '
1214                                    . '(saying "no" discards!) [y/n]? ')
1215                                 ) or return undef;
1216                 }
1217         }
1218 }
1219
1220 my %help_patch_modes = (
1221         stage => N__(
1222 "y - stage this hunk
1223 n - do not stage this hunk
1224 q - quit; do not stage this hunk or any of the remaining ones
1225 a - stage this hunk and all later hunks in the file
1226 d - do not stage this hunk or any of the later hunks in the file"),
1227         stash => N__(
1228 "y - stash this hunk
1229 n - do not stash this hunk
1230 q - quit; do not stash this hunk or any of the remaining ones
1231 a - stash this hunk and all later hunks in the file
1232 d - do not stash this hunk or any of the later hunks in the file"),
1233         reset_head => N__(
1234 "y - unstage this hunk
1235 n - do not unstage this hunk
1236 q - quit; do not unstage this hunk or any of the remaining ones
1237 a - unstage this hunk and all later hunks in the file
1238 d - do not unstage this hunk or any of the later hunks in the file"),
1239         reset_nothead => N__(
1240 "y - apply this hunk to index
1241 n - do not apply this hunk to index
1242 q - quit; do not apply this hunk or any of the remaining ones
1243 a - apply this hunk and all later hunks in the file
1244 d - do not apply this hunk or any of the later hunks in the file"),
1245         checkout_index => N__(
1246 "y - discard this hunk from worktree
1247 n - do not discard this hunk from worktree
1248 q - quit; do not discard this hunk or any of the remaining ones
1249 a - discard this hunk and all later hunks in the file
1250 d - do not discard this hunk or any of the later hunks in the file"),
1251         checkout_head => N__(
1252 "y - discard this hunk from index and worktree
1253 n - do not discard this hunk from index and worktree
1254 q - quit; do not discard this hunk or any of the remaining ones
1255 a - discard this hunk and all later hunks in the file
1256 d - do not discard this hunk or any of the later hunks in the file"),
1257         checkout_nothead => N__(
1258 "y - apply this hunk to index and worktree
1259 n - do not apply this hunk to index and worktree
1260 q - quit; do not apply this hunk or any of the remaining ones
1261 a - apply this hunk and all later hunks in the file
1262 d - do not apply this hunk or any of the later hunks in the file"),
1263 );
1264
1265 sub help_patch_cmd {
1266         local $_;
1267         my $other = $_[0] . ",?";
1268         print colored $help_color, __($help_patch_modes{$patch_mode}), "\n",
1269                 map { "$_\n" } grep {
1270                         my $c = quotemeta(substr($_, 0, 1));
1271                         $other =~ /,$c/
1272                 } split "\n", __ <<EOF ;
1273 g - select a hunk to go to
1274 / - search for a hunk matching the given regex
1275 j - leave this hunk undecided, see next undecided hunk
1276 J - leave this hunk undecided, see next hunk
1277 k - leave this hunk undecided, see previous undecided hunk
1278 K - leave this hunk undecided, see previous hunk
1279 s - split the current hunk into smaller hunks
1280 e - manually edit the current hunk
1281 ? - print help
1282 EOF
1283 }
1284
1285 sub apply_patch {
1286         my $cmd = shift;
1287         my $ret = run_git_apply $cmd, @_;
1288         if (!$ret) {
1289                 print STDERR @_;
1290         }
1291         return $ret;
1292 }
1293
1294 sub apply_patch_for_checkout_commit {
1295         my $reverse = shift;
1296         my $applies_index = run_git_apply 'apply '.$reverse.' --cached --check', @_;
1297         my $applies_worktree = run_git_apply 'apply '.$reverse.' --check', @_;
1298
1299         if ($applies_worktree && $applies_index) {
1300                 run_git_apply 'apply '.$reverse.' --cached', @_;
1301                 run_git_apply 'apply '.$reverse, @_;
1302                 return 1;
1303         } elsif (!$applies_index) {
1304                 print colored $error_color, __("The selected hunks do not apply to the index!\n");
1305                 if (prompt_yesno __("Apply them to the worktree anyway? ")) {
1306                         return run_git_apply 'apply '.$reverse, @_;
1307                 } else {
1308                         print colored $error_color, __("Nothing was applied.\n");
1309                         return 0;
1310                 }
1311         } else {
1312                 print STDERR @_;
1313                 return 0;
1314         }
1315 }
1316
1317 sub patch_update_cmd {
1318         my @all_mods = list_modified($patch_mode_flavour{FILTER});
1319         error_msg sprintf(__("ignoring unmerged: %s\n"), $_->{VALUE})
1320                 for grep { $_->{UNMERGED} } @all_mods;
1321         @all_mods = grep { !$_->{UNMERGED} } @all_mods;
1322
1323         my @mods = grep { !($_->{BINARY}) } @all_mods;
1324         my @them;
1325
1326         if (!@mods) {
1327                 if (@all_mods) {
1328                         print STDERR __("Only binary files changed.\n");
1329                 } else {
1330                         print STDERR __("No changes.\n");
1331                 }
1332                 return 0;
1333         }
1334         if ($patch_mode_only) {
1335                 @them = @mods;
1336         }
1337         else {
1338                 @them = list_and_choose({ PROMPT => __('Patch update'),
1339                                           HEADER => $status_head, },
1340                                         @mods);
1341         }
1342         for (@them) {
1343                 return 0 if patch_update_file($_->{VALUE});
1344         }
1345 }
1346
1347 # Generate a one line summary of a hunk.
1348 sub summarize_hunk {
1349         my $rhunk = shift;
1350         my $summary = $rhunk->{TEXT}[0];
1351
1352         # Keep the line numbers, discard extra context.
1353         $summary =~ s/@@(.*?)@@.*/$1 /s;
1354         $summary .= " " x (20 - length $summary);
1355
1356         # Add some user context.
1357         for my $line (@{$rhunk->{TEXT}}) {
1358                 if ($line =~ m/^[+-].*\w/) {
1359                         $summary .= $line;
1360                         last;
1361                 }
1362         }
1363
1364         chomp $summary;
1365         return substr($summary, 0, 80) . "\n";
1366 }
1367
1368
1369 # Print a one-line summary of each hunk in the array ref in
1370 # the first argument, starting with the index in the 2nd.
1371 sub display_hunks {
1372         my ($hunks, $i) = @_;
1373         my $ctr = 0;
1374         $i ||= 0;
1375         for (; $i < @$hunks && $ctr < 20; $i++, $ctr++) {
1376                 my $status = " ";
1377                 if (defined $hunks->[$i]{USE}) {
1378                         $status = $hunks->[$i]{USE} ? "+" : "-";
1379                 }
1380                 printf "%s%2d: %s",
1381                         $status,
1382                         $i + 1,
1383                         summarize_hunk($hunks->[$i]);
1384         }
1385         return $i;
1386 }
1387
1388 my %patch_update_prompt_modes = (
1389         stage => {
1390                 mode => N__("Stage mode change [y,n,q,a,d%s,?]? "),
1391                 deletion => N__("Stage deletion [y,n,q,a,d%s,?]? "),
1392                 hunk => N__("Stage this hunk [y,n,q,a,d%s,?]? "),
1393         },
1394         stash => {
1395                 mode => N__("Stash mode change [y,n,q,a,d%s,?]? "),
1396                 deletion => N__("Stash deletion [y,n,q,a,d%s,?]? "),
1397                 hunk => N__("Stash this hunk [y,n,q,a,d%s,?]? "),
1398         },
1399         reset_head => {
1400                 mode => N__("Unstage mode change [y,n,q,a,d%s,?]? "),
1401                 deletion => N__("Unstage deletion [y,n,q,a,d%s,?]? "),
1402                 hunk => N__("Unstage this hunk [y,n,q,a,d%s,?]? "),
1403         },
1404         reset_nothead => {
1405                 mode => N__("Apply mode change to index [y,n,q,a,d%s,?]? "),
1406                 deletion => N__("Apply deletion to index [y,n,q,a,d%s,?]? "),
1407                 hunk => N__("Apply this hunk to index [y,n,q,a,d%s,?]? "),
1408         },
1409         checkout_index => {
1410                 mode => N__("Discard mode change from worktree [y,n,q,a,d%s,?]? "),
1411                 deletion => N__("Discard deletion from worktree [y,n,q,a,d%s,?]? "),
1412                 hunk => N__("Discard this hunk from worktree [y,n,q,a,d%s,?]? "),
1413         },
1414         checkout_head => {
1415                 mode => N__("Discard mode change from index and worktree [y,n,q,a,d%s,?]? "),
1416                 deletion => N__("Discard deletion from index and worktree [y,n,q,a,d%s,?]? "),
1417                 hunk => N__("Discard this hunk from index and worktree [y,n,q,a,d%s,?]? "),
1418         },
1419         checkout_nothead => {
1420                 mode => N__("Apply mode change to index and worktree [y,n,q,a,d%s,?]? "),
1421                 deletion => N__("Apply deletion to index and worktree [y,n,q,a,d%s,?]? "),
1422                 hunk => N__("Apply this hunk to index and worktree [y,n,q,a,d%s,?]? "),
1423         },
1424 );
1425
1426 sub patch_update_file {
1427         my $quit = 0;
1428         my ($ix, $num);
1429         my $path = shift;
1430         my ($head, @hunk) = parse_diff($path);
1431         ($head, my $mode, my $deletion) = parse_diff_header($head);
1432         for (@{$head->{DISPLAY}}) {
1433                 print;
1434         }
1435
1436         if (@{$mode->{TEXT}}) {
1437                 unshift @hunk, $mode;
1438         }
1439         if (@{$deletion->{TEXT}}) {
1440                 foreach my $hunk (@hunk) {
1441                         push @{$deletion->{TEXT}}, @{$hunk->{TEXT}};
1442                         push @{$deletion->{DISPLAY}}, @{$hunk->{DISPLAY}};
1443                 }
1444                 @hunk = ($deletion);
1445         }
1446
1447         $num = scalar @hunk;
1448         $ix = 0;
1449
1450         while (1) {
1451                 my ($prev, $next, $other, $undecided, $i);
1452                 $other = '';
1453
1454                 if ($num <= $ix) {
1455                         $ix = 0;
1456                 }
1457                 for ($i = 0; $i < $ix; $i++) {
1458                         if (!defined $hunk[$i]{USE}) {
1459                                 $prev = 1;
1460                                 $other .= ',k';
1461                                 last;
1462                         }
1463                 }
1464                 if ($ix) {
1465                         $other .= ',K';
1466                 }
1467                 for ($i = $ix + 1; $i < $num; $i++) {
1468                         if (!defined $hunk[$i]{USE}) {
1469                                 $next = 1;
1470                                 $other .= ',j';
1471                                 last;
1472                         }
1473                 }
1474                 if ($ix < $num - 1) {
1475                         $other .= ',J';
1476                 }
1477                 if ($num > 1) {
1478                         $other .= ',g,/';
1479                 }
1480                 for ($i = 0; $i < $num; $i++) {
1481                         if (!defined $hunk[$i]{USE}) {
1482                                 $undecided = 1;
1483                                 last;
1484                         }
1485                 }
1486                 last if (!$undecided);
1487
1488                 if ($hunk[$ix]{TYPE} eq 'hunk' &&
1489                     hunk_splittable($hunk[$ix]{TEXT})) {
1490                         $other .= ',s';
1491                 }
1492                 if ($hunk[$ix]{TYPE} eq 'hunk') {
1493                         $other .= ',e';
1494                 }
1495                 for (@{$hunk[$ix]{DISPLAY}}) {
1496                         print;
1497                 }
1498                 print colored $prompt_color,
1499                         sprintf(__($patch_update_prompt_modes{$patch_mode}{$hunk[$ix]{TYPE}}), $other);
1500
1501                 my $line = prompt_single_character;
1502                 last unless defined $line;
1503                 if ($line) {
1504                         if ($line =~ /^y/i) {
1505                                 $hunk[$ix]{USE} = 1;
1506                         }
1507                         elsif ($line =~ /^n/i) {
1508                                 $hunk[$ix]{USE} = 0;
1509                         }
1510                         elsif ($line =~ /^a/i) {
1511                                 while ($ix < $num) {
1512                                         if (!defined $hunk[$ix]{USE}) {
1513                                                 $hunk[$ix]{USE} = 1;
1514                                         }
1515                                         $ix++;
1516                                 }
1517                                 next;
1518                         }
1519                         elsif ($line =~ /^g(.*)/) {
1520                                 my $response = $1;
1521                                 unless ($other =~ /g/) {
1522                                         error_msg __("No other hunks to goto\n");
1523                                         next;
1524                                 }
1525                                 my $no = $ix > 10 ? $ix - 10 : 0;
1526                                 while ($response eq '') {
1527                                         $no = display_hunks(\@hunk, $no);
1528                                         if ($no < $num) {
1529                                                 print __("go to which hunk (<ret> to see more)? ");
1530                                         } else {
1531                                                 print __("go to which hunk? ");
1532                                         }
1533                                         $response = <STDIN>;
1534                                         if (!defined $response) {
1535                                                 $response = '';
1536                                         }
1537                                         chomp $response;
1538                                 }
1539                                 if ($response !~ /^\s*\d+\s*$/) {
1540                                         error_msg sprintf(__("Invalid number: '%s'\n"),
1541                                                              $response);
1542                                 } elsif (0 < $response && $response <= $num) {
1543                                         $ix = $response - 1;
1544                                 } else {
1545                                         error_msg sprintf(__n("Sorry, only %d hunk available.\n",
1546                                                               "Sorry, only %d hunks available.\n", $num), $num);
1547                                 }
1548                                 next;
1549                         }
1550                         elsif ($line =~ /^d/i) {
1551                                 while ($ix < $num) {
1552                                         if (!defined $hunk[$ix]{USE}) {
1553                                                 $hunk[$ix]{USE} = 0;
1554                                         }
1555                                         $ix++;
1556                                 }
1557                                 next;
1558                         }
1559                         elsif ($line =~ /^q/i) {
1560                                 for ($i = 0; $i < $num; $i++) {
1561                                         if (!defined $hunk[$i]{USE}) {
1562                                                 $hunk[$i]{USE} = 0;
1563                                         }
1564                                 }
1565                                 $quit = 1;
1566                                 last;
1567                         }
1568                         elsif ($line =~ m|^/(.*)|) {
1569                                 my $regex = $1;
1570                                 unless ($other =~ m|/|) {
1571                                         error_msg __("No other hunks to search\n");
1572                                         next;
1573                                 }
1574                                 if ($regex eq "") {
1575                                         print colored $prompt_color, __("search for regex? ");
1576                                         $regex = <STDIN>;
1577                                         if (defined $regex) {
1578                                                 chomp $regex;
1579                                         }
1580                                 }
1581                                 my $search_string;
1582                                 eval {
1583                                         $search_string = qr{$regex}m;
1584                                 };
1585                                 if ($@) {
1586                                         my ($err,$exp) = ($@, $1);
1587                                         $err =~ s/ at .*git-add--interactive line \d+, <STDIN> line \d+.*$//;
1588                                         error_msg sprintf(__("Malformed search regexp %s: %s\n"), $exp, $err);
1589                                         next;
1590                                 }
1591                                 my $iy = $ix;
1592                                 while (1) {
1593                                         my $text = join ("", @{$hunk[$iy]{TEXT}});
1594                                         last if ($text =~ $search_string);
1595                                         $iy++;
1596                                         $iy = 0 if ($iy >= $num);
1597                                         if ($ix == $iy) {
1598                                                 error_msg __("No hunk matches the given pattern\n");
1599                                                 last;
1600                                         }
1601                                 }
1602                                 $ix = $iy;
1603                                 next;
1604                         }
1605                         elsif ($line =~ /^K/) {
1606                                 if ($other =~ /K/) {
1607                                         $ix--;
1608                                 }
1609                                 else {
1610                                         error_msg __("No previous hunk\n");
1611                                 }
1612                                 next;
1613                         }
1614                         elsif ($line =~ /^J/) {
1615                                 if ($other =~ /J/) {
1616                                         $ix++;
1617                                 }
1618                                 else {
1619                                         error_msg __("No next hunk\n");
1620                                 }
1621                                 next;
1622                         }
1623                         elsif ($line =~ /^k/) {
1624                                 if ($other =~ /k/) {
1625                                         while (1) {
1626                                                 $ix--;
1627                                                 last if (!$ix ||
1628                                                          !defined $hunk[$ix]{USE});
1629                                         }
1630                                 }
1631                                 else {
1632                                         error_msg __("No previous hunk\n");
1633                                 }
1634                                 next;
1635                         }
1636                         elsif ($line =~ /^j/) {
1637                                 if ($other !~ /j/) {
1638                                         error_msg __("No next hunk\n");
1639                                         next;
1640                                 }
1641                         }
1642                         elsif ($line =~ /^s/) {
1643                                 unless ($other =~ /s/) {
1644                                         error_msg __("Sorry, cannot split this hunk\n");
1645                                         next;
1646                                 }
1647                                 my @split = split_hunk($hunk[$ix]{TEXT}, $hunk[$ix]{DISPLAY});
1648                                 if (1 < @split) {
1649                                         print colored $header_color, sprintf(
1650                                                 __n("Split into %d hunk.\n",
1651                                                     "Split into %d hunks.\n",
1652                                                     scalar(@split)), scalar(@split));
1653                                 }
1654                                 splice (@hunk, $ix, 1, @split);
1655                                 $num = scalar @hunk;
1656                                 next;
1657                         }
1658                         elsif ($line =~ /^e/) {
1659                                 unless ($other =~ /e/) {
1660                                         error_msg __("Sorry, cannot edit this hunk\n");
1661                                         next;
1662                                 }
1663                                 my $newhunk = edit_hunk_loop($head, \@hunk, $ix);
1664                                 if (defined $newhunk) {
1665                                         splice @hunk, $ix, 1, $newhunk;
1666                                 }
1667                         }
1668                         else {
1669                                 help_patch_cmd($other);
1670                                 next;
1671                         }
1672                         # soft increment
1673                         while (1) {
1674                                 $ix++;
1675                                 last if ($ix >= $num ||
1676                                          !defined $hunk[$ix]{USE});
1677                         }
1678                 }
1679         }
1680
1681         @hunk = coalesce_overlapping_hunks(@hunk);
1682
1683         my $n_lofs = 0;
1684         my @result = ();
1685         for (@hunk) {
1686                 if ($_->{USE}) {
1687                         push @result, @{$_->{TEXT}};
1688                 }
1689         }
1690
1691         if (@result) {
1692                 my @patch = reassemble_patch($head->{TEXT}, @result);
1693                 my $apply_routine = $patch_mode_flavour{APPLY};
1694                 &$apply_routine(@patch);
1695                 refresh();
1696         }
1697
1698         print "\n";
1699         return $quit;
1700 }
1701
1702 sub diff_cmd {
1703         my @mods = list_modified('index-only');
1704         @mods = grep { !($_->{BINARY}) } @mods;
1705         return if (!@mods);
1706         my (@them) = list_and_choose({ PROMPT => __('Review diff'),
1707                                      IMMEDIATE => 1,
1708                                      HEADER => $status_head, },
1709                                    @mods);
1710         return if (!@them);
1711         my $reference = (is_initial_commit()) ? get_empty_tree() : 'HEAD';
1712         system(qw(git diff -p --cached), $reference, '--',
1713                 map { $_->{VALUE} } @them);
1714 }
1715
1716 sub quit_cmd {
1717         print __("Bye.\n");
1718         exit(0);
1719 }
1720
1721 sub help_cmd {
1722 # TRANSLATORS: please do not translate the command names
1723 # 'status', 'update', 'revert', etc.
1724         print colored $help_color, __ <<'EOF' ;
1725 status        - show paths with changes
1726 update        - add working tree state to the staged set of changes
1727 revert        - revert staged set of changes back to the HEAD version
1728 patch         - pick hunks and update selectively
1729 diff          - view diff between HEAD and index
1730 add untracked - add contents of untracked files to the staged set of changes
1731 EOF
1732 }
1733
1734 sub process_args {
1735         return unless @ARGV;
1736         my $arg = shift @ARGV;
1737         if ($arg =~ /--patch(?:=(.*))?/) {
1738                 if (defined $1) {
1739                         if ($1 eq 'reset') {
1740                                 $patch_mode = 'reset_head';
1741                                 $patch_mode_revision = 'HEAD';
1742                                 $arg = shift @ARGV or die __("missing --");
1743                                 if ($arg ne '--') {
1744                                         $patch_mode_revision = $arg;
1745                                         $patch_mode = ($arg eq 'HEAD' ?
1746                                                        'reset_head' : 'reset_nothead');
1747                                         $arg = shift @ARGV or die __("missing --");
1748                                 }
1749                         } elsif ($1 eq 'checkout') {
1750                                 $arg = shift @ARGV or die __("missing --");
1751                                 if ($arg eq '--') {
1752                                         $patch_mode = 'checkout_index';
1753                                 } else {
1754                                         $patch_mode_revision = $arg;
1755                                         $patch_mode = ($arg eq 'HEAD' ?
1756                                                        'checkout_head' : 'checkout_nothead');
1757                                         $arg = shift @ARGV or die __("missing --");
1758                                 }
1759                         } elsif ($1 eq 'stage' or $1 eq 'stash') {
1760                                 $patch_mode = $1;
1761                                 $arg = shift @ARGV or die __("missing --");
1762                         } else {
1763                                 die sprintf(__("unknown --patch mode: %s"), $1);
1764                         }
1765                 } else {
1766                         $patch_mode = 'stage';
1767                         $arg = shift @ARGV or die __("missing --");
1768                 }
1769                 die sprintf(__("invalid argument %s, expecting --"),
1770                                $arg) unless $arg eq "--";
1771                 %patch_mode_flavour = %{$patch_modes{$patch_mode}};
1772                 $patch_mode_only = 1;
1773         }
1774         elsif ($arg ne "--") {
1775                 die sprintf(__("invalid argument %s, expecting --"), $arg);
1776         }
1777 }
1778
1779 sub main_loop {
1780         my @cmd = ([ 'status', \&status_cmd, ],
1781                    [ 'update', \&update_cmd, ],
1782                    [ 'revert', \&revert_cmd, ],
1783                    [ 'add untracked', \&add_untracked_cmd, ],
1784                    [ 'patch', \&patch_update_cmd, ],
1785                    [ 'diff', \&diff_cmd, ],
1786                    [ 'quit', \&quit_cmd, ],
1787                    [ 'help', \&help_cmd, ],
1788         );
1789         while (1) {
1790                 my ($it) = list_and_choose({ PROMPT => __('What now'),
1791                                              SINGLETON => 1,
1792                                              LIST_FLAT => 4,
1793                                              HEADER => __('*** Commands ***'),
1794                                              ON_EOF => \&quit_cmd,
1795                                              IMMEDIATE => 1 }, @cmd);
1796                 if ($it) {
1797                         eval {
1798                                 $it->[1]->();
1799                         };
1800                         if ($@) {
1801                                 print "$@";
1802                         }
1803                 }
1804         }
1805 }
1806
1807 process_args();
1808 refresh();
1809 if ($patch_mode_only) {
1810         patch_update_cmd();
1811 }
1812 else {
1813         status_cmd();
1814         main_loop();
1815 }