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