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