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