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