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