#!/usr/bin/env perl

##
## cdif: word context diff
##
## Copyright (c) 1992- Kazumasa Utashiro
##
## Original version on Mar 11 1992
##

use v5.14;
use warnings;

use utf8;
use Carp;
use Encode;
use Encode::Guess;

use Pod::Usage;
use List::Util qw(first sum pairmap);
use Text::ParseWords qw(shellwords);
use IO::Divert;
use Text::VisualWidth::PP qw(vwidth);
use Data::Dumper; {
    no warnings 'redefine';
    *Data::Dumper::qquote = sub { qq["${\(shift)}"] };
    $Data::Dumper::Terse = 1;
    $Data::Dumper::Sortkeys = 1;
    $Data::Dumper::Useperl = 1;
}

use App::sdif;
our $VERSION = $App::sdif::VERSION;

use App::sdif::Util;
use App::cdif::Command::Mecab;

##
## options
##

use charnames ':full';
my %visible = (
    nul    => [ 1, "\000"      => "\N{SYMBOL FOR NULL}" ],
    soh    => [ 1, "\001"      => "\N{SYMBOL FOR START OF HEADING}" ],
    bel    => [ 1, "\007"      => "\N{SYMBOL FOR BELL}" ],
    bs     => [ 1, "\010"      => "\N{SYMBOL FOR BACKSPACE}" ],
    ht     => [ 0, "\011"      => "\N{SYMBOL FOR HORIZONTAL TABULATION}" ],
    nl     => [ 0, "\012"      => "\N{SYMBOL FOR NEWLINE}" . "\n" ],
    vt     => [ 1, "\013"      => "\N{SYMBOL FOR VERTICAL TABULATION}" ],
    np     => [ 1, "\014"      => "\N{SYMBOL FOR FORM FEED}" ],
    cr     => [ 1, "\015"      => "\N{SYMBOL FOR CARRIAGE RETURN}" ],
    esc    => [ 1, "\033"      => "\N{SYMBOL FOR ESCAPE}" ],
    sp     => [ 0, "\040"      => "\N{SYMBOL FOR SPACE}" ],
    del    => [ 1, "\177"      => "\N{SYMBOL FOR DELETE}" ],
    nbsp   => [ 1, "\x{00A0}"  => "\N{OPEN BOX}" ],
    nnbsp  => [ 1, "\x{202F}"  => "\N{OPEN BOX}" ],
    ensp   => [ 1, "\x{2002}"  => "\N{OPEN BOX}" ],
    emsp   => [ 1, "\x{2003}"  => "\N{OPEN BOX}" ],
    thinsp => [ 1, "\x{2009}"  => "\N{OPEN BOX}" ],
    hairsp => [ 1, "\x{200A}"  => "\N{OPEN BOX}" ],
    zwsp   => [ 1, "\x{200B}"  => "\N{OPEN BOX}" ],
    idesp  => [ 1, "\x{3000}"  => "\N{OPEN BOX}" ],
    );
my %opt_visible = do {
    map { $_ => splice @{$visible{$_}}, 0, 1 }
    keys %visible;
};

my @rcsopt;
my @diffopts;
my @sub_diffopts;

binmode STDOUT, ":encoding(utf8)";
binmode STDERR, ":encoding(utf8)";

if (my $env = $ENV{'CDIFOPTS'}) {
    unshift(@ARGV, shellwords($env));
}

my $unit_default = 'word';
my $prefix_default = q/(?:\\| )*(?:  )*/;

my $app;

use Getopt::EX::Hashed; {

    Getopt::EX::Hashed->configure( DEFAULT => [ is => 'rw' ] ) ;

    has help           => '        ' ;
    has version        => '        ' ;
    has man            => '        ' ;
    has debug          => ' d  =s@ ' , default => [] ;
    has diff           => '    =s  ' ;
    has subdiff        => '    =s  ' , default => 'diff' ;
    has color          => '    !   ' , default => 1 ;
    has 256            => '    !   ' , default => 1 ;
    has commandcolor   => ' cc !   ' , default => 1 ;
    has markcolor      => ' mc !   ' , default => 1 ;
    has textcolor      => ' tc !   ' , default => 1 ;
    has unknowncolor   => ' uc !   ' , default => 1 ;
    has colormap       => ' cm =s@ ' , default => [] ;
    has colordump      => '        ' ;
    has sdif           => '        ' ;
    has stat           => '    !   ' ;
    has unit           => ' by :s  ' , default => $unit_default ,
				     , any => [ qw(char word letter mecab 0), '' ];
    has show_old       => '    !   ' , default => 1 , alias => 'old' ;
    has show_new       => '    !   ' , default => 1 , alias => 'new' ;
    has show_mrg       => '    !   ' , default => 1 , alias => 'mrg' ;
    has command        => '    !   ' , default => 1 ;
    has unknown        => '    !   ' , default => 1 ;
    has mark           => '    !   ' , default => 1 ;
    has prefix         => '    !   ' , default => 1 ;
    has prefix_pattern => '    =s  ' , default => $prefix_default ;
    has visible        => '    =s@ ' , default => [] ;
    has lenience       => '    !   ' , default => 1 ;
    has limit          => '    =s% ' , default => { length => 1000 } ;
    has linebyline     => '    :2  ' , alias => 'lxl';
    has style          => '    =s  ' , default => '' ;

    has ignore_case         => 'i' ;
    has ignore_space_change => 'b' ;
    has ignore_all_space    => 'w' ;
    has expand_tabs         => 't' ;

    has rcs                 => '' ;

    has '+sdif' => sub {
	$app->commandcolor = 0;
	$app->markcolor    = 0;
	$app->textcolor    = 0;
	$app->unknowncolor = 0;
    } ;
    has mecab => '!', action => sub {
	$app->unit = $_[1] ? 'mecab' : $unit_default;
    } ;
    has c           => '         ' , action => sub { push @diffopts, "-c" } ;
    has u           => '         ' , action => sub { push @diffopts, "-u" } ;
    has context     => ' C    =i ' , action => sub { push @diffopts, "-C" . $_[1] } ;
    has unified     => ' U    =i ' , action => sub { push @diffopts, "-U" . $_[1] } ;
    has r           => '      =s ' , action => sub { push @rcsopt, "-r$_[1]" } ;
    has q           => '         ' , action => sub { push @rcsopt, "-q" } ;

    has '+help' => sub {
	pod2usage
	    -verbose  => 99,
	    -sections => [ qw(SYNOPSIS VERSION) ];
    };
    has '+man' => sub {
	pod2usage -verbose => 2;
    };
    has '+version' => sub {
	print "$VERSION\n";
	exit;
    };

} no Getopt::EX::Hashed;

