OSDN Git Service

* texi2pod.pl:
[pf3gnuchains/gcc-fork.git] / contrib / texi2pod.pl
1 #! /usr/bin/perl -w
2
3 # This does trivial (and I mean _trivial_) conversion of Texinfo
4 # markup to Perl POD format.  It's intended to be used to extract
5 # something suitable for a manpage from a Texinfo document.
6
7 $output = 0;
8 $ignore = 0;
9 $skipping = 0;
10 %sects = ();
11 $section = "";
12 @icstack = ();
13 @endwstack = ();
14 @skstack = ();
15 $shift = "";
16 %defs = ();
17
18 while($_ = shift)
19 {
20     if (/^-D(.*)$/) {
21         if ($1 ne "") {
22             $flag = $1;
23         } else {
24             $flag = shift;
25         }
26         die "no flag specified for -D\n"
27             unless $flag ne "";
28         die "flags may only contain letters, digits, hyphens, and underscores\n"
29             unless $flag =~ /^[a-zA-Z0-9_-]+$/;
30         $defs{$flag} = "";
31     } elsif (/^-/) {
32         usage();
33     } else {
34         $in = $_, next unless defined $in;
35         $out = $_, next unless defined $out;
36         usage();
37     }
38 }
39
40 if (defined $in) {
41     open(STDIN, $in) or die "opening \"$in\": $!\n";
42 }
43 if (defined $out) {
44     open(STDOUT, ">$out") or die "opening \"$out\": $!\n";
45 }
46
47 while(<STDIN>)
48 {
49     chomp;
50     /^\@c man begin ([A-Z]+)/ and $sect = $1, $output = 1, next;
51     /^\@c man end/ and do {
52         $_ = $section;
53
54         s/\@(?:dfn|var|emph|cite)\{([^\}]*)\}/I<$1>/g;
55         s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g;
56         s/\@(?:samp|strong|key)\{([^\}]*)\}/B<$1>/g;
57         s/\@value\{([a-zA-Z0-9_-]+)\}/$defs{$1}/g;
58         s/\@sc\{([^\}]*)\}/\U$1/g;
59         s/\@file\{([^\}]*)\}/F<$1>/g;
60         s/\@(?:url|email)\{([^\}]*)\}/E<lt>C<$1>E<rt>/g;
61         s/\@xref\{(?:[^\}]*)\}[^.]*.//g;
62         s/\s+\(\@p[a-z]?ref\{(?:[^\}]*)\}\)//g;
63         s/\@copyright\{\}//g;
64         s/\@noindent\s*//g;
65         s/\@refill//g;
66         s/\@\././g;
67
68         # Turn B<blah I<blah> blah> into B<blah> I<blah> B<blah> to
69         # match Texinfo semantics of @emph inside @samp.
70
71         s/&LT;/</g;
72         s/&GT;/>/g;
73         1 while (s/B<([^<>]*)I<([^>]+)>/B<$1>I<$2>B</g);
74         1 while (s/I<([^<>]*)B<([^>]+)>/I<$1>B<$2>I</g);
75         s/[BI]<>//g;
76         s/([BI])<(\s+)([^>]+)>/$2$1<$3>/g;
77         s/([BI])<([^>]+?)(\s+)>/$1<$2>$3/g;
78
79         s/&lt;/E<lt>/g;
80         s/&gt;/E<gt>/g;
81         s/&lbrace;/\{/g;
82         s/&rbrace;/\}/g;
83
84         $sects{$sect} = $_;
85         $section = "";
86         $output = 0;
87         next;
88     };
89
90     /^\@(c|[a-z]+index)\b/ and next;
91     /^\@subsection/ and next;
92     /^\@need/ and next;
93     /^\@node/ and next;
94
95     /^\@setfilename\s+([^.]+)/ and $fn = $1, next;
96     /^\@settitle\s+([^.]+)/ and $tl = $1, next;
97
98     next unless $output;
99
100     /^\@end\s+([a-z]+)/ and do {
101         if(defined $endw)
102         {
103             die "\@$endw ended by \@end $1 at line $.\n"
104                 unless $1 eq $endw;
105
106             if($endw =~ /example$/)
107             {
108                 $shift = "";
109                 $_ = "";
110             }
111             elsif($endw =~ /^if/)
112             {
113                 $skipping = pop @skstack;
114                 $_ = "";
115             }
116             else
117             {
118                 $_ = "\n=back\n";
119                 $ic = pop @icstack;
120             }
121             $endw = pop @endwstack;
122         }
123     };
124
125     /^\@end ignore/ and $ignore = 0, next;
126     next if $ignore;
127     next if $skipping;
128
129     /^\@ignore/ and $ignore = 1, next;
130
131     /^\@set\s+([a-zA-Z0-9_-]+)\s*(.*)$/ and $defs{$1} = $2, next;
132     /^\@clear\s+([a-zA-Z0-9_-]+)/ and delete $defs{$1}, next;
133
134     /^\@ifset\s+([a-zA-Z0-9_-]+)/ and do {
135         push @endwstack, $endw;
136         push @skstack, $skipping;
137         $endw = "ifset";
138         $skipping = 1 unless exists $defs{$1};
139     };
140
141     /^\@ifclear\s+([a-zA-Z0-9_-]+)/ and do {
142         push @endwstack, $endw;
143         push @skstack, $skipping;
144         $endw = "ifset";
145         $skipping = 1 if exists $defs{$1};
146     };
147
148     /^\@itemize (\@[a-z]+)/ and do {
149         push @endwstack, $endw;
150         push @icstack, $ic;
151         $ic = $1;
152         $ic =~ s/\@bullet/*/;
153         $ic =~ s/\@minus/-/;
154         $_ = "\n=over 4\n";
155         $endw = "itemize";
156     };
157
158     /^\@enumerate\s+([A-Z0-9]+)/ and do {
159         push @endwstack, $endw;
160         push @icstack, $ic;
161         $ic = $1 . ".";
162         $_ = "\n=over 4\n";
163         $endw = "enumerate";
164     };
165
166     /^\@table\s+(\@[a-z]+)/ and do {
167         push @endwstack, $endw;
168         push @icstack, $ic;
169         $ic = $1;
170         $ic =~ s/\@(?:samp|strong|key)/B/;
171         $ic =~ s/\@(?:code|kbd)/C/;
172         $ic =~ s/\@(?:dfn|var|emph|cite)/I/;
173         $ic =~ s/\@(?:file)/F/;
174         $_ = "\n=over 4\n";
175         $endw = "table";
176     };
177
178     /^\@((?:small)?example)/ and do {
179         push @endwstack, $endw;
180         $endw = $1;
181         $shift = "\t";
182         next;
183     };
184
185     /^\@itemx?\s*(.+)?$/ and do {
186         if(defined $1)
187         {
188             $_ = "=item $ic\&LT;$1\&GT;\n";
189         }
190         else
191         {
192             $_ = "=item $ic\n";
193             $ic =~ y/A-Ya-y1-8/B-Zb-z2-9/;
194         }
195     };
196
197     /^\@section\s+(.+)$/ and do {
198         $_ = "\n=head2 $1\n";
199     };
200
201     # POD doesn't interpret E<> inside a verbatim block.
202     if ($shift eq "") {
203         s/</&lt;/g;
204         s/>/&gt;/g;
205     } else {
206         s/</&LT;/g;
207         s/>/&GT;/g;
208     }
209     s/\@\{/&lbrace;/g;
210     s/\@\}/&rbrace;/g;
211     $section .= $shift.$_."\n";
212 }
213
214 $sects{NAME} = "$fn \- $tl\n";
215
216 for $sect (qw(NAME SYNOPSIS DESCRIPTION OPTIONS ENVIRONMENT FILES
217               BUGS NOTES SEEALSO AUTHOR COPYRIGHT))
218 {
219     if(exists $sects{$sect})
220     {
221         $head = $sect;
222         $head =~ s/SEEALSO/SEE ALSO/;
223         print "=head1 $head\n\n";
224         print $sects{$sect};
225         print "\n";
226     }
227 }
228
229 sub usage
230 {
231     die "usage: $0 [-D toggle...] [infile [outfile]]\n";
232 }