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, 51 Franklin Street, Fifth Floor, 20# Boston, MA 02110-1301 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@sects_sequence = (); 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 /^\@include\s+(.+)$/ and do { 104 push @instack, $inf; 105 $inf = gensym(); 106 107 # Try cwd and $ibase. 108 open($inf, "<" . $1) 109 or open($inf, "<" . $ibase . "/" . $1) 110 or die "cannot open $1 or $ibase/$1: $!\n"; 111 next; 112 }; 113 114 # Look for blocks surrounded by @c man begin SECTION ... @c man end. 115 # This really oughta be @ifman ... @end ifman and the like, but such 116 # would require rev'ing all other Texinfo translators. 117 /^\@c\s+man\s+begin\s+([A-Za-z ]+)/ and $sect = $1, push (@sects_sequence, $sect), $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; 148 next if $skipping && $ended !~ /^(?:ifset|ifclear|ignore|menu|iftex)$/; 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; 164 } else { 165 die "unknown command \@end $ended at line $.\n"; 166 } 167 }; 168 169 # We must handle commands which can cause skipping even while we 170 # are skipping, otherwise we will not process nested conditionals 171 # correctly. 172 /^\@ifset\s+([a-zA-Z0-9_-]+)/ and do { 173 push @endwstack, $endw; 174 push @skstack, $skipping; 175 $endw = "ifset"; 176 $skipping = 1 unless exists $defs{$1}; 177 next; 178 }; 179 180 /^\@ifclear\s+([a-zA-Z0-9_-]+)/ and do { 181 push @endwstack, $endw; 182 push @skstack, $skipping; 183 $endw = "ifclear"; 184 $skipping = 1 if exists $defs{$1}; 185 next; 186 }; 187 188 /^\@(ignore|menu|iftex)\b/ and do { 189 push @endwstack, $endw; 190 push @skstack, $skipping; 191 $endw = $1; 192 $skipping = 1; 193 next; 194 }; 195 196 next if $skipping; 197 198 # Character entities. First the ones that can be replaced by raw text 199 # or discarded outright: 200 s/\@copyright\{\}/(c)/g; 201 s/\@dots\{\}/.../g; 202 s/\@enddots\{\}/..../g; 203 s/\@([.!? ])/$1/g; 204 s/\@[:-]//g; 205 s/\@bullet(?:\{\})?/*/g; 206 s/\@TeX\{\}/TeX/g; 207 s/\@pounds\{\}/\#/g; 208 s/\@minus(?:\{\})?/-/g; 209 s/\\,/,/g; 210 211 # Now the ones that have to be replaced by special escapes 212 # (which will be turned back into text by unmunge()) 213 s/&/&/g; 214 s/\@\{/{/g; 215 s/\@\}/}/g; 216 s/\@\@/&at;/g; 217 218 # Inside a verbatim block, handle @var specially. 219 if ($shift ne "") { 220 s/\@var\{([^\}]*)\}/<$1>/g; 221 } 222 223 # POD doesn't interpret E<> inside a verbatim block. 224 if ($shift eq "") { 225 s/</</g; 226 s/>/>/g; 227 } else { 228 s/</</g; 229 s/>/>/g; 230 } 231 232 # Single line command handlers. 233 234 /^\@(?:section|unnumbered|unnumberedsec|center|heading)\s+(.+)$/ 235 and $_ = "\n=head2 $1\n"; 236 /^\@(?:subsection|subheading)\s+(.+)$/ 237 and $_ = "\n=head3 $1\n"; 238 /^\@(?:subsubsection|subsubheading)\s+(.+)$/ 239 and $_ = "\n=head4 $1\n"; 240 241 # Block command handlers: 242 /^\@itemize\s*(\@[a-z]+|\*|-)?/ and do { 243 push @endwstack, $endw; 244 push @icstack, $ic; 245 $ic = $1 ? $1 : "*"; 246 $_ = "\n=over 4\n"; 247 $endw = "itemize"; 248 }; 249 250 /^\@enumerate(?:\s+([a-zA-Z0-9]+))?/ and do { 251 push @endwstack, $endw; 252 push @icstack, $ic; 253 if (defined $1) { 254 $ic = $1 . "."; 255 } else { 256 $ic = "1."; 257 } 258 $_ = "\n=over 4\n"; 259 $endw = "enumerate"; 260 }; 261 262 /^\@([fv]?table)\s+(\@[a-z]+)/ and do { 263 push @endwstack, $endw; 264 push @icstack, $ic; 265 $endw = $1; 266 $ic = $2; 267 $ic =~ s/\@(?:samp|strong|key|gcctabopt|option|env)/B/; 268 $ic =~ s/\@(?:code|kbd)/C/; 269 $ic =~ s/\@(?:dfn|var|emph|cite|i)/I/; 270 $ic =~ s/\@(?:file)/F/; 271 $_ = "\n=over 4\n"; 272 }; 273 274 /^\@((?:small)?example|display)/ and do { 275 push @endwstack, $endw; 276 $endw = $1; 277 $shift = "\t"; 278 $_ = ""; # need a paragraph break 279 }; 280 281 /^\@itemx?\s*(.+)?$/ and do { 282 if (defined $1) { 283 # Entity escapes prevent munging by the <> processing below. 284 $_ = "\n=item $ic\<$1\>\n"; 285 } else { 286 $_ = "\n=item $ic\n"; 287 $ic =~ y/A-Ya-y/B-Zb-z/; 288 $ic =~ s/(\d+)/$1 + 1/eg; 289 } 290 }; 291 292 $section .= $shift.$_."\n"; 293} 294# End of current file. 295close($inf); 296$inf = pop @instack; 297} 298 299die "No filename or title\n" unless defined $fn && defined $tl; 300 301$sects{NAME} = "$fn \- $tl\n"; 302$sects{FOOTNOTES} .= "=back\n" if exists $sects{FOOTNOTES}; 303 304unshift @sects_sequence, "NAME"; 305for $sect (@sects_sequence) { 306 if(exists $sects{$sect}) { 307 $head = $sect; 308 $head =~ s/SEEALSO/SEE ALSO/; 309 print "=head1 $head\n\n"; 310 print scalar unmunge ($sects{$sect}); 311 print "\n"; 312 } 313} 314 315sub usage 316{ 317 die "usage: $0 [-D toggle...] [infile [outfile]]\n"; 318} 319 320sub postprocess 321{ 322 local $_ = $_[0]; 323 324 # @value{foo} is replaced by whatever 'foo' is defined as. 325 while (m/(\@value\{([a-zA-Z0-9_-]+)\})/g) { 326 if (! exists $defs{$2}) { 327 print STDERR "Option $2 not defined\n"; 328 s/\Q$1\E//; 329 } else { 330 $value = $defs{$2}; 331 s/\Q$1\E/$value/; 332 } 333 } 334 335 # Formatting commands. 336 # Temporary escape for @r. 337 s/\@r\{([^\}]*)\}/R<$1>/g; 338 s/\@(?:dfn|var|emph|cite|i)\{([^\}]*)\}/I<$1>/g; 339 s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g; 340 s/\@(?:gccoptlist|samp|strong|key|option|env|command|b)\{([^\}]*)\}/B<$1>/g; 341 s/\@sc\{([^\}]*)\}/\U$1/g; 342 s/\@file\{([^\}]*)\}/F<$1>/g; 343 s/\@w\{([^\}]*)\}/S<$1>/g; 344 s/\@(?:dmn|math)\{([^\}]*)\}/$1/g; 345 346 # Cross references are thrown away, as are @noindent and @refill. 347 # (@noindent is impossible in .pod, and @refill is unnecessary.) 348 # @* is also impossible in .pod; we discard it and any newline that 349 # follows it. Similarly, our macro @gol must be discarded. 350 351 s/\@anchor{(?:[^\}]*)\}//g; 352 s/\(?\@xref\{(?:[^\}]*)\}(?:[^.<]|(?:<[^<>]*>))*\.\)?//g; 353 s/\s+\(\@pxref\{(?:[^\}]*)\}\)//g; 354 s/;\s+\@pxref\{(?:[^\}]*)\}//g; 355 s/\@ref\{([^\}]*)\}/$1/g; 356 s/\@noindent\s*//g; 357 s/\@refill//g; 358 s/\@gol//g; 359 s/\@\*\s*\n?//g; 360 361 # @uref can take one, two, or three arguments, with different 362 # semantics each time. @url and @email are just like @uref with 363 # one argument, for our purposes. 364 s/\@(?:uref|url|email)\{([^\},]*)\}/<B<$1>>/g; 365 s/\@uref\{([^\},]*),([^\},]*)\}/$2 (C<$1>)/g; 366 s/\@uref\{([^\},]*),([^\},]*),([^\},]*)\}/$3/g; 367 368 # Turn B<blah I<blah> blah> into B<blah> I<blah> B<blah> to 369 # match Texinfo semantics of @emph inside @samp. Also handle @r 370 # inside bold. 371 s/</</g; 372 s/>/>/g; 373 1 while s/B<((?:[^<>]|I<[^<>]*>)*)R<([^>]*)>/B<$1>${2}B</g; 374 1 while (s/B<([^<>]*)I<([^>]+)>/B<$1>I<$2>B</g); 375 1 while (s/I<([^<>]*)B<([^>]+)>/I<$1>B<$2>I</g); 376 s/[BI]<>//g; 377 s/([BI])<(\s+)([^>]+)>/$2$1<$3>/g; 378 s/([BI])<([^>]+?)(\s+)>/$1<$2>$3/g; 379 380 # Extract footnotes. This has to be done after all other 381 # processing because otherwise the regexp will choke on formatting 382 # inside @footnote. 383 while (/\@footnote/g) { 384 s/\@footnote\{([^\}]+)\}/[$fnno]/; 385 add_footnote($1, $fnno); 386 $fnno++; 387 } 388 389 return $_; 390} 391 392sub unmunge 393{ 394 # Replace escaped symbols with their equivalents. 395 local $_ = $_[0]; 396 397 s/</E<lt>/g; 398 s/>/E<gt>/g; 399 s/{/\{/g; 400 s/}/\}/g; 401 s/&at;/\@/g; 402 s/&/&/g; 403 return $_; 404} 405 406sub add_footnote 407{ 408 unless (exists $sects{FOOTNOTES}) { 409 $sects{FOOTNOTES} = "\n=over 4\n\n"; 410 } 411 412 $sects{FOOTNOTES} .= "=item $fnno.\n\n"; $fnno++; 413 $sects{FOOTNOTES} .= $_[0]; 414 $sects{FOOTNOTES} .= "\n\n"; 415} 416 417# stolen from Symbol.pm 418{ 419 my $genseq = 0; 420 sub gensym 421 { 422 my $name = "GEN" . $genseq++; 423 my $ref = \*{$name}; 424 delete $::{$name}; 425 return $ref; 426 } 427} 428