$app = Getopt::EX::Hashed->new() or die;

use Getopt::EX::Long qw(:DEFAULT Configure ExConfigure);
ExConfigure BASECLASS => [ "App::cdif", "Getopt::EX" ];
Configure("bundling");
$app->getopt || usage({status => 1});

my %debug = map { $_ => 1 } map { split // } @{$app->debug};

$App::sdif::Util::NO_WARNINGS = $app->lenience;
$App::cdif::Command::Mecab::debug = 1 if $debug{m};

$app->rcs++ if @rcsopt;
my $diff = $app->diff || ($app->rcs ? 'rcsdiff' : 'diff');

push @diffopts, map { $_->[1] } grep { $_->[0] } (
    [ $app->ignore_case,         "-i" ],
    [ $app->ignore_space_change, "-b" ],
    [ $app->ignore_all_space,    "-w" ],
    [ $app->expand_tabs,         "-t" ],
);

push @sub_diffopts, map { $_->[1] } grep { $_->[0] } (
    [ $app->ignore_case,      "-i" ],
    [ $app->ignore_all_space, "-w" ],
);

my %colormap = do {
    my $col = $app->{256} ? 0 : 1;
    pairmap { $a => (ref $b eq 'ARRAY') ? $b->[$col] : $b } (
	UNKNOWN =>   ""   ,
	UMARK   => [ "/444" , "/w" ] ,
	CMARK   =>   "GS" ,
	OMARK   =>   "CS" ,
	NMARK   =>   "MS" ,
	MMARK   =>   "YS" ,
	UTEXT   =>   ""  ,
	CTEXT   =>   "G"  ,
	OTEXT   =>   "C"  ,
	NTEXT   =>   "M"  ,
	MTEXT   =>   "Y"  ,
	COMMAND => [ "555/222E" , "w/kE" ] ,
	OCHANGE => [ "K/445"    , "B/w" ] ,
	NCHANGE => [ "K/445"    , "B/w" ] ,
	DELETE  => [ "K/544"    , "R/w" ] ,
	APPEND  => [ "K/544"    , "R/w" ] ,
	VISIBLE => "",
    );
};

use Getopt::EX::Colormap qw(ansi_code);
my $color_handler = Getopt::EX::Colormap
    ->new(HASH => \%colormap)
    ->load_params(@{$app->colormap});

for (
    [ $app->unknowncolor => q/UNKNOWN/ ],
    [ $app->commandcolor => q/COMMAND/ ],
    [ $app->markcolor    => q/MARK/ ],
    [ $app->textcolor    => q/TEXT/ ],
) {
    my($color, $label) = @$_;
    $color and next;
    for (grep /$label/, keys %colormap) {
	$colormap{$_} = '';
    }
}

warn 'colormap = ', Dumper \%colormap if $debug{c};

if ($app->colordump) {
    print $color_handler->colormap(
	name => '--changeme', option => '--colormap');
    exit;
}

sub color {
    $color_handler->color(@_);
}

my $prefix_re = do {
    if ($app->prefix) {
	qr/$app->{prefix_pattern}/;
    } else {
	"";
    }
};

my $DIFF;
my $OLD;
my $NEW;

if ($app->rcs) {
    my $rcsfile = shift || usage("No RCS filename\n\n");
    $DIFF = "$diff @diffopts @rcsopt $rcsfile|";
} elsif (@ARGV == 2) {
    ($OLD, $NEW) = splice(@ARGV, 0, 2);
    $DIFF = "$diff @diffopts $OLD $NEW |";
} elsif (@ARGV < 2) {
    $DIFF = shift || '-';
} else {
    usage("Arguments error.\n\n") if @ARGV;
}
warn "DIFF = \"$DIFF\"\n" if $debug{f};

my %func = do {
    my $col = $app->color ? 0 : 1;
    pairmap { $a => $b->[$col] } (
	DELETE  => [ sub { color("DELETE",  @_) }, \&bd ],
	APPEND  => [ sub { color("APPEND",  @_) }, \&bd ],
	OLD     => [ sub { color("OCHANGE", @_) }, \&ul ],
	NEW     => [ sub { color("NCHANGE", @_) }, \&ul ],
	UNKNOWN => [ sub { color("UNKNOWN", @_) }, undef ],
    );
};

my $w_pattern = do {
    if ($app->unit =~ /^char/) {
	qr/\X/s;
    } else {
	my $w = $app->unit eq 'letter' ? '' : '_';
	qr{
	    \p{Han} | \p{InHiragana}+ | \p{InKatakana}+ |
	    [$w\p{Latin}]+    |
	    [$w\p{Hang}]+     |
	    [$w\p{Cyrillic}]+ |
	    [$w\p{Arabic}]+   |
	    [$w\p{Thai}]+     |
	    \d+ |
	#   (\p{Punct})\g{-1}* |
	    [\h\r\f]*\n | \s+ | (\X)\g{-1}*
	}x;
    }
};

##
## Converter/Effector function for visible characters
##
my($converter, $effector);
use Getopt::EX::LabeledParam;
Getopt::EX::LabeledParam
    ->new(HASH => \%opt_visible)
    ->load_params (@{$app->visible});
if (my @names = grep $opt_visible{$_}, keys %opt_visible) {
    my @chars = map $visible{$_}->[0], @names;
    my %hash = map { @$_ } values %visible;
    my $re = do { local $" = ''; qr/[\Q@chars\E]/ };
    my $sub0 = sub {          s/($re)/$hash{$1}/g };
    my $sub1 = sub { $_[0] =~ s/($re)/$hash{$1}/gr };
    my $sub2 = sub {
	my $mark_re = shift;
	for (@_) {
	    $_ // next;
	    s{^$mark_re\K(?=.*$re)(.*\R?)}{
		$sub1->($1);
	    }mge;
	}
    };
    $converter = $sub2;

    ##
    ## Only an effect which can be cancelled by tilde is usable here,
    ## since the end sequence is built by negating each character.
    ## Drop anything else, so that a wildcard spec such as `--cm *=N'
    ## does not end up asking for an impossible `~N'.
    ##
    if (my $color = $colormap{'VISIBLE'} =~ s/[^DFHIPQSUX]//gir) {
	my $s = ansi_code($color);
	my $e = ansi_code($color =~ s/(?=.)/~/gr); # cancel the effect
	my $symbols = join('',
			   map  { $visible{$_}->[-1] =~ s/\s+//gr }
			   @names);
	$effector = sub { s/([\Q$symbols\E]+)/${s}${1}${e}/g };
    }
}

##
## Temporary files
##
use Command::Run::Tmpfile;
my $T1 = Command::Run::Tmpfile->new;
my $T2 = Command::Run::Tmpfile->new;

##
## Total statistic info
##
my %stat;
@stat{'a', 'd', 'c', 'anl', 'dnl', 'cnl'} = (0, 0, 0, 0, 0, 0);
@stat{'anlb', 'dnlb', 'cnlb'} = (0, 0, 0);

open(DIFF, $DIFF) || die "$DIFF: $!\n";
binmode DIFF, ":encoding(utf8)";

my $stdout = IO::Divert->new;
sub sprintln { map { s/(?<=[^\n])\z/\n/r } @_ }
sub  println { print sprintln @_ }
sub print_lxl {
    my($l1, $l2) = (sprintln($_[0]), sprintln($_[1]));
    if ($app->style eq 'diff') {
	printf "1c1\n". "< $l1". "---\n". "> $l2",
    } else {
	print $l1, $l2;
    }
}

while (<DIFF>) {
    #
    # --linebyline, --lxl option
    #
    if ($app->linebyline) {
	my $old = $_;
	my $new = <DIFF> // do {
	    print $old;
	    next;
	};
	compare(\$old, \$new) if $app->unit;
	print_lxl(color("OTEXT", $old),
		  color("NTEXT", $new));
    }
    #
    # normal diff
    #
    elsif (/^([\d,]+)([adc])([\d,]+)\r?$/) {
	my($left, $cmd, $right) = ($1, $2, $3);
	my $command_line = $_;
	my($old, $del, $new);
	eval {
	    if ($cmd =~ /[cd]/) {
		$old =  read_diff(*DIFF, scalar(range($left)));
		$old =~ /^(?!<)/m and die;
	    }
	    if ($cmd =~ /[c]/) {
		$del =  read_diff(*DIFF, 1);
		$del =~ /^(?!---)/m and die;
	    }
	    if ($cmd =~ /[ca]/) {
		$new =  read_diff(*DIFF, scalar(range($right)));
		$new =~ /^(?!>)/m and die;
	    }
	    1;
	}
	or do {
	    defined and print for ($command_line, $old, $del, $new);
	    next;
	};

	print_command($command_line);

	if ($converter) {
	    $converter->(qr/[<>][ \t]/, $old, $new);
	}

	if ($cmd eq 'c') {
	    compare(\$old, \$new, qr/<[ \t]/, qr/>[ \t]/) if $app->unit;
	}

	if ($app->color) {
	    $old =~ s{^(<[ \t])(.*)}{
		color("OMARK", $1) . color("OTEXT", $2)
	    }mge if $old;
	    $new =~ s{^(>[ \t])(.*)}{
		color("NMARK", $1) . color("NTEXT", $2)
	    }mge if $new;
	}

	println $old if $old and $app->show_old;
	println $del if $del;
	println $new if $new and $app->show_new;
    }
    #
    # diff -c
    #
    elsif (/^\*\*\* ([\d,]+) \*\*\*\*\r?$/) {
	my $left = $1;
	print_command($_);
	my(@old, @new);
	my $oline = range($left);
	@old = read_diffc(*DIFF, $oline);
	my $new;
	if (@old and $old[0] =~ /^--- /) {
	    $new = shift @old;
	    @old = ("");
	} else {
	    $new = <DIFF>;
	}
	my $dline = map { /^-/mg } @old;
	if ($new =~ /^--- ([\d,]+) ----$/) {
	    my $right = $1;
	    my $nline = range($right);
	    if (@old == 1 and $old[0] ne "" and $oline - $dline == $nline) {
		@new = ("");
	    } else {
		@new = read_diffc(*DIFF, $nline);
	    }
	    if ($converter) {
		$converter->(qr/[\-\+\!\ ][ \t]/, @old, @new);
	    }
	    my $mark_re = qr/![ \t]/;
	    for my $i (keys @old) {
		my $cmark = "! ";
		if ($i % 2) {
		    compare(\$old[$i], \$new[$i], $mark_re) if $app->unit;
		}
		if ($app->color) {
		    $old[$i] =~ s{^([\-\!][ \t])(.*)}{
			color("OMARK", $1) . color("OTEXT", $2)
		    }mge;
		    $new[$i] =~ s{^([\+\!][ \t])(.*)}{
			color("NMARK", $1) . color("NTEXT", $2)
		    }mge;
		}
	    }
	}
	println @old if $app->show_old;
	println $new;
	println @new if $app->show_new;
    }
    #
    # diff --combined (generic)
    #
    elsif (m{^
	   (?<prefix> $prefix_re)
	   (?<command>
	     (?<mark> \@{2,} ) [ ]
	     (?<lines> (?: [-+]\d+(?:,\d+)? [ ] ){2,} )
	     \g{mark}
	     (?s:.*)
	   )
	   }x) {
	my($prefix, $command, $lines) = @+{qw(prefix command lines)};
	my $column = length $+{mark};
	my @lines = map {
	    $_ eq ' ' ? 1 : int $_
	} $lines =~ /\d+(?|,(\d+)|( ))/g;

	if (@lines != $column) {
	    print;
	    next;
	}

	my($divert, %read_opt);
	if ($prefix) {
	    $read_opt{prefix} = $prefix;
	    $divert = IO::Divert->new(FINAL => sub { s/^/$prefix/mg });
	}

	print_command($command);

	my @buf = read_unified \%read_opt, *DIFF, @lines;

	state @mark_re;
	my $mark_re = $mark_re[$column] //= do {
	    my $mark = '.' x ($column - 1);
	    qr/$mark/;
	};

	if ($converter) {
	    map { $converter->($mark_re, @$_) }
	    map { $_->lists }
	    @buf;
	}

	for my $buf (@buf) {
	    my @result = compare_unified($column, $buf, $mark_re);
	    if (@result == 3) {
		$app->show_new or splice @result, 2, 1;
		$app->show_old or splice @result, 1, 1;
	    }
	    println @result;
	}
    }
    #
    # conflict marker
    #
    elsif (/^<<<<<<<\s+(.*)/) {
      CONFLICT:
	{
	    my $c1 = $_;

	    my @old = read_until { /^=======$/ } *DIFF;
	    my $c2 = pop @old // do {
		print $c1, @old;
		last;
	    };

	    my @new = read_until { /^>>>>>>>\s+(.*)/ } *DIFF;
	    my $c3 = pop @new // do {
		print $c1, @old, $c2, @new;
		last;
	    };

	    my $i = first { $old[$_] =~ /^\Q|||||||\E/ } keys @old;
	    my @mrg = defined $i ? splice @old, $i : ();

	    my $old = join '', @old;
	    my $new = join '', @new;
	    $converter->('', $old, $new) if $converter;
	    compare(\$old, \$new) if $app->unit;

	    print $c1 if $app->mark;
	    print color("OTEXT", $old) if $app->show_old;
	    if (@mrg) {
		my $c4 = shift @mrg;
		print $c4 if $app->mark;
		my $mrg = join '', @mrg;
		$converter->('', $mrg) if $converter;
		print color("MTEXT", $mrg) if $app->show_mrg;
	    }
	    println $c2 if $app->mark;
	    println color("NTEXT", $new) if $app->show_new;
	    println $c3 if $app->mark;
	}
    }
    else {
	if ($app->unknown) {
	    if (my $f = $func{UNKNOWN}) {
		print $f->($_);
	    } else {
		print;
	    }
	}
    }
}
continue {
    $stdout->fh->flush;
    local *_ = $stdout->buffer;
    if (length) {
	$_ = decode 'utf8', $_;
	$effector->() if $effector;
	STDOUT->printflush($_);
	$stdout->clear;
    }
}
close DIFF;
my $exit = $DIFF =~ /\|$/ ? $? >> 8 : 0;

