~ubuntu-branches/ubuntu/maverick/wget/maverick

« back to all changes in this revision

Viewing changes to doc/texi2pod.pl

  • Committer: Bazaar Package Importer
  • Author(s): Michael Vogt
  • Date: 2008-05-27 11:49:54 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20080527114954-ame070pjhqtofeaf
Tags: 1.11.2-1ubuntu1
* Merge from debian unstable, remaining changes:
  - Add wget-udeb to ship wget.gnu as alternative to busybox wget
    implementation.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#! /usr/bin/env perl
 
2
 
 
3
#   Copyright (C) 1999, 2000, 2001, 2003, 2007 Free Software
 
4
#   Foundation, Inc.
 
5
 
 
6
# This file is part of GCC.
 
7
 
 
8
# GCC is free software; you can redistribute it and/or modify
 
9
# it under the terms of the GNU General Public License as published by
 
10
# the Free Software Foundation; either version 3, or (at your option)
 
11
# any later version.
 
12
 
 
13
# GCC is distributed in the hope that it will be useful,
 
14
# but WITHOUT ANY WARRANTY; without even the implied warranty of
 
15
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
16
# GNU General Public License for more details.
 
17
 
 
18
# You should have received a copy of the GNU General Public License
 
19
# along with GCC.  If not, see <http://www.gnu.org/licenses/>.
 
20
 
 
21
# This does trivial (and I mean _trivial_) conversion of Texinfo
 
22
# markup to Perl POD format.  It's intended to be used to extract
 
23
# something suitable for a manpage from a Texinfo document.
 
24
 
 
25
use warnings;
 
26
 
 
27
$output = 0;
 
28
$skipping = 0;
 
29
%sects = ();
 
30
$section = "";
 
31
@icstack = ();
 
32
@endwstack = ();
 
33
@skstack = ();
 
34
@instack = ();
 
35
$shift = "";
 
36
%defs = ();
 
37
$fnno = 1;
 
38
$inf = "";
 
39
$ibase = "";
 
40
 
 
41
while ($_ = shift) {
 
42
    if (/^-D(.*)$/) {
 
43
        if ($1 ne "") {
 
44
            $flag = $1;
 
45
        } else {
 
46
            $flag = shift;
 
47
        }
 
48
        $value = "";
 
49
        ($flag, $value) = ($flag =~ /^([^=]+)(?:=(.+))?/);
 
50
        die "no flag specified for -D\n"
 
51
            unless $flag ne "";
 
52
        die "flags may only contain letters, digits, hyphens, dashes and underscores\n"
 
53
            unless $flag =~ /^[a-zA-Z0-9_-]+$/;
 
54
        $defs{$flag} = $value;
 
55
    } elsif (/^-/) {
 
56
        usage();
 
57
    } else {
 
58
        $in = $_, next unless defined $in;
 
59
        $out = $_, next unless defined $out;
 
60
        usage();
 
61
    }
 
62
}
 
63
 
 
64
if (defined $in) {
 
65
    $inf = gensym();
 
66
    open($inf, "<$in") or die "opening \"$in\": $!\n";
 
67
    $ibase = $1 if $in =~ m|^(.+)/[^/]+$|;
 
68
} else {
 
69
    $inf = \*STDIN;
 
70
}
 
71
 
 
72
if (defined $out) {
 
73
    open(STDOUT, ">$out") or die "opening \"$out\": $!\n";
 
74
}
 
