contrib/cvs-1.12.11/doc/mkman.pl

   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'.
  26 require 5.005;
  27
  28 # The usual.
  29 use strict;
  30 use IO::File;
  31
  32
  33
  34 ###
  35 ### GLOBALS
  36 ###
  37 my $texi_num = 0; # Keep track of how many texinfo files have been encountered.
  38 my @parent;       # This needs to be global to be used inside of a regex later.
  39
  40
  41
  42 ###
  43 ### FUNCTIONS
  44 ###
  45 sub keyword_mode
  46 {
  47         my ($keyword, $file) = @_;
  48
  49         return "\\fR"
  50                 if $keyword =~ /^(|r|t)$/;
  51         return "\\fB"
  52                 if $keyword =~ /^(strong|sc|code|file|samp)$/;
  53         return "\\fI"
  54                 if $keyword =~ /^(emph|var|dfn)$/;
  55         die "no handler for keyword \`$keyword', found at line $. of file \`$file'\n";
  56 }
  57
  58
  59
  60 # Return replacement for \@$keyword{$content}.
  61 sub do_keyword
  62 {
  63         my ($file, $parent, $keyword, $content) = @_;
  64
  65         return "see node \`$content\\(aq in the CVS manual"
  66                 if $keyword =~ /^(p?x)?ref$/;
  67         return "\\fP\\fP$content"
  68                 if $keyword =~ /^splitrcskeyword$/;
  69
  70         my $endmode = keyword_mode $parent;
  71         my $startmode = keyword_mode $keyword, $file;
  72
  73         return "$startmode$content$endmode";
  74 }
  75
  76
  77
  78 ###
  79 ### MAIN
  80 ###
  81 for my $file (@ARGV)
  82 {
  83         my $fh = new IO::File "< $file"
  84                 or die "Failed to open file \`$file': $!";
  85
  86         if ($file !~ /\.(texinfo|texi|txi)$/)
  87         {
  88                 print stderr "Passing \`$file' through unprocessed.\n";
  89                 # Just cat any file that doesn't look like a Texinfo source.
  90                 while (my $line = $fh->getline)
  91                 {
  92                         print $line;
  93                 }
  94                 next;
  95         }
  96
  97         print stderr "Processing \`$file'.\n";
  98         $texi_num++;
  99         my $gotone = 0;
 100         my $inblank = 0;
 101         my $indent = 0;
 102         my $inexample = 0;
 103         my $inmenu = 0;
 104         my $intable = 0;
 105         my $last_header = "";
 106         my @table_headers;
 107         my @table_footers;
 108         my $table_header = "";
 109         my $table_footer = "";
 110         my $last;
 111         while ($_ = $fh->getline)
 112         {
 113                 if (!$gotone && /^\@c ----- START MAN $texi_num -----$/)
 114                 {
 115                         $gotone = 1;
 116                         next;
 117                 }
 118
 119                 # Skip ahead until our man section.
 120                 next unless $gotone;
 121
 122                 # If we find the end tag we are done.
 123                 last if /^\@c ----- END MAN $texi_num -----$/;
 124
 125                 # Need to do this everywhere.  i.e., before we print example
 126                 # lines, since literal back slashes can appear there too.
 127                 s/\\/\\\\/g;
 128                 s/^\./\\&./;
 129                 s/([\s])\./$1\\&./;
 130                 s/'/\\(aq/g;
 131                 s/`/\\`/g;
 132                 s/(?<!-)---(?!-)/\\(em/g;
 133                 s/\@bullet({}|\b)/\\(bu/g;
 134                 s/\@dots({}|\b)/\\&.../g;
 135
 136                 # Examples should be indented and otherwise untouched
 137                 if (/^\@example$/)
 138                 {
 139                         $indent += 2;
 140                         print qq{.SP\n.PD 0\n};
 141                         $inexample = 1;
 142                         next;
 143                 }
 144                 if ($inexample)
 145                 {
 146                         if (/^\@end example$/)
 147                         {
 148                                 $indent -= 2;
 149                                 print qq{\n.PD\n.IP "" $indent\n};
 150                                 $inexample = 0;
 151                                 next;
 152                         }
 153                         if (/^[         ]*$/)
 154                         {
 155                                 print ".SP\n";
 156                                 next;
 157                         }
 158
 159                         # Preserve the newline.
 160                         $_ = qq{.IP "" $indent\n} . $_;
 161                 }
 162
 163                 # Compress blank lines into a single line.  This and its
 164                 # corresponding skip purposely bracket the @menu and comment
 165                 # removal so that blanks on either side of a menu are
 166                 # compressed after the menu is removed.
 167                 if (/^[         ]*$/)
 168                 {
 169                         $inblank = 1;
 170                         next;
 171                 }
 172
 173                 # Not used
 174                 if (/^\@(ignore|menu)$/)
 175                 {
 176                         $inmenu++;
 177                         next;
 178                 }
 179                 # Delete menu contents.
 180                 if ($inmenu)
 181                 {
 182                         next unless /^\@end (ignore|menu)$/;
 183                         $inmenu--;
 184                         next;
 185                 }
 186
 187                 # Remove comments
 188                 next if /^\@c(omment)?\b/;
 189
 190                 # Ignore includes.
 191                 next if /^\@include\b/;
 192
 193                 # It's okay to ignore this keyword - we're not using any
 194                 # first-line indent commands at all.
 195                 next if s/^\@noindent\s*$//;
 196
 197                 # @need is only significant in printed manuals.
 198                 next if s/^\@need\s+.*$//;
 199
 200                 # If we didn't hit the previous check and $inblank is set, then
 201                 # we just finished with some number of blanks.  Print the man
 202                 # page blank symbol before continuing processing of this line.
 203                 if ($inblank)
 204                 {
 205                         print ".SP\n";
 206                         $inblank = 0;
 207                 }
 208
 209                 # Chapter headers.
 210                 $last_header = $1 if s/^\@node\s+(.*)$/.SH "$1"/;
 211                 if (/^\@appendix\w*\s+(.*)$/)
 212                 {
 213                         my $content = $1;
 214                         $content =~ s/^$last_header(\\\(em|\s+)?//;
 215                         next if $content =~ /^\s*$/;
 216                         s/^\@appendix\w*\s+.*$/.SS "$content"/;
 217                 }
 218
 219                 # Tables are similar to examples, except we need to handle the
 220                 # keywords.
 221                 if (/^\@(itemize|table)(\s+(.*))?$/)
 222                 {
 223                         $indent += 2;
 224                         push @table_headers, $table_header;
 225                         push @table_footers, $table_footer;
 226                         my $content = $3;
 227                         if (/^\@itemize/)
 228                         {
 229                                 my $bullet = $content;
 230                                 $table_header = qq{.IP "$bullet" $indent\n};
 231                                 $table_footer = "";
 232                         }
 233                         else
 234                         {
 235                                 my $hi = $indent - 2;
 236                                 $table_header = qq{.IP "" $hi\n};
 237                                 $table_footer = qq{\n.IP "" $indent};
 238                                 if ($content)
 239                                 {
 240                                         $table_header .= "$content\{";
 241                                         $table_footer = "\}$table_footer";
 242                                 }
 243                         }
 244                         $intable++;
 245                         next;
 246                 }
 247
 248                 if ($intable)
 249                 {
 250                         if (/^\@end (itemize|table)$/)
 251                         {
 252                                 $table_header = pop @table_headers;
 253                                 $table_footer = pop @table_footers;
 254                                 $indent -= 2;
 255                                 $intable--;
 256                                 next;
 257                         }
 258                         s/^\@itemx?(\s+(.*))?$/$table_header$2$table_footer/;
 259                         # Fall through so the rest of the table lines are
 260                         # processed normally.
 261                 }
 262
 263                 # Index entries.
 264                 s/^\@cindex\s+(.*)$/.IX "$1"/;
 265
 266                 $_ = "$last$_" if $last;
 267                 undef $last;
 268
 269                 # Trap keywords
 270                 my $nk = qr/
 271                                 \@(\w+)\{
 272                                 (?{ push @parent, $1 })       # Keep track of the last keyword
 273                                                               # keyword we encountered.
 274                                 ((?:
 275                                         (?> (?:[^{}]|(?<=\@)[{}])*) # Non-braces without backtracking
 276                                                 |
 277                                         (??{ $nk })                 # Nested keywords
 278                                 )*)
 279                                 \}
 280                                 (?{ pop (@parent) })            # Lose track of the current keyword.
 281                         /x;
 282
 283                 @parent = ("");
 284                 while (s/$nk/do_keyword $file, $parent[$#parent], $1, $2/e)
 285                 {
 286                         # Do nothing except replace our last-replacement
 287                         # tracker - the replacement regex above is handling
 288                         # everything else.
 289                         @parent = ("");
 290                 }
 291                 s/$nk/do_keyword $file, $parent[$#parent], $1, $2/ge;
 292
 293                 if (/\@\w+\{/)
 294                 {
 295                         # If there is still an opening keyword left, we need to
 296                         # find the close bracket.  Set $last to append the next
 297                         # line in the next pass.
 298                         $last = $_;
 299                         next;
 300                 }
 301
 302                 # Finally, unprotect texinfo special characters.
 303                 s/\@://g;
 304                 s/\@([{}])/$1/g;
 305
 306                 # Verify we haven't left commands unprocessed.
 307                 die "Unprocessed command at line $. of file \`$file': "
 308                     . ($1 ? "$1\n" : "<EOL>\n")
 309                         if /^(?>(?:[^\@]|\@\@)*)\@(\w+|.|$)/;
 310
 311                 # Unprotect @@.
 312                 s/\@\@/\@/g;
 313
 314                 # And print whatever's left.
 315                 print $_;
 316         }
 317 }