select STDOUT;

if ($app->stat) {
    select STDERR;

    print("TOTAL: ");
    printf("append=%d delete=%d change=%d\n",
	   $stat{'a'}, $stat{'d'}, $stat{'c'});
    print("IGNORE WHITESPACE: ");
    printf("append=%d delete=%d change=%d\n",
	   $stat{'anl'},
	   $stat{'dnl'},
	   $stat{'cnl'});
    print("IGNORE WHITESPACE (bytes): ");
    printf("append=%d delete=%d change=%d\n",
	   $stat{'anlb'},
	   $stat{'dnlb'},
	   $stat{'cnlb'});
}

exit($exit > 1);

######################################################################

sub compare_unified {
    my $column = shift;
    goto &compare_unified_3 if $column == 3;
    goto &compare_unified_generic;
}

sub compare_unified_generic {
    my($buf, $mark_re) = @_;
    my $c = $buf->collect(qr/^[\t ]+$/);
    my $o = $buf->collect(qr/[-]/);
    my $n = $buf->collect(qr/[+]/);
    compare(\$o, \$n, $mark_re) if $app->unit;
    if ($app->color) {
	map {
	    my($buf, $m, $t) = @$_;
	    $$buf =~ s{^($mark_re)(.*)}{
	    ($app->mark ? color($m, $1) : '') . color($t, $2)
	    }mge;
	} ( [ \$c, 'UMARK', 'UTEXT' ],
	    [ \$o, 'OMARK', 'OTEXT' ],
	    [ \$n, 'NMARK', 'NTEXT' ] );
    } else {
	map { s/^$mark_re//mg } $c, $o, $n if not $app->mark;
    }
    ($c, $o, $n);
}

sub compare_unified_3 {
    my($buf, $mark_re) = @_;

    my @mark = ( "  ", "--", "- ", " -", "+ ", " +", "++" );
    my %buf = map { $_ => scalar($buf->collect($_)) } @mark;

    goto SKIP unless $app->unit;

    my @r;
    $r[0] =     compare(\@buf{q/--/, q/++/}, $mark_re);
    $r[1] =     compare(\@buf{q/- /, q/ -/}, $mark_re);
    if ($r[1] == 0) {
	$r[2] = compare(\@buf{q/- /, q/+ /}, $mark_re);
	$r[3] = compare(\@buf{q/ -/, q/ +/}, $mark_re);
    }
    if (sum(@r) == 0) {
	$r[4] = compare(\@buf{q/- /, q/++/}, $mark_re);
	$r[5] = compare(\@buf{q/ -/, q/++/}, $mark_re) unless $r[4];
	$r[6] = compare(\@buf{q/--/, q/+ /}, $mark_re);
	$r[7] = compare(\@buf{q/--/, q/ +/}, $mark_re) unless $r[6];
    }

  SKIP:

    if ($app->color) {
	map { s/^$mark_re//mg } $buf{q/  /} if not $app->mark;
	map {
	    my($s, $m, $t) = @$_;
	    $$s =~ s{^($mark_re)(.*)}{
	    ($app->mark ? color($m, $1) : '') . color($t, $2)
	    }mge if $$s;
	} ( [ \$buf{q/--/}, 'CMARK', 'CTEXT' ],
	    [ \$buf{q/- /}, 'OMARK', 'OTEXT' ],
	    [ \$buf{q/ -/}, 'NMARK', 'NTEXT' ],
	    [ \$buf{q/+ /}, 'MMARK', 'MTEXT' ],
	    [ \$buf{q/ +/}, 'MMARK', 'MTEXT' ],
	    [ \$buf{q/++/}, 'MMARK', 'MTEXT' ] );
    } else {
	map { s/^$mark_re//mg } @buf{@mark} if not $app->mark;
    }

    @buf{$buf->labels};
}

sub print_command {
    return unless $app->command;
    my $line = shift;
    if ($app->color) {
	$line = color($colormap{COMMAND}, $line);
    }
    print $line;
}

sub compare {
    my($old, $new) = splice @_, 0, 2;
    return 0 unless $old && $new && $$old && $$new;

    # skip word comparison for lines exceeding max length
    if (my $max = $app->limit->{length}) {
	return 0 if $$old =~ /^.{$max}/m or $$new =~ /^.{$max}/m;
    }

    my $omark_re = shift || undef;
    my $nmark_re = shift || $omark_re;

    my(@omark, @nmark);
    if ($omark_re) {
	$$old =~ s/^($omark_re)/push(@omark, $1), ""/mge;
	$$new =~ s/^($nmark_re)/push(@nmark, $1), ""/mge;
    }

    ($$old, $$new) = context($$old, $$new);

    $$old =~ s/^/shift @omark/mge if @omark;
    $$new =~ s/^/shift @nmark/mge if @nmark;

    1;
}

use Getopt::EX::Colormap qw(colorize);

sub debug_list {
    my $i = 0;
    my @cmap = qw( K/444 K/333 );
    join "", map { colorize $cmap[$i++ % @cmap], $_ } @_;
}

sub context {
    my($old, $new) = @_;
    local $_;

    if ($debug{s}) {
	print STDERR "****************************** Comparing ...\n";
	print STDERR $old;
	print STDERR "****************************** and\n";
	print STDERR $new;
	print STDERR "****************************** .\n";
    }

    my @owlist = wordlist($old);
    my @nwlist = wordlist($new);

    if ($debug{w}) {
	print STDERR "****************************** Comparing ...\n";
	print STDERR debug_list @owlist;
	print STDERR "****************************** and\n";
	print STDERR debug_list @nwlist;
	print STDERR "****************************** .\n";
    }

    maketmp($T1, @owlist);
    maketmp($T2, @nwlist);

    my $diff = sprintf "$app->{subdiff} @sub_diffopts %s %s", $T1->path, $T2->path;
    open my $cdif, "$diff |" or die "diff: $!\n";
    binmode $cdif, ":encoding(utf8)";
    my @command;
    my %c = (a => 0, d => 0, c => 0);
    while (<$cdif>) {
	warn $_ if $debug{d};

	## Quick hack to read `git diff` unified output
	if (/^\@\@ \s+ \-(\d+)(?:,(\d+))? \s+ \+(\d+)(?:,(\d+))? \s+ \@\@/x) {
	    my($o, $ol, $n, $nl) = ($1, $2//1, $3, $4//1);
	    my $cmd = ($ol == 0) ? "a" : ($nl == 0) ? "d" : "c";
	    my $old = ($ol <= 1) ? $o  : sprintf "%d,%d", $o, $o + $ol - 1;
	    my $new = ($nl <= 1) ? $n  : sprintf "%d,%d", $n, $n + $nl - 1;
	    $_ = sprintf "%s%s%s\n", $old, $cmd, $new;
	}

	if (/^[\d,]+([adc])[\d,]+$/) {
	    push @command, $_;
	    $c{$1}++;
	}
    }
    close $cdif;

    if ($debug{d}) {
	printf(STDERR "old=%d new=%d command=%d\n",
	       @owlist+0, @nwlist+0, @command+0);
	printf(STDERR "append=$c{a} delete=$c{d} change=$c{c}\n");
    }

    my($obuf, $nbuf) = makebuf(\@owlist, \@nwlist, \@command);
    my $status = $?>>8;
    die "Unexpected status of subprocess ($status)\n" if $status > 1;

    ($obuf, $nbuf);
}

sub wordlist {
    my $text = shift;
    if ($app->unit eq 'mecab' and $text =~ /\P{ASCII}/) {
	mecab_words($text);
    } else {
	normal_words($text);
    }
}

sub normal_words {
    my $text = shift;
    my @words;
    while ($text =~ /\G($w_pattern)/g) {
	push @words, $1;
    }
    @words;
}

sub mecab_words {
    my $text = shift;
    state $mecab = App::cdif::Command::Mecab->new;
    $mecab->wordlist($text);
}

sub maketmp {
    my($tmpfile, @list) = @_;
    $tmpfile->reset;
    for (@list) {
	s/[ \t]+// if $app->ignore_space_change || $app->ignore_all_space;
	$tmpfile->write($_);
	$tmpfile->write("\n") unless /\n\z/;
    }
    $tmpfile->flush->rewind;
}

##
##  @owlist: old word list
##  @nwlist: new word list
##  @command: how different these lists (`diff' result command lines)
##
sub makebuf {
    my($ol, $nl, $c) = @_;
    my @owlist = @$ol;
    my @nwlist = @$nl;
    my @command = @$c;

    my($o, $n) = (0, 0);	# pointers
    my(@obuf, @nbuf);

    for (@command) {
	my($old, $cmd, $new) = /([\d,]+)([adc])([\d,]+)/ or do {
	    die "Panic! Unexpected diff output";
	};
	my($o1, $o2) = range($old);
	my($n1, $n2) = range($new);
	map { $_-- } $o1, $o2, $n1, $n2; # make them zero origined

	push(@obuf, @owlist[$o .. $o1 - 1]), $o = $o1 if $o < $o1;
	push(@nbuf, @nwlist[$n .. $n1 - 1]), $n = $n1 if $n < $n1;

	$stat{$cmd}++;

	if ($cmd eq 'd') {
	    my $os = join('', @owlist[$o1 .. $o2]);
	    if ($owlist[$o2] =~ /\S/) {
		$stat{'dnl'}++;
		$stat{'dnlb'} += length($os);
	    }
	    push(@obuf, $func{DELETE}->($os));
	    $o = $o2 + 1;
	}
	elsif ($cmd eq 'c') {
	    my $os = join('', @owlist[$o1 .. $o2]);
	    my $ns = join('', @nwlist[$n1 .. $n2]);
	    if (($owlist[$o2] =~ /\S/) || ($nwlist[$n2] =~ /\S/)) {
		$stat{'cnl'}++;
		$stat{'cnlb'} += length($os);
		$stat{'cnlb'} += length($ns);
	    }
	    push(@obuf, $func{OLD}->($os));
	    push(@nbuf, $func{NEW}->($ns));
	    $o = $o2 + 1;
	    $n = $n2 + 1;
	}
	elsif ($cmd eq 'a') {
	    my $ns = join('', @nwlist[$n1 .. $n2]);
	    if ($nwlist[$n2] =~ /\S/) {
		$stat{'anl'}++;
		$stat{'anlb'} += length($ns);
	    }
	    push(@nbuf, $func{APPEND}->($ns));
	    $n = $n2 + 1;
	}
    }
    push(@obuf, @owlist[$o .. $#owlist]);
    push(@nbuf, @nwlist[$n .. $#nwlist]);

    (join('', @obuf), join('', @nbuf));
}

sub read_diff {
    my($FH, $c) = @_;
    my @buf = ();
    while ($c-- > 0) {
	push @buf, scalar <$FH>;
    }
    wantarray ? @buf : join '', @buf;
}

sub read_diffc {
    my($FH, $n) = @_;
    my @buf;
    local $_;
    my $i = 0;
    while ($n-- && ($_ = <$FH>)) {
	$i++ if ($i % 2) != /^!/;
	$buf[$i] .= $_;
	last if /^--- /;
    }
    map { $_ // "" } @buf;
}

sub ul {
    local $_ = join '', @_;
    s/(.)/["", "_\010", "__\010\010"]->[vwidth($1)].$1/ge;
    $_;
}
sub bd {
    local $_ = join '', @_;
    s/(\S)/$1.["", "\010", "\010\010"]->[vwidth($1)].$1/ge;
    $_;
}

sub wc_l {
    my $file = shift;
    my $line;
    $file->rewind;
    $line++ while $file->fh->getline;
    $file->rewind;
    $line;
}

sub eval {
    print STDERR &unctrl($_[0]), "\n" x ($_[0] !~ /\n$/) if $_[1] || $debug{e};
    CORE::eval shift;
    die sprintf("eval failed in file %s on line %s\n$@", (caller)[1,2]) if $@;
}

######################################################################

=head1 NAME

cdif - word context diff

=head1 VERSION

Version 4.49

=head1 SYNOPSIS

cdif [option] file1 file2

cdif [option] [diff-data]

Options:

	-c, -Cn		context diff
	-u, -Un		unified diff
	-i		ignore case
	-b		ignore space change
	-w		ignore whitespace
	-t		expand tabs

	--rcs		use rcsdiff
	-r rev		RCS revision to compare
	-q		passed through to rcsdiff

	--diff=command      specify diff command
	--subdiff=command   specify backend diff command
	--stat              show statistical information
	--colormap=s        specify color map
	--sdif              sdif friendly option
	--[no]color         color or not            (default true)
	--[no]256           ANSI 256 color mode     (default true)
	--[no]cc            color command line      (default true)
	--[no]mc            color diff mark         (default true)
	--[no]tc            color normal text       (default true)
	--[no]uc            color unknown text      (default true)
	--[no]old	    print old text          (default true)
	--[no]new	    print new text          (default true)
	--[no]mrg	    print merged text       (default true)
	--[no]command	    print diff command line (default true)
	--[no]unknown	    print unknown line      (default true)
	--[no]mark	    print mark or not       (default true)
	--[no]prefix	    read git --graph output (default true)
	--unit=s            word/letter/char/mecab  (default word)
	--[no]mecab	    use mecab tokenizer     (default false)
	--prefix-pattern    prefix pattern
	--visible char=?    set visible attributes
	--[no]lenience      suppress unexpected input warning (default true)
	--limit length=#    skip word comparison for long lines (default 1000)
	--lxl               compare input data line-by-line
	--style=diff        print --lxl output in diff style
	--version           show version


=head1 DESCRIPTION

B<cdif> is a post-processor of the Unix diff command.  It highlights
deleted, changed and added words based on word context (B<--unit=word>
by default).  To compare text character by character, use option
B<--unit=char>.  Option B<--unit=mecab> calls the external B<mecab>
command as a tokenizer for Japanese text.

Given a single file, or no file at all, B<cdif> reads that file or
standard input as the output of a diff command.  Besides normal diff,
context diff and unified (combined) diff, the L<git(1)>-compatible
conflict marker format is accepted as input.

Lines that do not look like diff output are passed through untouched.

=head2 STARTUP and MODULE

B<cdif> uses the Perl L<Getopt::EX> module, and reads the F<~/.cdifrc>
file at startup if there is one.  You can define your own options and
defaults there.  The next line enables the B<--mecab> option and adds
a crossed-out effect to deleted words.

    option default --mecab --cm DELETE=+X

Modules under B<App::cdif> can be loaded by the B<-M> option without
the prefix.  The next command loads the B<App::cdif::colors> module.

    $ cdif -Mcolors

Options can be defined in a module file as well.  See
L<Getopt::EX::Module> for details.

=head2 COLOR

Each line is displayed in a different color.  Every text segment has
its own label, and the color for each label can be set by the
B<--colormap> option.  See L<Getopt::EX::Colormap> for details.

The standard module B<-Mcolors> is loaded by default, and defines
several color maps for light and dark screens.  To use CMY colors on a
dark screen, place the next line in your F<~/.cdifrc>.

    option default --dark-cmy

Option B<--autocolor> is defined in the B<default> module to call the
L<Getopt::EX::termcolor> module.  It sets the B<--light> or B<--dark>
option according to the brightness of the terminal screen.  You can
set your preferred colors in F<~/.cdifrc> like this:

    option --light --cmy
    option --dark  --dark-cmy

The detection is done by the L<Getopt::EX::termcolor> module, and
works with macOS Terminal.app and iTerm.app, and other XTerm
compatible terminals.  That module reads the environment variable
C<TERM_BGCOLOR> as the terminal background color.  For example, use
C<000> or C<#000000> for black and C<555> or C<#FFFFFF> for white.

Option B<--autocolor> is set by default; to disable it, override it
with something that does nothing.

    option --autocolor --nop

=head2 EXIT STATUS

B<cdif> always exits with status zero unless an error occurs.

=head1 OPTIONS

=over 7

=item B<->[B<cCuUibwtT>]

Almost the same as for the B<diff> command.

=item B<--rcs>, B<-r>I<rev>, B<-q>

Use B<rcsdiff> instead of the normal diff command, and take the
remaining argument as an RCS file name.  Option B<-r>I<rev> names the
revision to compare against, and B<-q> is passed to B<rcsdiff> as it
is.  B<--rcs> is not required when either of the other two is given.

    cdif -r1.3 file

=item B<-->B<unit>=[C<word>,C<letter>,C<char>,C<mecab>,C<0>,C<>]

=item B<-->B<by>=[C<word>,C<letter>,C<char>,C<mecab>,C<0>,C<>]

Specify the unit of comparison.  The default is C<word>, comparing
each line word by word.  Specify C<char> to compare character by
character.  Unit C<letter> is almost the same as C<word>, but does not
count an underscore as part of a word.

When C<mecab> is given as the unit, the B<mecab> command is called as
a tokenizer for non-ASCII text; ASCII text is still compared word by
word.  The external B<mecab> command has to be installed.

Given an empty string, as in C<--unit=>, or C<0>, B<cdif> does not
compare the text at all.  Colorization is still applied.

=item B<--mecab>

Shortcut for B<--unit=mecab>.

=item B<--diff>=I<command>

Specify the diff command to use.

=item B<--subdiff>=I<command>

Specify the backend diff command used to find word differences.  It
accepts normal and unified diff format.

To use the B<git diff> command, do not forget the I<-U0> option.

    --subdiff="git diff -U0 --no-index --histogram"

=item B<-->[B<no->]B<color>

Use ANSI color escape sequences in the output.

=item B<--colormap>=I<colormap>, B<--cm>=I<colormap>

Basic I<colormap> format is :

    FIELD=COLOR

where the FIELD is one from these :

    COMMAND  Command line
    OMARK    Old mark
    NMARK    New mark
    UTEXT    Same text
    OTEXT    Old text
    NTEXT    New text
    OCHANGE  Old change part
    NCHANGE  New change part
    APPEND   Appended part
    DELETE   Deleted part

=for comment
    VISIBLE  Visualized invisible chars

and additional I<Common> and I<Merged> FIELDs for git-diff combined
format.

    CMARK    Common mark
    CTEXT    Common text
    MMARK    Merged mark
    MTEXT    Merged text

You can give several fields the same color by joining them with = :

    FIELD1=FIELD2=...=COLOR

A wildcard can also be used for the field name :

    *CHANGE=BDw

Multiple fields can be specified by repeating the option :

    --cm FIELD1=COLOR1 --cm FIELD2=COLOR2 ...

or combined with comma (,) :

    --cm FIELD1=COLOR1,FIELD2=COLOR2, ...

Color specification is a combination of single uppercase character
representing 8 colors :

    R  Red
    G  Green
    B  Blue
    C  Cyan
    M  Magenta
    Y  Yellow
    K  Black
    W  White

and alternative (usually brighter) colors in lowercase :

    r, g, b, c, m, y, k, w

or RGB values and 24 grey levels on an ANSI 256-color or full-color
terminal :

    (255,255,255)      : 24bit decimal RGB colors
    #000000 .. #FFFFFF : 24bit hex RGB colors
    #000    .. #FFF    : 12bit hex RGB 4096 colors
    000 .. 555         : 6x6x6 RGB 216 colors
    L00 .. L25         : Black (L00), 24 grey levels, White (L25)

or color names enclosed in angle brackets :

    <red> <blue> <green> <cyan> <magenta> <yellow>
    <aliceblue> <honeydew> <hotpink> <moccasin>
    <medium_aqua_marine>

with other special effects :

    D  Double-struck (boldface)
    I  Italic
    U  Underline
    S  Stand-out (reverse video)

The above is a simplified summary; see L<Getopt::EX::Colormap> for the
complete specification.

Defaults are :

    COMMAND => "555/222E"
    OMARK   => "CS"
    NMARK   => "MS"
    UTEXT   => ""
    OTEXT   => "C"
    NTEXT   => "M"
    OCHANGE => "K/445"
    NCHANGE => "K/445"
    DELETE  => "K/544"
    APPEND  => "K/544"

    CMARK   => "GS"
    MMARK   => "YS"
    CTEXT   => "G"
    MTEXT   => "Y"

This is equivalent to :

    cdif --cm 'COMMAND=555/222E,OMARK=CS,NMARK=MS' \
         --cm 'UTEXT=,OTEXT=C,NTEXT=M,*CHANGE=BD/445,DELETE=APPEND=RD/544' \
         --cm 'CMARK=GS,MMARK=YS,CTEXT=G,MTEXT=Y'

=item B<--colormap>=C<&func>

=item B<--colormap>=C<sub{...}>

You can also give the name of a Perl subroutine, or its definition, to
be called for the matched words.  The target word is passed in the
variable C<$_>, and the return value of the subroutine is displayed.

The next option produces B<wdiff>-like output.

    --cm '*'= \
    --cm DELETE=OCHANGE='sub{"[-$_-]"}' \
    --cm APPEND=NCHANGE='sub{"{+$_+}"}'

See L<Getopt::EX::Colormap/FUNCTION SPEC> for details.

=item B<-->[B<no->]B<cc>, B<-->[B<no->]B<commandcolor>

=item B<-->[B<no->]B<mc>, B<-->[B<no->]B<markcolor>

=item B<-->[B<no->]B<tc>, B<-->[B<no->]B<textcolor>

=item B<-->[B<no->]B<uc>, B<-->[B<no->]B<unknowncolor>

Enable or disable color for the corresponding field.

=item B<--sdif>

Turn off the options that get in the way when the output is fed to
B<sdif>: B<--commandcolor>, B<--markcolor>, B<--textcolor> and
B<--unknowncolor>.

=item B<-->[B<no->]B<old>, B<-->[B<no->]B<new>, B<-->[B<no->]B<mrg>

Print, or do not print, the old/new/merged text in diff output.

=item B<-->[B<no->]B<command>

Print, or do not print, the command lines preceding diff output.

=item B<-->[B<no->]B<unknown>

Print, or do not print, lines that do not look like diff output.

=item B<-->[B<no->]B<mark>

Print, or do not print, the marks at the head of diff output lines.
For now this option is effective only for unified diff.

The next example produces output identical to F<new>, apart from the
visual effects.

    cdif -U100 --no-mark --no-old --no-command --no-unknown old new

These options are provided for the watchdiff(1) command.

=item B<-->[B<no->]B<prefix>

Understand a prefix in front of the diff output, such as the one
B<git> B<--graph> produces.  True by default.

=item B<--prefix-pattern>=I<pattern>

Specify the prefix pattern as a regular expression.  Default pattern is:

    (?:\| )*(?:  )*

This pattern matches B<git> graph style and whitespace indented diff
output.

=item B<--visible> I<charname>=[0,1]

Set the visible attribute for the given characters.  A visible
character is converted to the corresponding Unicode symbol.  Visible
by default: nul, bel, bs, vt, np, cr, esc, del, and all
non-breaking/special spaces.  Invisible by default: ht, nl, sp.

    NAME    CODE    Unicode NAME                      DEFAULT
    ------  ------  --------------------------------  -------
    nul     \000    SYMBOL FOR NULL                   YES
    soh     \001    SYMBOL FOR SOH                    YES
    bel     \007    SYMBOL FOR BELL                   YES
    bs      \010    SYMBOL FOR BACKSPACE              YES
    ht      \011    SYMBOL FOR HORIZONTAL TABULATION  NO
    nl      \012    SYMBOL FOR NEWLINE                NO
    vt      \013    SYMBOL FOR VERTICAL TABULATION    YES
    np      \014    SYMBOL FOR FORM FEED              YES
    cr      \015    SYMBOL FOR CARRIAGE RETURN        YES
    esc     \033    SYMBOL FOR ESCAPE                 YES
    sp      \040    SYMBOL FOR SPACE                  NO
    del     \177    SYMBOL FOR DELETE                 YES
    nbsp    \240    OPEN BOX (No-Break Space)         YES
    nnbsp   U+202F  OPEN BOX (Narrow No-Break Space)  YES
    ensp    U+2002  OPEN BOX (En Space)               YES
    emsp    U+2003  OPEN BOX (Em Space)               YES
    thinsp  U+2009  OPEN BOX (Thin Space)             YES
    hairsp  U+200A  OPEN BOX (Hair Space)             YES
    zwsp    U+200B  OPEN BOX (Zero Width Space)       YES
    idesp   U+3000  OPEN BOX (Ideographic Space)      YES

Since there are no dedicated Unicode symbols for nbsp and other
special space characters, OPEN BOX is used instead.

Several characters can be given at once: join them with a comma
(C<,>), as in C<--visible ht=1,sp=1>, or with an equal sign (C<=>), as
in C<--visible ht=sp=1>.  Character names accept a wildcard, as in
C<--visible '*=1'>.

=begin comment

Colormap label C<VISIBLE> is applied to those characters.  Default
setting is C<S>, and visible characters are displayed in reverse
video.  Unlike other colormaps, only special effects can be set to
this label.  Effect C<D> (double-struck) is exception (See
L<Getopt::EX::Colormap/~>).

=end comment

The B<sdif> command also supports the B<--visible> option, with better
visibility for horizontal tabs.

=item B<--stat>

Print statistical information at the end of the output, showing the
total number of appended, deleted and changed words as B<cdif> counts
them.  Refilling text inserts and deletes a great many newlines, so
the figures are followed by a second set that leaves those newlines
out.

=item B<-->[B<no->]B<lenience>

Suppress the warning message for unexpected input from the diff
command.  True
by default.

=item B<--limit> I<key>=I<value>

Set resource limits.  Available keys are:

=over 4

=item B<length>=I<#>

Skip word comparison for lines longer than I<#> characters.  Default
is 1000.  Extremely long lines, such as those found in SVG data, can
make word-level diff processing very slow with no useful result.  When
this limit is exceeded, the section is still displayed with basic
colorization but without fine-grained word highlighting.  Set to 0 to
disable this limit.

=back

=item B<--linebyline>, B<--lxl>

=item B<--style>=I<style>

Compare the input line by line.  The input is taken as a sequence of
line pairs, and the two lines of each pair are compared against each
other.

Suppose you have a document with old and new text on lines beginning
with C<OLD:> and C<NEW:> labels.

    OLD: this is old text
    NEW: and this is updated document

Only that old/new part can be compared, using B<greple>'s B<-Mtee>
module as follows.

    greple -Mtee cdif --lxl -- --cm=N -GE '^OLD: (.*\n)^NEW: (.*\n)'

The B<-Mtee> module sends the matched parts to a filter command and
replaces them with its output.  See L<App::Greple::tee> for details.

You can use the L<teip(1)> command as well.

    teip -g '^(OLD|NEW):' -- cdif --lxl

Given the C<--style=diff> option, the two strings are printed in
B<diff> format, which can be fed to the B<sdif> command as follows.

    cdif --lxl --style=diff ... | sdif --no-cdif

C<diff> is currently the only valid value for C<--style>, and it
affects nothing but the behavior of the C<--lxl> option.

=back

=head1 MODULE OPTIONS

=head2 default

  default      --autocolor
  --nop        do nothing

=head2 -Mcolors

The following options are available by default.  Run C<perldoc -m
App::cdif::colors> to see the actual settings.

  --light
  --green
  --cmy
  --mono

  --dark
  --dark-green
  --dark-cmy
  --dark-mono

=head1 GIT

See L<App::sdif/GIT> for how to use the B<sdif> family under GIT.

=head1 ENVIRONMENT

=over 7

=item B<CDIFOPTS>

Environment variable B<CDIFOPTS> is used to set default options.

=item B<LESS>

=item B<LESSANSIENDCHARS>

Since B<cdif> emits the ANSI Erase Line terminal sequence, it helps to
let the B<less> command know about it.

    LESS=-cR
    LESSANSIENDCHARS=mK

=back

=head1 AUTHOR

Kazumasa Utashiro

=head1 LICENSE

Copyright 1992-2026 Kazumasa Utashiro

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.


=head1 SEE ALSO

L<App::sdif>, L<https://github.com/kaz-utashiro/sdif-tools>

L<sdif(1)>, L<watchdiff(1)>

L<Getopt::EX::Colormap>

L<App::Greple::tee>

L<https://taku910.github.io/mecab/>

=head1 BUGS

B<cdif> is not very fast by nature, because it runs the normal diff
command as a back end to compare words.

=cut

#  LocalWords:  cdif diff rcs rcsdiff colormap commandcolor markcolor
#  LocalWords:  textcolor stdin OMARK NMARK OTEXT NTEXT OCHANGE CMARK
#  LocalWords:  NCHANGE CTEXT MMARK MTEXT Cyan RGB nomark stat cdifrc
#  LocalWords:  watchdiff mecab tokenizer Unicode lenience CDIFOPTS
#  LocalWords:  Kazumasa Utashiro sdif perldoc CMY cmy autocolor perl
#  LocalWords:  macOS XTerm subdiff LESSANSIENDCHARS