75
 
 
76
while(defined $inf) {
 
77
while(<$inf>) {
 
78
    # Certain commands are discarded without further processing.
 
79
    /^\@(?:
 
80
         [a-z]+index            # @*index: useful only in complete manual
 
81
         |need                  # @need: useful only in printed manual
 
82
         |(?:end\s+)?group      # @group .. @end group: ditto
 
83
         |page                  # @page: ditto
 
84
         |node                  # @node: useful only in .info file
 
85
         |(?:end\s+)?ifnottex   # @ifnottex .. @end ifnottex: use contents
 
86
        )\b/x and next;
 
87
 
 
88
    chomp;
 
89
 
 
90
    # Look for filename and title markers.
 
91
    /^\@setfilename\s+([^.]+)/ and $fn = $1, next;
 
92
    /^\@settitle\s+([^.]+)/ and $tl = postprocess($1), next;
 
93
 
 
94
    # Identify a man title but keep only the one we are interested in.
 
95
    /^\@c\s+man\s+title\s+([A-Za-z0-9-]+)\s+(.+)/ and do {
 
96
        if (exists $defs{$1}) {
 
97
            $fn = $1;
 
98
            $tl = postprocess($2);
 
99
        }
 
100
        next;
 
101
    };
 
102
 
 
103
    # Look for blocks surrounded by @c man begin SECTION ... @c man end.
 
104
    # This really oughta be @ifman ... @end ifman and the like, but such
 
105
    # would require rev'ing all other Texinfo translators.
 
106
    /^\@c\s+man\s+begin\s+([A-Z]+)\s+([A-Za-z0-9-]+)/ and do {
 
107
        $output = 1 if exists $defs{$2};
 
108
        $sect = $1;
 
109
        next;
 
110
    };
 
111
    /^\@c\s+man\s+begin\s+([A-Z]+)/ and $sect = $1, $output = 1, next;
 
112
    /^\@c\s+man\s+end/ and do {
 
113
        $sects{$sect} = "" unless exists $sects{$sect};
 
114
        $sects{$sect} .= postprocess($section);
 
115
        $section = "";
 
116
        $output = 0;
 
117
        next;
 
118
    };
 
119
 
 
120
    # handle variables
 
121
    /^\@set\s+([a-zA-Z0-9_-]+)\s*(.*)$/ and do {
 
122
        $defs{$1} = $2;
 
123
        next;
 
124
    };
 
125
    /^\@clear\s+([a-zA-Z0-9_-]+)/ and do {
 
126
        delete $defs{$1};
 
127
        next;
 
128
    };
 
129
 
 
130
    next unless $output;
 
131
 
 
132
    # Discard comments.  (Can't do it above, because then we'd never see
 
133
    # @c man lines.)
 
134
    /^\@c\b/ and next;
 
135
 
 
136
    # End-block handler goes up here because it needs to operate even
 
137
    # if we are skipping.
 
138
    /^\@end\s+([a-z]+)/ and do {
 
139
        # Ignore @end foo, where foo is not an operation which may
 
140
        # cause us to skip, if we are presently skipping.
 
141
        my $ended = $1;
 
142
        next if $skipping && $ended !~ /^(?:ifset|ifclear|ignore|menu|iftex|copying)$/;
 
143
 
 
144
        die "\@end $ended without \@$ended at line $.\n" unless defined $endw;
 
145
        die "\@$endw ended by \@end $ended at line $.\n" unless $ended eq $endw;
 
146
 
 
147
        $endw = pop @endwstack;
 
148
 
 
149
        if ($ended =~ /^(?:ifset|ifclear|ignore|menu|iftex)$/) {
 
150
            $skipping = pop @skstack;
 
151
            next;
 
152
        } elsif ($ended =~ /^(?:example|smallexample|display)$/) {
 
153
            $shift = "";
 
154
            $_ = "";    # need a paragraph break
 
155
        } elsif ($ended =~ /^(?:itemize|enumerate|[fv]?table)$/) {
 
156
            $_ = "\n=back\n";
 
157
            $ic = pop @icstack;
 
158
        } else {
 
159
            die "unknown command \@end $ended at line $.\n";
 
160
        }
 
161
    };
 
162
 
 
163
    # We must handle commands which can cause skipping even while we
 
164
    # are skipping, otherwise we will not process nested conditionals
 
165
    # correctly.
 
166
    /^\@ifset\s+([a-zA-Z0-9_-]+)/ and do {
 
167
        push @endwstack, $endw;
 
168
        push @skstack, $skipping;
 
169
        $endw = "ifset";
 
170
        $skipping = 1 unless exists $defs{$1};
 
171
        next;
 
172
    };
 
173
 
 
174
    /^\@ifclear\s+([a-zA-Z0-9_-]+)/ and do {
 
175
        push @endwstack, $endw;
 
176
        push @skstack, $skipping;
 
177
        $endw = "ifclear";
 
178
        $skipping = 1 if exists $defs{$1};
 
179
        next;
 
180
    };
 
181
 
 
182
    /^\@(ignore|menu|iftex|copying)\b/ and do {
 
183
        push @endwstack, $endw;
 
184
        push @skstack, $skipping;
 
185
        $endw = $1;
 
186
        $skipping = 1;
 
187
        next;
 
188
    };
 
189
 
 
190
    next if $skipping;
 
191
 
 
192
    # Character entities.  First the ones that can be replaced by raw text
 
193
    # or discarded outright:
 
194
    s/\@copyright\{\}/(c)/g;
 
195
    s/\@dots\{\}/.../g;
 
196
    s/\@enddots\{\}/..../g;
 
197
    s/\@([.!? ])/$1/g;
 
198
    s/\@[:-]//g;
 
199
    s/\@bullet(?:\{\})?/*/g;
 
200
    s/\@TeX\{\}/TeX/g;
 
201
    s/\@pounds\{\}/\#/g;
 
202
    s/\@minus(?:\{\})?/-/g;
 
203
    s/\\,/,/g;
 
204
 
 
205
    # Now the ones that have to be replaced by special escapes
 
206
    # (which will be turned back into text by unmunge())
 
207
    s/&/&amp;/g;
 
208
    s/\@\@/&at;/g;
 
209
    s/\@\{/&lbrace;/g;
 
210
    s/\@\}/&rbrace;/g;
 
211
 
 
212
    # Inside a verbatim block, handle @var specially.
 
213
    if ($shift ne "") {
 
214
        s/\@var\{([^\}]*)\}/<$1>/g;
 
215
    }
 
216
 
 
217
    # POD doesn't interpret E<> inside a verbatim block.
 
218
    if ($shift eq "") {
 
219
        s/</&lt;/g;
 
220
        s/>/&gt;/g;
 
221
    } else {
 
222
        s/</&LT;/g;
 
223
        s/>/&GT;/g;
 
224
    }
 
225
 
 
226
    # Single line command handlers.
 
227
 
 
228
    /^\@include\s+(.+)$/ and do {
 
229
        push @instack, $inf;
 
230
        $inf = gensym();
 
231
        $file = postprocess($1);
 
232
 
 
233
        # Try cwd and $ibase.
 
234
        open($inf, "<" . $file) 
 
235
            or open($inf, "<" . $ibase . "/" . $file)
 
236
                or die "cannot open $file or $ibase/$file: $!\n";
 
237
        next;
 
238
    };
 
239
 
 
240
    /^\@(?:section|unnumbered|unnumberedsec|center)\s+(.+)$/
 
241
        and $_ = "\n=head2 $1\n";
 
242
    /^\@subsection\s+(.+)$/
 
243
        and $_ = "\n=head3 $1\n";
 
244
 
 
245
    # Block command handlers:
 
246
    /^\@itemize(?:\s+(\@[a-z]+|\*|-))?/ and do {
 
247
        push @endwstack, $endw;
 
248
        push @icstack, $ic;
 
249
        if (defined $1) {
 
250
            $ic = $1;
 
251
        } else {
 
252
            $ic = '@bullet';
 
253
        }
 
254
        $_ = "\n=over 4\n";
 
255
        $endw = "itemize";
 
256
    };
 
257
 
 
258
    /^\@enumerate(?:\s+([a-zA-Z0-9]+))?/ and do {
 
259
        push @endwstack, $endw;
 
260
        push @icstack, $ic;
 
261
        if (defined $1) {
 
262
            $ic = $1 . ".";
 
263
        } else {
 
264
            $ic = "1.";
 
265
        }
 
266
        $_ = "\n=over 4\n";
 
267
        $endw = "enumerate";
 
268
    };
 
269
 
 
270
    /^\@([fv]?table)\s+(\@[a-z]+)/ and do {
 
271
        push @endwstack, $endw;
 
272
        push @icstack, $ic;
 
273
        $endw = $1;
 
274
        $ic = $2;
 
275
        $ic =~ s/\@(?:samp|strong|key|gcctabopt|env)/B/;
 
276
        $ic =~ s/\@(?:code|kbd)/C/;
 
277
        $ic =~ s/\@(?:dfn|var|emph|cite|i)/I/;
 
278
        $ic =~ s/\@(?:file)/F/;
 
279
        $_ = "\n=over 4\n";
 
280
    };
 
281
 
 
282
    /^\@((?:small)?example|display)/ and do {
 
283
        push @endwstack, $endw;
 
284
        $endw = $1;
 
285
        $shift = "\t";
 
286
        $_ = "";        # need a paragraph break
 
287
    };
 
288
 
 
289
    /^\@itemx?\s*(.+)?$/ and do {
 
290
        if (defined $1) {
 
291
            # Entity escapes prevent munging by the <> processing below.
 
292
            $_ = "\n=item $ic\&LT;$1\&GT;\n";
 
293
        } else {
 
294
            $_ = "\n=item $ic\n";
 
295
            $ic =~ y/A-Ya-y/B-Zb-z/;
 
296
            $ic =~ s/(\d+)/$1 + 1/eg;
 
297
        }
 
298
    };
 
299
 
 
300
    $section .= $shift.$_."\n";
 
301
}
 
302
# End of current file.
 
303
close($inf);
 
304
$inf = pop @instack;
 
305
}
 
306
 
 
307
die "No filename or title\n" unless defined $fn && defined $tl;
 
308
 
 
309
$sects{NAME} = "$fn \- $tl\n";
 
310
$sects{FOOTNOTES} .= "=back\n" if exists $sects{FOOTNOTES};
 
311
 
 
312
for $sect (qw(NAME SYNOPSIS DESCRIPTION OPTIONS ENVIRONMENT FILES
 
313
              BUGS NOTES FOOTNOTES SEEALSO AUTHOR COPYRIGHT)) {
 
314
    if(exists $sects{$sect}) {
 
315
        $head = $sect;
 
316
        $head =~ s/SEEALSO/SEE ALSO/;
 
317
        print "=head1 $head\n\n";
 
318
        print scalar unmunge ($sects{$sect});
 
319
        print "\n";
 
320
    }
 
321
}
 
322
 
 
323
sub usage
 
324
{
 
325
    die "usage: $0 [-D toggle...] [infile [outfile]]\n";
 
326
}
 
327
 
 
328
sub postprocess
 
329
{
 
330
    local $_ = $_[0];
 
331
 
 
332
    # @value{foo} is replaced by whatever 'foo' is defined as.
 
333
    while (m/(\@value\{([a-zA-Z0-9_-]+)\})/g) {
 
334
        if (! exists $defs{$2}) {
 
335
            print STDERR "Option $2 not defined\n";
 
336
            s/\Q$1\E//;
 
337
        } else {
 
338
            $value = $defs{$2};
 
339
            s/\Q$1\E/$value/;
 
340
        }
 
341
    }
 
342
 
 
343
    # Formatting commands.
 
344
    # Temporary escape for @r.
 
345
    s/\@r\{([^\}]*)\}/R<$1>/g;
 
346
    s/\@(?:dfn|var|emph|cite|i)\{([^\}]*)\}/I<$1>/g;
 
347
    s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g;
 
348
    s/\@(?:gccoptlist|samp|strong|key|option|env|command|b)\{([^\}]*)\}/B<$1>/g;
 
349
    s/\@sc\{([^\}]*)\}/\U$1/g;
 
350
    s/\@file\{([^\}]*)\}/F<$1>/g;
 
351
    s/\@w\{([^\}]*)\}/S<$1>/g;
 
352
    s/\@(?:dmn|math)\{([^\}]*)\}/$1/g;
 
353
 
 
354
    # keep references of the form @ref{...}, print them bold
 
355
    s/\@(?:ref)\{([^\}]*)\}/B<$1>/g;
 
356
 
 
357
    # Change double single quotes to double quotes.
 
358
    s/''/"/g;
 
359
    s/``/"/g;
 
360
 
 
361
    # Cross references are thrown away, as are @noindent and @refill.
 
362
    # (@noindent is impossible in .pod, and @refill is unnecessary.)
 
363
    # @* is also impossible in .pod; we discard it and any newline that
 
364
    # follows it.  Similarly, our macro @gol must be discarded.
 
365
 
 
366
    s/\(?\@xref\{(?:[^\}]*)\}(?:[^.<]|(?:<[^<>]*>))*\.\)?//g;
 
367
    s/\s+\(\@pxref\{(?:[^\}]*)\}\)//g;
 
368
    s/;\s+\@pxref\{(?:[^\}]*)\}//g;
 
369
    s/\@noindent\s*//g;
 
370
    s/\@refill//g;
 
371
    s/\@gol//g;
 
372
    s/\@\*\s*\n?//g;
 
373
 
 
374
    # @uref can take one, two, or three arguments, with different
 
375
    # semantics each time.  @url and @email are just like @uref with
 
376
    # one argument, for our purposes.
 
377
    s/\@(?:uref|url|email)\{([^\},]*)\}/&lt;B<$1>&gt;/g;
 
378
    s/\@uref\{([^\},]*),([^\},]*)\}/$2 (C<$1>)/g;
 
