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