1#! /usr/bin/env perl 2 3# Copyright (C) 1999, 2000, 2001, 2003, 2007, 2009 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 25use 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 41while ($_ = 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 64if (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 72if (defined $out) { 73 open(STDOUT, ">$out") or die "opening \"$out\": $!\n"; 74} 75 76while(defined $inf) { 77while(<$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/&/&/g; 208 s/\@\@/&at;/g; 209 s/\@\{/{/g; 210 s/\@\}/}/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/</</g; 220 s/>/>/g; 221 } else { 222 s/</</g; 223 s/>/>/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 my $thing = $1; 292 if ($ic =~ /\@asis/) { 293 $_ = "\n=item $thing\n"; 294 } else { 295 # Entity escapes prevent munging by the <> processing below. 296 $_ = "\n=item $ic\<$thing\>\n"; 297 } 298 } else { 299 $_ = "\n=item $ic\n"; 300 $ic =~ y/A-Ya-y/B-Zb-z/; 301 $ic =~ s/(\d+)/$1 + 1/eg; 302 } 303 }; 304 305 $section .= $shift.$_."\n"; 306} 307# End of current file. 308close($inf); 309$inf = pop @instack; 310} 311 312die "No filename or title\n" unless defined $fn && defined $tl; 313 314$sects{NAME} = "$fn \- $tl\n"; 315$sects{FOOTNOTES} .= "=back\n" if exists $sects{FOOTNOTES}; 316 317for $sect (qw(NAME SYNOPSIS DESCRIPTION OPTIONS ENVIRONMENT EXITSTATUS 318 FILES BUGS NOTES FOOTNOTES SEEALSO AUTHOR COPYRIGHT)) { 319 if(exists $sects{$sect}) { 320 $head = $sect; 321 $head =~ s/SEEALSO/SEE ALSO/; 322 $head =~ s/EXITSTATUS/EXIT STATUS/; 323 print "=head1 $head\n\n"; 324 print scalar unmunge ($sects{$sect}); 325 print "\n"; 326 } 327} 328 329sub usage 330{ 331 die "usage: $0 [-D toggle...] [infile [outfile]]\n"; 332} 333 334sub postprocess 335{ 336 local $_ = $_[0]; 337 338 # @value{foo} is replaced by whatever 'foo' is defined as. 339 while (m/(\@value\{([a-zA-Z0-9_-]+)\})/g) { 340 if (! exists $defs{$2}) { 341 print STDERR "Option $2 not defined\n"; 342 s/\Q$1\E//; 343 } else { 344 $value = $defs{$2}; 345 s/\Q$1\E/$value/; 346 } 347 } 348 349 # Formatting commands. 350 # Temporary escape for @r. 351 s/\@r\{([^\}]*)\}/R<$1>/g; 352 s/\@(?:dfn|var|emph|cite|i)\{([^\}]*)\}/I<$1>/g; 353 s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g; 354 s/\@(?:gccoptlist|samp|strong|key|option|env|command|b)\{([^\}]*)\}/B<$1>/g; 355 s/\@sc\{([^\}]*)\}/\U$1/g; 356 s/\@file\{([^\}]*)\}/F<$1>/g; 357 s/\@w\{([^\}]*)\}/S<$1>/g; 358 s/\@(?:dmn|math)\{([^\}]*)\}/$1/g; 359 360 # keep references of the form @ref{...}, print them bold 361 s/\@(?:ref)\{([^\}]*)\}/B<$1>/g; 362 363 # Change double single quotes to double quotes. 364 s/''/"/g; 365 s/``/"/g; 366 367 # Cross references are thrown away, as are @noindent and @refill. 368 # (@noindent is impossible in .pod, and @refill is unnecessary.) 369 # @* is also impossible in .pod; we discard it and any newline that 370 # follows it. Similarly, our macro @gol must be discarded. 371 372 s/\(?\@xref\{(?:[^\}]*)\}(?:[^.<]|(?:<[^<>]*>))*\.\)?//g; 373 s/\s+\(\@pxref\{(?:[^\}]*)\}\)//g; 374 s/;\s+\@pxref\{(?:[^\}]*)\}//g; 375 s/\@noindent\s*//g; 376 s/\@refill//g; 377 s/\@gol//g; 378 s/\@\*\s*\n?//g; 379 380 # @uref can take one, two, or three arguments, with different 381 # semantics each time. @url and @email are just like @uref with 382 # one argument, for our purposes. 383 s/\@(?:uref|url|email)\{([^\},]*)\}/<B<$1>>/g; 384 s/\@uref\{([^\},]*),([^\},]*)\}/$2 (C<$1>)/g; 385 s/\@uref\{([^\},]*),([^\},]*),([^\},]*)\}/$3/g; 386 387 # Un-escape <> at this point. 388 s/</</g; 389 s/>/>/g; 390 391 # Now un-nest all B<>, I<>, R<>. Theoretically we could have 392 # indefinitely deep nesting; in practice, one level suffices. 393 1 while s/([BIR])<([^<>]*)([BIR])<([^<>]*)>/$1<$2>$3<$4>$1</g; 394 395 # Replace R<...> with bare ...; eliminate empty markup, B<>; 396 # shift white space at the ends of [BI]<...> expressions outside 397 # the expression. 398 s/R<([^<>]*)>/$1/g; 399 s/[BI]<>//g; 400 s/([BI])<(\s+)([^>]+)>/$2$1<$3>/g; 401 s/([BI])<([^>]+?)(\s+)>/$1<$2>$3/g; 402 403 # Extract footnotes. This has to be done after all other 404 # processing because otherwise the regexp will choke on formatting 405 # inside @footnote. 406 while (/\@footnote/g) { 407 s/\@footnote\{([^\}]+)\}/[$fnno]/; 408 add_footnote($1, $fnno); 409 $fnno++; 410 } 411 412 return $_; 413} 414 415sub unmunge 416{ 417 # Replace escaped symbols with their equivalents. 418 local $_ = $_[0]; 419 420 s/</E<lt>/g; 421 s/>/E<gt>/g; 422 s/{/\{/g; 423 s/}/\}/g; 424 s/&at;/\@/g; 425 s/&/&/g; 426 return $_; 427} 428 429sub add_footnote 430{ 431 unless (exists $sects{FOOTNOTES}) { 432 $sects{FOOTNOTES} = "\n=over 4\n\n"; 433 } 434 435 $sects{FOOTNOTES} .= "=item $fnno.\n\n"; $fnno++; 436 $sects{FOOTNOTES} .= $_[0]; 437 $sects{FOOTNOTES} .= "\n\n"; 438} 439 440# stolen from Symbol.pm 441{ 442 my $genseq = 0; 443 sub gensym 444 { 445 my $name = "GEN" . $genseq++; 446 my $ref = \*{$name}; 447 delete $::{$name}; 448 return $ref; 449 } 450} 451