texi2pod.pl 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453
  1. #! /usr/bin/perl
  2. # Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
  3. # This file is part of GNU CC.
  4. # GNU CC is free software; you can redistribute it and/or modify
  5. # it under the terms of the GNU General Public License as published by
  6. # the Free Software Foundation; either version 2, or (at your option)
  7. # any later version.
  8. # GNU CC is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. # GNU General Public License for more details.
  12. # You should have received a copy of the GNU General Public License
  13. # along with GNU CC; see the file COPYING. If not, write to
  14. # the Free Software Foundation, 51 Franklin Street, Fifth Floor,
  15. # Boston, MA 02110-1301 USA
  16. # This does trivial (and I mean _trivial_) conversion of Texinfo
  17. # markup to Perl POD format. It's intended to be used to extract
  18. # something suitable for a manpage from a Texinfo document.
  19. use warnings;
  20. $output = 0;
  21. $skipping = 0;
  22. %chapters = ();
  23. @chapters_sequence = ();
  24. $chapter = "";
  25. @icstack = ();
  26. @endwstack = ();
  27. @skstack = ();
  28. @instack = ();
  29. $shift = "";
  30. %defs = ();
  31. $fnno = 1;
  32. $inf = "";
  33. @ibase = ();
  34. while ($_ = shift) {
  35. if (/^-D(.*)$/) {
  36. if ($1 ne "") {
  37. $flag = $1;
  38. } else {
  39. $flag = shift;
  40. }
  41. $value = "";
  42. ($flag, $value) = ($flag =~ /^([^=]+)(?:=(.+))?/);
  43. die "no flag specified for -D\n"
  44. unless $flag ne "";
  45. die "flags may only contain letters, digits, hyphens, dashes and underscores\n"
  46. unless $flag =~ /^[a-zA-Z0-9_-]+$/;
  47. $defs{$flag} = $value;
  48. } elsif (/^-I(.*)$/) {
  49. push @ibase, $1 ne "" ? $1 : shift;
  50. } elsif (/^-/) {
  51. usage();
  52. } else {
  53. $in = $_, next unless defined $in;
  54. $out = $_, next unless defined $out;
  55. usage();
  56. }
  57. }
  58. push @ibase, ".";
  59. if (defined $in) {
  60. $inf = gensym();
  61. open($inf, "<$in") or die "opening \"$in\": $!\n";
  62. push @ibase, $1 if $in =~ m|^(.+)/[^/]+$|;
  63. } else {
  64. $inf = \*STDIN;
  65. }
  66. if (defined $out) {
  67. open(STDOUT, ">$out") or die "opening \"$out\": $!\n";
  68. }
  69. while(defined $inf) {
  70. INF: while(<$inf>) {
  71. # Certain commands are discarded without further processing.
  72. /^\@(?:
  73. [a-z]+index # @*index: useful only in complete manual
  74. |need # @need: useful only in printed manual
  75. |(?:end\s+)?group # @group .. @end group: ditto
  76. |page # @page: ditto
  77. |node # @node: useful only in .info file
  78. |(?:end\s+)?ifnottex # @ifnottex .. @end ifnottex: use contents
  79. )\b/x and next;
  80. chomp;
  81. # Look for filename and title markers.
  82. /^\@setfilename\s+([^.]+)/ and $fn = $1, next;
  83. /^\@settitle\s+([^.]+)/ and $tl = postprocess($1), next;
  84. # Identify a man title but keep only the one we are interested in.
  85. /^\@c\s+man\s+title\s+([A-Za-z0-9-]+)\s+(.+)/ and do {
  86. if (exists $defs{$1}) {
  87. $fn = $1;
  88. $tl = postprocess($2);
  89. }
  90. next;
  91. };
  92. /^\@include\s+(.+)$/ and do {
  93. push @instack, $inf;
  94. $inf = gensym();
  95. for (@ibase) {
  96. open($inf, "<" . $_ . "/" . $1) and next INF;
  97. }
  98. die "cannot open $1: $!\n";
  99. };
  100. /^\@chapter\s+([A-Za-z ]+)/ and do {
  101. # close old chapter
  102. $chapters{$chapter_name} .= postprocess($chapter) if ($chapter_name);
  103. # start new chapter
  104. $chapter_name = $1, push (@chapters_sequence, $chapter_name) unless $skipping;
  105. $chapters{$chapter_name} = "" unless exists $chapters{$chapter_name};
  106. $chapter = "";
  107. $output = 1;
  108. next;
  109. };
  110. /^\@bye/ and do {
  111. # close old chapter
  112. $chapters{$chapter_name} .= postprocess($chapter) if ($chapter_name);
  113. last INF;
  114. };
  115. # handle variables
  116. /^\@set\s+([a-zA-Z0-9_-]+)\s*(.*)$/ and do {
  117. $defs{$1} = $2;
  118. next;
  119. };
  120. /^\@clear\s+([a-zA-Z0-9_-]+)/ and do {
  121. delete $defs{$1};
  122. next;
  123. };
  124. next unless $output;
  125. # Discard comments. (Can't do it above, because then we'd never see
  126. # @c man lines.)
  127. /^\@c\b/ and next;
  128. # End-block handler goes up here because it needs to operate even
  129. # if we are skipping.
  130. /^\@end\s+([a-z]+)/ and do {
  131. # Ignore @end foo, where foo is not an operation which may
  132. # cause us to skip, if we are presently skipping.
  133. my $ended = $1;
  134. next if $skipping && $ended !~ /^(?:ifset|ifclear|ignore|menu|iftex|ifhtml|ifnothtml)$/;
  135. die "\@end $ended without \@$ended at line $.\n" unless defined $endw;
  136. die "\@$endw ended by \@end $ended at line $.\n" unless $ended eq $endw;
  137. $endw = pop @endwstack;
  138. if ($ended =~ /^(?:ifset|ifclear|ignore|menu|iftex|ifhtml|ifnothtml)$/) {
  139. $skipping = pop @skstack;
  140. next;
  141. } elsif ($ended =~ /^(?:example|smallexample|display)$/) {
  142. $shift = "";
  143. $_ = ""; # need a paragraph break
  144. } elsif ($ended =~ /^(?:itemize|enumerate|(?:multi|[fv])?table)$/) {
  145. $_ = "\n=back\n";
  146. $ic = pop @icstack;
  147. } else {
  148. die "unknown command \@end $ended at line $.\n";
  149. }
  150. };
  151. # We must handle commands which can cause skipping even while we
  152. # are skipping, otherwise we will not process nested conditionals
  153. # correctly.
  154. /^\@ifset\s+([a-zA-Z0-9_-]+)/ and do {
  155. push @endwstack, $endw;
  156. push @skstack, $skipping;
  157. $endw = "ifset";
  158. $skipping = 1 unless exists $defs{$1};
  159. next;
  160. };
  161. /^\@ifclear\s+([a-zA-Z0-9_-]+)/ and do {
  162. push @endwstack, $endw;
  163. push @skstack, $skipping;
  164. $endw = "ifclear";
  165. $skipping = 1 if exists $defs{$1};
  166. next;
  167. };
  168. /^\@(ignore|menu|iftex|ifhtml|ifnothtml)\b/ and do {
  169. push @endwstack, $endw;
  170. push @skstack, $skipping;
  171. $endw = $1;
  172. $skipping = $endw !~ /ifnothtml/;
  173. next;
  174. };
  175. next if $skipping;
  176. # Character entities. First the ones that can be replaced by raw text
  177. # or discarded outright:
  178. s/\@copyright\{\}/(c)/g;
  179. s/\@dots\{\}/.../g;
  180. s/\@enddots\{\}/..../g;
  181. s/\@([.!? ])/$1/g;
  182. s/\@[:-]//g;
  183. s/\@bullet(?:\{\})?/*/g;
  184. s/\@TeX\{\}/TeX/g;
  185. s/\@pounds\{\}/\#/g;
  186. s/\@minus(?:\{\})?/-/g;
  187. # Now the ones that have to be replaced by special escapes
  188. # (which will be turned back into text by unmunge())
  189. s/&/&amp;/g;
  190. s/\@\{/&lbrace;/g;
  191. s/\@\}/&rbrace;/g;
  192. s/\@\@/&at;/g;
  193. # Inside a verbatim block, handle @var specially.
  194. if ($shift ne "") {
  195. s/\@var\{([^\}]*)\}/<$1>/g;
  196. }
  197. # POD doesn't interpret E<> inside a verbatim block.
  198. if ($shift eq "") {
  199. s/</&lt;/g;
  200. s/>/&gt;/g;
  201. } else {
  202. s/</&LT;/g;
  203. s/>/&GT;/g;
  204. }
  205. # Single line command handlers.
  206. /^\@(?:section|unnumbered|unnumberedsec|center|heading)\s+(.+)$/
  207. and $_ = "\n=head2 $1\n";
  208. /^\@(?:subsection|subheading)\s+(.+)$/
  209. and $_ = "\n=head3 $1\n";
  210. /^\@(?:subsubsection|subsubheading)\s+(.+)$/
  211. and $_ = "\n=head4 $1\n";
  212. # Block command handlers:
  213. /^\@itemize\s*(\@[a-z]+|\*|-)?/ and do {
  214. push @endwstack, $endw;
  215. push @icstack, $ic;
  216. $ic = $1 ? $1 : "*";
  217. $_ = "\n=over 4\n";
  218. $endw = "itemize";
  219. };
  220. /^\@enumerate(?:\s+([a-zA-Z0-9]+))?/ and do {
  221. push @endwstack, $endw;
  222. push @icstack, $ic;
  223. if (defined $1) {
  224. $ic = $1 . ".";
  225. } else {
  226. $ic = "1.";
  227. }
  228. $_ = "\n=over 4\n";
  229. $endw = "enumerate";
  230. };
  231. /^\@((?:multi|[fv])?table)\s+(\@[a-z]+)/ and do {
  232. push @endwstack, $endw;
  233. push @icstack, $ic;
  234. $endw = $1;
  235. $ic = $2;
  236. $ic =~ s/\@(?:samp|strong|key|gcctabopt|option|env|command)/B/;
  237. $ic =~ s/\@(?:code|kbd)/C/;
  238. $ic =~ s/\@(?:dfn|var|emph|cite|i)/I/;
  239. $ic =~ s/\@(?:file)/F/;
  240. $ic =~ s/\@(?:columnfractions)//;
  241. $_ = "\n=over 4\n";
  242. };
  243. /^\@((?:small)?example|display)/ and do {
  244. push @endwstack, $endw;
  245. $endw = $1;
  246. $shift = "\t";
  247. $_ = ""; # need a paragraph break
  248. };
  249. /^\@item\s+(.*\S)\s*$/ and $endw eq "multitable" and do {
  250. my $columns = $1;
  251. $columns =~ s/\@tab/ : /;
  252. $_ = "\n=item B&LT;". $columns ."&GT;\n";
  253. };
  254. /^\@tab\s+(.*\S)\s*$/ and $endw eq "multitable" and do {
  255. my $columns = $1;
  256. $columns =~ s/\@tab/ : /;
  257. $_ = " : ". $columns;
  258. $chapter =~ s/\n+\s+$//;
  259. };
  260. /^\@itemx?\s*(.+)?$/ and do {
  261. if (defined $1) {
  262. # Entity escapes prevent munging by the <> processing below.
  263. $_ = "\n=item $ic\&LT;$1\&GT;\n";
  264. } else {
  265. $_ = "\n=item $ic\n";
  266. $ic =~ y/A-Ya-y/B-Zb-z/;
  267. $ic =~ s/(\d+)/$1 + 1/eg;
  268. }
  269. };
  270. $chapter .= $shift.$_."\n";
  271. }
  272. # End of current file.
  273. close($inf);
  274. $inf = pop @instack;
  275. }
  276. die "No filename or title\n" unless defined $fn && defined $tl;
  277. $chapters{NAME} = "$fn \- $tl\n";
  278. $chapters{FOOTNOTES} .= "=back\n" if exists $chapters{FOOTNOTES};
  279. unshift @chapters_sequence, "NAME";
  280. for $chapter (@chapters_sequence) {
  281. if (exists $chapters{$chapter}) {
  282. $head = uc($chapter);
  283. print "=head1 $head\n\n";
  284. print scalar unmunge ($chapters{$chapter});
  285. print "\n";
  286. }
  287. }
  288. sub usage
  289. {
  290. die "usage: $0 [-D toggle...] [infile [outfile]]\n";
  291. }
  292. sub postprocess
  293. {
  294. local $_ = $_[0];
  295. # @value{foo} is replaced by whatever 'foo' is defined as.
  296. while (m/(\@value\{([a-zA-Z0-9_-]+)\})/g) {
  297. if (! exists $defs{$2}) {
  298. print STDERR "Option $2 not defined\n";
  299. s/\Q$1\E//;
  300. } else {
  301. $value = $defs{$2};
  302. s/\Q$1\E/$value/;
  303. }
  304. }
  305. # Formatting commands.
  306. # Temporary escape for @r.
  307. s/\@r\{([^\}]*)\}/R<$1>/g;
  308. s/\@(?:dfn|var|emph|cite|i)\{([^\}]*)\}/I<$1>/g;
  309. s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g;
  310. s/\@(?:gccoptlist|samp|strong|key|option|env|command|b)\{([^\}]*)\}/B<$1>/g;
  311. s/\@sc\{([^\}]*)\}/\U$1/g;
  312. s/\@file\{([^\}]*)\}/F<$1>/g;
  313. s/\@w\{([^\}]*)\}/S<$1>/g;
  314. s/\@(?:dmn|math)\{([^\}]*)\}/$1/g;
  315. # Cross references are thrown away, as are @noindent and @refill.
  316. # (@noindent is impossible in .pod, and @refill is unnecessary.)
  317. # @* is also impossible in .pod; we discard it and any newline that
  318. # follows it. Similarly, our macro @gol must be discarded.
  319. s/\@anchor{(?:[^\}]*)\}//g;
  320. s/\(?\@xref\{(?:[^\}]*)\}(?:[^.<]|(?:<[^<>]*>))*\.\)?//g;
  321. s/\s+\(\@pxref\{(?:[^\}]*)\}\)//g;
  322. s/;\s+\@pxref\{(?:[^\}]*)\}//g;
  323. s/\@ref\{(?:[^,\}]*,)(?:[^,\}]*,)([^,\}]*).*\}/$1/g;
  324. s/\@ref\{([^\}]*)\}/$1/g;
  325. s/\@noindent\s*//g;
  326. s/\@refill//g;
  327. s/\@gol//g;
  328. s/\@\*\s*\n?//g;
  329. # @uref can take one, two, or three arguments, with different
  330. # semantics each time. @url and @email are just like @uref with
  331. # one argument, for our purposes.
  332. s/\@(?:uref|url|email)\{([^\},]*),?[^\}]*\}/&lt;B<$1>&gt;/g;
  333. s/\@uref\{([^\},]*),([^\},]*)\}/$2 (C<$1>)/g;
  334. s/\@uref\{([^\},]*),([^\},]*),([^\},]*)\}/$3/g;
  335. # Turn B<blah I<blah> blah> into B<blah> I<blah> B<blah> to
  336. # match Texinfo semantics of @emph inside @samp. Also handle @r
  337. # inside bold.
  338. s/&LT;/</g;
  339. s/&GT;/>/g;
  340. 1 while s/B<((?:[^<>]|I<[^<>]*>)*)R<([^>]*)>/B<$1>${2}B</g;
  341. 1 while (s/B<([^<>]*)I<([^>]+)>/B<$1>I<$2>B</g);
  342. 1 while (s/I<([^<>]*)B<([^>]+)>/I<$1>B<$2>I</g);
  343. s/[BI]<>//g;
  344. s/([BI])<(\s+)([^>]+)>/$2$1<$3>/g;
  345. s/([BI])<([^>]+?)(\s+)>/$1<$2>$3/g;
  346. # Extract footnotes. This has to be done after all other
  347. # processing because otherwise the regexp will choke on formatting
  348. # inside @footnote.
  349. while (/\@footnote/g) {
  350. s/\@footnote\{([^\}]+)\}/[$fnno]/;
  351. add_footnote($1, $fnno);
  352. $fnno++;
  353. }
  354. return $_;
  355. }
  356. sub unmunge
  357. {
  358. # Replace escaped symbols with their equivalents.
  359. local $_ = $_[0];
  360. s/&lt;/E<lt>/g;
  361. s/&gt;/E<gt>/g;
  362. s/&lbrace;/\{/g;
  363. s/&rbrace;/\}/g;
  364. s/&at;/\@/g;
  365. s/&amp;/&/g;
  366. return $_;
  367. }
  368. sub add_footnote
  369. {
  370. unless (exists $chapters{FOOTNOTES}) {
  371. $chapters{FOOTNOTES} = "\n=over 4\n\n";
  372. }
  373. $chapters{FOOTNOTES} .= "=item $fnno.\n\n"; $fnno++;
  374. $chapters{FOOTNOTES} .= $_[0];
  375. $chapters{FOOTNOTES} .= "\n\n";
  376. }
  377. # stolen from Symbol.pm
  378. {
  379. my $genseq = 0;
  380. sub gensym
  381. {
  382. my $name = "GEN" . $genseq++;
  383. my $ref = \*{$name};
  384. delete $::{$name};
  385. return $ref;
  386. }
  387. }