1#!/usr/bin/env perl 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 26use warnings; 27 28$output = 0; 29$skipping = 0; 30%chapters = (); 31@chapters_sequence = (); 32$chapter = ""; 33@icstack = (); 34@endwstack = (); 35@skstack = (); 36@instack = (); 37$shift = ""; 38%defs = (); 39$fnno = 1; 40$inf = ""; 41@ibase = (); 42 43while ($_ = shift) { 44 if (/^-D(.*)$/) { 45 if ($1 ne "") { 46 $flag = $1; 47 } else { 48 $flag = shift; 49 } 50 $value = ""; 51 ($flag, $value) = ($flag =~ /^([^=]+)(?:=(.+))?/); 52 die "no flag specified for -D\n" 53 unless $flag ne ""; 54 die "flags may only contain letters, digits, hyphens, dashes and underscores\n" 55 unless $flag =~ /^[a-zA-Z0-9_-]+$/; 56 $defs{$flag} = $value; 57 } elsif (/^-I(.*)$/) { 58 push @ibase, $1 ne "" ? $1 : shift; 59 } elsif (/^-/) { 60 usage(); 61 } else { 62 $in = $_, next unless defined $in; 63 $out = $_, next unless defined $out; 64 usage(); 65 } 66} 67 68push @ibase, "."; 69 70if (defined $in) { 71 $inf = gensym(); 72 open($inf, "<$in") or die "opening \"$in\": $!\n"; 73 push @ibase, $1 if $in =~ m|^(.+)/[^/]+$|; 74} else { 75 $inf = \*STDIN; 76} 77 78if (defined $out) { 79 open(STDOUT, ">$out") or die "opening \"$out\": $!\n"; 80} 81 82while(defined $inf) { 83INF: 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 /^\@include\s+(.+)$/ and do { 110 push @instack, $inf; 111 $inf = gensym(); 112 113 for (@ibase) { 114 open($inf, "<" . $_ . "/" . $1) and next INF; 115 } 116 die "cannot open $1: $!\n"; 117 }; 118 119 /^\@chapter\s+([A-Za-z ]+)/ and do { 120 # close old chapter 121 $chapters{$chapter_name} .= postprocess($chapter) if ($chapter_name); 122 123 # start new chapter 124 $chapter_name = $1, push (@chapters_sequence, $chapter_name) unless $skipping; 125 $chapters{$chapter_name} = "" unless exists $chapters{$chapter_name}; 126 $chapter = ""; 127 $output = 1; 128 next; 129 }; 130 131 /^\@bye/ and do { 132 # close old chapter 133 $chapters{$chapter_name} .= postprocess($chapter) if ($chapter_name); 134 last INF; 135 }; 136 137 # handle variables 138 /^\@set\s+([a-zA-Z0-9_-]+)\s*(.*)$/ and do { 139 $defs{$1} = $2; 140 next; 141 }; 142 /^\@clear\s+([a-zA-Z0-9_-]+)/ and do { 143 delete $defs{$1}; 144 next; 145 }; 146 147 next unless $output; 148 149 # Discard comments. (Can't do it above, because then we'd never see 150 # @c man lines.) 151 /^\@c\b/ and next; 152 153 # End-block handler goes up here because it needs to operate even 154 # if we are skipping. 155 /^\@end\s+([a-z]+)/ and do { 156 # Ignore @end foo, where foo is not an operation which may 157 # cause us to skip, if we are presently skipping. 158 my $ended = $1; 159 next if $skipping && $ended !~ /^(?:ifset|ifclear|ignore|menu|iftex|ifhtml|ifnothtml)$/; 160 161 die "\@end $ended without \@$ended at line $.\n" unless defined $endw; 162 die "\@$endw ended by \@end $ended at line $.\n" unless $ended eq $endw; 163 164 $endw = pop @endwstack; 165 166 if ($ended =~ /^(?:ifset|ifclear|ignore|menu|iftex|ifhtml|ifnothtml)$/) { 167 $skipping = pop @skstack; 168 next; 169 } elsif ($ended =~ /^(?:example|smallexample|display)$/) { 170 $shift = ""; 171 $_ = ""; # need a paragraph break 172 } elsif ($ended =~ /^(?:itemize|enumerate|(?:multi|[fv])?table)$/) { 173 $_ = "\n=back\n"; 174 $ic = pop @icstack; 175 } else { 176 die "unknown command \@end $ended at line $.\n"; 177 } 178 }; 179 180 # We must handle commands which can cause skipping even while we 181 # are skipping, otherwise we will not process nested conditionals 182 # correctly. 183 /^\@ifset\s+([a-zA-Z0-9_-]+)/ and do { 184 push @endwstack, $endw; 185 push @skstack, $skipping; 186 $endw = "ifset"; 187 $skipping = 1 unless exists $defs{$1}; 188 next; 189 }; 190 191 /^\@ifclear\s+([a-zA-Z0-9_-]+)/ and do { 192 push @endwstack, $endw; 193 push @skstack, $skipping; 194 $endw = "ifclear"; 195 $skipping = 1 if exists $defs{$1}; 196 next; 197 }; 198 199 /^\@(ignore|menu|iftex|ifhtml|ifnothtml)\b/ and do { 200 push @endwstack, $endw; 201 push @skstack, $skipping; 202 $endw = $1; 203 $skipping = $endw !~ /ifnothtml/; 204 next; 205 }; 206 207 next if $skipping; 208 209 # Character entities. First the ones that can be replaced by raw text 210 # or discarded outright: 211 s/\@copyright\{\}/(c)/g; 212 s/\@dots\{\}/.../g; 213 s/\@enddots\{\}/..../g; 214 s/\@([.!? ])/$1/g; 215 s/\@[:-]//g; 216 s/\@bullet(?:\{\})?/*/g; 217 s/\@TeX\{\}/TeX/g; 218 s/\@pounds\{\}/\#/g; 219 s/\@minus(?:\{\})?/-/g; 220 221 # Now the ones that have to be replaced by special escapes 222 # (which will be turned back into text by unmunge()) 223 s/&/&/g; 224 s/\@\{/{/g; 225 s/\@\}/}/g; 226 s/\@\@/&at;/g; 227 228 # Inside a verbatim block, handle @var specially. 229 if ($shift ne "") { 230 s/\@var\{([^\}]*)\}/<$1>/g; 231 } 232 233 # POD doesn't interpret E<> inside a verbatim block. 234 if ($shift eq "") { 235 s/</</g; 236 s/>/>/g; 237 } else { 238 s/</</g; 239 s/>/>/g; 240 } 241 242 # Single line command handlers. 243 244 /^\@(?:section|unnumbered|unnumberedsec|center|heading)\s+(.+)$/ 245 and $_ = "\n=head2 $1\n"; 246 /^\@(?:subsection|subheading)\s+(.+)$/ 247 and $_ = "\n=head3 $1\n"; 248 /^\@(?:subsubsection|subsubheading)\s+(.+)$/ 249 and $_ = "\n=head4 $1\n"; 250 251 # Block command handlers: 252 /^\@itemize\s*(\@[a-z]+|\*|-)?/ and do { 253 push @endwstack, $endw; 254 push @icstack, $ic; 255 $ic = $1 ? $1 : "*"; 256 $_ = "\n=over 4\n"; 257 $endw = "itemize"; 258 }; 259 260 /^\@enumerate(?:\s+([a-zA-Z0-9]+))?/ and do { 261 push @endwstack, $endw; 262 push @icstack, $ic; 263 if (defined $1) { 264 $ic = $1 . "."; 265 } else { 266 $ic = "1."; 267 } 268 $_ = "\n=over 4\n"; 269 $endw = "enumerate"; 270 }; 271 272 /^\@((?:multi|[fv])?table)\s+(\@[a-z]+)/ and do { 273 push @endwstack, $endw; 274 push @icstack, $ic; 275 $endw = $1; 276 $ic = $2; 277 $ic =~ s/\@(?:samp|strong|key|gcctabopt|option|env|command)/B/; 278 $ic =~ s/\@(?:code|kbd)/C/; 279 $ic =~ s/\@(?:dfn|var|emph|cite|i)/I/; 280 $ic =~ s/\@(?:file)/F/; 281 $ic =~ s/\@(?:columnfractions)//; 282 $_ = "\n=over 4\n"; 283 }; 284 285 /^\@(multitable)\s+{.*/ and do { 286 push @endwstack, $endw; 287 push @icstack, $ic; 288 $endw = $1; 289 $ic = ""; 290 $_ = "\n=over 4\n"; 291 }; 292 293 /^\@((?:small)?example|display)/ and do { 294 push @endwstack, $endw; 295 $endw = $1; 296 $shift = "\t"; 297 $_ = ""; # need a paragraph break 298 }; 299 300 /^\@item\s+(.*\S)\s*$/ and $endw eq "multitable" and do { 301 my $columns = $1; 302 $columns =~ s/\@tab/ : /; 303 304 $_ = "\n=item B<". $columns .">\n"; 305 }; 306 307 /^\@tab\s+(.*\S)\s*$/ and $endw eq "multitable" and do { 308 my $columns = $1; 309 $columns =~ s/\@tab//; 310 311 $_ = $columns; 312 $chapter =~ s/$//; 313 }; 314 315 /^\@itemx?\s*(.+)?$/ and do { 316 if (defined $1) { 317 # Entity escapes prevent munging by the <> processing below. 318 $_ = "\n=item $ic\<$1\>\n"; 319 } else { 320 $_ = "\n=item $ic\n"; 321 $ic =~ y/A-Ya-y/B-Zb-z/; 322 $ic =~ s/(\d+)/$1 + 1/eg; 323 } 324 }; 325 326 $chapter .= $shift.$_."\n"; 327} 328# End of current file. 329close($inf); 330$inf = pop @instack; 331} 332 333die "No filename or title\n" unless defined $fn && defined $tl; 334 335# always use utf8 336print "=encoding utf8\n\n"; 337 338$chapters{NAME} = "$fn \- $tl\n"; 339$chapters{FOOTNOTES} .= "=back\n" if exists $chapters{FOOTNOTES}; 340 341unshift @chapters_sequence, "NAME"; 342for $chapter (@chapters_sequence) { 343 if (exists $chapters{$chapter}) { 344 $head = uc($chapter); 345 print "=head1 $head\n\n"; 346 print scalar unmunge ($chapters{$chapter}); 347 print "\n"; 348 } 349} 350 351sub usage 352{ 353 die "usage: $0 [-D toggle...] [infile [outfile]]\n"; 354} 355 356sub postprocess 357{ 358 local $_ = $_[0]; 359 360 # @value{foo} is replaced by whatever 'foo' is defined as. 361 while (m/(\@value\{([a-zA-Z0-9_-]+)\})/g) { 362 if (! exists $defs{$2}) { 363 print STDERR "Option $2 not defined\n"; 364 s/\Q$1\E//; 365 } else { 366 $value = $defs{$2}; 367 s/\Q$1\E/$value/; 368 } 369 } 370 371 # Formatting commands. 372 # Temporary escape for @r. 373 s/\@r\{([^\}]*)\}/R<$1>/g; 374 s/\@(?:dfn|var|emph|cite|i)\{([^\}]*)\}/I<$1>/g; 375 s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g; 376 s/\@(?:gccoptlist|samp|strong|key|option|env|command|b)\{([^\}]*)\}/B<$1>/g; 377 s/\@sc\{([^\}]*)\}/\U$1/g; 378 s/\@file\{([^\}]*)\}/F<$1>/g; 379 s/\@w\{([^\}]*)\}/S<$1>/g; 380 s/\@(?:dmn|math)\{([^\}]*)\}/$1/g; 381 382 # Cross references are thrown away, as are @noindent and @refill. 383 # (@noindent is impossible in .pod, and @refill is unnecessary.) 384 # @* is also impossible in .pod; we discard it and any newline that 385 # follows it. Similarly, our macro @gol must be discarded. 386 387 s/\@anchor\{(?:[^\}]*)\}//g; 388 s/\(?\@xref\{(?:[^\}]*)\}(?:[^.<]|(?:<[^<>]*>))*\.\)?//g; 389 s/\s+\(\@pxref\{(?:[^\}]*)\}\)//g; 390 s/;\s+\@pxref\{(?:[^\}]*)\}//g; 391 s/\@ref\{(?:[^,\}]*,)(?:[^,\}]*,)([^,\}]*).*\}/B<$1>/g; 392 s/\@ref\{([^\}]*)\}/B<$1>/g; 393 s/\@noindent\s*//g; 394 s/\@refill//g; 395 s/\@gol//g; 396 s/\@\*\s*\n?//g; 397 398 # @uref can take one, two, or three arguments, with different 399 # semantics each time. @url and @email are just like @uref with 400 # one argument, for our purposes. 401 s/\@(?:uref|url|email)\{([^\},]*),?[^\}]*\}/<B<$1>>/g; 402 s/\@uref\{([^\},]*),([^\},]*)\}/$2 (C<$1>)/g; 403 s/\@uref\{([^\},]*),([^\},]*),([^\},]*)\}/$3/g; 404 405 # Turn B<blah I<blah> blah> into B<blah> I<blah> B<blah> to 406 # match Texinfo semantics of @emph inside @samp. Also handle @r 407 # inside bold. 408 s/</</g; 409 s/>/>/g; 410 1 while s/B<((?:[^<>]|I<[^<>]*>)*)R<([^>]*)>/B<$1>${2}B</g; 411 1 while (s/B<([^<>]*)I<([^>]+)>/B<$1>I<$2>B</g); 412 1 while (s/I<([^<>]*)B<([^>]+)>/I<$1>B<$2>I</g); 413 s/[BI]<>//g; 414 s/([BI])<(\s+)([^>]+)>/$2$1<$3>/g; 415 s/([BI])<([^>]+?)(\s+)>/$1<$2>$3/g; 416 417 # Extract footnotes. This has to be done after all other 418 # processing because otherwise the regexp will choke on formatting 419 # inside @footnote. 420 while (/\@footnote/g) { 421 s/\@footnote\{([^\}]+)\}/[$fnno]/; 422 add_footnote($1, $fnno); 423 $fnno++; 424 } 425 426 return $_; 427} 428 429sub unmunge 430{ 431 # Replace escaped symbols with their equivalents. 432 local $_ = $_[0]; 433 434 s/</E<lt>/g; 435 s/>/E<gt>/g; 436 s/{/\{/g; 437 s/}/\}/g; 438 s/&at;/\@/g; 439 s/&/&/g; 440 return $_; 441} 442 443sub add_footnote 444{ 445 unless (exists $chapters{FOOTNOTES}) { 446 $chapters{FOOTNOTES} = "\n=over 4\n\n"; 447 } 448 449 $chapters{FOOTNOTES} .= "=item $fnno.\n\n"; $fnno++; 450 $chapters{FOOTNOTES} .= $_[0]; 451 $chapters{FOOTNOTES} .= "\n\n"; 452} 453 454# stolen from Symbol.pm 455{ 456 my $genseq = 0; 457 sub gensym 458 { 459 my $name = "GEN" . $genseq++; 460 my $ref = \*{$name}; 461 delete $::{$name}; 462 return $ref; 463 } 464} 465