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