source: rtems/doc/tools/texi2www/texi2dvi @ 8e12a82

4.104.114.84.95
Last change on this file since 8e12a82 was 8e12a82, checked in by Joel Sherrill <joel.sherrill@…>, on Apr 3, 1998 at 3:35:52 PM

Changed Perl executable location

  • Property mode set to 100644
File size: 5.8 KB
Line 
1#!/usr/bin/perl
2
3$version = <<END_VERSION;
4Jan 2 1996
5END_VERSION
6
7$copyright = <<END_COPYRIGHT;
8texi2dvi - converts texinfo to dvi
9Copyright (C) 1996 Tim Singletary
10
11This program is freely distributable under the terms of the GNU
12GENERAL PUBLIC LICENSE.  In particular, modified versions of this
13program must retain this copyright notice and must remain freely
14distributable.
15END_COPYRIGHT
16
17$usage = <<END_USAGE;
18Usage: texi2dvi [option ...] texinfo_file ...
19  -k (-nocleanup) -- don't ``rm -f'' the intermediate files.
20  -v (-verbose) -- print additional output.
21  -copyright -- print the copyright and die.
22  -version -- print the version and die.
23Generates a .dvi file from each texinfo (.texi or .texinfo) file.
24Understands texi2www extensions (\@gif, etc.).
25END_USAGE
26
27unless ($tex = $ENV{TEX}) {$tex = tex;}
28unless ($texindex = $ENV{TEXINDEX}) {$texindex = texindex;}
29$texinputs = $ENV{TEXINPUTS};
30
31$cleanup = 1;
32while ($ARGV[0] =~ /^-/) {
33    $_ = shift;
34    if (/-k$/ || /-nocleanup/) {$cleanup = 0; next;}
35    if (/-v$/ || /-verbose/) {$verbose = 1; next;}
36    if (/-d$/ || /-vv$/ || /-debug/)   {$verbose = 2; next;}
37    if (/-copyright/) {die $copyright;}
38    if (/-version/) {die $version;}
39    die $usage;
40}
41
42$font_prefix = "xx";
43while (&prefix_in_use($font_prefix)) {
44    ++$font_prefix;
45    if (length($font_prefix) > 2) {
46        $font_prefix = "aa";
47    }
48}
49
50$unique_base = "_" . $$ . "a-";
51while (&prefix_in_use($unique_base)) {++$unique_base;}
52
53print "Generated files will begin with \`$unique_base\'\n" if $verbose;
54
55$arg_index = 'a';
56foreach $raw_texi (@ARGV) {
57    $base = $unique_base . $arg_index;
58    ++$arg_index;
59
60    # $tawtexifile is a texinfo file; suffix must be either `.texi' or
61    # `.texinfo'.  If arg is in a different directory, adjust
62    # TEXINPUTS environment variable to include that (and the current)
63    # directory.
64    unless ($raw_texi =~ /(.*).texi(nfo)?$/) {
65        print "skipping $raw_texi -- has unknown extension!\n";
66        next;
67    }
68    $raw_texi_base = $1;
69    if ($raw_texi_base =~ m|^(.*)/([^/]*)$|) {
70        $raw_texi_base = $2;
71        $ENV{TEXINPUTS} = ".:$1:$texinputs";
72    } else {
73        $ENV{TEXINPUTS} = ".:$texinputs";
74    }
75
76    unless (-r $raw_texi) {
77        print "skipping $raw_texi -- not readable or doesn't exist!\n";
78        next;
79    }
80
81    # Preprocesses the $rawtexifile (because of @gif{} and other extensions)
82    $processed_texi = "$base.texi";
83    print "Preprocessing $raw_texi into $processed_texi:\n" if $verbose;
84    &preprocess_texinfo($raw_texi,$processed_texi,$base);
85
86    print "$tex $processed_texi\n" if $verbose;
87    if (system("$tex $processed_texi") == 0) {
88
89        # @possible_index_file = <$base.??>; only works for the
90        # first value of $base ... so,
91        opendir(DIR,".") || die "Couldn't read current directory -- $!\n";
92        @possible_index_files = ();
93        while ($_ = readdir(DIR)) {
94            push(@possible_index_files,$_) if (/^$base\...$/);
95        }
96        closedir(DIR);
97
98        @index_files = ();
99        foreach $possible_index_file (@possible_index_files) {
100            print "DEBUG: possible_index_file $possible_index_file\n"
101                                                           if ($verbose > 1);
102            next unless (-s $possible_index_file);
103            push(@index_files,$possible_index_file);
104        }
105
106        if (@index_files > 0) {
107            $texindex_cmd =  "$texindex " . join(' ',@index_files);
108            print "$texindex_cmd\n" if $verbose;
109            if (system($texindex_cmd) == 0) {
110                print "$tex $processed_texi\n" if $verbose;
111                system("$tex $processed_texi");
112            }
113        }
114    }
115
116    # At this point, $base.dvi should exist -- rename it
117    # to $raw_texi_base.dvi
118    if (-e "$base.dvi") {
119        rename("$base.dvi","$raw_texi_base.dvi")
120            || die "rename $base.dvi $raw_texi_base.dvi -- $!\n";
121    }
122}
123if ($cleanup) {unlink(<$base*>);}
124
125sub preprocess_texinfo 
126{
127    local ($infile,$outfile,$b) = @_;
128
129    open(IN,"<$infile") || die "Couldn't open $infile -- $!\n";
130    open(OUT,">$outfile") || die "Couldn't open $outfile -- $!\n";
131
132    $gif_index = 'a';
133    while (<IN>) {
134
135        # @gif{gif} or @gif{html_gif, tex_gif}
136        if (/(.*)\@gif\{([^{]*)\}(.*)/) {
137            $prefix = $1;
138            $arg = $2;
139            $suffix = $3;
140            print OUT "$prefix\n" if $prefix;
141
142            while (1) {
143                $gif_base = $b . $gif_index;
144                last unless (-e $gif_base . ".gif");
145                ++$gif_index;
146            }
147
148            $gif_file = '';
149            if ($arg =~ /.*,(..*\.gif)/) {
150                $gif_file = $1;
151                $font_base = $gif_file;
152            } else {
153                $font_base = $arg;
154                $gif_file = $gif_base . ".gif";
155                print "Scaling $arg into $gif_file:\n" if $verbose;
156                $scale_cmd = "giftopnm $arg | pnmscale 2 | pnmnlfilt 2 1 "
157                    . "| ppmquant 255 | ppmtogif > $gif_file";
158                print "$scale_cmd\n" if $verbose;
159                if (system($scale_cmd) != 0) {
160                    print "$scale_cmd failed\n";
161                    $gif_file = '';
162                }
163            }
164           
165            if ($gif_file =~ /.*\.gif/) {
166
167
168                $font_base =~ s|.*/||;
169                $font_base =~ s|\..*||;
170
171                # $font_base, due to bm2font requirements, can't be more
172                # than six characters long and must consist entirely of
173                # lower case letters.
174                $font_base =~ s/[^a-z]//g;
175                $font_base = $font_prefix . substr($font_base,0,5);
176                while (&prefix_in_use($font_base)) {++$font_base;}
177
178                $bm2font_cmd = "bm2font -f$font_base $gif_file";
179                print "$bm2font_cmd\n" if $verbose;
180                if (system($bm2font_cmd) != 0) {
181                    print "$bm2font_cmd failed\n";
182                } else {
183                    print OUT "\@tex\n";
184                    print OUT "\\input $font_base.tex\n";
185                    print OUT "\\set$font_base\n";
186                    print OUT "\@end tex\n";
187                }
188            }
189
190            print OUT "$suffix \n" if $suffix;
191        } else {
192            print OUT "$_";
193        }
194    }
195    close OUT;
196    close IN;
197}
198
199sub prefix_in_use
200{
201    local ($p) = @_;
202
203    # Returns true or false; returns true if any file in the current
204    # directory begins with $p.  This function is here because
205    # `<$p*>' only works for the first value of $p!
206
207    opendir(DIR,".") || die "Couldn't read current directory -- $!\n";
208    while ($_ = readdir(DIR)) {
209        last if /^$p/;
210    }
211    closedir(DIR);
212    $rc = /^$p/;
213}
Note: See TracBrowser for help on using the repository browser.