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