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