[thirdparty/git.git] / git-add--interactive.perl

#!/usr/bin/perl -w

use strict;

sub run_cmd_pipe {
	if ($^O eq 'MSWin32') {
		my @invalid = grep {m/[":*]/} @_;
		die "$^O does not support: @invalid\n" if @invalid;
		my @args = map { m/ /o ? "\"$_\"": $_ } @_;
		return qx{@args};
	} else {
		my $fh = undef;
		open($fh, '-|', @_) or die;
		return <$fh>;
	}
}

my ($GIT_DIR) = run_cmd_pipe(qw(git rev-parse --git-dir));

if (!defined $GIT_DIR) {
	exit(1); # rev-parse would have already said "not a git repo"
}
chomp($GIT_DIR);

sub refresh {
	my $fh;
	open $fh, 'git update-index --refresh |'
	    or die;
	while (<$fh>) {
		;# ignore 'needs update'
	}
	close $fh;
}

sub list_untracked {
	map {
		chomp $_;
		$_;
	}
	run_cmd_pipe(qw(git ls-files --others --exclude-standard --), @_);
}

my $status_fmt = '%12s %12s %s';
my $status_head = sprintf($status_fmt, 'staged', 'unstaged', 'path');

# Returns list of hashes, contents of each of which are:
# PRINT:	print message
# VALUE:	pathname
# BINARY:	is a binary path
# INDEX:	is index different from HEAD?
# FILE:		is file different from index?
# INDEX_ADDDEL:	is it add/delete between HEAD and index?
# FILE_ADDDEL:	is it add/delete between index and file?

sub list_modified {
	my ($only) = @_;
	my (%data, @return);
	my ($add, $del, $adddel, $file);

	for (run_cmd_pipe(qw(git diff-index --cached
			     --numstat --summary HEAD))) {
		if (($add, $del, $file) =
		    /^([-\d]+)	([-\d]+)	(.*)/) {
			my ($change, $bin);
			if ($add eq '-' && $del eq '-') {
				$change = 'binary';
				$bin = 1;
			}
			else {
				$change = "+$add/-$del";
			}
			$data{$file} = {
				INDEX => $change,
				BINARY => $bin,
				FILE => 'nothing',
			}
		}
		elsif (($adddel, $file) =
		       /^ (create|delete) mode [0-7]+ (.*)$/) {
			$data{$file}{INDEX_ADDDEL} = $adddel;
		}
	}

	for (run_cmd_pipe(qw(git diff-files --numstat --summary))) {
		if (($add, $del, $file) =
		    /^([-\d]+)	([-\d]+)	(.*)/) {
			if (!exists $data{$file}) {
				$data{$file} = +{
					INDEX => 'unchanged',
					BINARY => 0,
				};
			}
			my ($change, $bin);
			if ($add eq '-' && $del eq '-') {
				$change = 'binary';
				$bin = 1;
			}
			else {
				$change = "+$add/-$del";
			}
			$data{$file}{FILE} = $change;
			if ($bin) {
				$data{$file}{BINARY} = 1;
			}
		}
		elsif (($adddel, $file) =
		       /^ (create|delete) mode [0-7]+ (.*)$/) {
			$data{$file}{FILE_ADDDEL} = $adddel;
		}
	}

	for (sort keys %data) {
		my $it = $data{$_};

		if ($only) {
			if ($only eq 'index-only') {
				next if ($it->{INDEX} eq 'unchanged');
			}
			if ($only eq 'file-only') {
				next if ($it->{FILE} eq 'nothing');
			}
		}
		push @return, +{
			VALUE => $_,
			PRINT => (sprintf $status_fmt,
				  $it->{INDEX}, $it->{FILE}, $_),
			%$it,
		};
	}
	return @return;
}

sub find_unique {
	my ($string, @stuff) = @_;
	my $found = undef;
	for (my $i = 0; $i < @stuff; $i++) {
		my $it = $stuff[$i];
		my $hit = undef;
		if (ref $it) {
			if ((ref $it) eq 'ARRAY') {
				$it = $it->[0];
			}
			else {
				$it = $it->{VALUE};
			}
		}
		eval {
			if ($it =~ /^$string/) {
				$hit = 1;
			};
		};
		if (defined $hit && defined $found) {
			return undef;
		}
		if ($hit) {
			$found = $i + 1;
		}
	}
	return $found;
}

sub list_and_choose {
	my ($opts, @stuff) = @_;
	my (@chosen, @return);
	my $i;

      TOPLOOP:
	while (1) {
		my $last_lf = 0;

		if ($opts->{HEADER}) {
			if (!$opts->{LIST_FLAT}) {
				print "     ";
			}
			print "$opts->{HEADER}\n";
		}
		for ($i = 0; $i < @stuff; $i++) {
			my $chosen = $chosen[$i] ? '*' : ' ';
			my $print = $stuff[$i];
			if (ref $print) {
				if ((ref $print) eq 'ARRAY') {
					$print = $print->[0];
				}
				else {
					$print = $print->{PRINT};
				}
			}
			printf("%s%2d: %s", $chosen, $i+1, $print);
			if (($opts->{LIST_FLAT}) &&
			    (($i + 1) % ($opts->{LIST_FLAT}))) {
				print "\t";
				$last_lf = 0;
			}
			else {
				print "\n";
				$last_lf = 1;
			}
		}
		if (!$last_lf) {
			print "\n";
		}

		return if ($opts->{LIST_ONLY});

		print $opts->{PROMPT};
		if ($opts->{SINGLETON}) {
			print "> ";
		}
		else {
			print ">> ";
		}
		my $line = <STDIN>;
		if (!$line) {
			print "\n";
			$opts->{ON_EOF}->() if $opts->{ON_EOF};
			last;
		}
		chomp $line;
		last if $line eq '';
		for my $choice (split(/[\s,]+/, $line)) {
			my $choose = 1;
			my ($bottom, $top);

			# Input that begins with '-'; unchoose
			if ($choice =~ s/^-//) {
				$choose = 0;
			}
			# A range can be specified like 5-7
			if ($choice =~ /^(\d+)-(\d+)$/) {
				($bottom, $top) = ($1, $2);
			}
			elsif ($choice =~ /^\d+$/) {
				$bottom = $top = $choice;
			}
			elsif ($choice eq '*') {
				$bottom = 1;
				$top = 1 + @stuff;
			}
			else {
				$bottom = $top = find_unique($choice, @stuff);
				if (!defined $bottom) {
					print "Huh ($choice)?\n";
					next TOPLOOP;
				}
			}
			if ($opts->{SINGLETON} && $bottom != $top) {
				print "Huh ($choice)?\n";
				next TOPLOOP;
			}
			for ($i = $bottom-1; $i <= $top-1; $i++) {
				next if (@stuff <= $i || $i < 0);
				$chosen[$i] = $choose;
			}
		}
		last if ($opts->{IMMEDIATE});
	}
	for ($i = 0; $i < @stuff; $i++) {
		if ($chosen[$i]) {
			push @return, $stuff[$i];
		}
	}
	return @return;
}

sub status_cmd {
	list_and_choose({ LIST_ONLY => 1, HEADER => $status_head },
			list_modified());
	print "\n";
}

sub say_n_paths {
	my $did = shift @_;
	my $cnt = scalar @_;
	print "$did ";
	if (1 < $cnt) {
		print "$cnt paths\n";
	}
	else {
		print "one path\n";
	}
}

sub update_cmd {
	my @mods = list_modified('file-only');
	return if (!@mods);

	my @update = list_and_choose({ PROMPT => 'Update',
				       HEADER => $status_head, },
				     @mods);
	if (@update) {
		system(qw(git update-index --add --remove --),
		       map { $_->{VALUE} } @update);
		say_n_paths('updated', @update);
	}
	print "\n";
}

sub revert_cmd {
	my @update = list_and_choose({ PROMPT => 'Revert',
				       HEADER => $status_head, },
				     list_modified());
	if (@update) {
		my @lines = run_cmd_pipe(qw(git ls-tree HEAD --),
					 map { $_->{VALUE} } @update);
		my $fh;
		open $fh, '| git update-index --index-info'
		    or die;
		for (@lines) {
			print $fh $_;
		}
		close($fh);
		for (@update) {
			if ($_->{INDEX_ADDDEL} &&
			    $_->{INDEX_ADDDEL} eq 'create') {
				system(qw(git update-index --force-remove --),
				       $_->{VALUE});
				print "note: $_->{VALUE} is untracked now.\n";
			}
		}
		refresh();
		say_n_paths('reverted', @update);
	}
	print "\n";
}

sub add_untracked_cmd {
	my @add = list_and_choose({ PROMPT => 'Add untracked' },
				  list_untracked());
	if (@add) {
		system(qw(git update-index --add --), @add);
		say_n_paths('added', @add);
	}
	print "\n";
}

sub parse_diff {
	my ($path) = @_;
	my @diff = run_cmd_pipe(qw(git diff-files -p --), $path);
	my (@hunk) = { TEXT => [] };

	for (@diff) {
		if (/^@@ /) {
			push @hunk, { TEXT => [] };
		}
		push @{$hunk[-1]{TEXT}}, $_;
	}
	return @hunk;
}

sub hunk_splittable {
	my ($text) = @_;

	my @s = split_hunk($text);
	return (1 < @s);
}

sub parse_hunk_header {
	my ($line) = @_;
	my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
	    $line =~ /^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/;
	$o_cnt = 1 unless defined $o_cnt;
	$n_cnt = 1 unless defined $n_cnt;
	return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
}

sub split_hunk {
	my ($text) = @_;
	my @split = ();

	# If there are context lines in the middle of a hunk,
	# it can be split, but we would need to take care of
	# overlaps later.

	my ($o_ofs, undef, $n_ofs) = parse_hunk_header($text->[0]);
	my $hunk_start = 1;

      OUTER:
	while (1) {
		my $next_hunk_start = undef;
		my $i = $hunk_start - 1;
		my $this = +{
			TEXT => [],
			OLD => $o_ofs,
			NEW => $n_ofs,
			OCNT => 0,
			NCNT => 0,
			ADDDEL => 0,
			POSTCTX => 0,
		};

		while (++$i < @$text) {
			my $line = $text->[$i];
			if ($line =~ /^ /) {
				if ($this->{ADDDEL} &&
				    !defined $next_hunk_start) {
					# We have seen leading context and
					# adds/dels and then here is another
					# context, which is trailing for this
					# split hunk and leading for the next
					# one.
					$next_hunk_start = $i;
				}
				push @{$this->{TEXT}}, $line;
				$this->{OCNT}++;
				$this->{NCNT}++;
				if (defined $next_hunk_start) {
					$this->{POSTCTX}++;
				}
				next;
			}

			# add/del
			if (defined $next_hunk_start) {
				# We are done with the current hunk and
				# this is the first real change for the
				# next split one.
				$hunk_start = $next_hunk_start;
				$o_ofs = $this->{OLD} + $this->{OCNT};
				$n_ofs = $this->{NEW} + $this->{NCNT};
				$o_ofs -= $this->{POSTCTX};
				$n_ofs -= $this->{POSTCTX};
				push @split, $this;
				redo OUTER;
			}
			push @{$this->{TEXT}}, $line;
			$this->{ADDDEL}++;
			if ($line =~ /^-/) {
				$this->{OCNT}++;
			}
			else {
				$this->{NCNT}++;
			}
		}

		push @split, $this;
		last;
	}

	for my $hunk (@split) {
		$o_ofs = $hunk->{OLD};
		$n_ofs = $hunk->{NEW};
		my $o_cnt = $hunk->{OCNT};
		my $n_cnt = $hunk->{NCNT};

		my $head = ("@@ -$o_ofs" .
			    (($o_cnt != 1) ? ",$o_cnt" : '') .
			    " +$n_ofs" .
			    (($n_cnt != 1) ? ",$n_cnt" : '') .
			    " @@\n");
		unshift @{$hunk->{TEXT}}, $head;
	}
	return map { $_->{TEXT} } @split;
}

sub find_last_o_ctx {
	my ($it) = @_;
	my $text = $it->{TEXT};
	my ($o_ofs, $o_cnt) = parse_hunk_header($text->[0]);
	my $i = @{$text};
	my $last_o_ctx = $o_ofs + $o_cnt;
	while (0 < --$i) {
		my $line = $text->[$i];
		if ($line =~ /^ /) {
			$last_o_ctx--;
			next;
		}
		last;
	}
	return $last_o_ctx;
}

sub merge_hunk {
	my ($prev, $this) = @_;
	my ($o0_ofs, $o0_cnt, $n0_ofs, $n0_cnt) =
	    parse_hunk_header($prev->{TEXT}[0]);
	my ($o1_ofs, $o1_cnt, $n1_ofs, $n1_cnt) =
	    parse_hunk_header($this->{TEXT}[0]);

	my (@line, $i, $ofs, $o_cnt, $n_cnt);
	$ofs = $o0_ofs;
	$o_cnt = $n_cnt = 0;
	for ($i = 1; $i < @{$prev->{TEXT}}; $i++) {
		my $line = $prev->{TEXT}[$i];
		if ($line =~ /^\+/) {
			$n_cnt++;
			push @line, $line;
			next;
		}

		last if ($o1_ofs <= $ofs);

		$o_cnt++;
		$ofs++;
		if ($line =~ /^ /) {
			$n_cnt++;
		}
		push @line, $line;
	}

	for ($i = 1; $i < @{$this->{TEXT}}; $i++) {
		my $line = $this->{TEXT}[$i];
		if ($line =~ /^\+/) {
			$n_cnt++;
			push @line, $line;
			next;
		}
		$ofs++;
		$o_cnt++;
		if ($line =~ /^ /) {
			$n_cnt++;
		}
		push @line, $line;
	}
	my $head = ("@@ -$o0_ofs" .
		    (($o_cnt != 1) ? ",$o_cnt" : '') .
		    " +$n0_ofs" .
		    (($n_cnt != 1) ? ",$n_cnt" : '') .
		    " @@\n");
	@{$prev->{TEXT}} = ($head, @line);
}

sub coalesce_overlapping_hunks {
	my (@in) = @_;
	my @out = ();

	my ($last_o_ctx);

	for (grep { $_->{USE} } @in) {
		my $text = $_->{TEXT};
		my ($o_ofs) = parse_hunk_header($text->[0]);
		if (defined $last_o_ctx &&
		    $o_ofs <= $last_o_ctx) {
			merge_hunk($out[-1], $_);
		}
		else {
			push @out, $_;
		}
		$last_o_ctx = find_last_o_ctx($out[-1]);
	}
	return @out;
}

sub help_patch_cmd {
	print <<\EOF ;
y - stage this hunk
n - do not stage this hunk
a - stage this and all the remaining hunks
d - do not stage this hunk nor any of the remaining hunks
j - leave this hunk undecided, see next undecided hunk
J - leave this hunk undecided, see next hunk
k - leave this hunk undecided, see previous undecided hunk
K - leave this hunk undecided, see previous hunk
s - split the current hunk into smaller hunks
EOF
}

sub patch_update_cmd {
	my @mods = list_modified('file-only');
	@mods = grep { !($_->{BINARY}) } @mods;
	return if (!@mods);

	my ($it) = list_and_choose({ PROMPT => 'Patch update',
				     SINGLETON => 1,
				     IMMEDIATE => 1,
				     HEADER => $status_head, },
				   @mods);
	return if (!$it);

	my ($ix, $num);
	my $path = $it->{VALUE};
	my ($head, @hunk) = parse_diff($path);
	for (@{$head->{TEXT}}) {
		print;
	}
	$num = scalar @hunk;
	$ix = 0;

	while (1) {
		my ($prev, $next, $other, $undecided, $i);
		$other = '';

		if ($num <= $ix) {
			$ix = 0;
		}
		for ($i = 0; $i < $ix; $i++) {
			if (!defined $hunk[$i]{USE}) {
				$prev = 1;
				$other .= '/k';
				last;
			}
		}
		if ($ix) {
			$other .= '/K';
		}
		for ($i = $ix + 1; $i < $num; $i++) {
			if (!defined $hunk[$i]{USE}) {
				$next = 1;
				$other .= '/j';
				last;
			}
		}
		if ($ix < $num - 1) {
			$other .= '/J';
		}
		for ($i = 0; $i < $num; $i++) {
			if (!defined $hunk[$i]{USE}) {
				$undecided = 1;
				last;
			}
		}
		last if (!$undecided);

		if (hunk_splittable($hunk[$ix]{TEXT})) {
			$other .= '/s';
		}
		for (@{$hunk[$ix]{TEXT}}) {
			print;
		}
		print "Stage this hunk [y/n/a/d$other/?]? ";
		my $line = <STDIN>;
		if ($line) {
			if ($line =~ /^y/i) {
				$hunk[$ix]{USE} = 1;
			}
			elsif ($line =~ /^n/i) {
				$hunk[$ix]{USE} = 0;
			}
			elsif ($line =~ /^a/i) {
				while ($ix < $num) {
					if (!defined $hunk[$ix]{USE}) {
						$hunk[$ix]{USE} = 1;
					}
					$ix++;
				}
				next;
			}
			elsif ($line =~ /^d/i) {
				while ($ix < $num) {
					if (!defined $hunk[$ix]{USE}) {
						$hunk[$ix]{USE} = 0;
					}
					$ix++;
				}
				next;
			}
			elsif ($other =~ /K/ && $line =~ /^K/) {
				$ix--;
				next;
			}
			elsif ($other =~ /J/ && $line =~ /^J/) {
				$ix++;
				next;
			}
			elsif ($other =~ /k/ && $line =~ /^k/) {
				while (1) {
					$ix--;
					last if (!$ix ||
						 !defined $hunk[$ix]{USE});
				}
				next;
			}
			elsif ($other =~ /j/ && $line =~ /^j/) {
				while (1) {
					$ix++;
					last if ($ix >= $num ||
						 !defined $hunk[$ix]{USE});
				}
				next;
			}
			elsif ($other =~ /s/ && $line =~ /^s/) {
				my @split = split_hunk($hunk[$ix]{TEXT});
				if (1 < @split) {
					print "Split into ",
					scalar(@split), " hunks.\n";
				}
				splice(@hunk, $ix, 1,
				       map { +{ TEXT => $_, USE => undef } }
				       @split);
				$num = scalar @hunk;
				next;
			}
			else {
				help_patch_cmd($other);
				next;
			}
			# soft increment
			while (1) {
				$ix++;
				last if ($ix >= $num ||
					 !defined $hunk[$ix]{USE});
			}
		}
	}

	@hunk = coalesce_overlapping_hunks(@hunk);

	my $n_lofs = 0;
	my @result = ();
	for (@hunk) {
		my $text = $_->{TEXT};
		my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
		    parse_hunk_header($text->[0]);

		if (!$_->{USE}) {
			# We would have added ($n_cnt - $o_cnt) lines
			# to the postimage if we were to use this hunk,
			# but we didn't.  So the line number that the next
			# hunk starts at would be shifted by that much.
			$n_lofs -= ($n_cnt - $o_cnt);
			next;
		}
		else {
			if ($n_lofs) {
				$n_ofs += $n_lofs;
				$text->[0] = ("@@ -$o_ofs" .
					      (($o_cnt != 1)
					       ? ",$o_cnt" : '') .
					      " +$n_ofs" .
					      (($n_cnt != 1)
					       ? ",$n_cnt" : '') .
					      " @@\n");
			}
			for (@$text) {
				push @result, $_;
			}
		}
	}

	if (@result) {
		my $fh;

		open $fh, '| git apply --cached';
		for (@{$head->{TEXT}}, @result) {
			print $fh $_;
		}
		if (!close $fh) {
			for (@{$head->{TEXT}}, @result) {
				print STDERR $_;
			}
		}
		refresh();
	}

	print "\n";
}

sub diff_cmd {
	my @mods = list_modified('index-only');
	@mods = grep { !($_->{BINARY}) } @mods;
	return if (!@mods);
	my (@them) = list_and_choose({ PROMPT => 'Review diff',
				     IMMEDIATE => 1,
				     HEADER => $status_head, },
				   @mods);
	return if (!@them);
	system(qw(git diff-index -p --cached HEAD --),
	       map { $_->{VALUE} } @them);
}

sub quit_cmd {
	print "Bye.\n";
	exit(0);
}

sub help_cmd {
	print <<\EOF ;
status        - show paths with changes
update        - add working tree state to the staged set of changes
revert        - revert staged set of changes back to the HEAD version
patch         - pick hunks and update selectively
diff	      - view diff between HEAD and index
add untracked - add contents of untracked files to the staged set of changes
EOF
}

sub main_loop {
	my @cmd = ([ 'status', \&status_cmd, ],
		   [ 'update', \&update_cmd, ],
		   [ 'revert', \&revert_cmd, ],
		   [ 'add untracked', \&add_untracked_cmd, ],
		   [ 'patch', \&patch_update_cmd, ],
		   [ 'diff', \&diff_cmd, ],
		   [ 'quit', \&quit_cmd, ],
		   [ 'help', \&help_cmd, ],
	);
	while (1) {
		my ($it) = list_and_choose({ PROMPT => 'What now',
					     SINGLETON => 1,
					     LIST_FLAT => 4,
					     HEADER => '*** Commands ***',
					     ON_EOF => \&quit_cmd,
					     IMMEDIATE => 1 }, @cmd);
		if ($it) {
			eval {
				$it->[1]->();
			};
			if ($@) {
				print "$@";
			}
		}
	}
}

refresh();
status_cmd();
main_loop();
Commit	Line	Data
5cde71d6 JH	1	#!/usr/bin/perl -w
	2
	3	use strict;
	4
	5	sub run_cmd_pipe {
21e9757e AR	6	if ($^O eq 'MSWin32') {
	7	my @invalid = grep {m/[":*]/} @_;
	8	die "$^O does not support: @invalid\n" if @invalid;
	9	my @args = map { m/ /o ? "\"$_\"": $_ } @_;
	10	return qx{@args};
	11	} else {
	12	my $fh = undef;
	13	open($fh, '-\|', @_) or die;
	14	return <$fh>;
	15	}
5cde71d6 JH	16	}
	17
	18	my ($GIT_DIR) = run_cmd_pipe(qw(git rev-parse --git-dir));
	19
	20	if (!defined $GIT_DIR) {
	21	exit(1); # rev-parse would have already said "not a git repo"
	22	}
	23	chomp($GIT_DIR);
	24
	25	sub refresh {
	26	my $fh;
21e9757e	27	open $fh, 'git update-index --refresh \|'
5cde71d6 JH	28	or die;
	29	while (<$fh>) {
	30	;# ignore 'needs update'
	31	}
	32	close $fh;
	33	}
	34
	35	sub list_untracked {
	36	map {
	37	chomp $_;
	38	$_;
	39	}
8e7b07c8	40	run_cmd_pipe(qw(git ls-files --others --exclude-standard --), @_);
5cde71d6 JH	41	}
	42
	43	my $status_fmt = '%12s %12s %s';
	44	my $status_head = sprintf($status_fmt, 'staged', 'unstaged', 'path');
	45
	46	# Returns list of hashes, contents of each of which are:
	47	# PRINT: print message
	48	# VALUE: pathname
	49	# BINARY: is a binary path
	50	# INDEX: is index different from HEAD?
	51	# FILE: is file different from index?
	52	# INDEX_ADDDEL: is it add/delete between HEAD and index?
	53	# FILE_ADDDEL: is it add/delete between index and file?
	54
	55	sub list_modified {
	56	my ($only) = @_;
	57	my (%data, @return);
	58	my ($add, $del, $adddel, $file);
	59
	60	for (run_cmd_pipe(qw(git diff-index --cached
	61	--numstat --summary HEAD))) {
	62	if (($add, $del, $file) =
	63	/^([-\d]+) ([-\d]+) (.*)/) {
	64	my ($change, $bin);
	65	if ($add eq '-' && $del eq '-') {
	66	$change = 'binary';
	67	$bin = 1;
	68	}
	69	else {
	70	$change = "+$add/-$del";
	71	}
	72	$data{$file} = {
	73	INDEX => $change,
	74	BINARY => $bin,
	75	FILE => 'nothing',
	76	}
	77	}
	78	elsif (($adddel, $file) =
	79	/^ (create\|delete) mode [0-7]+ (.*)$/) {
	80	$data{$file}{INDEX_ADDDEL} = $adddel;
	81	}
	82	}
	83
	84	for (run_cmd_pipe(qw(git diff-files --numstat --summary))) {
	85	if (($add, $del, $file) =
	86	/^([-\d]+) ([-\d]+) (.*)/) {
	87	if (!exists $data{$file}) {
	88	$data{$file} = +{
	89	INDEX => 'unchanged',
	90	BINARY => 0,
	91	};
	92	}
	93	my ($change, $bin);
	94	if ($add eq '-' && $del eq '-') {
	95	$change = 'binary';
	96	$bin = 1;
	97	}
	98	else {
	99	$change = "+$add/-$del";
	100	}
	101	$data{$file}{FILE} = $change;
	102	if ($bin) {
	103	$data{$file}{BINARY} = 1;
	104	}
105	}
106	elsif (($adddel, $file) =
107	/^ (create\|delete) mode [0-7]+ (.*)$/) {
108	$data{$file}{FILE_ADDDEL} = $adddel;
109	}
110	}
111
112	for (sort keys %data) {
113	my $it = $data{$_};
114
115	if ($only) {
116	if ($only eq 'index-only') {
117	next if ($it->{INDEX} eq 'unchanged');
118	}
119	if ($only eq 'file-only') {
120	next if ($it->{FILE} eq 'nothing');
121	}
122	}
123	push @return, +{
124	VALUE => $_,
125	PRINT => (sprintf $status_fmt,
126	$it->{INDEX}, $it->{FILE}, $_),
127	%$it,
128	};
129	}
130	return @return;
131	}
132
133	sub find_unique {
134	my ($string, @stuff) = @_;
135	my $found = undef;
136	for (my $i = 0; $i < @stuff; $i++) {
137	my $it = $stuff[$i];
138	my $hit = undef;
139	if (ref $it) {
140	if ((ref $it) eq 'ARRAY') {
141	$it = $it->[0];
142	}
143	else {
144	$it = $it->{VALUE};
145	}
146	}
147	eval {
148	if ($it =~ /^$string/) {
149	$hit = 1;
150	};
151	};
152	if (defined $hit && defined $found) {
153	return undef;
154	}
155	if ($hit) {
156	$found = $i + 1;
157	}
158	}
159	return $found;
160	}
161
162	sub list_and_choose {
163	my ($opts, @stuff) = @_;
164	my (@chosen, @return);
165	my $i;
166
167	TOPLOOP:
168	while (1) {
169	my $last_lf = 0;
170
171	if ($opts->{HEADER}) {
172	if (!$opts->{LIST_FLAT}) {
173	print " ";
174	}
175	print "$opts->{HEADER}\n";
176	}
177	for ($i = 0; $i < @stuff; $i++) {
178	my $chosen = $chosen[$i] ? '*' : ' ';
179	my $print = $stuff[$i];
180	if (ref $print) {
181	if ((ref $print) eq 'ARRAY') {
182	$print = $print->[0];
183	}
184	else {
185	$print = $print->{PRINT};
186	}
187	}
188	printf("%s%2d: %s", $chosen, $i+1, $print);
189	if (($opts->{LIST_FLAT}) &&
190	(($i + 1) % ($opts->{LIST_FLAT}))) {
191	print "\t";
192	$last_lf = 0;
193	}
194	else {
195	print "\n";
196	$last_lf = 1;
197	}
198	}
199	if (!$last_lf) {
200	print "\n";
201	}
202
203	return if ($opts->{LIST_ONLY});
204
205	print $opts->{PROMPT};
206	if ($opts->{SINGLETON}) {
207	print "> ";
208	}
209	else {
210	print ">> ";
211	}
212	my $line = <STDIN>;
c95c0248 JLH	213	if (!$line) {
	214	print "\n";
	215	$opts->{ON_EOF}->() if $opts->{ON_EOF};
	216	last;
	217	}
5cde71d6	218	chomp $line;
6a6eb3d0	219	last if $line eq '';
5cde71d6 JH	220	for my $choice (split(/[\s,]+/, $line)) {
	221	my $choose = 1;
	222	my ($bottom, $top);
	223
	224	# Input that begins with '-'; unchoose
	225	if ($choice =~ s/^-//) {
	226	$choose = 0;
	227	}
	228	# A range can be specified like 5-7
	229	if ($choice =~ /^(\d+)-(\d+)$/) {
	230	($bottom, $top) = ($1, $2);
	231	}
	232	elsif ($choice =~ /^\d+$/) {
	233	$bottom = $top = $choice;
	234	}
	235	elsif ($choice eq '*') {
	236	$bottom = 1;
	237	$top = 1 + @stuff;
	238	}
	239	else {
	240	$bottom = $top = find_unique($choice, @stuff);
	241	if (!defined $bottom) {
	242	print "Huh ($choice)?\n";
	243	next TOPLOOP;
	244	}
	245	}
	246	if ($opts->{SINGLETON} && $bottom != $top) {
	247	print "Huh ($choice)?\n";
	248	next TOPLOOP;
	249	}
	250	for ($i = $bottom-1; $i <= $top-1; $i++) {
6a6eb3d0	251	next if (@stuff <= $i \|\| $i < 0);
5cde71d6	252	$chosen[$i] = $choose;
5cde71d6 JH	253	}
5cde71d6 JH	254	}
6a6eb3d0	255	last if ($opts->{IMMEDIATE});
5cde71d6 JH	256	}
	257	for ($i = 0; $i < @stuff; $i++) {
	258	if ($chosen[$i]) {
	259	push @return, $stuff[$i];
	260	}
	261	}
	262	return @return;
	263	}
	264
	265	sub status_cmd {
	266	list_and_choose({ LIST_ONLY => 1, HEADER => $status_head },
	267	list_modified());
	268	print "\n";
	269	}
	270
	271	sub say_n_paths {
	272	my $did = shift @_;
	273	my $cnt = scalar @_;
	274	print "$did ";
	275	if (1 < $cnt) {
	276	print "$cnt paths\n";
	277	}
	278	else {
	279	print "one path\n";
	280	}
	281	}
	282
	283	sub update_cmd {
	284	my @mods = list_modified('file-only');
	285	return if (!@mods);
	286
	287	my @update = list_and_choose({ PROMPT => 'Update',
	288	HEADER => $status_head, },
	289	@mods);
	290	if (@update) {
a4f7112f	291	system(qw(git update-index --add --remove --),
5cde71d6 JH	292	map { $_->{VALUE} } @update);
	293	say_n_paths('updated', @update);
	294	}
	295	print "\n";
	296	}
	297
	298	sub revert_cmd {
	299	my @update = list_and_choose({ PROMPT => 'Revert',
	300	HEADER => $status_head, },
	301	list_modified());
	302	if (@update) {
	303	my @lines = run_cmd_pipe(qw(git ls-tree HEAD --),
	304	map { $_->{VALUE} } @update);
	305	my $fh;
21e9757e	306	open $fh, '\| git update-index --index-info'
5cde71d6 JH	307	or die;
	308	for (@lines) {
	309	print $fh $_;
	310	}
	311	close($fh);
	312	for (@update) {
	313	if ($_->{INDEX_ADDDEL} &&
	314	$_->{INDEX_ADDDEL} eq 'create') {
	315	system(qw(git update-index --force-remove --),
	316	$_->{VALUE});
	317	print "note: $_->{VALUE} is untracked now.\n";
	318	}
	319	}
	320	refresh();
	321	say_n_paths('reverted', @update);
	322	}
	323	print "\n";
	324	}
	325
	326	sub add_untracked_cmd {
	327	my @add = list_and_choose({ PROMPT => 'Add untracked' },
	328	list_untracked());
	329	if (@add) {
	330	system(qw(git update-index --add --), @add);
	331	say_n_paths('added', @add);
	332	}
	333	print "\n";
	334	}
	335
	336	sub parse_diff {
	337	my ($path) = @_;
	338	my @diff = run_cmd_pipe(qw(git diff-files -p --), $path);
	339	my (@hunk) = { TEXT => [] };
	340
	341	for (@diff) {
	342	if (/^@@ /) {
	343	push @hunk, { TEXT => [] };
	344	}
	345	push @{$hunk[-1]{TEXT}}, $_;
	346	}
	347	return @hunk;
	348	}
	349
835b2aeb JH	350	sub hunk_splittable {
	351	my ($text) = @_;
	352
	353	my @s = split_hunk($text);
	354	return (1 < @s);
	355	}
	356
	357	sub parse_hunk_header {
	358	my ($line) = @_;
	359	my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
7288ed8e JLH	360	$line =~ /^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/;
	361	$o_cnt = 1 unless defined $o_cnt;
	362	$n_cnt = 1 unless defined $n_cnt;
835b2aeb JH	363	return ($o_ofs, $o_cnt, $n_ofs, $n_cnt);
	364	}
	365
	366	sub split_hunk {
	367	my ($text) = @_;
	368	my @split = ();
	369
	370	# If there are context lines in the middle of a hunk,
	371	# it can be split, but we would need to take care of
	372	# overlaps later.
	373
7b40a455	374	my ($o_ofs, undef, $n_ofs) = parse_hunk_header($text->[0]);
835b2aeb	375	my $hunk_start = 1;
835b2aeb JH	376
	377	OUTER:
	378	while (1) {
	379	my $next_hunk_start = undef;
	380	my $i = $hunk_start - 1;
	381	my $this = +{
	382	TEXT => [],
	383	OLD => $o_ofs,
	384	NEW => $n_ofs,
	385	OCNT => 0,
	386	NCNT => 0,
	387	ADDDEL => 0,
	388	POSTCTX => 0,
	389	};
	390
	391	while (++$i < @$text) {
	392	my $line = $text->[$i];
	393	if ($line =~ /^ /) {
	394	if ($this->{ADDDEL} &&
	395	!defined $next_hunk_start) {
	396	# We have seen leading context and
	397	# adds/dels and then here is another
	398	# context, which is trailing for this
	399	# split hunk and leading for the next
	400	# one.
	401	$next_hunk_start = $i;
	402	}
	403	push @{$this->{TEXT}}, $line;
	404	$this->{OCNT}++;
	405	$this->{NCNT}++;
	406	if (defined $next_hunk_start) {
	407	$this->{POSTCTX}++;
	408	}
	409	next;
	410	}
	411
	412	# add/del
	413	if (defined $next_hunk_start) {
	414	# We are done with the current hunk and
	415	# this is the first real change for the
	416	# next split one.
	417	$hunk_start = $next_hunk_start;
	418	$o_ofs = $this->{OLD} + $this->{OCNT};
	419	$n_ofs = $this->{NEW} + $this->{NCNT};
	420	$o_ofs -= $this->{POSTCTX};
	421	$n_ofs -= $this->{POSTCTX};
	422	push @split, $this;
	423	redo OUTER;
	424	}
	425	push @{$this->{TEXT}}, $line;
	426	$this->{ADDDEL}++;
	427	if ($line =~ /^-/) {
	428	$this->{OCNT}++;
	429	}
	430	else {
	431	$this->{NCNT}++;
	432	}
	433	}
	434
	435	push @split, $this;
	436	last;
	437	}
	438
	439	for my $hunk (@split) {
440	$o_ofs = $hunk->{OLD};
441	$n_ofs = $hunk->{NEW};
7b40a455 JLH	442	my $o_cnt = $hunk->{OCNT};
7b40a455 JLH	443	my $n_cnt = $hunk->{NCNT};
835b2aeb JH	444
	445	my $head = ("@@ -$o_ofs" .
	446	(($o_cnt != 1) ? ",$o_cnt" : '') .
	447	" +$n_ofs" .
	448	(($n_cnt != 1) ? ",$n_cnt" : '') .
	449	" @@\n");
	450	unshift @{$hunk->{TEXT}}, $head;
	451	}
	452	return map { $_->{TEXT} } @split;
	453	}
	454
	455	sub find_last_o_ctx {
	456	my ($it) = @_;
	457	my $text = $it->{TEXT};
7b40a455	458	my ($o_ofs, $o_cnt) = parse_hunk_header($text->[0]);
835b2aeb JH	459	my $i = @{$text};
	460	my $last_o_ctx = $o_ofs + $o_cnt;
	461	while (0 < --$i) {
	462	my $line = $text->[$i];
	463	if ($line =~ /^ /) {
	464	$last_o_ctx--;
	465	next;
	466	}
	467	last;
	468	}
	469	return $last_o_ctx;
	470	}
	471
	472	sub merge_hunk {
	473	my ($prev, $this) = @_;
	474	my ($o0_ofs, $o0_cnt, $n0_ofs, $n0_cnt) =
	475	parse_hunk_header($prev->{TEXT}[0]);
	476	my ($o1_ofs, $o1_cnt, $n1_ofs, $n1_cnt) =
	477	parse_hunk_header($this->{TEXT}[0]);
	478
	479	my (@line, $i, $ofs, $o_cnt, $n_cnt);
	480	$ofs = $o0_ofs;
	481	$o_cnt = $n_cnt = 0;
	482	for ($i = 1; $i < @{$prev->{TEXT}}; $i++) {
	483	my $line = $prev->{TEXT}[$i];
	484	if ($line =~ /^\+/) {
	485	$n_cnt++;
	486	push @line, $line;
	487	next;
	488	}
	489
	490	last if ($o1_ofs <= $ofs);
	491
	492	$o_cnt++;
	493	$ofs++;
	494	if ($line =~ /^ /) {
	495	$n_cnt++;
	496	}
	497	push @line, $line;
	498	}
	499
	500	for ($i = 1; $i < @{$this->{TEXT}}; $i++) {
	501	my $line = $this->{TEXT}[$i];
	502	if ($line =~ /^\+/) {
	503	$n_cnt++;
	504	push @line, $line;
	505	next;
	506	}
	507	$ofs++;
	508	$o_cnt++;
	509	if ($line =~ /^ /) {
	510	$n_cnt++;
	511	}
	512	push @line, $line;
	513	}
	514	my $head = ("@@ -$o0_ofs" .
	515	(($o_cnt != 1) ? ",$o_cnt" : '') .
	516	" +$n0_ofs" .
	517	(($n_cnt != 1) ? ",$n_cnt" : '') .
	518	" @@\n");
	519	@{$prev->{TEXT}} = ($head, @line);
	520	}
	521
	522	sub coalesce_overlapping_hunks {
523	my (@in) = @_;
524	my @out = ();
525
526	my ($last_o_ctx);
527
528	for (grep { $_->{USE} } @in) {
529	my $text = $_->{TEXT};
7b40a455	530	my ($o_ofs) = parse_hunk_header($text->[0]);
835b2aeb JH	531	if (defined $last_o_ctx &&
	532	$o_ofs <= $last_o_ctx) {
	533	merge_hunk($out[-1], $_);
	534	}
	535	else {
	536	push @out, $_;
	537	}
	538	$last_o_ctx = find_last_o_ctx($out[-1]);
	539	}
	540	return @out;
	541	}
	542
5cde71d6 JH	543	sub help_patch_cmd {
	544	print <<\EOF ;
	545	y - stage this hunk
	546	n - do not stage this hunk
	547	a - stage this and all the remaining hunks
	548	d - do not stage this hunk nor any of the remaining hunks
	549	j - leave this hunk undecided, see next undecided hunk
	550	J - leave this hunk undecided, see next hunk
	551	k - leave this hunk undecided, see previous undecided hunk
	552	K - leave this hunk undecided, see previous hunk
835b2aeb	553	s - split the current hunk into smaller hunks
5cde71d6 JH	554	EOF
	555	}
	556
	557	sub patch_update_cmd {
	558	my @mods = list_modified('file-only');
	559	@mods = grep { !($_->{BINARY}) } @mods;
	560	return if (!@mods);
	561
	562	my ($it) = list_and_choose({ PROMPT => 'Patch update',
	563	SINGLETON => 1,
	564	IMMEDIATE => 1,
	565	HEADER => $status_head, },
	566	@mods);
	567	return if (!$it);
	568
	569	my ($ix, $num);
	570	my $path = $it->{VALUE};
	571	my ($head, @hunk) = parse_diff($path);
	572	for (@{$head->{TEXT}}) {
	573	print;
	574	}
	575	$num = scalar @hunk;
	576	$ix = 0;
	577
	578	while (1) {
835b2aeb	579	my ($prev, $next, $other, $undecided, $i);
5cde71d6 JH	580	$other = '';
	581
	582	if ($num <= $ix) {
	583	$ix = 0;
	584	}
835b2aeb	585	for ($i = 0; $i < $ix; $i++) {
5cde71d6 JH	586	if (!defined $hunk[$i]{USE}) {
	587	$prev = 1;
	588	$other .= '/k';
	589	last;
	590	}
	591	}
	592	if ($ix) {
	593	$other .= '/K';
	594	}
835b2aeb	595	for ($i = $ix + 1; $i < $num; $i++) {
5cde71d6 JH	596	if (!defined $hunk[$i]{USE}) {
	597	$next = 1;
	598	$other .= '/j';
	599	last;
	600	}
	601	}
	602	if ($ix < $num - 1) {
	603	$other .= '/J';
	604	}
835b2aeb	605	for ($i = 0; $i < $num; $i++) {
5cde71d6 JH	606	if (!defined $hunk[$i]{USE}) {
	607	$undecided = 1;
	608	last;
	609	}
	610	}
	611	last if (!$undecided);
	612
835b2aeb JH	613	if (hunk_splittable($hunk[$ix]{TEXT})) {
	614	$other .= '/s';
	615	}
5cde71d6 JH	616	for (@{$hunk[$ix]{TEXT}}) {
	617	print;
	618	}
	619	print "Stage this hunk [y/n/a/d$other/?]? ";
	620	my $line = <STDIN>;
	621	if ($line) {
	622	if ($line =~ /^y/i) {
	623	$hunk[$ix]{USE} = 1;
	624	}
	625	elsif ($line =~ /^n/i) {
	626	$hunk[$ix]{USE} = 0;
	627	}
	628	elsif ($line =~ /^a/i) {
	629	while ($ix < $num) {
	630	if (!defined $hunk[$ix]{USE}) {
	631	$hunk[$ix]{USE} = 1;
	632	}
	633	$ix++;
	634	}
	635	next;
	636	}
	637	elsif ($line =~ /^d/i) {
	638	while ($ix < $num) {
	639	if (!defined $hunk[$ix]{USE}) {
	640	$hunk[$ix]{USE} = 0;
	641	}
	642	$ix++;
	643	}
	644	next;
	645	}
	646	elsif ($other =~ /K/ && $line =~ /^K/) {
	647	$ix--;
	648	next;
	649	}
	650	elsif ($other =~ /J/ && $line =~ /^J/) {
	651	$ix++;
	652	next;
	653	}
	654	elsif ($other =~ /k/ && $line =~ /^k/) {
	655	while (1) {
	656	$ix--;
	657	last if (!$ix \|\|
	658	!defined $hunk[$ix]{USE});
	659	}
	660	next;
	661	}
	662	elsif ($other =~ /j/ && $line =~ /^j/) {
	663	while (1) {
	664	$ix++;
	665	last if ($ix >= $num \|\|
	666	!defined $hunk[$ix]{USE});
	667	}
	668	next;
	669	}
835b2aeb JH	670	elsif ($other =~ /s/ && $line =~ /^s/) {
	671	my @split = split_hunk($hunk[$ix]{TEXT});
	672	if (1 < @split) {
	673	print "Split into ",
	674	scalar(@split), " hunks.\n";
	675	}
	676	splice(@hunk, $ix, 1,
	677	map { +{ TEXT => $_, USE => undef } }
	678	@split);
	679	$num = scalar @hunk;
	680	next;
	681	}
5cde71d6 JH	682	else {
	683	help_patch_cmd($other);
	684	next;
	685	}
	686	# soft increment
	687	while (1) {
	688	$ix++;
	689	last if ($ix >= $num \|\|
	690	!defined $hunk[$ix]{USE});
	691	}
	692	}
	693	}
	694
835b2aeb JH	695	@hunk = coalesce_overlapping_hunks(@hunk);
835b2aeb JH	696
7b40a455	697	my $n_lofs = 0;
5cde71d6 JH	698	my @result = ();
	699	for (@hunk) {
	700	my $text = $_->{TEXT};
	701	my ($o_ofs, $o_cnt, $n_ofs, $n_cnt) =
835b2aeb JH	702	parse_hunk_header($text->[0]);
835b2aeb JH	703
5cde71d6	704	if (!$_->{USE}) {
835b2aeb JH	705	# We would have added ($n_cnt - $o_cnt) lines
	706	# to the postimage if we were to use this hunk,
	707	# but we didn't. So the line number that the next
	708	# hunk starts at would be shifted by that much.
	709	$n_lofs -= ($n_cnt - $o_cnt);
5cde71d6 JH	710	next;
	711	}
	712	else {
835b2aeb JH	713	if ($n_lofs) {
	714	$n_ofs += $n_lofs;
	715	$text->[0] = ("@@ -$o_ofs" .
7288ed8e	716	(($o_cnt != 1)
835b2aeb JH	717	? ",$o_cnt" : '') .
835b2aeb JH	718	" +$n_ofs" .
7288ed8e	719	(($n_cnt != 1)
835b2aeb JH	720	? ",$n_cnt" : '') .
	721	" @@\n");
	722	}
5cde71d6 JH	723	for (@$text) {
	724	push @result, $_;
	725	}
	726	}
	727	}
	728
	729	if (@result) {
	730	my $fh;
	731
21e9757e	732	open $fh, '\| git apply --cached';
5cde71d6 JH	733	for (@{$head->{TEXT}}, @result) {
	734	print $fh $_;
	735	}
835b2aeb JH	736	if (!close $fh) {
	737	for (@{$head->{TEXT}}, @result) {
	738	print STDERR $_;
	739	}
	740	}
5cde71d6 JH	741	refresh();
	742	}
	743
	744	print "\n";
	745	}
	746
	747	sub diff_cmd {
	748	my @mods = list_modified('index-only');
	749	@mods = grep { !($_->{BINARY}) } @mods;
	750	return if (!@mods);
	751	my (@them) = list_and_choose({ PROMPT => 'Review diff',
	752	IMMEDIATE => 1,
	753	HEADER => $status_head, },
	754	@mods);
	755	return if (!@them);
	756	system(qw(git diff-index -p --cached HEAD --),
	757	map { $_->{VALUE} } @them);
	758	}
	759
	760	sub quit_cmd {
	761	print "Bye.\n";
	762	exit(0);
	763	}
	764
	765	sub help_cmd {
	766	print <<\EOF ;
	767	status - show paths with changes
	768	update - add working tree state to the staged set of changes
	769	revert - revert staged set of changes back to the HEAD version
	770	patch - pick hunks and update selectively
	771	diff - view diff between HEAD and index
	772	add untracked - add contents of untracked files to the staged set of changes
	773	EOF
	774	}
	775
	776	sub main_loop {
	777	my @cmd = ([ 'status', \&status_cmd, ],
	778	[ 'update', \&update_cmd, ],
	779	[ 'revert', \&revert_cmd, ],
	780	[ 'add untracked', \&add_untracked_cmd, ],
	781	[ 'patch', \&patch_update_cmd, ],
	782	[ 'diff', \&diff_cmd, ],
	783	[ 'quit', \&quit_cmd, ],
	784	[ 'help', \&help_cmd, ],
	785	);
	786	while (1) {
	787	my ($it) = list_and_choose({ PROMPT => 'What now',
	788	SINGLETON => 1,
	789	LIST_FLAT => 4,
	790	HEADER => '* Commands *',
c95c0248	791	ON_EOF => \&quit_cmd,
5cde71d6 JH	792	IMMEDIATE => 1 }, @cmd);
	793	if ($it) {
	794	eval {
	795	$it->[1]->();
	796	};
	797	if ($@) {
	798	print "$@";
	799	}
	800	}
	801	}
	802	}
	803
5cde71d6 JH	804	refresh();
	805	status_cmd();
	806	main_loop();