diff options
Diffstat (limited to 'lib/PublicInbox/LeiViewText.pm')
| -rw-r--r-- | lib/PublicInbox/LeiViewText.pm | 237 |
1 files changed, 237 insertions, 0 deletions
diff --git a/lib/PublicInbox/LeiViewText.pm b/lib/PublicInbox/LeiViewText.pm new file mode 100644 index 00000000..6f5fca49 --- /dev/null +++ b/lib/PublicInbox/LeiViewText.pm @@ -0,0 +1,237 @@ +# Copyright (C) 2021 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> + +# PublicInbox::Eml to (optionally colorized) text coverter for terminals +# the non-HTML counterpart to PublicInbox::View +package PublicInbox::LeiViewText; +use strict; +use v5.10.1; +use PublicInbox::MsgIter qw(msg_part_text); +use PublicInbox::ContentHash qw(git_sha); +use PublicInbox::MID qw(references); +use PublicInbox::View; +use PublicInbox::Hval; +use PublicInbox::ViewDiff; +use PublicInbox::Spawn qw(popen_rd); +use Term::ANSIColor; + +sub _xs { + # xhtml_map works since we don't search for HTML ([&<>'"]) + $_[0] =~ s/([\x7f\x00-\x1f])/$PublicInbox::Hval::xhtml_map{$1}/sge; +} + +my %DEFAULT_COLOR = ( + # mutt names, loaded from ~/.config/lei/config + quoted => 'blue', + hdrdefault => 'cyan', + status => 'bright_cyan', # smsg stuff + + # git names and defaults, falls back to ~/.gitconfig + new => 'green', + old => 'red', + meta => 'bold', + frag => 'cyan', + func => undef, + context => undef, +); + +sub my_colored { + my ($self, $slot) = @_; # $_[2] = buffer + my $val = $self->{"color.$slot"} //= + $self->{-leicfg}->{"color.$slot"} // + $self->{-gitcfg}->{"color.diff.$slot"} // + $self->{-gitcfg}->{"diff.color.$slot"} // + $DEFAULT_COLOR{$slot}; + $val = $val->[-1] if ref($val) eq 'ARRAY'; + if (defined $val) { + # git doesn't use "_", Term::ANSIColor does + $val =~ s/\Abright([^_])/bright_$1/i; + ${$self->{obuf}} .= Term::ANSIColor::colored($_[2], lc $val); + } else { + ${$self->{obuf}} .= $_[2]; + } +} + +sub uncolored { ${$_[0]->{obuf}} .= $_[2] } + +sub new { + my ($cls, $lei) = @_; + my $self = bless { %{$lei->{opt}}, -colored => \&uncolored }, $cls; + return $self unless $self->{color} || -t $lei->{1}; + my $cmd = [ qw(git config -z --includes -l) ]; + my ($r, $pid) = popen_rd($cmd, undef, { 2 => $lei->{2} }); + my $cfg = PublicInbox::Config::config_fh_parse($r, "\0", "\n"); + waitpid($pid, 0); + if ($?) { + $lei->err("# git-config failed, no color (non-fatal)"); + return $self; + } + $self->{-colored} = \&my_colored; + $self->{-gitcfg} = $cfg; + $self->{-leicfg} = $lei->{cfg}; + $self; +} + +sub hdr_buf ($$) { + my ($self, $eml) = @_; + my $hbuf = ''; + for my $f (qw(From To Cc)) { + for my $v ($eml->header($f)) { + next if $v !~ /\S/; + PublicInbox::View::fold_addresses($v); + _xs($v); + $hbuf .= "$f: $v\n"; + } + } + for my $f (qw(Subject Date Newsgroups Message-ID X-Message-ID)) { + for my $v ($eml->header($f)) { + _xs($v); + $hbuf .= "$f: $v\n"; + } + } + if (my @irt = $eml->header_raw('In-Reply-To')) { + for my $v (@irt) { + _xs($v); + $hbuf .= "In-Reply-To: $v\n"; + } + } else { + my $refs = references($eml); + if (defined(my $irt = pop @$refs)) { + _xs($irt); + $hbuf .= "In-Reply-To: <$irt>\n"; + } + if (@$refs) { + my $max = $self->{-max_cols}; + $hbuf .= 'References: ' . + join("\n\t", map { '<'._xs($_).'>' } @$refs) . + ">\n"; + } + } + $self->{-colored}->($self, 'hdrdefault', $hbuf .= "\n"); +} + +sub attach_note ($$$$;$) { + my ($self, $ct, $p, $fn, $err) = @_; + my ($part, $depth, $idx) = @$p; + my $obuf = $self->{obuf}; + my $nl = $idx eq '1' ? '' : "\n"; # like join("\n", ...) + $$obuf .= <<EOF if $err; +[-- Warning: decoded text below may be mangled, UTF-8 assumed --] +EOF + my $blob = $self->{-smsg}->{blob} // ''; + $blob .= ':' if $blob ne ''; + $$obuf .= "[-- Attachment $blob$idx "; + _xs($ct); + my $size = length($part->body); + my $ts = "Type: $ct, Size: $size bytes"; + my $d = $part->header('Content-Description') // $fn // ''; + _xs($d); + $$obuf .= $d eq '' ? "$ts --]\n" : "$d --]\n[-- $ts --]\n"; + hdr_buf($self, $part) if $part->{is_submsg}; +} + +sub flush_text_diff ($$) { + my ($self, $cur) = @_; + my @top = split($PublicInbox::ViewDiff::EXTRACT_DIFFS, $$cur); + undef $$cur; # free memory + my $dctx; + my $obuf = $self->{obuf}; + my $colored = $self->{-colored}; + while (defined(my $x = shift @top)) { + if (scalar(@top) >= 4 && + $top[1] =~ $PublicInbox::ViewDiff::IS_OID && + $top[0] =~ $PublicInbox::ViewDiff::IS_OID) { + splice(@top, 0, 4); + $dctx = 1; + $colored->($self, 'meta', $x); + } elsif ($dctx) { + # Quiet "Complex regular subexpression recursion limit" + # warning. Perl will truncate matches upon hitting + # that limit, giving us more (and shorter) scalars than + # would be ideal, but otherwise it's harmless. + # + # We could replace the `+' metacharacter with `{1,100}' + # to limit the matches ourselves to 100, but we can + # let Perl do it for us, quietly. + no warnings 'regexp'; + + for my $s (split(/((?:(?:^\+[^\n]*\n)+)| + (?:(?:^-[^\n]*\n)+)| + (?:^@@ [^\n]+\n))/xsm, $x)) { + if (!defined($dctx)) { + ${$self->{obuf}} .= $s; + } elsif ($s =~ s/\A(@@ \S+ \S+ @@\s*)//) { + $colored->($self, 'frag', $1); + $colored->($self, 'func', $s); + } elsif ($s =~ /\A\+/) { + $colored->($self, 'new', $s); + } elsif ($s =~ /\A-- $/sm) { # email sig starts + $dctx = undef; + ${$self->{obuf}} .= $s; + } elsif ($s =~ /\A-/) { + $colored->($self, 'old', $s); + } else { + $colored->($self, 'context', $s); + } + } + } else { + ${$self->{obuf}} .= $x; + } + } +} + +sub add_text_buf { # callback for Eml->each_part + my ($p, $self) = @_; + my ($part, $depth, $idx) = @$p; + my $ct = $part->content_type || 'text/plain'; + my $fn = $part->filename; + my ($s, $err) = msg_part_text($part, $ct); + return attach_note($self, $ct, $p, $fn) unless defined $s; + hdr_buf($self, $part) if $part->{is_submsg}; + $s =~ s/\r\n/\n/sg; + _xs($s); + $s .= "\n" unless substr($s, -1, 1) eq "\n"; + my $diff = ($s =~ /^--- [^\n]+\n\+{3} [^\n]+\n@@ /ms); + my @sections = PublicInbox::MsgIter::split_quotes($s); + undef $s; # free memory + if (defined($fn) || ($depth > 0 && !$part->{is_submsg}) || $err) { + # badly-encoded message with $err? tell the world about it! + attach_note($self, $ct, $p, $fn, $err); + ${$self->{obuf}} .= "\n"; + } + my $colored = $self->{-colored}; + for my $cur (@sections) { + if ($cur =~ /\A>/) { + $colored->($self, 'quoted', $cur); + } elsif ($diff) { + flush_text_diff($self, \$cur); + } else { + ${$self->{obuf}} .= $cur; + } + undef $cur; # free memory + } +} + +# returns an arrayref suitable for $lei->out or print +sub eml_to_text { + my ($self, $smsg, $eml) = @_; + local $Term::ANSIColor::EACHLINE = "\n"; + $self->{obuf} = \(my $obuf = ''); + $self->{-smsg} = $smsg; + $self->{-max_cols} = ($self->{columns} //= 80) - 8; # for header wrap + my @h = (); + for my $f (qw(blob pct)) { + push @h, "$f:$smsg->{$f}" if defined $smsg->{$f}; + } + @h = ("# @h\n") if @h; + for my $f (qw(kw L)) { + my $v = $smsg->{$f} or next; + push @h, "# $f:".join(',', @$v)."\n" if @$v; + } + $self->{-colored}->($self, 'status', join('', @h)); + hdr_buf($self, $eml); + $eml->each_part(\&add_text_buf, $self, 1); + delete $self->{obuf}; +} + +1; |