Annotation of embedaddon/bird/doc/sbase/dist/fmt_txt.pl, revision 1.1
1.1 ! misho 1: #
! 2: # fmt_txt.pl
! 3: #
! 4: # $Id$
! 5: #
! 6: # TXT-specific driver stuff
! 7: #
! 8: # © Copyright 1996, Cees de Groot
! 9: #
! 10: package LinuxDocTools::fmt_txt;
! 11: use strict;
! 12:
! 13: use File::Copy;
! 14: use Text::EntityMap;
! 15: use LinuxDocTools::CharEnts;
! 16: use LinuxDocTools::Lang;
! 17: use LinuxDocTools::Vars;
! 18: use LinuxDocTools::Utils qw(create_temp);
! 19:
! 20: my $txt = {};
! 21: $txt->{NAME} = "txt";
! 22: $txt->{HELP} = "";
! 23: $txt->{OPTIONS} = [
! 24: { option => "manpage", type => "f", short => "m" },
! 25: { option => "filter", type => "f", short => "f" },
! 26: { option => "blanks", type => "i", short => "b" }
! 27: ];
! 28: $txt->{manpage} = 0;
! 29: $txt->{filter} = 0;
! 30: $txt->{blanks} = 3;
! 31:
! 32: $Formats{$txt->{NAME}} = $txt;
! 33:
! 34: #
! 35: # Set correct NsgmlsOpts
! 36: #
! 37: $txt->{preNSGMLS} = sub
! 38: {
! 39: if ($txt->{manpage})
! 40: {
! 41: $global->{NsgmlsOpts} .= " -iman ";
! 42: $global->{charset} = "man";
! 43: }
! 44: else
! 45: {
! 46: $global->{NsgmlsOpts} .= " -ifmttxt ";
! 47: $global->{charset} = "latin1" if $global->{charset} eq "latin";
! 48: }
! 49:
! 50:
! 51: #
! 52: # Is there a cleaner solution than this? Can't do it earlier,
! 53: # would show up in the help messages...
! 54: #
! 55: # the language support ja.
! 56: # the charset support nippon.
! 57: #
! 58: $global->{format} = $global->{charset};
! 59: $global->{charset} = "nippon" if $global->{language} eq "ja";
! 60: $global->{format} = "groff" if $global->{format} eq "ascii";
! 61: $global->{format} = "groff" if $global->{format} eq "nippon";
! 62: $global->{format} = "groff" if $global->{format} eq "euc-kr";
! 63: $ENV{SGML_SEARCH_PATH} =~ s/txt/$global->{format}/;
! 64:
! 65: $Formats{"groff"} = $txt;
! 66: $Formats{"latin1"} = $txt;
! 67: $Formats{"man"} = $txt;
! 68:
! 69: $global->{NsgmlsPrePipe} = "cat $global->{file} " ;
! 70: };
! 71:
! 72:
! 73: # Ascii escape sub. this is called-back by `parse_data' below in
! 74: # `txt_preASP' to properly escape `\' characters coming from the SGML
! 75: # source.
! 76: my $txt_escape = sub {
! 77: my ($data) = @_;
! 78:
! 79: $data =~ s|"|\\\&\"|g; # Insert zero-width space in front of "
! 80: $data =~ s|^\.|\\&.|; # ditto in front of . at start of line
! 81: $data =~ s|\\|\\\\|g; # Escape backslashes
! 82:
! 83: return ($data);
! 84: };
! 85:
! 86: #
! 87: # Run the file through the genertoc utility before sgmlsasp. Not necessary
! 88: # when producing a manpage. A lot of code from FJM, untested by me.
! 89: #
! 90: $txt->{preASP} = sub
! 91: {
! 92: my ($infile, $outfile) = @_;
! 93: my (@toc, @lines);
! 94: my $char_maps = load_char_maps ('.2tr', [ Text::EntityMap::sdata_dirs() ]);
! 95: if ( $global->{charset} eq "latin1" )
! 96: {
! 97: $char_maps = load_char_maps ('.2l1tr', [ Text::EntityMap::sdata_dirs() ]);
! 98: }
! 99:
! 100: if ($txt->{manpage})
! 101: {
! 102: while (<$infile>)
! 103: {
! 104: if (/^-/)
! 105: {
! 106: my ($str) = $';
! 107: chop ($str);
! 108: print $outfile "-" .
! 109: parse_data ($str, $char_maps, $txt_escape) . "\n";
! 110: next;
! 111: }
! 112: elsif (/^A/)
! 113: {
! 114: /^A(\S+) (IMPLIED|CDATA|NOTATION|ENTITY|TOKEN)( (.*))?$/
! 115: || die "bad attribute data: $_\n";
! 116: my ($name,$type,$value) = ($1,$2,$4);
! 117: if ($type eq "CDATA")
! 118: {
! 119: # CDATA attributes get translated also
! 120: $value = parse_data ($value, $char_maps, $txt_escape);
! 121: }
! 122: print $outfile "A$name $type $value\n";
! 123: next;
! 124: }
! 125: #
! 126: # Default action if not skipped over with next: copy in to out.
! 127: #
! 128: print $outfile $_;
! 129: }
! 130:
! 131: return;
! 132: }
! 133:
! 134: # note the conversion of `sdata_dirs' list to an anonymous array to
! 135: # make a single argument
! 136:
! 137: #
! 138: # Build TOC. The file is read into @lines in the meantime, we need to
! 139: # traverse it twice.
! 140: #
! 141: push (@toc, "(HLINE\n");
! 142: push (@toc, ")HLINE\n");
! 143: push (@toc, "(P\n");
! 144: push (@toc, "-" . Xlat ("Table of Contents") . "\n");
! 145: push (@toc, ")P\n");
! 146: push (@toc, "(VERB\n");
! 147: my (@prevheader, @header);
! 148: my $appendix = 0;
! 149: my $nonprint = 0;
! 150: while (<$infile>)
! 151: {
! 152: push (@lines, $_);
! 153:
! 154: if (/^\(SECT(.*)/)
! 155: {
! 156: @prevheader = @header;
! 157: @header = @header[0..$1];
! 158: if ($appendix == 1)
! 159: {
! 160: $header[$1] = "A";
! 161: $appendix = 0;
! 162: } else
! 163: {
! 164: $header[$1]++;
! 165: }
! 166: }
! 167: if (/^\(APPEND(.*)/)
! 168: {
! 169: $appendix = 1;
! 170: }
! 171: if (/^\(HEADING/)
! 172: {
! 173: $_ = <$infile>;
! 174: s/\\n/ /g;
! 175: push (@lines, $_);
! 176: chop;
! 177: s/^-//;
! 178: $_ = join(".",@header) . " " . $_;
! 179: s/\(\\[0-9][0-9][0-9]\)/\\\1/g;
! 180:
! 181: if (!$#header)
! 182: {
! 183: # put a newline before top-level sections unless previous was also
! 184: # a top level section
! 185: $_ = "\\n" . $_ unless (!$#prevheader);
! 186: # put a . and a space after top level sections
! 187: s/ /. /;
! 188: ##### $_ = "-" . $_ . "\\n";
! 189: $_ = "-" . $_;
! 190: }
! 191: else
! 192: {
! 193: # subsections get indentation matching hierarchy
! 194: $_ = "-" . " " x $#header . $_;
! 195: }
! 196:
! 197: # remove tags from a toc
! 198: s/\)TT//g;
! 199: s/\(TT//g;
! 200: s/\)IT//g;
! 201: s/\(IT//g;
! 202: s/\)EM//g;
! 203: s/\(EM//g;
! 204: s/\)BF//g;
! 205: s/\(BF//g;
! 206: s/AID * CDATA.*$//g;
! 207: s/\)LABEL//g;
! 208: s/\(LABEL//g;
! 209:
! 210: push(@toc, parse_data ($_, $char_maps, $txt_escape));
! 211:
! 212: $_ = <$infile>;
! 213: while (!/^\)HEADING/) {
! 214: s/\\n/ /g; ####
! 215: push(@lines, $_);
! 216: chop;
! 217: s/^-//;
! 218:
! 219: # remove tags from a toc
! 220: s/\)TT//g;
! 221: s/\(TT//g;
! 222: s/\)IT//g;
! 223: s/\(IT//g;
! 224: s/\)EM//g;
! 225: s/\(EM//g;
! 226: s/\)BF//g;
! 227: s/\(BF//g;
! 228: s/AID * CDATA.*$//g;
! 229: s/\)LABEL//g;
! 230: s/\(LABEL//g;
! 231:
! 232: # remove NIDX, NCDX from a toc entry
! 233: if (/^\(NIDX$/ || /^\(NCDX$/) { $nonprint = 1; }
! 234: if (/^\)NIDX$/ || /^\)NCDX$/) { $nonprint = 1; }
! 235:
! 236: # $_ = "-" . $_ . "\\n";
! 237: push(@toc, parse_data ($_, $char_maps, $txt_escape))
! 238: if (! $nonprint);
! 239: $_ = <$infile>;
! 240: }
! 241: s/\\n/ /g; ###
! 242: push(@lines, $_);
! 243: push(@toc, "\\n\n");
! 244: }
! 245: }
! 246: push (@toc, ")VERB\n");
! 247: push (@toc, "(HLINE\n");
! 248: push (@toc, ")HLINE\n");
! 249:
! 250: my $inheading = 0;
! 251: my $tipo = '';
! 252: for (@lines)
! 253: {
! 254: if ($inheading)
! 255: {
! 256: next if (/^\)TT/ || /^\(TT/ || /^\)IT/ || /^\(IT/ ||
! 257: /^\)EM/ || /^\(EM/ || /^\)BF/ || /^\(BF/);
! 258: if (/^-/)
! 259: {
! 260: $tipo .= $' ;
! 261: chop ($tipo);
! 262: $tipo .= " " unless $tipo =~ / $/;
! 263: }
! 264: else
! 265: {
! 266: $tipo =~ s/ $//;
! 267: if ($tipo)
! 268: {
! 269: print $outfile "-"
! 270: . parse_data ($tipo, $char_maps, $txt_escape)
! 271: . "\n";
! 272: }
! 273: print $outfile $_;
! 274: $tipo = '';
! 275: }
! 276: if (/^\)HEADING/)
! 277: {
! 278: $inheading = 0;
! 279: }
! 280: next;
! 281: }
! 282: if (/^\(HEADING/)
! 283: {
! 284: #
! 285: # Go into heading processing mode.
! 286: #
! 287: $tipo = '';
! 288: $inheading = 1;
! 289: }
! 290: if (/^\(TOC/)
! 291: {
! 292: print $outfile @toc;
! 293: next;
! 294: }
! 295: if (/^-/)
! 296: {
! 297: my ($str) = $';
! 298: chop ($str);
! 299: print $outfile "-" . parse_data ($str, $char_maps, $txt_escape) . "\n";
! 300: next;
! 301: }
! 302: elsif (/^A/)
! 303: {
! 304: /^A(\S+) (IMPLIED|CDATA|NOTATION|ENTITY|TOKEN)( (.*))?$/
! 305: || die "bad attribute data: $_\n";
! 306: my ($name,$type,$value) = ($1,$2,$4);
! 307: if ($type eq "CDATA")
! 308: {
! 309: # CDATA attributes get translated also
! 310: $value = parse_data ($value, $char_maps, $txt_escape);
! 311: }
! 312: print $outfile "A$name $type $value\n";
! 313: next;
! 314: }
! 315:
! 316: #
! 317: # Default action if not skipped over with next: copy in to out.
! 318: #
! 319: print $outfile $_;
! 320: }
! 321: };
! 322:
! 323:
! 324: #
! 325: # Take the sgmlsasp output, and make something
! 326: # useful from it.
! 327: #
! 328: $txt->{postASP} = sub
! 329: {
! 330: my $infile = shift;
! 331: my ($outfile, $groffout);
! 332:
! 333: if ($txt->{manpage})
! 334: {
! 335: $outfile = new FileHandle ">$global->{filename}.man";
! 336: }
! 337: else
! 338: {
! 339: create_temp("$global->{tmpbase}.txt.1");
! 340: $outfile = new FileHandle
! 341: "|$main::progs->{GROFF} $global->{pass} -T $global->{charset} -t $main::progs->{GROFFMACRO} >\"$global->{tmpbase}.txt.1\"";
! 342: }
! 343:
! 344: #
! 345: # Feed $outfile with roff input.
! 346: #
! 347: while (<$infile>)
! 348: {
! 349: unless (/^\.DS/.../^\.DE/)
! 350: {
! 351: s/^[ \t]{1,}(.*)/$1/g;
! 352: }
! 353: s/^\.[ \t].*/\\\&$&/g;
! 354: s/\\fC/\\fR/g;
! 355: s/^.ft C/.ft R/g;
! 356: print $outfile $_;
! 357: }
! 358: $outfile->close;
! 359:
! 360: #
! 361: # If we were making a manpage, we're done. Otherwise, a little bit
! 362: # of work is left.
! 363: #
! 364: if ($txt->{manpage})
! 365: {
! 366: return 0;
! 367: }
! 368: else
! 369: {
! 370: $outfile->open (">$global->{filename}.txt");
! 371: $groffout = new FileHandle "<$global->{tmpbase}.txt.1";
! 372: my $count = 0;
! 373: if ($txt->{filter})
! 374: {
! 375: while (<$groffout>)
! 376: {
! 377: s/[^\cH][^\cH]\cH\cH//g;
! 378: s/.//g;
! 379: if ($txt->{blanks})
! 380: {
! 381: $count = &{$txt->{cutblank}}($count, $outfile, $_);
! 382: }
! 383: else
! 384: {
! 385: print $outfile $_;
! 386: }
! 387: }
! 388: }
! 389: else
! 390: {
! 391: if ($txt->{blanks})
! 392: {
! 393: while (<$groffout>)
! 394: {
! 395: $count = &{$txt->{cutblank}}($count, $outfile, $_);
! 396: }
! 397: }
! 398: else
! 399: {
! 400: copy ($groffout, $outfile);
! 401: }
! 402: }
! 403: }
! 404: $groffout->close;
! 405: $outfile->close;
! 406:
! 407: return 0;
! 408: };
! 409:
! 410: $txt->{cutblank} = sub
! 411: {
! 412: my ($num, $out, $in) = @_;
! 413: if ( $in =~ /^$/ )
! 414: {
! 415: $num++;
! 416: }
! 417: else
! 418: {
! 419: $num = 0;
! 420: }
! 421: if ( $num <= $txt->{blanks} )
! 422: {
! 423: print $out $in;
! 424: }
! 425:
! 426: return ($num);
! 427: };
! 428:
! 429: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to fmt_txt.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / bird / doc / sbase / dist