1175261Sobrien#! @PERL@ 2175261Sobrien# 3175261Sobrien# Generate a man page from sections of a Texinfo manual. 4175261Sobrien# 5177391Sobrien# Copyright 2004, 2006 6177391Sobrien# The Free Software Foundation, 7175261Sobrien# Derek R. Price, 8175261Sobrien# & Ximbiot <http://ximbiot.com> 9175261Sobrien# 10175261Sobrien# This program is free software; you can redistribute it and/or modify 11175261Sobrien# it under the terms of the GNU General Public License as published by 12175261Sobrien# the Free Software Foundation; either version 2, or (at your option) 13175261Sobrien# any later version. 14175261Sobrien# 15175261Sobrien# This program is distributed in the hope that it will be useful, 16175261Sobrien# but WITHOUT ANY WARRANTY; without even the implied warranty of 17175261Sobrien# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18175261Sobrien# GNU General Public License for more details. 19175261Sobrien# 20175261Sobrien# You should have received a copy of the GNU General Public License 21175261Sobrien# along with this program; if not, write to the Free Software Foundation, 22175261Sobrien# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 23175261Sobrien 24175261Sobrien 25175261Sobrien 26175261Sobrien# Need Perl 5.005 or greater for re 'eval'. 27175261Sobrienrequire 5.005; 28175261Sobrien 29175261Sobrien# The usual. 30175261Sobrienuse strict; 31175261Sobrienuse IO::File; 32175261Sobrien 33175261Sobrien 34175261Sobrien 35175261Sobrien### 36175261Sobrien### GLOBALS 37175261Sobrien### 38175261Sobrienmy $texi_num = 0; # Keep track of how many texinfo files have been encountered. 39175261Sobrienmy @parent; # This needs to be global to be used inside of a regex later. 40175261Sobrienmy $nk; # Ditto. 41175261Sobrienmy $ret; # The RE match Type, used in debug prints. 42175261Sobrienmy $debug = 0; # Debug mode? 43175261Sobrien 44175261Sobrien 45175261Sobrien 46175261Sobrien### 47175261Sobrien### FUNCTIONS 48175261Sobrien### 49175261Sobriensub debug_print 50175261Sobrien{ 51175261Sobrien print @_ if $debug; 52175261Sobrien} 53175261Sobrien 54175261Sobrien 55175261Sobrien 56175261Sobriensub keyword_mode 57175261Sobrien{ 58175261Sobrien my ($keyword, $file) = @_; 59175261Sobrien 60175261Sobrien return "\\fR" 61175261Sobrien if $keyword =~ /^(|r|t)$/; 62175261Sobrien return "\\fB" 63175261Sobrien if $keyword =~ /^(strong|sc|code|file|samp)$/; 64175261Sobrien return "\\fI" 65175261Sobrien if $keyword =~ /^(emph|var|dfn)$/; 66175261Sobrien die "no handler for keyword \`$keyword', found at line $. of file \`$file'\n"; 67175261Sobrien} 68175261Sobrien 69175261Sobrien 70175261Sobrien 71175261Sobrien# Return replacement for \@$keyword{$content}. 72175261Sobriensub do_keyword 73175261Sobrien{ 74175261Sobrien my ($file, $parent, $keyword, $content) = @_; 75175261Sobrien 76177391Sobrien return "`$content\\(aq in the CVS manual" 77177391Sobrien if $keyword eq "ref"; 78177391Sobrien return "see node `$content\\(aq in the CVS manual" 79177391Sobrien if $keyword =~ /^p?xref$/; 80175261Sobrien return "\\fP\\fP$content" 81175261Sobrien if $keyword =~ /^splitrcskeyword$/; 82175261Sobrien 83175261Sobrien my $endmode = keyword_mode $parent; 84175261Sobrien my $startmode = keyword_mode $keyword, $file; 85175261Sobrien 86175261Sobrien return "$startmode$content$endmode"; 87175261Sobrien} 88175261Sobrien 89175261Sobrien 90175261Sobrien 91175261Sobrien### 92175261Sobrien### MAIN 93175261Sobrien### 94175261Sobrienfor my $file (@ARGV) 95175261Sobrien{ 96175261Sobrien my $fh = new IO::File "< $file" 97175261Sobrien or die "Failed to open file \`$file': $!"; 98175261Sobrien 99175261Sobrien if ($file !~ /\.(texinfo|texi|txi)$/) 100175261Sobrien { 101175261Sobrien print stderr "Passing \`$file' through unprocessed.\n"; 102175261Sobrien # Just cat any file that doesn't look like a Texinfo source. 103175261Sobrien while (my $line = $fh->getline) 104175261Sobrien { 105175261Sobrien print $line; 106175261Sobrien } 107175261Sobrien next; 108175261Sobrien } 109175261Sobrien 110175261Sobrien print stderr "Processing \`$file'.\n"; 111175261Sobrien $texi_num++; 112175261Sobrien my $gotone = 0; 113175261Sobrien my $inblank = 0; 114175261Sobrien my $indent = 0; 115175261Sobrien my $inexample = 0; 116175261Sobrien my $inmenu = 0; 117175261Sobrien my $intable = 0; 118175261Sobrien my $last_header = ""; 119175261Sobrien my @table_headers; 120175261Sobrien my @table_footers; 121175261Sobrien my $table_header = ""; 122175261Sobrien my $table_footer = ""; 123175261Sobrien my $last; 124175261Sobrien while ($_ = $fh->getline) 125175261Sobrien { 126175261Sobrien if (!$gotone && /^\@c ----- START MAN $texi_num -----$/) 127175261Sobrien { 128175261Sobrien $gotone = 1; 129175261Sobrien next; 130175261Sobrien } 131175261Sobrien 132175261Sobrien # Skip ahead until our man section. 133175261Sobrien next unless $gotone; 134175261Sobrien 135175261Sobrien # If we find the end tag we are done. 136175261Sobrien last if /^\@c ----- END MAN $texi_num -----$/; 137175261Sobrien 138175261Sobrien # Need to do this everywhere. i.e., before we print example 139175261Sobrien # lines, since literal back slashes can appear there too. 140175261Sobrien s/\\/\\\\/g; 141175261Sobrien s/^\./\\&./; 142175261Sobrien s/([\s])\./$1\\&./; 143175261Sobrien s/'/\\(aq/g; 144175261Sobrien s/`/\\`/g; 145175261Sobrien s/(?<!-)---(?!-)/\\(em/g; 146175261Sobrien s/\@bullet({}|\b)/\\(bu/g; 147175261Sobrien s/\@dots({}|\b)/\\&.../g; 148175261Sobrien 149175261Sobrien # Examples should be indented and otherwise untouched 150175261Sobrien if (/^\@example$/) 151175261Sobrien { 152175261Sobrien $indent += 2; 153175261Sobrien print qq{.SP\n.PD 0\n}; 154175261Sobrien $inexample = 1; 155175261Sobrien next; 156175261Sobrien } 157175261Sobrien if ($inexample) 158175261Sobrien { 159175261Sobrien if (/^\@end example$/) 160175261Sobrien { 161175261Sobrien $indent -= 2; 162175261Sobrien print qq{\n.PD\n.IP "" $indent\n}; 163175261Sobrien $inexample = 0; 164175261Sobrien next; 165175261Sobrien } 166175261Sobrien if (/^[ ]*$/) 167175261Sobrien { 168175261Sobrien print ".SP\n"; 169175261Sobrien next; 170175261Sobrien } 171175261Sobrien 172175261Sobrien # Preserve the newline. 173175261Sobrien $_ = qq{.IP "" $indent\n} . $_; 174175261Sobrien } 175175261Sobrien 176175261Sobrien # Compress blank lines into a single line. This and its 177175261Sobrien # corresponding skip purposely bracket the @menu and comment 178175261Sobrien # removal so that blanks on either side of a menu are 179175261Sobrien # compressed after the menu is removed. 180175261Sobrien if (/^[ ]*$/) 181175261Sobrien { 182175261Sobrien $inblank = 1; 183175261Sobrien next; 184175261Sobrien } 185175261Sobrien 186175261Sobrien # Not used 187175261Sobrien if (/^\@(ignore|menu)$/) 188175261Sobrien { 189175261Sobrien $inmenu++; 190175261Sobrien next; 191175261Sobrien } 192175261Sobrien # Delete menu contents. 193175261Sobrien if ($inmenu) 194175261Sobrien { 195175261Sobrien next unless /^\@end (ignore|menu)$/; 196175261Sobrien $inmenu--; 197175261Sobrien next; 198175261Sobrien } 199175261Sobrien 200175261Sobrien # Remove comments 201175261Sobrien next if /^\@c(omment)?\b/; 202175261Sobrien 203175261Sobrien # Ignore includes. 204175261Sobrien next if /^\@include\b/; 205175261Sobrien 206175261Sobrien # It's okay to ignore this keyword - we're not using any 207175261Sobrien # first-line indent commands at all. 208175261Sobrien next if s/^\@noindent\s*$//; 209175261Sobrien 210175261Sobrien # @need is only significant in printed manuals. 211175261Sobrien next if s/^\@need\s+.*$//; 212175261Sobrien 213175261Sobrien # If we didn't hit the previous check and $inblank is set, then 214175261Sobrien # we just finished with some number of blanks. Print the man 215175261Sobrien # page blank symbol before continuing processing of this line. 216175261Sobrien if ($inblank) 217175261Sobrien { 218175261Sobrien print ".SP\n"; 219175261Sobrien $inblank = 0; 220175261Sobrien } 221175261Sobrien 222175261Sobrien # Chapter headers. 223175261Sobrien $last_header = $1 if s/^\@node\s+(.*)$/.SH "$1"/; 224175261Sobrien if (/^\@appendix\w*\s+(.*)$/) 225175261Sobrien { 226175261Sobrien my $content = $1; 227175261Sobrien $content =~ s/^$last_header(\\\(em|\s+)?//; 228175261Sobrien next if $content =~ /^\s*$/; 229175261Sobrien s/^\@appendix\w*\s+.*$/.SS "$content"/; 230175261Sobrien } 231175261Sobrien 232175261Sobrien # Tables are similar to examples, except we need to handle the 233175261Sobrien # keywords. 234175261Sobrien if (/^\@(itemize|table)(\s+(.*))?$/) 235175261Sobrien { 236175261Sobrien $indent += 2; 237175261Sobrien push @table_headers, $table_header; 238175261Sobrien push @table_footers, $table_footer; 239175261Sobrien my $content = $3; 240175261Sobrien if (/^\@itemize/) 241175261Sobrien { 242175261Sobrien my $bullet = $content; 243175261Sobrien $table_header = qq{.IP "$bullet" $indent\n}; 244175261Sobrien $table_footer = ""; 245175261Sobrien } 246175261Sobrien else 247175261Sobrien { 248175261Sobrien my $hi = $indent - 2; 249175261Sobrien $table_header = qq{.IP "" $hi\n}; 250175261Sobrien $table_footer = qq{\n.IP "" $indent}; 251175261Sobrien if ($content) 252175261Sobrien { 253175261Sobrien $table_header .= "$content\{"; 254175261Sobrien $table_footer = "\}$table_footer"; 255175261Sobrien } 256175261Sobrien } 257175261Sobrien $intable++; 258175261Sobrien next; 259175261Sobrien } 260175261Sobrien 261175261Sobrien if ($intable) 262175261Sobrien { 263175261Sobrien if (/^\@end (itemize|table)$/) 264175261Sobrien { 265175261Sobrien $table_header = pop @table_headers; 266175261Sobrien $table_footer = pop @table_footers; 267175261Sobrien $indent -= 2; 268175261Sobrien $intable--; 269175261Sobrien next; 270175261Sobrien } 271175261Sobrien s/^\@itemx?(\s+(.*))?$/$table_header$2$table_footer/; 272175261Sobrien # Fall through so the rest of the table lines are 273175261Sobrien # processed normally. 274175261Sobrien } 275175261Sobrien 276175261Sobrien # Index entries. 277175261Sobrien s/^\@cindex\s+(.*)$/.IX "$1"/; 278175261Sobrien 279175261Sobrien $_ = "$last$_" if $last; 280175261Sobrien undef $last; 281175261Sobrien 282175261Sobrien # Trap keywords 283175261Sobrien $nk = qr/ 284175261Sobrien \@(\w+)\{ 285175261Sobrien (?{ debug_print "$ret MATCHED $&\nPUSHING $1\n"; 286175261Sobrien push @parent, $1; }) # Keep track of the last keyword 287175261Sobrien # keyword we encountered. 288175261Sobrien ((?> 289175261Sobrien [^{}]|(?<=\@)[{}] # Non-braces... 290175261Sobrien | # ...or... 291175261Sobrien (??{ $nk }) # ...nested keywords... 292175261Sobrien )*) # ...without backtracking. 293175261Sobrien \} 294175261Sobrien (?{ debug_print "$ret MATCHED $&\nPOPPING ", 295175261Sobrien pop (@parent), "\n"; }) # Lose track of the current keyword. 296175261Sobrien /x; 297175261Sobrien 298175261Sobrien $ret = "m//"; 299175261Sobrien if (/\@\w+\{(?:[^{}]|(?<=\@)[{}]|(??{ $nk }))*$/) 300175261Sobrien { 301175261Sobrien # If there is an opening keyword on this line without a 302175261Sobrien # close bracket, we need to find the close bracket 303175261Sobrien # before processing the line. Set $last to append the 304175261Sobrien # next line in the next pass. 305175261Sobrien $last = $_; 306175261Sobrien next; 307175261Sobrien } 308175261Sobrien 309175261Sobrien # Okay, the following works somewhat counter-intuitively. $nk 310175261Sobrien # processes the whole line, so @parent gets loaded properly, 311175261Sobrien # then, since no closing brackets have been found for the 312175261Sobrien # outermost matches, the innermost matches match and get 313175261Sobrien # replaced first. 314175261Sobrien # 315175261Sobrien # For example: 316175261Sobrien # 317175261Sobrien # Processing the line: 318175261Sobrien # 319175261Sobrien # yadda yadda @code{yadda @var{foo} yadda @var{bar} yadda} 320175261Sobrien # 321175261Sobrien # Happens something like this: 322175261Sobrien # 323175261Sobrien # 1. Ignores "yadda yadda " 324175261Sobrien # 2. Sees "@code{" and pushes "code" onto @parent. 325175261Sobrien # 3. Ignores "yadda " (backtracks and ignores "yadda yadda 326175261Sobrien # @code{yadda "?) 327175261Sobrien # 4. Sees "@var{" and pushes "var" onto @parent. 328175261Sobrien # 5. Sees "foo}", pops "var", and realizes that "@var{foo}" 329175261Sobrien # matches the overall pattern ($nk). 330175261Sobrien # 6. Replaces "@var{foo}" with the result of: 331175261Sobrien # 332175261Sobrien # do_keyword $file, $parent[$#parent], $1, $2; 333175261Sobrien # 334175261Sobrien # which would be "\Ifoo\B", in this case, because "var" 335175261Sobrien # signals a request for italics, or "\I", and "code" is 336175261Sobrien # still on the stack, which means the previous style was 337175261Sobrien # bold, or "\B". 338175261Sobrien # 339175261Sobrien # Then the while loop restarts and a similar series of events 340175261Sobrien # replaces "@var{bar}" with "\Ibar\B". 341175261Sobrien # 342175261Sobrien # Then the while loop restarts and a similar series of events 343175261Sobrien # replaces "@code{yadda \Ifoo\B yadda \Ibar\B yadda}" with 344175261Sobrien # "\Byadda \Ifoo\B yadda \Ibar\B yadda\R". 345175261Sobrien # 346175261Sobrien $ret = "s///"; 347175261Sobrien @parent = (""); 348175261Sobrien while (s/$nk/do_keyword $file, $parent[$#parent], $1, $2/e) 349175261Sobrien { 350175261Sobrien # Do nothing except reset our last-replacement 351175261Sobrien # tracker - the replacement regex above is handling 352175261Sobrien # everything else. 353175261Sobrien debug_print "FINAL MATCH $&\n"; 354175261Sobrien @parent = (""); 355175261Sobrien } 356175261Sobrien 357175261Sobrien # Finally, unprotect texinfo special characters. 358175261Sobrien s/\@://g; 359175261Sobrien s/\@([{}])/$1/g; 360175261Sobrien 361175261Sobrien # Verify we haven't left commands unprocessed. 362175261Sobrien die "Unprocessed command at line $. of file \`$file': " 363175261Sobrien . ($1 ? "$1\n" : "<EOL>\n") 364175261Sobrien if /^(?>(?:[^\@]|\@\@)*)\@(\w+|.|$)/; 365175261Sobrien 366175261Sobrien # Unprotect @@. 367175261Sobrien s/\@\@/\@/g; 368175261Sobrien 369175261Sobrien # And print whatever's left. 370175261Sobrien print $_; 371175261Sobrien } 372175261Sobrien} 373