379
    s/\@uref\{([^\},]*),([^\},]*),([^\},]*)\}/$3/g;
 
380
 
 
381
    # Un-escape <> at this point.
 
382
    s/&LT;/</g;
 
383
    s/&GT;/>/g;
 
384
 
 
385
    # Now un-nest all B<>, I<>, R<>.  Theoretically we could have
 
386
    # indefinitely deep nesting; in practice, one level suffices.
 
387
    1 while s/([BIR])<([^<>]*)([BIR])<([^<>]*)>/$1<$2>$3<$4>$1</g;
 
388
 
 
389
    # Replace R<...> with bare ...; eliminate empty markup, B<>;
 
390
    # shift white space at the ends of [BI]<...> expressions outside
 
391
    # the expression.
 
392
    s/R<([^<>]*)>/$1/g;
 
393
    s/[BI]<>//g;
 
394
    s/([BI])<(\s+)([^>]+)>/$2$1<$3>/g;
 
395
    s/([BI])<([^>]+?)(\s+)>/$1<$2>$3/g;
 
396
 
 
397
    # Extract footnotes.  This has to be done after all other
 
398
    # processing because otherwise the regexp will choke on formatting
 
399
    # inside @footnote.
 
400
    while (/\@footnote/g) {
 
401
        s/\@footnote\{([^\}]+)\}/[$fnno]/;
 
