59a7a16c2a
Leaving the rest to be formatted as links to the included man page instead. Primary reason for this change is to make it possible to cache formatted man pages, as they now no longer depend on anything except the raw source of the page itself.
78 lines
2.5 KiB
Perl
78 lines
2.5 KiB
Perl
package ManUtils 0.2;
|
|
|
|
use v5.36;
|
|
use IPC::Open3;
|
|
use IO::Poll qw/POLLOUT POLLIN/;
|
|
use Symbol 'gensym';
|
|
use XSLoader;
|
|
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
|
|
XSLoader::load('ManUtils');
|
|
|
|
sub fmt($input) {
|
|
my @cmd = 'groff';
|
|
push @cmd, '-t' if $input =~ /^\.TS/m;
|
|
push @cmd, '-e' if $input =~ /^\.EQ/m;
|
|
# $MANWIDTH works by using the following groff options: -rLL=100n -rLT=100n
|
|
push @cmd, qw/-mandoc -Tutf8 -DUTF-8 -P-c -rLL=80n -rLT=80n -/;
|
|
|
|
# tix comes with* a custom(?) man.macros package. But it looks okay even without loading that.
|
|
# (* It actually doesn't, the tcllib package appears to have that file, but doesn't '.so' it)
|
|
# Other .so's are just turned into a link.
|
|
$input =~ s/^\.so (.+)$/$1 eq 'man.macros' ? '' : ".in -10\n.sp\n[[[MANNEDINCLUDE$1]]]"/emg;
|
|
|
|
$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"
|
|
# Unbreak some quotes, there's plenty of man pages that ("incorrectly") use these for code samples.
|
|
.".char ` \\`\n"
|
|
.".char ' \\[aq]\n"
|
|
.$input;
|
|
utf8::encode($input);
|
|
|
|
my $pid = open3(my $in, my $out, my $err = gensym, @cmd);
|
|
|
|
# "POLLOUT" does NOT guarantee that a write will not block, we must set
|
|
# O_NONBLOCK to tell the kernel that we can handle short writes.
|
|
fcntl($in, F_SETFL, fcntl($in, F_GETFL, 0) | O_NONBLOCK);
|
|
|
|
my $inoff = 0;
|
|
my $output = '';
|
|
my $poll = IO::Poll->new;
|
|
$poll->mask($in => POLLOUT);
|
|
$poll->mask($out => POLLIN);
|
|
$poll->mask($err => POLLIN);
|
|
while (1) {
|
|
$poll->poll;
|
|
|
|
if ($poll->events($in)) {
|
|
my $r = syswrite $in, $input, 16*1024, $inoff;
|
|
die "Write error: $!\n" if $r <= 0;
|
|
$inoff += $r;
|
|
if ($inoff == length $input) {
|
|
$poll->remove($in);
|
|
close $in;
|
|
}
|
|
}
|
|
|
|
if ($poll->events($out)) {
|
|
my $r = sysread $out, $output, 16*1024, length $output;
|
|
die "Read error: $!\n" if $r < 0;
|
|
if ($r == 0) {
|
|
utf8::decode($output);
|
|
waitpid $pid, 0;
|
|
die "Groff exited with $?\n" if $?;
|
|
return $output =~ s/\s+$//r;
|
|
}
|
|
}
|
|
|
|
if ($poll->events($err)) {
|
|
my $r = sysread $err, my $buf, 16*1024;
|
|
$poll->remove($err) if $r == 0;
|
|
#warn "GROFF: $buf\n" if $r > 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
1;
|