contrib/cvs/doc/mkman.pl

   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'.
  27 require 5.005;
  28
  29 # The usual.
  30 use strict;
  31 use IO::File;
  32
  33
  34
  35 ###
  36 ### GLOBALS
  37 ###
  38 my $texi_num = 0; # Keep track of how many texinfo files have been encountered.
  39 my @parent;       # This needs to be global to be used inside of a regex later.
  40 my $nk;           # Ditto.
  41 my $ret;          # The RE match Type, used in debug prints.
  42 my $debug = 0;    # Debug mode?
  43
  44
  45
  46 ###
  47 ### FUNCTIONS
  48 ###
  49 sub debug_print
  50 {
  51         print @_ if $debug;
  52 }
  53
  54
  55
  56 sub 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}.
  72 sub 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 ###
  94 for 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 }