Statistics
| Branch: | Revision:

iof-bird / bird-2.0.1 / doc / sbase / dist / fmt_txt.pl @ 6b3f1a54

History | View | Annotate | Download (9 KB)

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;