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