402
        add_footnote($1, $fnno);
 
403
        $fnno++;
 
404
    }
 
405
 
 
406
    return $_;
 
407
}
 
408
 
 
409
sub unmunge
 
410
{
 
411
    # Replace escaped symbols with their equivalents.
 
412
    local $_ = $_[0];
 
413
 
 
414
    s/&lt;/E<lt>/g;
 
415
    s/&gt;/E<gt>/g;
 
416
    s/&lbrace;/\{/g;
 
417
    s/&rbrace;/\}/g;
 
418
    s/&at;/\@/g;
 
419
    s/&amp;/&/g;
 
420
    return $_;
 
421
}
 
422
 
 
423
sub add_footnote
 
424
{
 
425
    unless (exists $sects{FOOTNOTES}) {
 
426
        $sects{FOOTNOTES} = "\n=over 4\n\n";
 
427
    }
 
428
 
 
429
    $sects{FOOTNOTES} .= "=item $fnno.\n\n"; $fnno++;
 
430
    $sects{FOOTNOTES} .= $_[0];
 
431
    $sects{FOOTNOTES} .= "\n\n";
 
432
}
 
433
 
 
434
# stolen from Symbol.pm
 
435
{
 
436
    my $genseq = 0;
 
437
    sub gensym
 
438
    {
 
439
        my $name = "GEN" . $genseq++;
 
440
        my $ref = \*{$name};
 
441
        delete $::{$name};
 
442
        return $ref;
 
443
    }
 
444
}