diff options
Diffstat (limited to 'doc/sbase/dist/fmt_txt.pl')
| -rw-r--r-- | doc/sbase/dist/fmt_txt.pl | 178 |
1 files changed, 160 insertions, 18 deletions
diff --git a/doc/sbase/dist/fmt_txt.pl b/doc/sbase/dist/fmt_txt.pl index 81c2b15..87d70d3 100644 --- a/doc/sbase/dist/fmt_txt.pl +++ b/doc/sbase/dist/fmt_txt.pl @@ -7,24 +7,27 @@ # # © Copyright 1996, Cees de Groot # -package SGMLTools::fmt_txt; +package LinuxDocTools::fmt_txt; use strict; use File::Copy; use Text::EntityMap; -use SGMLTools::CharEnts; -use SGMLTools::Lang; -use SGMLTools::Vars; +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 => "filter", type => "f", short => "f" }, + { option => "blanks", type => "i", short => "b" } ]; $txt->{manpage} = 0; $txt->{filter} = 0; +$txt->{blanks} = 3; $Formats{$txt->{NAME}} = $txt; @@ -44,19 +47,26 @@ $txt->{preNSGMLS} = sub $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; - return 0; + $global->{NsgmlsPrePipe} = "cat $global->{file} " ; }; @@ -81,16 +91,48 @@ $txt->{preASP} = sub { my ($infile, $outfile) = @_; my (@toc, @lines); - if ($txt->{manpage}) + 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}) { - copy ($infile, $outfile); + 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 - 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 @@ -103,6 +145,8 @@ $txt->{preASP} = sub push (@toc, ")P\n"); push (@toc, "(VERB\n"); my (@prevheader, @header); + my $appendix = 0; + my $nonprint = 0; while (<$infile>) { push (@lines, $_); @@ -111,16 +155,27 @@ $txt->{preASP} = sub { @prevheader = @header; @header = @header[0..$1]; - $header[$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/\\n/ /g; s/\(\\[0-9][0-9][0-9]\)/\\\1/g; if (!$#header) @@ -130,15 +185,63 @@ $txt->{preASP} = sub $_ = "\\n" . $_ unless (!$#prevheader); # put a . and a space after top level sections s/ /. /; - $_ = "-" . $_ . "\\n"; +##### $_ = "-" . $_ . "\\n"; + $_ = "-" . $_; } else { # subsections get indentation matching hierarchy $_ = "-" . " " x $#header . $_; } - push(@toc, parse_data ($_, $char_maps, $txt_escape), "\\n\n"); - } + +# 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"); @@ -233,8 +336,9 @@ $txt->{postASP} = sub } else { + create_temp("$global->{tmpbase}.txt.1"); $outfile = new FileHandle - "|$main::progs->{GROFF} -T $global->{pass} $global->{charset} -t $main::progs->{GROFFMACRO} >$global->{tmpbase}.txt.1"; + "|$main::progs->{GROFF} $global->{pass} -T $global->{charset} -t $main::progs->{GROFFMACRO} >\"$global->{tmpbase}.txt.1\""; } # @@ -265,17 +369,36 @@ $txt->{postASP} = sub { $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; - print $outfile $_; + if ($txt->{blanks}) + { + $count = &{$txt->{cutblank}}($count, $outfile, $_); + } + else + { + print $outfile $_; + } } } else { - copy ($groffout, $outfile); + if ($txt->{blanks}) + { + while (<$groffout>) + { + $count = &{$txt->{cutblank}}($count, $outfile, $_); + } + } + else + { + copy ($groffout, $outfile); + } } } $groffout->close; @@ -284,4 +407,23 @@ $txt->{postASP} = sub 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; |