When I have time I'll do a search for man pages that actually *need* -ms, as I'm getting the impression that it's never used for man pages and all of grog's guesses for it are wrong.
109 lines
2.8 KiB
Perl
109 lines
2.8 KiB
Perl
package ManUtils;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use AE;
|
|
use AnyEvent::Util;
|
|
use Encode 'decode_utf8', 'encode_utf8';
|
|
|
|
|
|
our $VERSION = '0.01';
|
|
|
|
require XSLoader;
|
|
XSLoader::load('ManUtils', $VERSION);
|
|
|
|
|
|
sub _groff {
|
|
my($input, $output, $errors, $cv, @cmd) = @_;
|
|
|
|
# $MANWIDTH works by using the following groff options: -rLL=100n -rLT=100n
|
|
splice @cmd, 1, 0, qw|-Tutf8 -DUTF-8 -P-c -rLL=80n -rLT=80n|;
|
|
|
|
$input =
|
|
# Disable hyphenation, since that screws up man page references. :-(
|
|
".hy 0\n.de hy\n..\n"
|
|
# Emulate man-db's --nj option
|
|
.".na\n.de ad\n..\n"
|
|
.$input;
|
|
|
|
my $groff = run_cmd \@cmd,
|
|
'<' => \$input,
|
|
'>' => \my $fmt,
|
|
'2>' => sub { if($_[0]) { chomp(my $e = $_[0]); push @$errors, "groff: $e" } };
|
|
|
|
$groff->cb(sub {
|
|
$$output = $fmt ? decode_utf8($fmt) : '';
|
|
$$output =~ s/[\t\s\r\n]+$//;
|
|
$cv->send;
|
|
});
|
|
$cv
|
|
}
|
|
|
|
|
|
# Usage: $cv = fmt($input, \$output, \@errors)
|
|
# $cv = AnyEvent condition variable, fired when done.
|
|
# $input = UTF-8 encoded manual page source
|
|
# $output = variable that will hold the output when done
|
|
# @errors = list of warnings/errors while running groff
|
|
sub fmt {
|
|
my($input, $output, $errors) = @_;
|
|
my $cv = AE::cv;
|
|
$$output = '';
|
|
@$errors = ();
|
|
|
|
$input = encode_utf8($input);
|
|
|
|
# grog has a tendency to recognize pod2man generated pages as -ms, let's just work around that by enforcing -man
|
|
return _groff $input, $output, $errors, $cv, 'groff', '-man' if $input =~ /^.\\" Automatically generated by Pod::Man/;
|
|
|
|
# Call grog to figure out which preprocessors to use.
|
|
my $grog = run_cmd [qw|grog -Tutf8 -DUTF-8 -|],
|
|
'<' => \$input,
|
|
'>' => \my $cmd,
|
|
'2>' => sub { $_[0] && push @$errors, "grog: $_[0]" };
|
|
|
|
$grog->cb(sub {
|
|
chomp($cmd);
|
|
if(!$cmd || $cmd =~ /\n/) {
|
|
push @$errors, !$cmd ? 'grog failed to produce output' : "Excessive grog output: $cmd";
|
|
$cv->send;
|
|
return;
|
|
}
|
|
|
|
my $double;
|
|
@$errors = grep {
|
|
chomp;
|
|
s/^grog: grog: /grog: /;
|
|
!$double && /there are several macro packages: (.+)$/ ? ($double = $1) && 0 : 1;
|
|
} @$errors;
|
|
|
|
my @cmd = split / /, $cmd;
|
|
if($double) {
|
|
my %double = map +($_,1), split / /, $double;
|
|
# Use the first macro package in ASCIIbetical order. (This is somewhat
|
|
# arbitrary, need to find a better conflict resolution method).
|
|
my $macros = (sort keys %double)[0];
|
|
# Replace macro arguments with our selected one.
|
|
@cmd = grep !$double{$_}, @cmd;
|
|
@cmd = (@cmd[0..$#cmd-1], $macros, $cmd[$#cmd]);
|
|
push @$errors, "grog detected several macro packages: $double. Using $macros. (@cmd)";
|
|
}
|
|
|
|
_groff $input, $output, $errors, $cv, @cmd;
|
|
});
|
|
|
|
$cv;
|
|
}
|
|
|
|
|
|
# Blocking version of fmt(). Returns the formatted man page, errors are
|
|
# forwarded to warn().
|
|
sub fmt_block {
|
|
my $c = shift;
|
|
my $cv = fmt $c, \my $out, \my @err;
|
|
$cv->recv;
|
|
#warn "$_\n" for @err;
|
|
$out;
|
|
}
|
|
|
|
1;
|