help2man.PL

   1 #!/usr/bin/perl
   2
   3 #
   4 # Self extracting help2man script.
   5 #
   6 #   -q, --quiet         Suppress extraction message
   7 #   -s, --stdout        Extract to stdout
   8 #   -w, --with-gettext  Add support for localized man pages
   9 #   -n, --name          Print name only*
  10 #   -v, --version       Print version only*
  11 #
  12 # *script not created
  13 #
  14
  15 use 5.008;
  16 use Config;
  17 use Getopt::Long;
  18
  19 my ($program, $version) = ('help2man', '1.48.3');
  20
  21 my %opts;
  22 die "Usage: $0 [--quiet] [--stdout] [--with-gettext] [--name] [--version]\n"
  23     unless GetOptions \%opts, qw(quiet stdout with-gettext name version)
  24       and !@ARGV;
  25
  26 print "$program\n" if $opts{name};
  27 print "$version\n" if $opts{version};
  28 exit               if $opts{name} or $opts{version};
  29
  30 my $target = $0;
  31 my $tmp;
  32 if ($opts{stdout})
  33 {
  34     *OUT = *STDOUT;
  35     $opts{quiet} = 1;
  36 }
  37 else
  38 {
  39     $target =~ s!.*/!!;
  40     $target =~ s/\.PL$// or die "$0: can't determine target name\n";
  41     $tmp = "$target.tmp$$";
  42     unlink $tmp          or die "$0: can't unlink $tmp ($!)\n" if -e $tmp;
  43     open OUT, ">$tmp"    or die "$0: can't create $tmp ($!)\n";
  44 }
  45
  46 print "Extracting $target (with variable substitutions)\n"
  47     unless $opts{quiet};
  48
  49 # Add startup header.
  50 print OUT "$Config{startperl} -w\n";
  51
  52 # For systems without the crash-bang hack also add:
  53 print OUT <<"!GROK!THIS!" if $Config{sharpbang} !~ /^#!/;
  54 eval 'exec $Config{perlpath} -wS \$0 \${1+"\$@"}'
  55     if \$running_under_some_shell;
  56
  57 \$running_under_some_shell = 0; # for -w
  58 !GROK!THIS!
  59
  60 # No substitutions for this chunk:
  61 print OUT <<'!NO!SUBS!';
  62
  63 # Generate a short man page from --help and --version output.
  64 # Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2009,
  65 # 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2020, 2021 Free Software
  66 # Foundation, Inc.
  67
  68 # This program is free software; you can redistribute it and/or modify
  69 # it under the terms of the GNU General Public License as published by
  70 # the Free Software Foundation; either version 3, or (at your option)
  71 # any later version.
  72
  73 # This program is distributed in the hope that it will be useful,
  74 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  75 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  76 # GNU General Public License for more details.
  77
  78 # You should have received a copy of the GNU General Public License
  79 # along with this program; if not, see <http://www.gnu.org/licenses/>.
  80
  81 # Written by Brendan O'Dea <bod@debian.org>
  82 # Available from ftp://ftp.gnu.org/gnu/help2man/
  83
  84 use 5.008;
  85 use strict;
  86 use Getopt::Long;
  87 use Text::ParseWords qw(shellwords);
  88 use Text::Tabs qw(expand);
  89 use POSIX qw(strftime setlocale LC_ALL);
  90 !NO!SUBS!
  91
  92 print OUT <<'!NO!SUBS!' if $opts{'with-gettext'};
  93 use Locale::gettext qw(gettext);
  94 use Encode qw(decode encode);
  95 use I18N::Langinfo qw(langinfo CODESET);
  96 !NO!SUBS!
  97
  98 # Interpolate program name and version:
  99 print OUT <<"!GROK!THIS!";
 100
 101 my \$this_program = '$program';
 102 my \$this_version = '$version';
 103 !GROK!THIS!
 104
 105 # Conditionally include gettext support:
 106 print OUT $opts{'with-gettext'} ? <<'!WITH!GETTEXT!' : <<'!NO!GETTEXT!';
 107 my $encoding;
 108
 109 {
 110     my $gettext = Locale::gettext->domain($this_program);
 111     sub _ { $gettext->get($_[0]) }
 112
 113     my ($user_locale) = grep defined && length,
 114         (map $ENV{$_}, qw(LANGUAGE LC_ALL LC_MESSAGES LANG)), 'C';
 115
 116     my $user_encoding = langinfo CODESET;
 117
 118     # Set localisation of date and executable's output.
 119     sub configure_locale
 120     {
 121         delete @ENV{qw(LANGUAGE LC_MESSAGES LANG)};
 122         setlocale LC_ALL, $ENV{LC_ALL} = shift || 'C';
 123         $encoding = langinfo CODESET;
 124     }
 125
 126     sub dec { $encoding ? decode $encoding, $_[0] : $_[0] }
 127     sub enc { $encoding ? encode $encoding, $_[0] : $_[0] }
 128     sub enc_user { encode $user_encoding, $_[0] }
 129     sub kark # die with message formatted in the invoking user's locale
 130     {
 131         setlocale LC_ALL, $user_locale;
 132         my $fmt = $gettext->get(shift);
 133         my $errmsg = enc_user sprintf $fmt, @_;
 134         die $errmsg, "\n";
 135     }
 136 }
 137
 138 !WITH!GETTEXT!
 139
 140 sub _ { $_[0] }
 141 sub configure_locale
 142 {
 143     my $locale = shift;
 144     die "$this_program: no locale support (Locale::gettext required)\n"
 145         unless $locale eq 'C';
 146 }
 147
 148 sub dec { $_[0] }
 149 sub enc { $_[0] }
 150 sub enc_user { $_[0] }
 151 sub kark { die +(sprintf shift, @_), "\n" }
 152 !NO!GETTEXT!
 153
 154 # No substitutions for this chunk:
 155 print OUT <<'!NO!SUBS!';
 156 sub N_ { $_[0] }
 157
 158 sub program_basename;
 159 sub get_option_value;
 160 sub convert_option;
 161 sub fix_italic_spacing;
 162
 163 my $version_info = enc_user sprintf _(<<'EOT'), $this_program, $this_version;
 164 GNU %s %s
 165
 166 Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2009,
 167 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2020, 2021 Free Software
 168 Foundation, Inc.
 169 This is free software; see the source for copying conditions.  There is NO
 170 warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 171
 172 Written by Brendan O'Dea <bod@debian.org>
 173 EOT
 174
 175 my $help_info = enc_user sprintf _(<<'EOT'), $this_program, $this_program;
 176 `%s' generates a man page out of `--help' and `--version' output.
 177
 178 Usage: %s [OPTION]... EXECUTABLE
 179
 180  -n, --name=STRING       description for the NAME paragraph
 181  -s, --section=SECTION   section number for manual page (1, 6, 8)
 182  -m, --manual=TEXT       name of manual (User Commands, ...)
 183  -S, --source=TEXT       source of program (FSF, Debian, ...)
 184  -L, --locale=STRING     select locale (default "C")
 185  -i, --include=FILE      include material from `FILE'
 186  -I, --opt-include=FILE  include material from `FILE' if it exists
 187  -o, --output=FILE       send output to `FILE'
 188  -p, --info-page=TEXT    name of Texinfo manual
 189  -N, --no-info           suppress pointer to Texinfo manual
 190  -l, --libtool           exclude the `lt-' from the program name
 191      --help              print this help, then exit
 192      --version           print version number, then exit
 193
 194 EXECUTABLE should accept `--help' and `--version' options and produce output on
 195 stdout although alternatives may be specified using:
 196
 197  -h, --help-option=STRING     help option string
 198  -v, --version-option=STRING  version option string
 199  --version-string=STRING      version string
 200  --no-discard-stderr          include stderr when parsing option output
 201
 202 Report bugs to <bug-help2man@gnu.org>.
 203 EOT
 204
 205 my $section = 1;
 206 my $manual = '';
 207 my $source = '';
 208 my $help_option = '--help';
 209 my $version_option = '--version';
 210 my $discard_stderr = 1;
 211 my ($opt_name, @opt_include, $opt_output, $opt_info, $opt_no_info, $opt_libtool,
 212     $version_text);
 213
 214 my %opt_def = (
 215     'n|name=s'           => \$opt_name,
 216     's|section=s'        => \$section,
 217     'm|manual=s'         => \$manual,
 218     'S|source=s'         => \$source,
 219     'L|locale=s'         => sub { configure_locale pop },
 220     'i|include=s'        => sub { push @opt_include, [ pop, 1 ] },
 221     'I|opt-include=s'    => sub { push @opt_include, [ pop, 0 ] },
 222     'o|output=s'         => \$opt_output,
 223     'p|info-page=s'      => \$opt_info,
 224     'N|no-info'          => \$opt_no_info,
 225     'l|libtool'          => \$opt_libtool,
 226     'help'               => sub { print $help_info; exit },
 227     'version'            => sub { print $version_info; exit },
 228     'h|help-option=s'    => \$help_option,
 229     'v|version-option=s' => \$version_option,
 230     'version-string=s'   => \$version_text,
 231     'discard-stderr!'    => \$discard_stderr,
 232 );
 233
 234 # Parse options.
 235 Getopt::Long::config('bundling');
 236 die $help_info unless GetOptions %opt_def and @ARGV == 1;
 237
 238 !NO!SUBS!
 239
 240 print OUT <<'!NO!SUBS!' if $opts{'with-gettext'};
 241 configure_locale unless $encoding;
 242
 243 !NO!SUBS!
 244
 245 # No substitutions for the remainder of the script:
 246 print OUT <<'!NO!SUBS!';
 247 my %include = ();
 248 my %replace = ();
 249 my %append = ();
 250 my %append_match = ();
 251 my @sections = ();  # retain order of include file or in-line *section*s
 252
 253 # Process include file (if given).  Format is:
 254 #
 255 #   Optional initial text, ignored.  May include lines starting with `-'
 256 #   which are processed as options.
 257 #
 258 #   [section]
 259 #   Verbatim text to be included in the named section.  By default at
 260 #   the start, but in the case of `name' and `synopsis' the content
 261 #   will replace the autogenerated contents.
 262 #
 263 #   [<section]
 264 #   Verbatim text to be inserted at the start of the named section.
 265 #
 266 #   [=section]
 267 #   Verbatim text to replace the named section.
 268 #
 269 #   [>section]
 270 #   Verbatim text to be appended to the end of the named section.
 271 #
 272 #   /pattern/
 273 #   Verbatim text for inclusion below a paragraph matching `pattern'.
 274 #
 275
 276 while (@opt_include)
 277 {
 278     my ($inc, $required) = @{shift @opt_include};
 279
 280     next unless -f $inc or $required;
 281     kark N_("%s: can't open `%s' (%s)"), $this_program, $inc, $!
 282         unless open INC, $inc;
 283
 284     my $key;
 285     my $hash;
 286
 287     while (<INC>)
 288     {
 289         # Convert input to internal Perl format, so that multibyte
 290         # sequences are treated as single characters.
 291         $_ = dec $_;
 292
 293         # [section]
 294         if (/^\[([^]]+)\]\s*$/)
 295         {
 296             $key = uc $1;
 297             $key =~ s/^\s+//;
 298             $key =~ s/\s+$//;
 299             $hash = \%include;
 300             # Handle explicit [<section], [=section] and [>section]
 301             if ($key =~ s/^([<>=])\s*//)
 302             {
 303                 if    ($1 eq '>') { $hash = \%append; }
 304                 elsif ($1 eq '=') { $hash = \%replace; }
 305             }
 306             # NAME/SYNOPSIS replace by default
 307             elsif ($key eq _('NAME') or $key eq _('SYNOPSIS'))
 308             {
 309                 $hash = \%replace;
 310             }
 311             else
 312             {
 313                 $hash = \%include;
 314             }
 315
 316             push @sections, $key;
 317             next;
 318         }
 319
 320         # /pattern/
 321         if (m!^/(.*)/([ims]*)\s*$!)
 322         {
 323             my $pat = $2 ? "(?$2)$1" : $1;
 324
 325             # Check pattern.
 326             eval { $key = qr($pat) };
 327             if ($@)
 328             {
 329                 $@ =~ s/ at .*? line \d.*//;
 330                 die "$inc:$.:$@";
 331             }
 332
 333             $hash = \%append_match;
 334             next;
 335         }
 336
 337         # Check for options before the first section--anything else is
 338         # silently ignored, allowing the first for comments and
 339         # revision info.
 340         unless ($key)
 341         {
 342             # handle options
 343             if (/^-/)
 344             {
 345                 local @ARGV = shellwords $_;
 346                 GetOptions %opt_def;
 347             }
 348
 349             next;
 350         }
 351
 352         $hash->{$key} .= $_;
 353     }
 354
 355     close INC;
 356
 357     kark N_("%s: no valid information found in `%s'"), $this_program, $inc
 358         unless $key;
 359 }
 360
 361 # Compress trailing blank lines.
 362 for my $hash (\(%include, %replace, %append, %append_match))
 363 {
 364     for (keys %$hash) { $hash->{$_} =~ s/\n+$/\n/ }
 365 }
 366
 367 # Grab help and version info from executable.
 368 my $help_text   = get_option_value $ARGV[0], $help_option;
 369 $version_text ||= get_option_value $ARGV[0], $version_option;
 370
 371 # By default the generated manual pages will include the current date.  This may
 372 # however be overriden by setting the environment variable $SOURCE_DATE_EPOCH to
 373 # an integer value of the seconds since the UNIX epoch.  This is primarily
 374 # intended to support reproducible builds (wiki.debian.org/ReproducibleBuilds)
 375 # and will additionally ensure that the output date string is UTC.
 376 my $epoch_secs = time;
 377 if (exists $ENV{SOURCE_DATE_EPOCH} and $ENV{SOURCE_DATE_EPOCH} =~ /^(\d+)$/)
 378 {
 379     $epoch_secs = $1;
 380     $ENV{TZ} = 'UTC0';
 381 }
 382
 383 # Translators: the following message is a strftime(3) format string, which in
 384 # the English version expands to the month as a word and the full year.  It
 385 # is used on the footer of the generated manual pages.  If in doubt, you may
 386 # just use %x as the value (which should be the full locale-specific date).
 387 my $date = enc strftime _("%B %Y"), localtime $epoch_secs;
 388 my $program = program_basename $ARGV[0];
 389 my $package = $program;
 390 my $version;
 391
 392 if ($opt_output)
 393 {
 394     unlink $opt_output or kark N_("%s: can't unlink %s (%s)"),
 395         $this_program, $opt_output, $! if -e $opt_output;
 396
 397     open STDOUT, ">$opt_output"
 398         or kark N_("%s: can't create %s (%s)"), $this_program, $opt_output, $!;
 399 }
 400
 401 # The first line of the --version information is assumed to be in one
 402 # of the following formats:
 403 #
 404 #   <version>
 405 #   <program> <version>
 406 #   {GNU,Free} <program> <version>
 407 #   <program> ({GNU,Free,} <package>) <version>
 408 #   <program> - {GNU,Free,} <package> <version>
 409 #   <program> - {GNU,Free,} <package> - <version>
 410 #
 411 # and separated from any copyright/author details by a blank line.
 412
 413 ($_, $version_text) = ((split /\n+/, $version_text, 2), '');
 414
 415 if (/^(\S+) +\(((?:(?:GNU|Free) +)?[^)]+)\) +(\S.*)$/ or
 416     /^(\S+) +- +((?:(?:GNU|Free) +)?\S.*) +- +(\S.*)$/ or
 417     /^(\S+) +- +((?:(?:GNU|Free) +)?\S+) +(\S.*)$/)
 418 {
 419     $program = program_basename $1;
 420     $package = $2;
 421     $version = $3;
 422 }
 423 elsif (/^((?:GNU|Free) +)?(\S+) +(\S.*)$/)
 424 {
 425     $program = program_basename $2;
 426     $package = $1 ? "$1$program" : $program;
 427     $version = $3;
 428 }
 429 else
 430 {
 431     $version = $_;
 432 }
 433
 434 # No info for `info' itself.
 435 $opt_no_info = 1 if $program eq 'info';
 436
 437 if ($opt_name)
 438 {
 439     # --name overrides --include contents.
 440     $replace{_('NAME')} = "$program \\- $opt_name\n";
 441 }
 442
 443 # Translators: "NAME", "SYNOPSIS" and other one or two word strings in all
 444 # upper case are manual page section headings.  The man(1) manual page in your
 445 # language, if available should provide the conventional translations.
 446 for ($replace{_('NAME')} || ($include{_('NAME')} ||= ''))
 447 {
 448     if ($_) # Use first name given as $program
 449     {
 450         $program = $1 if /^([^\s,]+)(?:,?\s*[^\s,\\-]+)*\s+\\?-/;
 451     }
 452     else # Set a default (useless) NAME paragraph.
 453     {
 454         $_ = sprintf _("%s \\- manual page for %s %s") . "\n", $program,
 455             $program, $version;
 456     }
 457 }
 458
 459 # Man pages traditionally have the page title in caps.
 460 my $PROGRAM = uc $program;
 461
 462 # Set default page head/footers
 463 $source ||= "$package $version";
 464 unless ($manual)
 465 {
 466     for ($section)
 467     {
 468         if (/^(1[Mm]|8)/) { $manual = enc _('System Administration Utilities') }
 469         elsif (/^6/)      { $manual = enc _('Games') }
 470         else              { $manual = enc _('User Commands') }
 471     }
 472 }
 473
 474 # Extract usage clause(s) [if any] for SYNOPSIS.
 475 # Translators: "Usage" and "or" here are patterns (regular expressions) which
 476 # are used to match the usage synopsis in program output.  An example from cp
 477 # (GNU coreutils) which contains both strings:
 478 #  Usage: cp [OPTION]... [-T] SOURCE DEST
 479 #    or:  cp [OPTION]... SOURCE... DIRECTORY
 480 #    or:  cp [OPTION]... -t DIRECTORY SOURCE...
 481 my $PAT_USAGE = _('Usage');
 482 my $PAT_USAGE_CONT = _('or');
 483 if ($help_text =~ s/^($PAT_USAGE):( +(\S+))(.*)((?:\n(?: {6}\1| *($PAT_USAGE_CONT): +\S).*)*)//om)
 484 {
 485     my @syn = $3 . $4;
 486
 487     if ($_ = $5)
 488     {
 489         s/^\n//;
 490         for (split /\n/) { s/^ *(($PAT_USAGE_CONT): +)?//o; push @syn, $_ }
 491     }
 492
 493     my $synopsis = '';
 494     for (@syn)
 495     {
 496         $synopsis .= ".br\n" if $synopsis;
 497         s!^\S*/!!;
 498         s/^lt-// if $opt_libtool;
 499         s/^(\S+) *//;
 500         $synopsis .= ".B $1\n";
 501         s/\s+$//;
 502         s/(([][]|\.\.+)+)/\\fR$1\\fI/g;
 503         s/^/\\fI/ unless s/^\\fR//;
 504         $_ .= '\fR';
 505         s/(\\fI)( *)/$2$1/g;
 506         s/\\fI\\fR//g;
 507         s/^\\fR//;
 508         s/\\fI$//;
 509         s/^\./\\&./;
 510
 511         $_ = fix_italic_spacing $_;
 512         $synopsis .= "$_\n";
 513     }
 514
 515     $include{_('SYNOPSIS')} .= $synopsis;
 516 }
 517
 518 # Process text, initial section is DESCRIPTION.
 519 my $sect = _('DESCRIPTION');
 520 $_ = "$help_text\n\n$version_text";
 521
 522 # Normalise paragraph breaks.
 523 s/^\n+//;
 524 s/\n*$/\n/;
 525 s/\n\n+/\n\n/g;
 526
 527 # Join hyphenated lines.
 528 s/([A-Za-z])-\n *([A-Za-z])/$1$2/g;
 529
 530 # Temporarily exchange leading dots, apostrophes and backslashes for
 531 # tokens.
 532 s/^\./\x80/mg;
 533 s/^'/\x81/mg;
 534 s/\\/\x82/g;
 535
 536 # Translators: patterns are used to match common program output. In the source
 537 # these strings are all of the form of "my $PAT_something = _('...');" and are
 538 # regular expressions.  If there is more than one commonly used string, you
 539 # may separate alternatives with "|".  Spaces in these expressions are written
 540 # as " +" to indicate that more than one space may be matched.  The string
 541 # "(?:[\\w-]+ +)?" in the bug reporting pattern is used to indicate an
 542 # optional word, so that either "Report bugs" or "Report _program_ bugs" will
 543 # be matched.
 544 my $PAT_BUGS          = _('Report +(?:[\w-]+ +)?bugs|Email +bug +reports +to');
 545 my $PAT_AUTHOR        = _('Written +by');
 546 my $PAT_OPTIONS       = _('Options');
 547 my $PAT_ENVIRONMENT   = _('Environment');
 548 my $PAT_FILES         = _('Files');
 549 my $PAT_EXAMPLES      = _('Examples');
 550 my $PAT_FREE_SOFTWARE = _('This +is +free +software');
 551
 552 # Start a new paragraph (if required) for these.
 553 s/([^\n])\n($PAT_BUGS|$PAT_AUTHOR) /$1\n\n$2 /og;
 554
 555 # Convert iso-8859-1 copyright symbol or (c) to nroff
 556 # character.
 557 s/^Copyright +(?:\xa9|\([Cc]\))/Copyright \\(co/mg;
 558
 559 while (length)
 560 {
 561     # Convert some standard paragraph names.
 562     if (s/^($PAT_OPTIONS): *\n+//o)
 563     {
 564         $sect = _('OPTIONS');
 565         next;
 566     }
 567     if (s/^($PAT_ENVIRONMENT): *\n+//o)
 568     {
 569         $sect = _('ENVIRONMENT');
 570         next;
 571     }
 572     if (s/^($PAT_FILES): *\n+//o)
 573     {
 574         $sect = _('FILES');
 575         next;
 576     }
 577     elsif (s/^($PAT_EXAMPLES): *\n+//o)
 578     {
 579         $sect = _('EXAMPLES');
 580         next;
 581     }
 582
 583     # Custom section indicated by a line containing "*Section Name*".
 584     if (s/^\*(\w(.*\w)?)\* *\n+//)
 585     {
 586         $sect = uc $1;
 587         $sect =~ tr/*/ /;  # also accept *Section*Name*
 588         push @sections, $sect;
 589         next;
 590     }
 591
 592     # Copyright section.
 593     if (/^Copyright /)
 594     {
 595         $sect = _('COPYRIGHT');
 596     }
 597
 598     # Bug reporting section.
 599     elsif (/^($PAT_BUGS) /o)
 600     {
 601         $sect = _('REPORTING BUGS');
 602     }
 603
 604     # Author section.
 605     elsif (/^($PAT_AUTHOR)/o)
 606     {
 607         $sect = _('AUTHOR');
 608     }
 609
 610     # Examples, indicated by an indented leading $, % or > are
 611     # rendered in a constant width font.
 612     if (/^( +)([\$\%>] )\S/)
 613     {
 614         my $indent = $1;
 615         my $prefix = $2;
 616         my $break = '.IP';
 617         while (s/^$indent\Q$prefix\E(\S.*)\n*//)
 618         {
 619             $include{$sect} .= "$break\n\\f(CW$prefix$1\\fR\n";
 620             $break = '.br';
 621         }
 622
 623         next;
 624     }
 625
 626     my $matched = '';
 627
 628     # Sub-sections have a trailing colon and the second line indented.
 629     if (s/^(\S.*:) *\n / /)
 630     {
 631         $matched .= $& if %append_match;
 632         $include{$sect} .= qq(.SS "$1"\n);
 633     }
 634
 635     my $indent = 0;
 636     my $content = '';
 637
 638     # Option with description.
 639     if (s/^( {1,10}([+-]\S.*?))(?:(  +(?!-))|\n( {20,}))(\S.*)\n//)
 640     {
 641         $matched .= $& if %append_match;
 642         $indent = length ($4 || "$1$3");
 643         $content = ".TP\n\x84$2\n\x84$5\n";
 644         unless ($4)
 645         {
 646             # Indent may be different on second line.
 647             $indent = length $& if /^ {20,}/;
 648         }
 649     }
 650
 651     # Option without description.
 652     elsif (s/^ {1,10}([+-]\S.*)\n//)
 653     {
 654         $matched .= $& if %append_match;
 655         $content = ".HP\n\x84$1\n";
 656         $indent = 80; # not continued
 657     }
 658
 659     # Indented paragraph with tag.
 660     elsif (s/^( +(\S.*?))(?:(  +)|\n( {20,}))(\S.*)\n//)
 661     {
 662         $matched .= $& if %append_match;
 663         $indent = length ($4 || "$1$3");
 664         $content = ".TP\n\x84$2\n\x84$5\n";
 665     }
 666
 667     # Indented paragraph.
 668     elsif (s/^( +)(\S.*)\n//)
 669     {
 670         $matched .= $& if %append_match;
 671         $indent = length $1;
 672         $content = ".IP\n\x84$2\n";
 673     }
 674
 675     # Left justified paragraph.
 676     else
 677     {
 678         s/(.*)\n//;
 679         $matched .= $& if %append_match;
 680         $content = ".PP\n" if $include{$sect};
 681         $content .= "$1\n";
 682     }
 683
 684     # Append continuations.
 685     while ($indent ? s/^ {$indent}(\S.*)\n// : s/^(\S.*)\n//)
 686     {
 687         $matched .= $& if %append_match;
 688         $content .= "\x84$1\n";
 689     }
 690
 691     # Move to next paragraph.
 692     s/^\n+//;
 693
 694     for ($content)
 695     {
 696         # Leading dot and apostrophe protection.
 697         s/\x84\./\x80/g;
 698         s/\x84'/\x81/g;
 699         s/\x84//g;
 700
 701         # Examples should be verbatim.
 702         unless ($sect eq _('EXAMPLES'))
 703         {
 704             # Convert options.
 705             s/(^|[ (])(-[][\w=-]+)/$1 . convert_option $2/mge;
 706
 707             # Italicise filenames: /a/b, $VAR/c/d, ~/e/f
 708             s!
 709                 (^|[ (])                        # space/punctuation before
 710                 (
 711                     (?:\$\w+|~)?                # leading variable, or tilde
 712                     (?:/\w(?:[\w.-]*\w)?)+      # path components
 713                 )
 714                 ($|[ ,;.)])                     # space/punctuation after
 715             !$1\\fI$2\\fP$3!xmg;
 716
 717             $_ = fix_italic_spacing $_;
 718         }
 719
 720         # Escape remaining hyphens.
 721         s/-/\x83/g;
 722
 723         if ($sect eq _('COPYRIGHT'))
 724         {
 725             # Insert line breaks before additional copyright messages
 726             # and the disclaimer.
 727             s/\n(Copyright |$PAT_FREE_SOFTWARE)/\n.br\n$1/og;
 728         }
 729         elsif ($sect eq _('REPORTING BUGS'))
 730         {
 731             # Handle multi-line bug reporting sections of the form:
 732             #
 733             #   Report <program> bugs to <addr>
 734             #   GNU <package> home page: <url>
 735             #   ...
 736             s/\n([[:upper:]])/\n.br\n$1/g;
 737         }
 738     }
 739
 740     # Check if matched paragraph contains /pat/.
 741     if (%append_match)
 742     {
 743         for my $pat (keys %append_match)
 744         {
 745             if ($matched =~ $pat)
 746             {
 747                 $content .= ".PP\n" unless $append_match{$pat} =~ /^\./;
 748                 $content .= $append_match{$pat};
 749             }
 750         }
 751     }
 752
 753     $include{$sect} .= $content;
 754 }
 755
 756 # Refer to the real documentation.
 757 unless ($opt_no_info)
 758 {
 759     my $info_page = $opt_info || $program;
 760
 761     $sect = _('SEE ALSO');
 762     $include{$sect} .= ".PP\n" if $include{$sect};
 763     $include{$sect} .= sprintf _(<<'EOT'), $program, $program, $info_page;
 764 The full documentation for
 765 .B %s
 766 is maintained as a Texinfo manual.  If the
 767 .B info
 768 and
 769 .B %s
 770 programs are properly installed at your site, the command
 771 .IP
 772 .B info %s
 773 .PP
 774 should give you access to the complete manual.
 775 EOT
 776 }
 777
 778 # Append additional text.
 779 while (my ($sect, $text) = each %append)
 780 {
 781     $include{$sect} .= $append{$sect};
 782 }
 783
 784 # Replace sections.
 785 while (my ($sect, $text) = each %replace)
 786 {
 787     $include{$sect} = $replace{$sect};
 788 }
 789
 790 # Output header.
 791 print <<EOT;
 792 .\\" DO NOT MODIFY THIS FILE!  It was generated by $this_program $this_version.
 793 .TH $PROGRAM "$section" "$date" "$source" "$manual"
 794 EOT
 795
 796 # Section ordering.
 797 my @pre = (_('NAME'), _('SYNOPSIS'), _('DESCRIPTION'), _('OPTIONS'));
 798 my @post = (_('ENVIRONMENT'), _('FILES'), _('EXAMPLES'), _('AUTHOR'),
 799     _('REPORTING BUGS'), _('COPYRIGHT'), _('SEE ALSO'));
 800 my %filter = map { $_ => 1 } @pre, @post;
 801
 802 # Output content.
 803 my %done;
 804 for my $sect (@pre, (grep !$filter{$_}, @sections), @post)
 805 {
 806     next if $done{$sect}++;  # ignore duplicates
 807     next unless $include{$sect};
 808     if ($include{$sect})
 809     {
 810         my $quote = $sect =~ /\W/ ? '"' : '';
 811         print enc ".SH $quote$sect$quote\n";
 812
 813         for ($include{$sect})
 814         {
 815             # Replace leading dot, apostrophe, backslash and hyphen
 816             # tokens.
 817             s/\x80/\\&./g;
 818             s/\x81/\\&'/g;
 819             s/\x82/\\e/g;
 820             s/\x83/\\-/g;
 821
 822             # Convert some latin1 chars to troff equivalents
 823             s/\xa0/\\ /g; # non-breaking space
 824
 825             print enc $_;
 826         }
 827     }
 828 }
 829
 830 close STDOUT or kark N_("%s: error writing to %s (%s)"), $this_program,
 831     $opt_output || 'stdout', $!;
 832
 833 exit;
 834
 835 # Get program basename, and strip libtool "lt-" prefix if required.
 836 sub program_basename
 837 {
 838     local $_ = shift;
 839     s!.*/!!;
 840     s/^lt-// if $opt_libtool;
 841     $_;
 842 }
 843
 844 # Call program with given option and return results.
 845 sub get_option_value
 846 {
 847     my ($prog, $opt) = @_;
 848     my $stderr = $discard_stderr ? '/dev/null' : '&1';
 849     my $value = join '',
 850         map { s/ +$//; expand $_ }
 851         map { dec $_ }
 852         `$prog $opt 2>$stderr`;
 853
 854     unless ($value)
 855     {
 856         my $err = N_("%s: can't get `%s' info from %s%s");
 857         my $extra = $discard_stderr
 858             ? "\n" . N_("Try `--no-discard-stderr' if option outputs to stderr")
 859             : '';
 860
 861         kark $err, $this_program, $opt, $prog, $extra;
 862     }
 863
 864     $value;
 865 }
 866
 867 # Convert option dashes to \- to stop nroff from hyphenating 'em, and
 868 # embolden.  Option arguments get italicised.
 869 sub convert_option
 870 {
 871     local $_ = '\fB' . shift;
 872
 873     s/-/\x83/g;
 874     unless (s/\[=(.*)\]$/\\fR[=\\fI$1\\fR]/)
 875     {
 876         s/=(.)/\\fR=\\fI$1/;
 877         s/ (.)/ \\fI$1/;
 878         $_ .= '\fR';
 879     }
 880
 881     $_;
 882 }
 883
 884 # Insert spacing escape characters \, and \/ before and after italic text.  See
 885 # http://www.gnu.org/software/groff/manual/html_node/Ligatures-and-Kerning.html
 886 sub fix_italic_spacing
 887 {
 888     local $_ = shift;
 889     s!\\fI(.*?)\\f([BRP])!\\fI\\,$1\\/\\f$2!g;
 890     return $_;
 891 }
 892 !NO!SUBS!
 893
 894 # Rename output and fix permissions
 895 unless ($opts{stdout})
 896 {
 897     close OUT;
 898     rename $tmp, $target or die "$0: can't rename $tmp to $target ($!)\n";
 899     chmod 0555, $target  or warn "$0: can't change mode of $target ($!)\n";
 900 }
 901
 902 exit 0;