source: branches/libc-0.6/src/gcc/contrib/texi2pod.pl

Last change on this file was 1589, checked in by bird, 21 years ago

This commit was generated by cvs2svn to compensate for changes in r1588,
which included commits to RCS files with non-trunk default branches.

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