mirror of
https://gitlab.nic.cz/labs/bird.git
synced 2024-12-23 02:01:55 +00:00
288 lines
5.9 KiB
Perl
288 lines
5.9 KiB
Perl
|
#
|
|||
|
# fmt_txt.pl
|
|||
|
#
|
|||
|
# $Id$
|
|||
|
#
|
|||
|
# TXT-specific driver stuff
|
|||
|
#
|
|||
|
# <20> Copyright 1996, Cees de Groot
|
|||
|
#
|
|||
|
package SGMLTools::fmt_txt;
|
|||
|
use strict;
|
|||
|
|
|||
|
use File::Copy;
|
|||
|
use Text::EntityMap;
|
|||
|
use SGMLTools::CharEnts;
|
|||
|
use SGMLTools::Lang;
|
|||
|
use SGMLTools::Vars;
|
|||
|
|
|||
|
my $txt = {};
|
|||
|
$txt->{NAME} = "txt";
|
|||
|
$txt->{HELP} = "";
|
|||
|
$txt->{OPTIONS} = [
|
|||
|
{ option => "manpage", type => "f", short => "m" },
|
|||
|
{ option => "filter", type => "f", short => "f" }
|
|||
|
];
|
|||
|
$txt->{manpage} = 0;
|
|||
|
$txt->{filter} = 0;
|
|||
|
|
|||
|
$Formats{$txt->{NAME}} = $txt;
|
|||
|
|
|||
|
#
|
|||
|
# Set correct NsgmlsOpts
|
|||
|
#
|
|||
|
$txt->{preNSGMLS} = sub
|
|||
|
{
|
|||
|
if ($txt->{manpage})
|
|||
|
{
|
|||
|
$global->{NsgmlsOpts} .= " -iman ";
|
|||
|
$global->{charset} = "man";
|
|||
|
}
|
|||
|
else
|
|||
|
{
|
|||
|
$global->{NsgmlsOpts} .= " -ifmttxt ";
|
|||
|
$global->{charset} = "latin1" if $global->{charset} eq "latin";
|
|||
|
}
|
|||
|
|
|||
|
#
|
|||
|
# Is there a cleaner solution than this? Can't do it earlier,
|
|||
|
# would show up in the help messages...
|
|||
|
#
|
|||
|
$global->{format} = $global->{charset};
|
|||
|
$global->{format} = "groff" if $global->{format} eq "ascii";
|
|||
|
$ENV{SGML_SEARCH_PATH} =~ s/txt/$global->{format}/;
|
|||
|
|
|||
|
$Formats{"groff"} = $txt;
|
|||
|
$Formats{"latin1"} = $txt;
|
|||
|
$Formats{"man"} = $txt;
|
|||
|
|
|||
|
return 0;
|
|||
|
};
|
|||
|
|
|||
|
|
|||
|
# Ascii escape sub. this is called-back by `parse_data' below in
|
|||
|
# `txt_preASP' to properly escape `\' characters coming from the SGML
|
|||
|
# source.
|
|||
|
my $txt_escape = sub {
|
|||
|
my ($data) = @_;
|
|||
|
|
|||
|
$data =~ s|"|\\\&\"|g; # Insert zero-width space in front of "
|
|||
|
$data =~ s|^\.|\\&.|; # ditto in front of . at start of line
|
|||
|
$data =~ s|\\|\\\\|g; # Escape backslashes
|
|||
|
|
|||
|
return ($data);
|
|||
|
};
|
|||
|
|
|||
|
#
|
|||
|
# Run the file through the genertoc utility before sgmlsasp. Not necessary
|
|||
|
# when producing a manpage. A lot of code from FJM, untested by me.
|
|||
|
#
|
|||
|
$txt->{preASP} = sub
|
|||
|
{
|
|||
|
my ($infile, $outfile) = @_;
|
|||
|
my (@toc, @lines);
|
|||
|
if ($txt->{manpage})
|
|||
|
{
|
|||
|
copy ($infile, $outfile);
|
|||
|
return;
|
|||
|
}
|
|||
|
|
|||
|
# note the conversion of `sdata_dirs' list to an anonymous array to
|
|||
|
# make a single argument
|
|||
|
my $char_maps = load_char_maps ('.2tr', [ Text::EntityMap::sdata_dirs() ]);
|
|||
|
$char_maps = load_char_maps ('.2l1tr', [ Text::EntityMap::sdata_dirs() ]) if $global->{charset} eq "latin1";
|
|||
|
|
|||
|
#
|
|||
|
# Build TOC. The file is read into @lines in the meantime, we need to
|
|||
|
# traverse it twice.
|
|||
|
#
|
|||
|
push (@toc, "(HLINE\n");
|
|||
|
push (@toc, ")HLINE\n");
|
|||
|
push (@toc, "(P\n");
|
|||
|
push (@toc, "-" . Xlat ("Table of Contents") . "\n");
|
|||
|
push (@toc, ")P\n");
|
|||
|
push (@toc, "(VERB\n");
|
|||
|
my (@prevheader, @header);
|
|||
|
while (<$infile>)
|
|||
|
{
|
|||
|
push (@lines, $_);
|
|||
|
|
|||
|
if (/^\(SECT(.*)/)
|
|||
|
{
|
|||
|
@prevheader = @header;
|
|||
|
@header = @header[0..$1];
|
|||
|
$header[$1]++;
|
|||
|
}
|
|||
|
if (/^\(HEADING/)
|
|||
|
{
|
|||
|
$_ = <$infile>;
|
|||
|
push (@lines, $_);
|
|||
|
chop;
|
|||
|
s/^-//;
|
|||
|
$_ = join(".",@header) . " " . $_;
|
|||
|
s/\\n/ /g;
|
|||
|
s/\(\\[0-9][0-9][0-9]\)/\\\1/g;
|
|||
|
|
|||
|
if (!$#header)
|
|||
|
{
|
|||
|
# put a newline before top-level sections unless previous was also
|
|||
|
# a top level section
|
|||
|
$_ = "\\n" . $_ unless (!$#prevheader);
|
|||
|
# put a . and a space after top level sections
|
|||
|
s/ /. /;
|
|||
|
$_ = "-" . $_ . "\\n";
|
|||
|
}
|
|||
|
else
|
|||
|
{
|
|||
|
# subsections get indentation matching hierarchy
|
|||
|
$_ = "-" . " " x $#header . $_;
|
|||
|
}
|
|||
|
push(@toc, parse_data ($_, $char_maps, $txt_escape), "\\n\n");
|
|||
|
}
|
|||
|
}
|
|||
|
push (@toc, ")VERB\n");
|
|||
|
push (@toc, "(HLINE\n");
|
|||
|
push (@toc, ")HLINE\n");
|
|||
|
|
|||
|
my $inheading = 0;
|
|||
|
my $tipo = '';
|
|||
|
for (@lines)
|
|||
|
{
|
|||
|
if ($inheading)
|
|||
|
{
|
|||
|
next if (/^\)TT/ || /^\(TT/ || /^\)IT/ || /^\(IT/ ||
|
|||
|
/^\)EM/ || /^\(EM/ || /^\)BF/ || /^\(BF/);
|
|||
|
if (/^-/)
|
|||
|
{
|
|||
|
$tipo .= $' ;
|
|||
|
chop ($tipo);
|
|||
|
$tipo .= " " unless $tipo =~ / $/;
|
|||
|
}
|
|||
|
else
|
|||
|
{
|
|||
|
$tipo =~ s/ $//;
|
|||
|
if ($tipo)
|
|||
|
{
|
|||
|
print $outfile "-"
|
|||
|
. parse_data ($tipo, $char_maps, $txt_escape)
|
|||
|
. "\n";
|
|||
|
}
|
|||
|
print $outfile $_;
|
|||
|
$tipo = '';
|
|||
|
}
|
|||
|
if (/^\)HEADING/)
|
|||
|
{
|
|||
|
$inheading = 0;
|
|||
|
}
|
|||
|
next;
|
|||
|
}
|
|||
|
if (/^\(HEADING/)
|
|||
|
{
|
|||
|
#
|
|||
|
# Go into heading processing mode.
|
|||
|
#
|
|||
|
$tipo = '';
|
|||
|
$inheading = 1;
|
|||
|
}
|
|||
|
if (/^\(TOC/)
|
|||
|
{
|
|||
|
print $outfile @toc;
|
|||
|
next;
|
|||
|
}
|
|||
|
if (/^-/)
|
|||
|
{
|
|||
|
my ($str) = $';
|
|||
|
chop ($str);
|
|||
|
print $outfile "-" . parse_data ($str, $char_maps, $txt_escape) . "\n";
|
|||
|
next;
|
|||
|
}
|
|||
|
elsif (/^A/)
|
|||
|
{
|
|||
|
/^A(\S+) (IMPLIED|CDATA|NOTATION|ENTITY|TOKEN)( (.*))?$/
|
|||
|
|| die "bad attribute data: $_\n";
|
|||
|
my ($name,$type,$value) = ($1,$2,$4);
|
|||
|
if ($type eq "CDATA")
|
|||
|
{
|
|||
|
# CDATA attributes get translated also
|
|||
|
$value = parse_data ($value, $char_maps, $txt_escape);
|
|||
|
}
|
|||
|
print $outfile "A$name $type $value\n";
|
|||
|
next;
|
|||
|
}
|
|||
|
|
|||
|
#
|
|||
|
# Default action if not skipped over with next: copy in to out.
|
|||
|
#
|
|||
|
print $outfile $_;
|
|||
|
}
|
|||
|
};
|
|||
|
|
|||
|
|
|||
|
#
|
|||
|
# Take the sgmlsasp output, and make something
|
|||
|
# useful from it.
|
|||
|
#
|
|||
|
$txt->{postASP} = sub
|
|||
|
{
|
|||
|
my $infile = shift;
|
|||
|
my ($outfile, $groffout);
|
|||
|
|
|||
|
if ($txt->{manpage})
|
|||
|
{
|
|||
|
$outfile = new FileHandle ">$global->{filename}.man";
|
|||
|
}
|
|||
|
else
|
|||
|
{
|
|||
|
$outfile = new FileHandle
|
|||
|
"|$main::progs->{GROFF} -T $global->{pass} $global->{charset} -t $main::progs->{GROFFMACRO} >$global->{tmpbase}.txt.1";
|
|||
|
}
|
|||
|
|
|||
|
#
|
|||
|
# Feed $outfile with roff input.
|
|||
|
#
|
|||
|
while (<$infile>)
|
|||
|
{
|
|||
|
unless (/^\.DS/.../^\.DE/)
|
|||
|
{
|
|||
|
s/^[ \t]{1,}(.*)/$1/g;
|
|||
|
}
|
|||
|
s/^\.[ \t].*/\\\&$&/g;
|
|||
|
s/\\fC/\\fR/g;
|
|||
|
s/^.ft C/.ft R/g;
|
|||
|
print $outfile $_;
|
|||
|
}
|
|||
|
$outfile->close;
|
|||
|
|
|||
|
#
|
|||
|
# If we were making a manpage, we're done. Otherwise, a little bit
|
|||
|
# of work is left.
|
|||
|
#
|
|||
|
if ($txt->{manpage})
|
|||
|
{
|
|||
|
return 0;
|
|||
|
}
|
|||
|
else
|
|||
|
{
|
|||
|
$outfile->open (">$global->{filename}.txt");
|
|||
|
$groffout = new FileHandle "<$global->{tmpbase}.txt.1";
|
|||
|
if ($txt->{filter})
|
|||
|
{
|
|||
|
while (<$groffout>)
|
|||
|
{
|
|||
|
s/.//g;
|
|||
|
print $outfile $_;
|
|||
|
}
|
|||
|
}
|
|||
|
else
|
|||
|
{
|
|||
|
copy ($groffout, $outfile);
|
|||
|
}
|
|||
|
}
|
|||
|
$groffout->close;
|
|||
|
$outfile->close;
|
|||
|
|
|||
|
return 0;
|
|||
|
};
|
|||
|
|
|||
|
1;
|