bird/doc/sbase/dist/fmt_txt.pl

430 lines
9 KiB
Perl
Raw Normal View History

#
# fmt_txt.pl
#
# $Id$
#
# TXT-specific driver stuff
#
# <20> Copyright 1996, Cees de Groot
#
package LinuxDocTools::fmt_txt;
use strict;
use File::Copy;
use Text::EntityMap;
use LinuxDocTools::CharEnts;
use LinuxDocTools::Lang;
use LinuxDocTools::Vars;
use LinuxDocTools::Utils qw(create_temp);
my $txt = {};
$txt->{NAME} = "txt";
$txt->{HELP} = "";
$txt->{OPTIONS} = [
{ option => "manpage", type => "f", short => "m" },
{ option => "filter", type => "f", short => "f" },
{ option => "blanks", type => "i", short => "b" }
];
$txt->{manpage} = 0;
$txt->{filter} = 0;
$txt->{blanks} = 3;
$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...
#
# the language support ja.
# the charset support nippon.
#
$global->{format} = $global->{charset};
$global->{charset} = "nippon" if $global->{language} eq "ja";
$global->{format} = "groff" if $global->{format} eq "ascii";
$global->{format} = "groff" if $global->{format} eq "nippon";
$global->{format} = "groff" if $global->{format} eq "euc-kr";
$ENV{SGML_SEARCH_PATH} =~ s/txt/$global->{format}/;
$Formats{"groff"} = $txt;
$Formats{"latin1"} = $txt;
$Formats{"man"} = $txt;
$global->{NsgmlsPrePipe} = "cat $global->{file} " ;
};
# 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);
my $char_maps = load_char_maps ('.2tr', [ Text::EntityMap::sdata_dirs() ]);
if ( $global->{charset} eq "latin1" )
{
$char_maps = load_char_maps ('.2l1tr', [ Text::EntityMap::sdata_dirs() ]);
}
if ($txt->{manpage})
{
while (<$infile>)
{
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 $_;
}
return;
}
# note the conversion of `sdata_dirs' list to an anonymous array to
# make a single argument
#
# 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);
my $appendix = 0;
my $nonprint = 0;
while (<$infile>)
{
push (@lines, $_);
if (/^\(SECT(.*)/)
{
@prevheader = @header;
@header = @header[0..$1];
if ($appendix == 1)
{
$header[$1] = "A";
$appendix = 0;
} else
{
$header[$1]++;
}
}
if (/^\(APPEND(.*)/)
{
$appendix = 1;
}
if (/^\(HEADING/)
{
$_ = <$infile>;
s/\\n/ /g;
push (@lines, $_);
chop;
s/^-//;
$_ = join(".",@header) . " " . $_;
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 . $_;
}
# remove tags from a toc
s/\)TT//g;
s/\(TT//g;
s/\)IT//g;
s/\(IT//g;
s/\)EM//g;
s/\(EM//g;
s/\)BF//g;
s/\(BF//g;
s/AID * CDATA.*$//g;
s/\)LABEL//g;
s/\(LABEL//g;
push(@toc, parse_data ($_, $char_maps, $txt_escape));
$_ = <$infile>;
while (!/^\)HEADING/) {
s/\\n/ /g; ####
push(@lines, $_);
chop;
s/^-//;
# remove tags from a toc
s/\)TT//g;
s/\(TT//g;
s/\)IT//g;
s/\(IT//g;
s/\)EM//g;
s/\(EM//g;
s/\)BF//g;
s/\(BF//g;
s/AID * CDATA.*$//g;
s/\)LABEL//g;
s/\(LABEL//g;
# remove NIDX, NCDX from a toc entry
if (/^\(NIDX$/ || /^\(NCDX$/) { $nonprint = 1; }
if (/^\)NIDX$/ || /^\)NCDX$/) { $nonprint = 1; }
# $_ = "-" . $_ . "\\n";
push(@toc, parse_data ($_, $char_maps, $txt_escape))
if (! $nonprint);
$_ = <$infile>;
}
s/\\n/ /g; ###
push(@lines, $_);
push(@toc, "\\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
{
create_temp("$global->{tmpbase}.txt.1");
$outfile = new FileHandle
"|$main::progs->{GROFF} $global->{pass} -T $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";
my $count = 0;
if ($txt->{filter})
{
while (<$groffout>)
{
s/[^\cH][^\cH]\cH\cH//g;
s/.//g;
if ($txt->{blanks})
{
$count = &{$txt->{cutblank}}($count, $outfile, $_);
}
else
{
print $outfile $_;
}
}
}
else
{
if ($txt->{blanks})
{
while (<$groffout>)
{
$count = &{$txt->{cutblank}}($count, $outfile, $_);
}
}
else
{
copy ($groffout, $outfile);
}
}
}
$groffout->close;
$outfile->close;
return 0;
};
$txt->{cutblank} = sub
{
my ($num, $out, $in) = @_;
if ( $in =~ /^$/ )
{
$num++;
}
else
{
$num = 0;
}
if ( $num <= $txt->{blanks} )
{
print $out $in;
}
return ($num);
};
1;