use 5.024;
our $VERSION = "0.9909";
our $config = Getopt::EX::Config->new(
annotate => \(our $opt_annotate = 1),
alignto => 1,
split => 0,
);
lock_keys %{$config};
my %type = ( '*' => ':1' );
sub optspec { $_[0] . ( $type{$_[0]} // $type{'*'} // '' ) }
sub finalize {
our($mod, $argv) = @_;
$config->deal_with($argv,
map(optspec($_), keys %{$config}));
}
Text::ANSI::Fold->configure(expand => 1);
*vwidth = \&ansi_width;
package
Local::Annon {
sub new {
my $class = shift;
@_ == 3 or die;
bless [ @_ ], $class;
}
sub start { shift->[0] }
sub end { shift->[1] }
sub annon :lvalue { shift->[2] }
}
package
Local::Annon::List {
sub new {
my $class = shift;
bless {
Annotation => [],
Count => [],
}, $class;
}
sub annotation { $_[0]->{Annotation} }
sub count { $_[0]->{Count} }
sub push {
my $obj = CORE::shift;
push @{$obj->annotation}, @_;
push @{$obj->count}, int @_;
}
sub append {
my $obj = CORE::shift;
CORE::push @{$obj->annotation}, @_;
$obj->count->[-1] += int @_;
}
sub shift {
my $obj = CORE::shift;
my $count = CORE::shift @{$obj->count} or return ();
splice @{$obj->annotation}, 0, $count;
}
sub join {
my $obj = CORE::shift;
for (@_) {
CORE::push @{$obj->annotation}, @{$_->annotation};
CORE::push @{$obj->count}, @{$_->count};
}
}
sub total {
my $obj = CORE::shift;
List::Util::sum(@{$obj->count}) // 0;
}
sub last {
my $obj = CORE::shift;
$obj->annotation->[-1];
}
sub maxpos {
my $obj = CORE::shift;
List::Util::max map { $_->end - 1 } @{$obj->annotation};
}
}
sub code {
state $format = [ qw(\x{%02x} \x{%04x}) ];
my $ord = ord($_[0]);
sprintf($format->[$ord > 0xff], $ord);
}
my %cmap = (
"\t" => '\t',
"\n" => '\n',
"\r" => '\r',
"\f" => '\f',
"\b" => '\b',
"\a" => '\a',
"\e" => '\e',
);
sub control {
local $_ = @_ ? shift : $_;
if (s/\A([\t\n\r\f\b\a\e])/$cmap{$1}/e) {
$_;
} elsif (s/\A([\x00-\x1f])/sprintf "\\c%c", ord($1)+0x40/e) {
$_;
} else {
code($_);
}
}
sub visible {
local $_ = @_ ? shift : $_;
s{([^\pL\pN\pP\pS])}{control($1)}ger;
}
our $ANNOTATE //= sub {
my %param = @_;
my($column, $str) = @param{qw(column match)};
sprintf("%3d %s", $column, visible($str));
};
my $annotation;
sub prepare {
config('annotate') or return;
state $target;
if (defined $target and \$_ == $target) {
return;
} else {
$target = \$_;
}
$annotation = Local::Annon::List->new;
goto &_prepare;
}
sub _prepare {
my $grep = shift;
my @result = $grep->result or return;
for my $r (@result) {
my($b, @match) = @$r;
my @slice = $grep->slice_result($r);
my $start = 0;
my $progress = '';
my $indent = '';
my $current = Local::Annon::List->new;
while (my($i, $slice) = each @slice) {
if ($slice eq '') {
$current->push() if $i % 2;
next;
}
my $end = vwidth($progress . $slice);
my $gap = $end - $start;
my $indent_mark = '';
if ($i % 2) {
my $match = $match[$i / 2];
$indent_mark = '│';
my $head = '┌';
if ($gap == 0) {
if ($start == 0) {
$head = '╾';
$indent_mark = '';
} elsif ($current->total > 0 and $current->last->end == $start) {
$head = '├';
$start = $current->last->start;
substr($indent, $start) = '';
} elsif ($start > 0) {
$start = vwidth($progress =~ s/\X\z//r);
substr($indent, $start) = '';
}
}
my $marker = sub {
my($head, $match) = @_;
sprintf("%s%s%s\N{NBSP}%s",
$indent, $head, '─',
$ANNOTATE->(column => $start, match => $match));
};
$current->push( do {
if ($config->{split}) {
map {
my $out = $marker->($head, $_);
$head = '├';
Local::Annon->new($start, $end, $out);
} $slice =~ /./sg;
} else {
Local::Annon->new($start, $end, $marker->($head, $slice));
}
} );
}
$indent .= sprintf("%-*s", $end - $start, $indent_mark);
$progress .= $slice;
$start = $end;
}
@{$current->count} == 0 and next;
my $alignto = $config->{alignto};
if ($alignto > 0 and $current->total > 0) {
alignto($current, $alignto > 1 ? $alignto : $current->last->[0]);
}
$annotation->join($current);
}
if ($config->{alignto} == -1) {
alignto($annotation, $annotation->maxpos);
}
elsif ($config->{alignto} == -2) {
if (my $maxlen = max map { vwidth($grep->cut($_->[0]->@*)) } @result) {
alignto($annotation, $maxlen - 1);
}
}
}
sub alignto {
my($list, $pos) = @_;
for (@{$list->annotation}) {
if ((my $extend = $pos - $_->[0]) > 0) {
$_->annon =~ s/(?=([─]))/$1 x $extend/e;
}
}
}
sub annotate {
config('annotate') or return;
if (my @annon = $annotation->shift) {
say $_->annon for @annon;
}
undef;
}
1;
