mirror of
https://git.FreeBSD.org/src.git
synced 2024-12-24 11:29:10 +00:00
593 lines
9.7 KiB
Perl
593 lines
9.7 KiB
Perl
#!/usr/bin/perl
|
|
###
|
|
### Quick usage: mdoc2man.pl < mdoc_manpage.8 > man_manpage.8
|
|
###
|
|
###
|
|
### Copyright (c) 2001 University of Illinois Board of Trustees
|
|
### Copyright (c) 2001 Mark D. Roth
|
|
### All rights reserved.
|
|
###
|
|
### Redistribution and use in source and binary forms, with or without
|
|
### modification, are permitted provided that the following conditions
|
|
### are met:
|
|
### 1. Redistributions of source code must retain the above copyright
|
|
### notice, this list of conditions and the following disclaimer.
|
|
### 2. Redistributions in binary form must reproduce the above copyright
|
|
### notice, this list of conditions and the following disclaimer in the
|
|
### documentation and/or other materials provided with the distribution.
|
|
### 3. All advertising materials mentioning features or use of this software
|
|
### must display the following acknowledgement:
|
|
### This product includes software developed by the University of
|
|
### Illinois at Urbana, and their contributors.
|
|
### 4. The University nor the names of their
|
|
### contributors may be used to endorse or promote products derived from
|
|
### this software without specific prior written permission.
|
|
###
|
|
### THIS SOFTWARE IS PROVIDED BY THE TRUSTEES AND CONTRIBUTORS ``AS IS'' AND
|
|
### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
### ARE DISCLAIMED. IN NO EVENT SHALL THE TRUSTEES OR CONTRIBUTORS BE LIABLE
|
|
### FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
### DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
|
### OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
|
### HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
### LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
|
### OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
|
### SUCH DAMAGE.
|
|
###
|
|
|
|
use strict;
|
|
|
|
my ($name, $date, $id);
|
|
my ($line);
|
|
my ($optlist, $oldoptlist, $nospace, $enum, $synopsis);
|
|
my ($reference, $block, $ext, $extopt, $literal);
|
|
my (@refauthors, $reftitle, $refissue, $refdate, $refopt);
|
|
|
|
|
|
$optlist = 0; ### 1 = bullet, 2 = enum, 3 = tag, 4 = item
|
|
$oldoptlist = 0;
|
|
$nospace = 0;
|
|
$synopsis = 0;
|
|
$reference = 0;
|
|
$block = 0;
|
|
$ext = 0;
|
|
$extopt = 0;
|
|
$literal = 0;
|
|
|
|
while ($line = <STDIN>)
|
|
{
|
|
if ($line !~ /^\./)
|
|
{
|
|
print $line;
|
|
print ".br\n"
|
|
if ($literal);
|
|
next;
|
|
}
|
|
|
|
$line =~ s/^\.//;
|
|
|
|
next
|
|
if ($line =~ m/\\"/);
|
|
|
|
$line = ParseMacro($line);
|
|
print($line)
|
|
if (defined $line);
|
|
}
|
|
|
|
|
|
|
|
sub ParseMacro # ($line)
|
|
{
|
|
my ($line) = @_;
|
|
my (@words, $retval, $option, $parens);
|
|
|
|
@words = split(/\s+/, $line);
|
|
$retval = '';
|
|
$option = 0;
|
|
$parens = 0;
|
|
|
|
# print('@words = ', scalar(@words), ': ', join(' ', @words), "\n");
|
|
|
|
while ($_ = shift @words)
|
|
{
|
|
# print "WORD: $_\n";
|
|
|
|
next
|
|
if (/^(Li|Pf)$/);
|
|
|
|
if (/^Xo$/)
|
|
{
|
|
$ext = 1;
|
|
$retval .= ' '
|
|
if ($retval ne '' && $retval !~ m/[\n ]$/);
|
|
next;
|
|
}
|
|
|
|
if (/^Xc$/)
|
|
{
|
|
$ext = 0;
|
|
$retval .= "\n"
|
|
if (! $extopt);
|
|
last;
|
|
}
|
|
|
|
if (/^Bd$/)
|
|
{
|
|
$literal = 1
|
|
if ($words[0] eq '-literal');
|
|
$retval .= "\n";
|
|
last;
|
|
}
|
|
|
|
if (/^Ed$/)
|
|
{
|
|
$literal = 0;
|
|
last;
|
|
}
|
|
|
|
if (/^Ns$/)
|
|
{
|
|
$nospace = 1
|
|
if (! $nospace);
|
|
$retval =~ s/ $//;
|
|
next;
|
|
}
|
|
|
|
if (/^No$/)
|
|
{
|
|
$retval =~ s/ $//;
|
|
$retval .= shift @words;
|
|
next;
|
|
}
|
|
|
|
if (/^Dq$/)
|
|
{
|
|
$retval .= '``';
|
|
do
|
|
{
|
|
$retval .= (shift @words) . ' ';
|
|
}
|
|
while (@words > 0 && $words[0] !~ m/^[\.,]/);
|
|
$retval =~ s/ $//;
|
|
$retval .= '\'\'';
|
|
$nospace = 1
|
|
if (! $nospace && $words[0] =~ m/^[\.,]/);
|
|
next;
|
|
}
|
|
|
|
if (/^(Sq|Ql)$/)
|
|
{
|
|
$retval .= '`' . (shift @words) . '\'';
|
|
$nospace = 1
|
|
if (! $nospace && $words[0] =~ m/^[\.,]/);
|
|
next;
|
|
}
|
|
|
|
# if (/^Ic$/)
|
|
# {
|
|
# $retval .= '\\fB' . shift(@words) . '\\fP';
|
|
# next;
|
|
# }
|
|
|
|
if (/^Oo$/)
|
|
{
|
|
# $retval .= "[\\c\n";
|
|
$extopt = 1;
|
|
$nospace = 1
|
|
if (! $nospace);
|
|
$retval .= '[';
|
|
next;
|
|
}
|
|
|
|
if (/^Oc$/)
|
|
{
|
|
$extopt = 0;
|
|
$retval .= ']';
|
|
next;
|
|
}
|
|
|
|
$retval .= ' '
|
|
if (! $nospace && $retval ne '' && $retval !~ m/[\n ]$/);
|
|
$nospace = 0
|
|
if ($nospace == 1);
|
|
|
|
if (/^Dd$/)
|
|
{
|
|
$date = join(' ', @words);
|
|
return undef;
|
|
}
|
|
|
|
if (/^Dt$/)
|
|
{
|
|
$id = join(' ', @words);
|
|
return undef;
|
|
}
|
|
|
|
if (/^Os$/)
|
|
{
|
|
$retval .= '.TH '
|
|
. $id
|
|
. " \"$date\" \""
|
|
. join(' ', @words)
|
|
. "\"";
|
|
last;
|
|
}
|
|
|
|
if (/^Sh$/)
|
|
{
|
|
$retval .= '.SH';
|
|
if ($words[0] eq 'SYNOPSIS')
|
|
{
|
|
$synopsis = 1;
|
|
}
|
|
else
|
|
{
|
|
$synopsis = 0;
|
|
}
|
|
next;
|
|
}
|
|
|
|
if (/^Xr$/)
|
|
{
|
|
$retval .= '\\fB' . (shift @words) .
|
|
'\\fP(' . (shift @words) . ')'
|
|
. (shift @words);
|
|
last;
|
|
}
|
|
|
|
if (/^Rs/)
|
|
{
|
|
@refauthors = ();
|
|
$reftitle = '';
|
|
$refissue = '';
|
|
$refdate = '';
|
|
$refopt = '';
|
|
$reference = 1;
|
|
last;
|
|
}
|
|
|
|
if (/^Re/)
|
|
{
|
|
$retval .= "\n";
|
|
|
|
# authors
|
|
while (scalar(@refauthors) > 1)
|
|
{
|
|
$retval .= shift(@refauthors) . ', ';
|
|
}
|
|
$retval .= 'and '
|
|
if ($retval ne '');
|
|
$retval .= shift(@refauthors);
|
|
|
|
# title
|
|
$retval .= ', \\fI' . $reftitle . '\\fP';
|
|
|
|
# issue
|
|
$retval .= ', ' . $refissue
|
|
if ($refissue ne '');
|
|
|
|
# date
|
|
$retval .= ', ' . $refdate
|
|
if ($refdate ne '');
|
|
|
|
# optional info
|
|
$retval .= ', ' . $refopt
|
|
if ($refopt ne '');
|
|
|
|
$retval .= ".\n";
|
|
|
|
$reference = 0;
|
|
last;
|
|
}
|
|
|
|
if ($reference)
|
|
{
|
|
if (/^%A$/)
|
|
{
|
|
unshift(@refauthors, join(' ', @words));
|
|
last;
|
|
}
|
|
|
|
if (/^%T$/)
|
|
{
|
|
$reftitle = join(' ', @words);
|
|
$reftitle =~ s/^"//;
|
|
$reftitle =~ s/"$//;
|
|
last;
|
|
}
|
|
|
|
if (/^%N$/)
|
|
{
|
|
$refissue = join(' ', @words);
|
|
last;
|
|
}
|
|
|
|
if (/^%D$/)
|
|
{
|
|
$refdate = join(' ', @words);
|
|
last;
|
|
}
|
|
|
|
if (/^%O$/)
|
|
{
|
|
$refopt = join(' ', @words);
|
|
last;
|
|
}
|
|
}
|
|
|
|
if (/^Nm$/)
|
|
{
|
|
my $n = $name;
|
|
$n = shift @words
|
|
if (@words > 0);
|
|
$name = $n unless $name;
|
|
$retval .= ".br\n"
|
|
if ($synopsis);
|
|
$retval .= "\\fB$n\\fP";
|
|
$nospace = 1
|
|
if (! $nospace && $words[0] =~ m/^[\.,]/);
|
|
next;
|
|
}
|
|
|
|
if (/^Nd$/)
|
|
{
|
|
$retval .= '\\-';
|
|
next;
|
|
}
|
|
|
|
if (/^Fl$/)
|
|
{
|
|
$retval .= '\\fB\\-' . (shift @words) . '\\fP';
|
|
$nospace = 1
|
|
if (! $nospace && $words[0] =~ m/^[\.,]/);
|
|
next;
|
|
}
|
|
|
|
if (/^Ar$/)
|
|
{
|
|
$retval .= '\\fI';
|
|
if (! defined $words[0])
|
|
{
|
|
$retval .= 'file ...\\fP';
|
|
}
|
|
else
|
|
{
|
|
$retval .= shift(@words) . '\\fP';
|
|
while ($words[0] eq '|')
|
|
{
|
|
$retval .= ' ' . shift(@words);
|
|
$retval .= ' \\fI' . shift(@words);
|
|
$retval .= '\\fP';
|
|
}
|
|
}
|
|
$nospace = 1
|
|
if (! $nospace && $words[0] =~ m/^[\.,]/);
|
|
next;
|
|
}
|
|
|
|
if (/^Cm$/)
|
|
{
|
|
$retval .= '\\fB' . (shift @words) . '\\fP';
|
|
while ($words[0] =~ m/^[\.,:)]$/)
|
|
{
|
|
$retval .= shift(@words);
|
|
}
|
|
next;
|
|
}
|
|
|
|
if (/^Op$/)
|
|
{
|
|
$option = 1;
|
|
$nospace = 1
|
|
if (! $nospace);
|
|
$retval .= '[';
|
|
# my $tmp = pop(@words);
|
|
# $tmp .= ']';
|
|
# push(@words, $tmp);
|
|
next;
|
|
}
|
|
|
|
if (/^Pp$/)
|
|
{
|
|
$retval .= "\n";
|
|
next;
|
|
}
|
|
|
|
if (/^Ss$/)
|
|
{
|
|
$retval .= '.SS';
|
|
next;
|
|
}
|
|
|
|
if (/^Pa$/ && ! $option)
|
|
{
|
|
$retval .= '\\fI';
|
|
$retval .= '\\&'
|
|
if ($words[0] =~ m/^\./);
|
|
$retval .= (shift @words) . '\\fP';
|
|
while ($words[0] =~ m/^[\.,:;)]$/)
|
|
{
|
|
$retval .= shift(@words);
|
|
}
|
|
# $nospace = 1
|
|
# if (! $nospace && $words[0] =~ m/^[\.,:)]/);
|
|
next;
|
|
}
|
|
|
|
if (/^Dv$/)
|
|
{
|
|
$retval .= '.BR';
|
|
next;
|
|
}
|
|
|
|
if (/^(Em|Ev)$/)
|
|
{
|
|
$retval .= '.IR';
|
|
next;
|
|
}
|
|
|
|
if (/^Pq$/)
|
|
{
|
|
$retval .= '(';
|
|
$nospace = 1;
|
|
$parens = 1;
|
|
next;
|
|
}
|
|
|
|
if (/^(S[xy])$/)
|
|
{
|
|
$retval .= '.B ' . join(' ', @words);
|
|
last;
|
|
}
|
|
|
|
if (/^Ic$/)
|
|
{
|
|
$retval .= '\\fB';
|
|
while (defined $words[0]
|
|
&& $words[0] !~ m/^[\.,]/)
|
|
{
|
|
if ($words[0] eq 'Op')
|
|
{
|
|
shift(@words);
|
|
$retval .= '[';
|
|
my $tmp = pop(@words);
|
|
$tmp .= ']';
|
|
push(@words, $tmp);
|
|
next;
|
|
}
|
|
if ($words[0] eq 'Ar')
|
|
{
|
|
shift @words;
|
|
$retval .= '\\fI';
|
|
$retval .= shift @words;
|
|
$retval .= '\\fP';
|
|
}
|
|
else
|
|
{
|
|
$retval .= shift @words;
|
|
}
|
|
$retval .= ' '
|
|
if (! $nospace);
|
|
}
|
|
$retval =~ s/ $//;
|
|
$retval .= '\\fP';
|
|
$retval .= shift @words
|
|
if (defined $words[0]);
|
|
last;
|
|
}
|
|
|
|
if (/^Bl$/)
|
|
{
|
|
$oldoptlist = $optlist;
|
|
if ($words[0] eq '-bullet')
|
|
{
|
|
$optlist = 1;
|
|
}
|
|
elsif ($words[0] eq '-enum')
|
|
{
|
|
$optlist = 2;
|
|
$enum = 0;
|
|
}
|
|
elsif ($words[0] eq '-tag')
|
|
{
|
|
$optlist = 3;
|
|
}
|
|
elsif ($words[0] eq '-item')
|
|
{
|
|
$optlist = 4;
|
|
}
|
|
last;
|
|
}
|
|
|
|
if (/^El$/)
|
|
{
|
|
$optlist = $oldoptlist;
|
|
next;
|
|
}
|
|
|
|
if ($optlist && /^It$/)
|
|
{
|
|
if ($optlist == 1)
|
|
{
|
|
# bullets
|
|
$retval .= '.IP \\(bu';
|
|
next;
|
|
}
|
|
|
|
if ($optlist == 2)
|
|
{
|
|
# enum
|
|
$retval .= '.IP ' . (++$enum) . '.';
|
|
next;
|
|
}
|
|
|
|
if ($optlist == 3)
|
|
{
|
|
# tags
|
|
$retval .= ".TP\n";
|
|
if ($words[0] =~ m/^(Pa|Ev)$/)
|
|
{
|
|
shift @words;
|
|
$retval .= '.B';
|
|
}
|
|
next;
|
|
}
|
|
|
|
if ($optlist == 4)
|
|
{
|
|
# item
|
|
$retval .= ".IP\n";
|
|
next;
|
|
}
|
|
|
|
next;
|
|
}
|
|
|
|
if (/^Sm$/)
|
|
{
|
|
if ($words[0] eq 'off')
|
|
{
|
|
$nospace = 2;
|
|
}
|
|
elsif ($words[0] eq 'on')
|
|
{
|
|
# $retval .= "\n";
|
|
$nospace = 0;
|
|
}
|
|
shift @words;
|
|
next;
|
|
}
|
|
|
|
$retval .= "$_";
|
|
}
|
|
|
|
return undef
|
|
if ($retval eq '.');
|
|
|
|
$retval =~ s/^\.([^a-zA-Z])/$1/;
|
|
# $retval =~ s/ $//;
|
|
|
|
$retval .= ')'
|
|
if ($parens == 1);
|
|
|
|
$retval .= ']'
|
|
if ($option == 1);
|
|
|
|
# $retval .= ' '
|
|
# if ($nospace && $retval ne '' && $retval !~ m/\n$/);
|
|
|
|
# $retval .= ' '
|
|
# if ($extended && $retval !~ m/ $/);
|
|
|
|
$retval .= ' '
|
|
if ($ext && ! $extopt && $retval !~ m/ $/);
|
|
|
|
$retval .= "\n"
|
|
if (! $ext && ! $extopt && $retval ne '' && $retval !~ m/\n$/);
|
|
|
|
return $retval;
|
|
}
|
|
|
|
|