let’s see whether this works around #820860
[alioth/cvs.git] / doc / mkman.pl
1 #! @PERL@
2 #
3 # Generate a man page from sections of a Texinfo manual.
4 #
5 # Copyright 2004 The Free Software Foundation,
6 #                Derek R. Price,
7 #                & Ximbiot <http://ximbiot.com>
8 #
9 # This program is free software; you can redistribute it and/or modify
10 # it under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 2, or (at your option)
12 # any later version.
13 #
14 # This program is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 # GNU General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public License
20 # along with this program; if not, write to the Free Software Foundation,
21 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
22
23
24
25 # Need Perl 5.005 or greater for re 'eval'.
26 require 5.005;
27
28 # The usual.
29 use strict;
30 use IO::File;
31
32
33
34 ###
35 ### GLOBALS
36 ###
37 my $texi_num = 0; # Keep track of how many texinfo files have been encountered.
38 my @parent;       # This needs to be global to be used inside of a regex later.
39 my $nk;           # Ditto.
40 my $ret;          # The RE match Type, used in debug prints.
41 my $debug = 0;    # Debug mode?
42
43
44
45 ###
46 ### FUNCTIONS
47 ###
48 sub debug_print
49 {
50         print @_ if $debug;
51 }
52
53
54
55 sub keyword_mode
56 {
57         my ($keyword, $file) = @_;
58
59         return "\\fR"
60                 if $keyword =~ /^(|r|t)$/;
61         return "\\fB"
62                 if $keyword =~ /^(strong|sc|code|file|samp)$/;
63         return "\\fI"
64                 if $keyword =~ /^(emph|var|dfn)$/;
65         die "no handler for keyword '$keyword', found at line $. of file '$file'\n";
66 }
67
68
69
70 # Return replacement for \@$keyword{$content}.
71 sub do_keyword
72 {
73         my ($file, $parent, $keyword, $content) = @_;
74
75         return "node \\(aq$content\\(aq in the CVS manual"
76                 if $keyword =~ /^ref$/;
77         return "See node \\(aq$content\\(aq in the CVS manual"
78                 if $keyword =~ /^xref$/;
79         return "see node \\(aq$content\\(aq in the CVS manual"
80                 if $keyword =~ /^pxref$/;
81         return "\\fP\\fP$content"
82                 if $keyword =~ /^splitrcskeyword$/;
83
84         my $endmode = keyword_mode $parent;
85         my $startmode = keyword_mode $keyword, $file;
86
87         return "$startmode$content$endmode";
88 }
89
90
91
92 ###
93 ### MAIN
94 ###
95 for my $file (@ARGV)
96 {
97         my $fh = new IO::File "< $file"
98                 or die "Failed to open file '$file': $!";
99
100         if ($file !~ /\.(texinfo|texi|txi)$/)
101         {
102                 print stderr "Passing '$file' through unprocessed.\n";
103                 # Just cat any file that doesn't look like a Texinfo source.
104                 while (my $line = $fh->getline)
105                 {
106                         print $line;
107                 }
108                 next;
109         }
110
111         print stderr "Processing '$file'.\n";
112         $texi_num++;
113         my $gotone = 0;
114         my $inblank = 0;
115         my $indent = 0;
116         my $inexample = 0;
117         my $inmenu = 0;
118         my $intable = 0;
119         my $last_header = "";
120         my @table_headers;
121         my @table_footers;
122         my $table_header = "";
123         my $table_footer = "";
124         my $last;
125         while ($_ = $fh->getline)
126         {
127                 if (!$gotone && /^\@c ----- START MAN $texi_num -----$/)
128                 {
129                         $gotone = 1;
130                         next;
131                 }
132
133                 # Skip ahead until our man section.
134                 next unless $gotone;
135
136                 # If we find the end tag we are done.
137                 last if /^\@c ----- END MAN $texi_num -----$/;
138
139                 # Need to do this everywhere.  i.e., before we print example
140                 # lines, since literal back slashes can appear there too.
141                 s/\\/\\\\/g;
142                 s/^\./\\&./;
143                 s/([\s])\./$1\\&./;
144                 s/'/\\(aq/g;
145                 s/`/\\`/g;
146                 s/(?<!-)---(?!-)/\\(em/g;
147                 s/\@bullet({}|\b)/\\(bu/g;
148                 s/\@dots({}|\b)/\\&.../g;
149
150                 # Hack for GNU groff with nroff -Tutf8
151                 s/-/\\-/g;
152
153                 # Examples should be indented and otherwise untouched
154                 if (/^\@example$/)
155                 {
156                         $indent += 2;
157                         print qq{.SP\n.PD 0\n};
158                         $inexample = 1;
159                         next;
160                 }
161                 if ($inexample)
162                 {
163                         if (/^\@end example$/)
164                         {
165                                 $indent -= 2;
166                                 print qq{\n.PD\n.IP "" $indent\n};
167                                 $inexample = 0;
168                                 next;
169                         }
170                         if (/^[         ]*$/)
171                         {
172                                 print ".SP\n";
173                                 next;
174                         }
175
176                         # Preserve the newline.
177                         $_ = qq{.IP "" $indent\n} . $_;
178                 }
179
180                 # Compress blank lines into a single line.  This and its
181                 # corresponding skip purposely bracket the @menu and comment
182                 # removal so that blanks on either side of a menu are
183                 # compressed after the menu is removed.
184                 if (/^[         ]*$/)
185                 {
186                         $inblank = 1;
187                         next;
188                 }
189
190                 # Not used
191                 if (/^\@(ignore|menu)$/)
192                 {
193                         $inmenu++;
194                         next;
195                 }
196                 # Delete menu contents.
197                 if ($inmenu)
198                 {
199                         next unless /^\@end (ignore|menu)$/;
200                         $inmenu--;
201                         next;
202                 }
203
204                 # Remove comments
205                 next if /^\@c(omment)?\b/;
206
207                 # Ignore includes.
208                 next if /^\@include\b/;
209
210                 # It's okay to ignore this keyword - we're not using any
211                 # first-line indent commands at all.
212                 next if s/^\@noindent\s*$//;
213
214                 # @need is only significant in printed manuals.
215                 next if s/^\@need\s+.*$//;
216
217                 # If we didn't hit the previous check and $inblank is set, then
218                 # we just finished with some number of blanks.  Print the man
219                 # page blank symbol before continuing processing of this line.
220                 if ($inblank)
221                 {
222                         print ".SP\n";
223                         $inblank = 0;
224                 }
225
226                 # Chapter headers.
227                 $last_header = $1 if s/^\@node\s+(.*)$/.SH "$1"/;
228                 if (/^\@appendix\w*\s+(.*)$/)
229                 {
230                         my $content = $1;
231                         $content =~ s/^$last_header(\\\(em|\s+)?//;
232                         next if $content =~ /^\s*$/;
233                         s/^\@appendix\w*\s+.*$/.SS "$content"/;
234                 }
235
236                 # Tables are similar to examples, except we need to handle the
237                 # keywords.
238                 if (/^\@(itemize|table)(\s+(.*))?$/)
239                 {
240                         $indent += 2;
241                         push @table_headers, $table_header;
242                         push @table_footers, $table_footer;
243                         my $content = $3;
244                         if (/^\@itemize/)
245                         {
246                                 my $bullet = $content;
247                                 $table_header = qq{.IP "$bullet" $indent\n};
248                                 $table_footer = "";
249                         }
250                         else
251                         {
252                                 my $hi = $indent - 2;
253                                 $table_header = qq{.IP "" $hi\n};
254                                 $table_footer = qq{\n.IP "" $indent};
255                                 if ($content)
256                                 {
257                                         $table_header .= "$content\{";
258                                         $table_footer = "\}$table_footer";
259                                 }
260                         }
261                         $intable++;
262                         next;
263                 }
264
265                 if ($intable)
266                 {
267                         if (/^\@end (itemize|table)$/)
268                         {
269                                 $table_header = pop @table_headers;
270                                 $table_footer = pop @table_footers;
271                                 $indent -= 2;
272                                 $intable--;
273                                 next;
274                         }
275                         s/^\@itemx?(\s+(.*))?$/$table_header$2$table_footer/;
276                         # Fall through so the rest of the table lines are
277                         # processed normally.
278                 }
279
280                 # Index entries.
281                 s/^\@cindex\s+(.*)$/.IX "$1"/;
282
283                 $_ = "$last$_" if $last;
284                 undef $last;
285
286                 # Trap keywords
287                 $nk = qr/
288                                 \@(\w+)\{
289                                 (?{ debug_print "$ret MATCHED $&\nPUSHING $1\n";
290                                     push @parent, $1; })      # Keep track of the last keyword
291                                                               # keyword we encountered.
292                                 ((?>
293                                         [^{}]|(?<=\@)[{}]     # Non-braces...
294                                                 |             #    ...or...
295                                         (??{ $nk })           # ...nested keywords...
296                                 )*)                           # ...without backtracking.
297                                 \}
298                                 (?{ debug_print "$ret MATCHED $&\nPOPPING ",
299                                                 pop (@parent), "\n"; })            # Lose track of the current keyword.
300                         /x;
301
302                 $ret = "m//";
303                 if (/\@\w+\{(?:[^{}]|(?<=\@)[{}]|(??{ $nk }))*$/)
304                 {
305                         # If there is an opening keyword on this line without a
306                         # close bracket, we need to find the close bracket
307                         # before processing the line.  Set $last to append the
308                         # next line in the next pass.
309                         $last = $_;
310                         next;
311                 }
312
313                 # Okay, the following works somewhat counter-intuitively.  $nk
314                 # processes the whole line, so @parent gets loaded properly,
315                 # then, since no closing brackets have been found for the
316                 # outermost matches, the innermost matches match and get
317                 # replaced first.
318                 #
319                 # For example:
320                 #
321                 # Processing the line:
322                 #
323                 #   yadda yadda @code{yadda @var{foo} yadda @var{bar} yadda}
324                 #
325                 # Happens something like this:
326                 #
327                 # 1. Ignores "yadda yadda "
328                 # 2. Sees "@code{" and pushes "code" onto @parent.
329                 # 3. Ignores "yadda " (backtracks and ignores "yadda yadda
330                 #                      @code{yadda "?)
331                 # 4. Sees "@var{" and pushes "var" onto @parent.
332                 # 5. Sees "foo}", pops "var", and realizes that "@var{foo}"
333                 #    matches the overall pattern ($nk).
334                 # 6. Replaces "@var{foo}" with the result of:
335                 #
336                 #      do_keyword $file, $parent[$#parent], $1, $2;
337                 #
338                 #    which would be "\Ifoo\B", in this case, because "var"
339                 #    signals a request for italics, or "\I", and "code" is
340                 #    still on the stack, which means the previous style was
341                 #    bold, or "\B".
342                 #
343                 # Then the while loop restarts and a similar series of events
344                 # replaces "@var{bar}" with "\Ibar\B".
345                 #
346                 # Then the while loop restarts and a similar series of events
347                 # replaces "@code{yadda \Ifoo\B yadda \Ibar\B yadda}" with
348                 # "\Byadda \Ifoo\B yadda \Ibar\B yadda\R".
349                 #
350                 $ret = "s///";
351                 @parent = ("");
352                 while (s/$nk/do_keyword $file, $parent[$#parent], $1, $2/e)
353                 {
354                         # Do nothing except reset our last-replacement
355                         # tracker - the replacement regex above is handling
356                         # everything else.
357                         debug_print "FINAL MATCH $&\n";
358                         @parent = ("");
359                 }
360
361                 # Finally, unprotect texinfo special characters.
362                 s/\@://g;
363                 s/\@([{}])/$1/g;
364
365                 # Verify we haven't left commands unprocessed.
366                 die "Unprocessed command at line $. of file '$file': "
367                     . ($1 ? "$1\n" : "<EOL>\n")
368                         if /^(?>(?:[^\@]|\@\@)*)\@(\w+|.|$)/;
369
370                 # Unprotect @@.
371                 s/\@\@/\@/g;
372
373                 # And print whatever's left.
374                 print $_;
375         }
376 }