1#! @PERL@
2# $MirOS: src/gnu/usr.bin/cvs/doc/mkman.pl,v 1.5 2010/09/19 19:42:56 tg Exp $
3#
4# Generate a man page from sections of a Texinfo manual.
5#
6# Copyright 2004 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 "node \\(aq$content\\(aq in the CVS manual"
77		if $keyword =~ /^ref$/;
78	return "See node \\(aq$content\\(aq in the CVS manual"
79		if $keyword =~ /^xref$/;
80	return "see node \\(aq$content\\(aq in the CVS manual"
81		if $keyword =~ /^pxref$/;
82	return "\\fP\\fP$content"
83		if $keyword =~ /^splitrcskeyword$/;
84
85	my $endmode = keyword_mode $parent;
86	my $startmode = keyword_mode $keyword, $file;
87
88	return "$startmode$content$endmode";
89}
90
91
92
93###
94### MAIN
95###
96for my $file (@ARGV)
97{
98	my $fh = new IO::File "< $file"
99		or die "Failed to open file '$file': $!";
100
101	if ($file !~ /\.(texinfo|texi|txi)$/)
102	{
103		print stderr "Passing '$file' through unprocessed.\n";
104		# Just cat any file that doesn't look like a Texinfo source.
105		while (my $line = $fh->getline)
106		{
107			print $line;
108		}
109		next;
110	}
111
112	print stderr "Processing '$file'.\n";
113	$texi_num++;
114	my $gotone = 0;
115	my $inblank = 0;
116	my $indent = 0;
117	my $inexample = 0;
118	my $inmenu = 0;
119	my $intable = 0;
120	my $last_header = "";
121	my @table_headers;
122	my @table_footers;
123	my $table_header = "";
124	my $table_footer = "";
125	my $last;
126	while ($_ = $fh->getline)
127	{
128		if (!$gotone && /^\@c ----- START MAN $texi_num -----$/)
129		{
130			$gotone = 1;
131			next;
132		}
133
134		# Skip ahead until our man section.
135		next unless $gotone;
136
137		# If we find the end tag we are done.
138		last if /^\@c ----- END MAN $texi_num -----$/;
139
140		# Need to do this everywhere.  i.e., before we print example
141		# lines, since literal back slashes can appear there too.
142		s/\\/\\\\/g;
143		s/^\./\\&./;
144		s/([\s])\./$1\\&./;
145		s/'/\\(aq/g;
146		s/`/\\`/g;
147		s/(?<!-)---(?!-)/\\(em/g;
148		s/\@bullet({}|\b)/\\(bu/g;
149		s/\@dots({}|\b)/\\&.../g;
150
151		# Hack for GNU groff with nroff -Tutf8
152		s/-/\\-/g;
153
154		# Examples should be indented and otherwise untouched
155		if (/^\@example$/)
156		{
157			$indent += 2;
158			print qq{.SP\n.PD 0\n};
159			$inexample = 1;
160			next;
161		}
162		if ($inexample)
163		{
164			if (/^\@end example$/)
165			{
166				$indent -= 2;
167				print qq{\n.PD\n.IP "" $indent\n};
168				$inexample = 0;
169				next;
170			}
171			if (/^[ 	]*$/)
172			{
173				print ".SP\n";
174				next;
175			}
176
177			# Preserve the newline.
178			$_ = qq{.IP "" $indent\n} . $_;
179		}
180
181		# Compress blank lines into a single line.  This and its
182		# corresponding skip purposely bracket the @menu and comment
183		# removal so that blanks on either side of a menu are
184		# compressed after the menu is removed.
185		if (/^[ 	]*$/)
186		{
187			$inblank = 1;
188			next;
189		}
190
191		# Not used
192		if (/^\@(ignore|menu)$/)
193		{
194			$inmenu++;
195			next;
196		}
197		# Delete menu contents.
198		if ($inmenu)
199		{
200			next unless /^\@end (ignore|menu)$/;
201			$inmenu--;
202			next;
203		}
204
205		# Remove comments
206		next if /^\@c(omment)?\b/;
207
208		# Ignore includes.
209		next if /^\@include\b/;
210
211		# It's okay to ignore this keyword - we're not using any
212		# first-line indent commands at all.
213		next if s/^\@noindent\s*$//;
214
215		# @need is only significant in printed manuals.
216		next if s/^\@need\s+.*$//;
217
218		# If we didn't hit the previous check and $inblank is set, then
219		# we just finished with some number of blanks.  Print the man
220		# page blank symbol before continuing processing of this line.
221		if ($inblank)
222		{
223			print ".SP\n";
224			$inblank = 0;
225		}
226
227		# Chapter headers.
228		$last_header = $1 if s/^\@node\s+(.*)$/.SH "$1"/;
229		if (/^\@appendix\w*\s+(.*)$/)
230		{
231			my $content = $1;
232			$content =~ s/^$last_header(\\\(em|\s+)?//;
233			next if $content =~ /^\s*$/;
234			s/^\@appendix\w*\s+.*$/.SS "$content"/;
235		}
236
237		# Tables are similar to examples, except we need to handle the
238		# keywords.
239		if (/^\@(itemize|table)(\s+(.*))?$/)
240		{
241			$indent += 2;
242			push @table_headers, $table_header;
243			push @table_footers, $table_footer;
244			my $content = $3;
245			if (/^\@itemize/)
246			{
247				my $bullet = $content;
248				$table_header = qq{.IP "$bullet" $indent\n};
249				$table_footer = "";
250			}
251			else
252			{
253				my $hi = $indent - 2;
254				$table_header = qq{.IP "" $hi\n};
255				$table_footer = qq{\n.IP "" $indent};
256				if ($content)
257				{
258					$table_header .= "$content\{";
259					$table_footer = "\}$table_footer";
260				}
261			}
262			$intable++;
263			next;
264		}
265
266		if ($intable)
267		{
268			if (/^\@end (itemize|table)$/)
269			{
270				$table_header = pop @table_headers;
271				$table_footer = pop @table_footers;
272				$indent -= 2;
273				$intable--;
274				next;
275			}
276			s/^\@itemx?(\s+(.*))?$/$table_header$2$table_footer/;
277			# Fall through so the rest of the table lines are
278			# processed normally.
279		}
280
281		# Index entries.
282		s/^\@cindex\s+(.*)$/.IX "$1"/;
283
284		$_ = "$last$_" if $last;
285		undef $last;
286
287		# Trap keywords
288		$nk = qr/
289				\@(\w+)\{
290				(?{ debug_print "$ret MATCHED $&\nPUSHING $1\n";
291				    push @parent, $1; })      # Keep track of the last keyword
292				                              # keyword we encountered.
293				((?>
294					[^{}]|(?<=\@)[{}]     # Non-braces...
295						|             #    ...or...
296					(??{ $nk })           # ...nested keywords...
297				)*)                           # ...without backtracking.
298				\}
299				(?{ debug_print "$ret MATCHED $&\nPOPPING ",
300				                pop (@parent), "\n"; })            # Lose track of the current keyword.
301			/x;
302
303		$ret = "m//";
304		if (/\@\w+\{(?:[^{}]|(?<=\@)[{}]|(??{ $nk }))*$/)
305		{
306			# If there is an opening keyword on this line without a
307			# close bracket, we need to find the close bracket
308			# before processing the line.  Set $last to append the
309			# next line in the next pass.
310			$last = $_;
311			next;
312		}
313
314		# Okay, the following works somewhat counter-intuitively.  $nk
315		# processes the whole line, so @parent gets loaded properly,
316		# then, since no closing brackets have been found for the
317		# outermost matches, the innermost matches match and get
318		# replaced first.
319		#
320		# For example:
321		#
322		# Processing the line:
323		#
324		#   yadda yadda @code{yadda @var{foo} yadda @var{bar} yadda}
325		#
326		# Happens something like this:
327		#
328		# 1. Ignores "yadda yadda "
329		# 2. Sees "@code{" and pushes "code" onto @parent.
330		# 3. Ignores "yadda " (backtracks and ignores "yadda yadda
331		#                      @code{yadda "?)
332		# 4. Sees "@var{" and pushes "var" onto @parent.
333		# 5. Sees "foo}", pops "var", and realizes that "@var{foo}"
334		#    matches the overall pattern ($nk).
335		# 6. Replaces "@var{foo}" with the result of:
336		#
337		#      do_keyword $file, $parent[$#parent], $1, $2;
338		#
339		#    which would be "\Ifoo\B", in this case, because "var"
340		#    signals a request for italics, or "\I", and "code" is
341		#    still on the stack, which means the previous style was
342		#    bold, or "\B".
343		#
344		# Then the while loop restarts and a similar series of events
345		# replaces "@var{bar}" with "\Ibar\B".
346		#
347		# Then the while loop restarts and a similar series of events
348		# replaces "@code{yadda \Ifoo\B yadda \Ibar\B yadda}" with
349		# "\Byadda \Ifoo\B yadda \Ibar\B yadda\R".
350		#
351		$ret = "s///";
352		@parent = ("");
353		while (s/$nk/do_keyword $file, $parent[$#parent], $1, $2/e)
354		{
355			# Do nothing except reset our last-replacement
356			# tracker - the replacement regex above is handling
357			# everything else.
358			debug_print "FINAL MATCH $&\n";
359			@parent = ("");
360		}
361
362		# Finally, unprotect texinfo special characters.
363		s/\@://g;
364		s/\@([{}])/$1/g;
365
366		# Verify we haven't left commands unprocessed.
367		die "Unprocessed command at line $. of file '$file': "
368		    . ($1 ? "$1\n" : "<EOL>\n")
369			if /^(?>(?:[^\@]|\@\@)*)\@(\w+|.|$)/;
370
371		# Unprotect @@.
372		s/\@\@/\@/g;
373
374		# And print whatever's left.
375		print $_;
376	}
377}
378