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