![[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 / bird2 / doc / sbase / dist|
Return to fmt_txt.pl CVS log | Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / bird2 / doc / sbase / dist |
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;