mkmanpages.pl

   1 #!/usr/bin/perl -w
   2
   3 # Generate manual pages for sgt-puzzles by running extracts of puzzles.but
   4 # through halibut.
   5
   6 use strict;
   7 use File::Temp;
   8 use IO::File;
   9 use Locale::PO;
  10 use POSIX ();
  11
  12 my $package = 'sgt-puzzles';
  13 my $language = $ARGV[0] or die 'mkmanpages.pl: no language specified';
  14
  15 # Fake up gettext without compilation or locales
  16 my $po_map = Locale::PO->load_file_ashash("po/$language.po");
  17 sub gettext {
  18     my $msgid = shift;
  19     my $po = $po_map->{Locale::PO->quote($msgid)};
  20     return $po ? Locale::PO->dequote($po->msgstr()) : $msgid;
  21 }
  22
  23 # Header information
  24 my $package_roff = $package;
  25 $package_roff =~ s/-/\\-/g;
  26 my $date;
  27 # Translator: conventional name for manual section 6
  28 my $section = gettext('Games');
  29 my $section_no = "6";
  30 my $man_dir = "doc/man-$language";
  31
  32 my %commands;
  33 my %short_descs;
  34 my $gamedesc = new IO::File('gamedesc.txt', 'r');
  35 while (<$gamedesc>) {
  36     (my $name, undef, undef, my $desc) = split /:/;
  37     $commands{$name} = $ENV{BINPREFIX} . $name;
  38     $short_descs{$name} = $desc;
  39 }
  40 close $gamedesc;
  41
  42 # We should be able to look these up with strftime('%A') but that
  43 # requires the relevant locale to be installed on the build host
  44 my @MONTHS = (gettext('January'), gettext('February'), gettext('March'),
  45               gettext('April'),   gettext('May'),      gettext('June'),
  46               gettext('July'),    gettext('August'),   gettext('September'),
  47               gettext('October'), gettext('November'), gettext('December'));
  48
  49 # Chapter name, initialised to dummy value to capture header
  50 my $name = '__HEADER__';
  51
  52 # Contents of each chapter/appendix
  53 my %contents;
  54
  55 # Gather chapters from the original documentation
  56 my $source_name =
  57     $language eq 'en' ? 'preprocessed.but' : "doc/preprocessed.but.$language";
  58 my $source = new IO::File($source_name, 'r') or die "$source_name: $!";
  59 while (<$source>) {
  60     # Look for chapter/appendix heading
  61     if (/^\\[AC]{([^}]+)}\s*/) {
  62         $name = $1;
  63         # The odd one out - chapter name doesn't match command name
  64         if ($name eq 'rectangles') {
  65             $name = 'rect';
  66         }
  67     }
  68     # Look for version ID with date
  69     if (/^\\versionid .* (\d{4})(\d{2})\d{2}\./) {
  70         $date = "${MONTHS[$2-1]} $1";
  71     }
  72     $contents{$name} .= $_;
  73 }
  74 close $source;
  75
  76 # Remove all normal text from the header
  77 $contents{__HEADER__} =~ s/^(?!\\(?:cfg|define|title){).*$//gm;
  78
  79 # Remove introduction from "common features" chapter
  80 $contents{common} =~ s/^.*?(?=\\H\{)//s;
  81
  82 for my $short_name (keys %commands) {
  83     my $command = $commands{$short_name};
  84     print "Generating $command.6\n";
  85
  86     my $text_name = $language eq 'en' ? 'puzzles.txt' : "puzzles.txt.$language";
  87     my $contents =
  88       "\\cfg{man-mindepth}{1}\n" # don't show original chapter headings
  89       . "\\cfg{man-identity}{".uc($command)."}{$section_no}{$date}{$command ($package_roff)}{$section}\n\n"
  90       . "\\cfg{man-charset}{UTF-8}\n" # output encoding
  91       . $contents{__HEADER__}
  92       . "\\C{man-$command} $command\n\n" # dummy chapter
  93       . "\\H{man-$command-name} " . gettext('NAME') . "\n\n"
  94       . "\\c{$command} \\- $short_descs{$short_name}\n\n"
  95       . "\\H{man-$command-synopsis} " . gettext('SYNOPSIS') . "\n\n"
  96       # Translator: abbreviation for 'number'
  97       . "\\cw{$command} [\\cw{--generate }\\e{" . gettext('n') . "}]\n"
  98       # Translator: abbreviation for 'width'
  99       . "[\\cw{--print }\\e{" . gettext('w') . "}\\cw{x}\\e{"
 100       # Translator: abbreviation for 'height'
 101       . gettext('h') . "} [\\cw{--with-solutions}]\n"
 102       . "[\\cw{--scale }\\e{" . gettext('n') . "}] [\\cw{--colour}]]\n"
 103       . "[\\e{" . gettext('game-parameters') . "}|\\e{" . gettext('game-ID')
 104       . "}|\\e{" . gettext('random-seed') . "}]\n\n"
 105       . "\\cw{$command --version}\n\n"
 106       . "\\H{man-$command-desc} " . gettext('DESCRIPTION') . "\n\n"
 107       . $contents{$short_name}
 108       . $contents{common}
 109       . "\\H{man-$command-see-also} " . gettext('SEE ALSO') . "\n\n"
 110       # Translator: "Full documentation in <filename>."
 111       . sprintf(gettext("Full documentation in %s."),
 112                 "/usr/share/doc/$package/$text_name.gz")
 113       . "\n";
 114
 115     # Kluge cross-references
 116     sub replace_ref {
 117         my ($above, $target, $below) = @_;
 118         # If the target is an earlier or later section in the current page, say
 119         # it's above or below.
 120         if ($above =~ m/\\(?:[CHA]|S\d*){$target}/) {
 121             # Translator: earlier in the manual page
 122             gettext('above');
 123         } elsif ($below =~ m/\\(?:[CHA]|S\d*){$target}/) {
 124             # Translator: later in the manual page
 125             gettext('below');
 126         }
 127         # Else if the target is a bibliographic entry, include the entry directly.
 128         elsif ($below =~ m/\\B\{$target\}\s*(.*?)\s*(?:\\(?:[BCHA]|S\d*|$))/s) {
 129             "($1)";
 130         }
 131         # Else if it appears to refer to another game, convert to a customary
 132         # cross-manual-page reference.
 133         elsif ($target =~ /(\w+)/ && exists $commands{$1}) {
 134             "\\e{$commands{$1}}($section_no)";
 135         }
 136         # Otherwise (and this shouldn't happen), show the reference target.
 137         else {
 138             print STDERR "Failed to resolve reference to $target\n";
 139             $target;
 140         }
 141     }
 142     $contents =~ s/(?:\bin\s+)?\\[kK]{([^}]+)}/replace_ref($`, $1, $')/eg;
 143
 144     # Run through halibut.  It does not default to using stdin or stdout,
 145     # and /dev/std{in,out} apparently don't exist on some systems, so we
 146     # can't reliably do this with a pipeline.
 147     my ($temp_but, $temp_but_name) = mkstemp "/tmp/sgt-puzzles-but-XXXXXX"
 148       or die "$!";
 149     my $man_name = "$command.$section_no";
 150     print $temp_but $contents or die "$!";
 151     close $temp_but;
 152     system "halibut --man=$man_dir/$man_name --input-charset=UTF-8 $temp_but_name";
 153     unlink $temp_but_name;
 154     -s "$man_dir/$man_name" or die "halibut produced an empty $man_name";
 155 }
 156
 157 exit;