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