contrib/groffer/main_subs.pl

   1 #! /usr/bin/env perl
   2
   3 # groffer - display groff files
   4
   5 # Source file position: <groff-source>/contrib/groffer/subs.pl
   6 # Installed position: <prefix>/lib/groff/groffer/subs.pl
   7
   8 # Copyright (C) 2006-2014  Free Software Foundation, Inc.
   9 # Written by Bernd Warken <groff-bernd.warken-72@web.de>.
  10
  11 # This file is part of `groffer', which is part of `groff'.
  12
  13 # `groff' is free software; you can redistribute it and/or modify it
  14 # under the terms of the GNU General Public License as published by
  15 # the Free Software Foundation, either version 2 of the License, or
  16 # (at your option) any later version.
  17
  18 # `groff' is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program. If not, see
  25 # <http://www.gnu.org/licenses/gpl-2.0.html>.
  26
  27 ########################################################################
  28 # This file contains the main functions formerly in `groff.pl'
  29
  30 use strict;
  31 use warnings;
  32
  33
  34 ########################################################################
  35 # main_set_options()
  36 ########################################################################
  37
  38 sub main_set_options {
  39   our %Opts_Cmdline_Short;
  40   our %Opts_Cmdline_Long;
  41   our $Opts_Cmdline_Long_Str;
  42   our %Opts_Cmdline_Double;
  43   our %Opts_Groff_Short;
  44
  45   # the following options are ignored in groffer.pl, but are kept from
  46   # groffer.sh: --shell arg, --debug-shell
  47
  48   my @opts_ignored_short_na = ();
  49   my @opts_ignored_short_arg = ();
  50
  51   my @opts_ignored_long_na = ('debug-shell');
  52
  53   my @opts_ignored_long_arg = ('shell');
  54
  55
  56   ###### groffer native options
  57
  58   my @opts_groffer_short_na = ('h', 'Q', 'v', 'V', 'X', 'Z');
  59   my @opts_groffer_short_arg = ('T');
  60
  61   my @opts_groffer_long_na = ('auto', 'apropos', 'apropos-data',
  62   'apropos-devel', 'apropos-progs', 'debug', 'debug-all',
  63   'debug-filenames', 'debug-func', 'debug-grog', 'debug-not-func',
  64   'debug-keep', 'debug-lm', 'debug-params', 'debug-stacks',
  65   'debug-tmpdir', 'debug-user', 'default', 'do-nothing', 'dvi',
  66   'groff', 'help', 'intermediate-output', 'html', 'latin1', 'man',
  67   'no-location', 'no-man', 'no-special', 'pdf', 'pdf2', 'ps', 'rv',
  68   'source', 'text', 'to-stdout', 'text-device', 'tty', 'tty-device',
  69   'utf8', 'version', 'whatis', 'where', 'www', 'x', 'X');
  70
  71 ### main_set_options()
  72   my @opts_groffer_long_arg =
  73     ('default-modes', 'device', 'extension', 'fg', 'fn', 'font',
  74      'foreground', 'mode', 'print', 'title', 'viewer',
  75      # tty viewers are ignored
  76      'dvi-viewer-tty', 'html-viewer-tty', 'pdf-viewer-tty',
  77      'ps-viewer-tty', 'tty-viewer-tty', 'www-viewer-tty',
  78      'X-viewer-tty', 'x-viewer-tty',
  79      # viewers for modes are ignored
  80      'dvi-viewer', 'html-viewer', 'pdf-viewer', 'ps-viewer', 'tty-viewer',
  81      'www-viewer', 'X-viewer', 'x-viewer',
  82     );
  83
  84   ##### groffer options inhereted from groff
  85
  86   my @opts_groff_short_na = ('a', 'b', 'c', 'C', 'e', 'E', 'g', 'G',
  87   'i', 'j', 'J', 'k', 'l', 'N', 'p', 'R', 's', 'S', 't', 'U', 'z');
  88
  89   my @opts_groff_short_arg = ('d', 'f', 'F', 'I', 'K', 'L', 'm', 'M', 'n',
  90   'o', 'P', 'r', 'w', 'W');
  91
  92   my @opts_groff_long_na = ();
  93   my @opts_groff_long_arg = ();
  94
  95   ##### groffer options inhereted from the X Window toolkit
  96
  97   my @opts_x_short_na = ();
  98   my @opts_x_short_arg = ();
  99
 100   my @opts_x_long_na = ('iconic', 'rv');
 101
 102   my @opts_x_long_arg = ('background', 'bd', 'bg', 'bordercolor',
 103   'borderwidth', 'bw', 'display', 'fg', 'fn', 'font', 'foreground',
 104   'ft', 'geometry', 'resolution', 'title', 'xrm');
 105
 106 ### main_set_options()
 107   ###### groffer options inherited from man
 108
 109   my @opts_man_short_na = ();
 110   my @opts_man_short_arg = ();
 111
 112   my @opts_man_long_na = ('all', 'ascii', 'catman', 'ditroff',
 113   'local-file', 'location', 'troff', 'update');
 114
 115   my @opts_man_long_arg = ('locale', 'manpath', 'pager',
 116   'preprocessor', 'prompt', 'sections', 'systems', 'troff-device');
 117
 118   ###### additional options for parsing evironment variable $MANOPT only
 119
 120   my @opts_manopt_short_na = ('7', 'a', 'c', 'd', 'D', 'f', 'h', 'k',
 121   'l', 't', 'u', 'V', 'w', 'Z');
 122
 123   my @opts_manopt_short_arg = ('e', 'L', 'm', 'M', 'p', 'P', 'r', 'S',
 124   'T');
 125
 126   my @opts_manopt_long_na = (@opts_man_long_na, 'apropos', 'debug',
 127   'default', 'help', 'html', 'ignore-case', 'location-cat',
 128   'match-case', 'troff', 'update', 'version', 'whatis', 'where',
 129   'where-cat');
 130
 131   my @opts_manopt_long_arg = (@opts_man_long_na, 'config_file',
 132   'encoding', 'extension', 'locale');
 133
 134 ### main_set_options()
 135   ###### collections of command line options
 136
 137   # There are two hashes that control the whole of the command line
 138   # options, one for short and one for long options.  Options without
 139   # and with arguments are mixed by advicing a value of 0 for an option
 140   # without argument and a value of 1 for an option with argument.
 141   # The options are with leading minus.
 142
 143   foreach (@opts_groffer_short_na, @opts_groff_short_na,
 144            @opts_x_short_na, @opts_man_short_na, @opts_ignored_short_na) {
 145     $Opts_Cmdline_Short{"-$_"} = 0 if $_;
 146   }
 147   foreach (@opts_groffer_short_arg, @opts_groff_short_arg,
 148            @opts_x_short_arg, @opts_man_short_arg, @opts_ignored_short_arg) {
 149     $Opts_Cmdline_Short{"-$_"} = 1 if $_;
 150   }
 151
 152   foreach (@opts_groffer_long_na, @opts_groff_long_na,
 153            @opts_x_long_na, @opts_man_long_na, @opts_ignored_long_na) {
 154     $Opts_Cmdline_Long{"--$_"} = 0 if $_;
 155   }
 156   foreach (@opts_groffer_long_arg, @opts_groff_long_arg,
 157            @opts_x_long_arg, @opts_man_long_arg, @opts_ignored_long_arg) {
 158     $Opts_Cmdline_Long{"--$_"} = 1 if $_;
 159   }
 160
 161   # For determining abbreviations of an option take two spaces as join
 162   # for better check.
 163   # The options are without leading minus.
 164   $Opts_Cmdline_Long_Str = join '  ', keys %Opts_Cmdline_Long;
 165   if ($Opts_Cmdline_Long_Str) {
 166     $Opts_Cmdline_Long_Str = " $Opts_Cmdline_Long_Str ";
 167     $Opts_Cmdline_Long_Str =~ s/--//g;
 168   }
 169
 170 ### main_set_options()
 171   # options with equal meaning are mapped to a single option name
 172   # all of these have leading minus characters
 173   %Opts_Cmdline_Double = ('-h' => '--help',
 174                           '-Q' => '--source',
 175                           '-T' => '--device',
 176                           '-v' => '--version',
 177                           '-Z' => '--intermediate-output',
 178                           '--bd' => '--bordercolor',
 179                           '--bg' => '--background',
 180                           '--bw' => '--borderwidth',
 181                           '--debug-all' => '--debug',
 182                           '--ditroff' => '--intermediate-output',
 183                           '--fg' => '--foreground',
 184                           '--fn' => '--font',
 185                           '--ft' => '--font',
 186                           '--latin1' => '--tty',
 187                           '--troff-device' => '--device',
 188                           '--tty-device' => '--text-device',
 189                           '--viewer' => '--viewer',
 190                           '--where' => '--location',
 191                           '--www' => '--html',
 192                           '--X' => '--x',
 193                           # '--dvi-viewer' => '--viewer',
 194                           '--dvi-viewer-tty' => '--viewer',
 195                           '--html-viewer-tty' => '--viewer',
 196                           '--pdf-viewer-tty' => '--viewer',
 197                           '--ps-viewer-tty' => '--viewer',
 198                           '--tty-viewer' => '--pager',
 199                           '--tty-viewer-tty' => '--pager',
 200                           '--www-viewer' => '--viewer',
 201                           '--www-viewer-tty' => '--pager',
 202                           '--X-viewer' => '--viewer', '--X-viewer-tty'
 203                           => '--pager', '--x-viewer' => '--viewer',
 204                           '--x-viewer-tty' => '--pager', );
 205
 206   # groff short options with leading minus
 207   foreach (@opts_groff_short_na) {
 208     $Opts_Groff_Short{"-$_"} = 0;
 209   }
 210   foreach (@opts_groff_short_arg) {
 211     $Opts_Groff_Short{"-$_"} = 1;
 212   }
 213
 214 } # main_set_options()
 215
 216
 217 ########################################################################
 218 # main_parse_MANOPT
 219 ########################################################################
 220
 221 sub main_parse_MANOPT {
 222   our @Manopt;
 223   our $File_split_env_sh;
 224
 225   if ( $ENV{'MANOPT'} ) {
 226     @Manopt = `sh $File_split_env_sh MANOPT`;
 227     chomp @Manopt;
 228
 229     my @manopt;
 230     # %opts stores options that are used by groffer for $MANOPT
 231     # All options not in %opts are ignored.
 232     # Check options used with %Opts_Cmdline_Double.
 233     # 0: option used ('' for ignore), 1: has argument or not
 234     ### main_parse_MANOPT()
 235     my %opts = ('-7' => ['--ascii', 0],
 236                 '-L' => ['--locale', 1],
 237                 '-M' => ['--manpath', 1],
 238                 '-P' => ['--pager', 1],
 239                 '-S' => ['--sections', 1],
 240                 '-T' => ['-T', 1],
 241                 '-w' => ['--location', 0],
 242                 '-a' => ['--all', 0],
 243                 '-c' => ['', 1],
 244                 '-e' => ['--extension', 1],
 245                 '-f' => ['--whatis', 1],
 246                 '-m' => ['--systems', 1],
 247                 '-p' => ['', 1],
 248                 '-r' => ['', 1],
 249                 '-manpath' => ['--manpath', 1],
 250                 '-pager' => ['--pager', 1],
 251                 '-prompt' => ['', 1],
 252                 '-sections' => ['--sections', 1],
 253                 '--all' => ['--all', 0],
 254                 '--ascii' => ['--ascii', 0],
 255                 '--catman' => ['', 1],
 256                 '--device' => ['-T', 1],
 257                 '--extension' => ['--extension', 1],
 258                 '--locale' => ['--locale', 1],
 259                 '--location' => ['--location', 0],
 260                 '--manpath' => ['--manpath', 1],
 261                 '--preprocessor' => ['', 1],
 262                 '--systems' => ['--systems', 1],
 263                 '--whatis' => ['--whatis', 1],
 264                 '--where' => ['--location', 0],
 265                );
 266
 267 ### main_parse_MANOPT()
 268     my ($opt, $has_arg);
 269     my $i = 0;
 270     my $n = $#Manopt;
 271     while ($i <= $n) {
 272       my $o = $Manopt[$i];
 273       ++$i;
 274       # ignore, when not in %opts
 275       next unless (exists $opts{$o});
 276       if (($o eq '-D') or ($o eq '--default')) {
 277         @manopt = ();
 278         next;
 279       }
 280       $opt = $opts{$o}[0];
 281       $has_arg = $opts{$o}[1];
 282       # ignore, when empty in %opts
 283       unless ($opt) {
 284         # ignore without argument
 285         next unless ($has_arg);
 286         # ignore the argument as well
 287         ++$i;
 288         next;
 289       }
 290       if ($has_arg) {
 291         last if ($i > $n);
 292         push @manopt, $opt, $Manopt[$i];
 293         ++$i;
 294         next;
 295       } else {
 296         push @manopt, $opt;
 297         next;
 298       }
 299     }
 300     @Manopt = @manopt;
 301   }
 302 }                               # main_parse_MANOPT()
 303
 304
 305 ########################################################################
 306 # configuration files, $GROFFER_OPT, and command line, main_config_params()
 307 ########################################################################
 308
 309 sub main_config_params {        # handle configuration files
 310   our @Options;
 311   our @Filespecs;
 312   our @Starting_Conf;
 313   our @Starting_ARGV = @ARGV;
 314
 315   our %Opts_Cmdline_Short;
 316   our %Opts_Cmdline_Long;
 317   our $Opts_Cmdline_Long_Str;
 318   our %Opts_Cmdline_Double;
 319   our %Opts_Groff_Short;
 320
 321   our $File_split_env_sh;
 322   our @Manopt;
 323   our @Conf_Files;
 324
 325   # options may not be abbreviated, but must be exact
 326   my @conf_args;
 327   foreach my $f ( @Conf_Files ) {
 328     if (-s $f) {
 329       my $fh;
 330       open $fh, "<$f" || next;
 331       my $nr = 0;
 332     LINE: foreach my $line (<$fh>) {
 333         ++ $nr;
 334         chomp $line;
 335         # remove starting and ending whitespace
 336         $line =~ s/^\s+|\s+$//g;
 337         # replace whitespace by single space
 338         $line =~ s/\s+/ /g;
 339         # ignore all lines that do not start with minus
 340         next unless $line =~ /^-/;
 341         # three minus
 342         if ($line =~ /^---/) {
 343           warn "Wrong option $line in configuration file $f.\n";
 344           next;
 345         }
 346         if ( $line =~ /^--[ =]/ ) {
 347           warn "No option name in `$line' in configuration " .
 348             "file $f.\n";
 349           next;
 350         }
 351         push @Starting_Conf, $line;
 352         # -- or -
 353         if ($line =~ /^--?$/) {
 354           warn "`$line' is not allowed in configuration files.\n";
 355           next; }
 356 ### main_config_params()
 357         if ($line =~ /^--/) {           # line is long option
 358           my ($name, $arg);
 359           if ($line =~ /[ =]/) {        # has arg on line $line =~
 360             /^(--[^ =]+)[ =] ?(.*)$/;
 361             ($name, $arg) = ($1, $2);
 362             $arg =~ s/[\'\"]//g;
 363           } else {                      # does not have an argument on line
 364             $name = $line;
 365           } $name =~ s/[\'\"]//g;
 366           unless (exists $Opts_Cmdline_Long{$name}) {
 367             # option does not exist
 368             warn "Option `$name' does not exist.\n";
 369             next LINE;
 370           }
 371           # option exists
 372           if ( $Opts_Cmdline_Long{$name} ) { # option has arg
 373             if (defined $arg) {
 374               push @conf_args, $name, $arg;
 375               next LINE;
 376             } else { warn "Option `$name' needs an argument in " .
 377                        "configuration file $f\n";
 378                      next LINE;
 379                    }
 380           } else { # option has no arg
 381             if (defined $arg) {
 382               warn "Option `$name' may not have an argument " .
 383                 "in configuration file $f\n";
 384               next LINE;
 385             } else {
 386               push @conf_args, $name; next LINE;
 387             }
 388           }
 389 ### main_config_params()
 390         } else {                        # line is short option or cluster
 391           $line =~ s/^-//;
 392           while ($line) {
 393             $line =~ s/^(.)//;
 394             my $opt = "-$1";
 395             next if ($opt =~ /\'\"/);
 396             if ($opt =~ /- /) {
 397               warn "Option `$conf_args[$#conf_args]' does not " .
 398                 "have an argument.\n";
 399               next LINE;
 400             }
 401             if ( exists $Opts_Cmdline_Short{$opt} ) {
 402               # short opt exists
 403               push @conf_args, $opt;
 404               if ( $Opts_Cmdline_Short{$opt} ) { # with arg
 405                 my $arg = $line;
 406                 $arg =~ s/^ //;
 407                 $arg =~ s/\'\"//g;
 408                 push @conf_args, "$arg";
 409                 next LINE;
 410               } else { # no arg
 411                 next;
 412               }
 413             } else { # short option does not exist
 414               warn "Wrong short option `-$opt' from " .
 415                 "configuration.  Rest of line ignored.\n";
 416               next LINE;
 417             }
 418           }
 419         }
 420       }
 421       close $fh;
 422     }
 423   }
 424
 425 ### main_config_params()
 426   #handle environment variable $GROFFER_OPT
 427   my @GROFFER_OPT;
 428   if ( $ENV{'GROFFER_OPT'} ) {
 429     @GROFFER_OPT = `sh $File_split_env_sh GROFFER_OPT`;
 430     chomp @GROFFER_OPT;
 431   }
 432
 433   # Handle command line parameters together with $GROFFER_OPT.
 434   # Options can be abbreviated, with each - as abbreviation place.
 435   {
 436     my @argv0 = (@GROFFER_OPT, @ARGV);
 437     my @argv;
 438     my $only_files = 0;
 439     my $n = $#argv0;            # last element
 440     my $n1 = scalar @GROFFER_OPT; # first element of @ARGV
 441     my $i = 0;                  # number of the element
 442     my @s = ('the environment variable $GROFFER_OPT', 'the command line');
 443     my $j = 0;                  # index in @s, 0 before $n1, 1 then
 444   ELT: while ($i <= $n) {
 445       my $elt = $argv0[$i];
 446       $j = 1 if $i >= $n1;
 447       ++$i;
 448       # remove starting and ending whitespace
 449       $elt =~ s/^\s+|\s+$//g;
 450       # replace whitespace by single space
 451       $elt =~ s/\s+/ /g;
 452
 453       if ($only_files) {
 454         push @Filespecs, $elt;
 455         next ELT;
 456       }
 457
 458 ### main_config_params()
 459       if ( $elt =~ /^-$/ ) { # -
 460         push @Filespecs, $elt;
 461         next ELT;
 462       }
 463       if ($elt =~ /^--$/) { # --
 464         $only_files = 1;
 465         next ELT;
 466       }
 467
 468       if ($elt =~ /^--[ =]/) { # no option name
 469         warn "No option name in `$elt' at $s[$j].\n";
 470         next ELT;
 471       }
 472       if ($elt =~ /^---/) { # wrong with three minus
 473         warn "Wrong option `$elt' at $s[$j].\n";
 474         next ELT;
 475       }
 476
 477       if ($elt =~ /^--[^-]/) { # long option
 478         my ($name, $opt, $abbrev, $arg);
 479         if ($elt =~ /[ =]/) { # has arg on elt
 480           $elt =~ /^--([^ =]+)[ =] ?(.*)$/;
 481           ($name, $arg) = ($1, $2);
 482           $opt = "--$name";
 483           $abbrev = $name;
 484           $arg =~ s/[\'\"]//g;
 485         } else {                # does not have an argument in the element
 486           $opt = $name = $elt;
 487           $name =~ s/^--//;
 488           $abbrev = $name;
 489         }
 490 ### main_config_params()
 491         # remove quotes in name
 492         $name =~ s/[\'\"]//g;
 493         my $match = $name;
 494         $match =~ s/-/[^- ]*-/g;
 495         if ( exists $Opts_Cmdline_Long{$opt} ) {
 496           # option exists exactly
 497         } elsif ( $Opts_Cmdline_Long_Str =~ / (${match}[^- ]*?) / ) {
 498           # option is an abbreviation without further -
 499           my $n0 = $1;
 500           if ( $Opts_Cmdline_Long_Str =~
 501                /\s(${match}[^-\s]*)\s.*\s(${match}[^-\s]*) / ) {
 502             warn "Option name `--$abbrev' is not unique: " .
 503               "--$1 --$2 \n";
 504             next ELT;
 505           }
 506           $name = $n0;
 507           $opt = "--$n0";
 508         } elsif ( $Opts_Cmdline_Long_Str =~ /\s(${match}[^\s]*)\s/ ) {
 509           # option is an abbreviation with further -
 510           my $n0 = $1;
 511           if ( $Opts_Cmdline_Long_Str =~
 512                /\s(${match}[^\s]*)\s.*\s(${match}[^\s]*)\s/ ) {
 513             warn "Option name `--$abbrev' is not unique: " .
 514               "--$1 --$2 \n";
 515             next ELT;
 516           }
 517           $name = $n0;
 518           $opt = "--$n0";
 519         } else {
 520           warn "Option `--$abbrev' does not exist.\n";
 521           next ELT;
 522         }
 523 ### main_config_params()
 524         if ( $Opts_Cmdline_Long{$opt} ) { # option has arg
 525           if (defined $arg) {
 526             push @argv, "--$name", $arg;
 527             next ELT;
 528           } else { # $arg not defined, argument at next element
 529             if (($i == $n1) || ($i > $n)) {
 530               warn "No argument left for option " .
 531                 "`$elt' at $s[$j].\n";
 532               next ELT; }
 533             # add argument as next element
 534             push @argv, "--$name", $argv0[$i];
 535             ++$i;
 536             next ELT;
 537           }             # if (defined $arg)
 538         } else {        # option has no arg
 539           if (defined $arg) {
 540             warn "Option `$abbrev' may not have an argument " .
 541               "at $s[$j].\n";
 542             next ELT;
 543           } else {
 544             push @argv, "--$name";
 545             next ELT;
 546           }
 547         }               # if ($Opts_Cmdline_Long{$opt})
 548 ### main_config_params()
 549       } elsif ( $elt =~ /^-[^-]/ ) { # short option or cluster
 550         my $cluster = $elt;
 551         $cluster =~ s/^-//;
 552         while ($cluster) {
 553           $cluster =~ s/^(.)//;
 554           my $opt = "-$1";
 555           if ( exists $Opts_Cmdline_Short{$opt} ) {     # opt exists
 556             if ( $Opts_Cmdline_Short{$opt} ) {          # with arg
 557               if ($cluster) {   # has argument in this element
 558                 $cluster =~ s/^\s//;
 559                 $cluster =~ s/\'\"//g;
 560                 # add argument as rest of this element
 561                 push @argv, $opt, $cluster;
 562                 next ELT;
 563               } else { # argument at next element
 564                 if (($i == $n1) || ($i > $n)) {
 565                   warn "No argument left for option " .
 566                     "`$opt' at $s[$j].\n";
 567                   next ELT; }
 568 ### main_config_params()
 569                 # add argument as next element
 570                 push @argv, $opt, $argv0[$i];
 571                 ++$i;
 572                 next ELT;
 573               }
 574             } else { # no arg
 575               push @argv, $opt; next;
 576             }
 577           } else { # short option does not exist
 578             warn "Wrong short option `$opt' at $s[$j].\n";
 579             next ELT;
 580           }             # if (exists $Opts_Cmdline_Short{$opt})
 581         }               # while ($cluster)
 582       } else {          # not an option, file name
 583         push @Filespecs, $elt;
 584         next;
 585       }
 586     }
 587 ### main_config_params()
 588     @Options = (@Manopt, @conf_args, @argv);
 589     foreach my $i ( 0..$#Options ) {
 590       if ( exists $Opts_Cmdline_Double{$Options[$i]} ) {
 591         $Options[$i] = $Opts_Cmdline_Double{ $Options[$i] };
 592       }
 593     } @Filespecs = ('-') unless (@Filespecs);
 594     @ARGV = (@Options, '--', @Filespecs);
 595   }
 596 } # main_config_params()
 597
 598
 599 ########################################################################
 600 # main_parse_params()
 601 ########################################################################
 602
 603 sub main_parse_params {
 604   # options that are ignored in this part
 605   # shell version of groffer: --debug*, --shell
 606   # man options: --catman (only special in man),
 607   #              --preprocessor (force groff preproc., handled by grog),
 608   #              --prompt (prompt for less, ignored),
 609   #              --troff (-mandoc, handled by grog),
 610   #              --update (inode check, ignored)
 611   our %Opt;
 612   our %Man;
 613   our %Debug;
 614   our %Opts_Cmdline_Short;
 615   our %Opts_Cmdline_Double;
 616   our %Opts_Cmdline_Long;
 617   our %Opts_Groff_Short;
 618   our $i;
 619   our $n;
 620   our @Starting_ARGV;
 621   our @Starting_Conf;
 622   our @Default_Modes;
 623   our @Addopts_Groff;
 624   our @Options;
 625
 626   my %ignored_opts = (
 627                       '--catman' => 0,
 628                       '--debug-func' => 0,
 629                       '--debug-not-func' => 0,
 630                       '--debug-lm' => 0,
 631                       '--debug-shell' => 0,
 632                       '--debug-stacks' => 0,
 633                       '--debug-user' => 0,
 634                       '--preprocessor' => 1,
 635                       '--prompt' => 1,
 636                       '--shell' => 1,
 637                       '--troff' => 0,
 638                       '--update' => 0,
 639                      );
 640
 641 ### main_parse_params()
 642   my %long_opts =
 643     (
 644      '--debug' =>
 645      sub { $Debug{$_} = 1 foreach (qw/FILENAMES GROG KEEP PARAMS TMPDIR/); },
 646      '--debug-filenames' => sub { $Debug{'FILENAMES'} = 1; },
 647      '--debug-grog' => sub { $Debug{'GROG'} = 1; },
 648      '--debug-keep' => sub { $Debug{'KEEP'} = 1; $Debug{'PARAMS'} = 1; },
 649      '--debug-params' => sub { $Debug{'PARAMS'} = 1; },
 650      '--debug-tmpdir' => sub { $Debug{'TMPDIR'} = 1; },
 651      '--help' => sub { &usage(); $Opt{'DO_NOTHING'} = 1; },
 652      '--source' => sub { $Opt{'MODE'} = 'source'; },
 653      '--device' =>
 654      sub { $Opt{'DEVICE'} = &_get_arg();
 655            my %modes = (
 656                         'ascii' => 'tty',
 657                         'cp1047' => 'tty',
 658                         'dvi'=> 'dvi',
 659                         'html' => 'html',
 660                         'latin1' => 'tty',
 661                         'lbp' => 'groff',
 662                         'lj4' => 'groff',
 663                         'pdf' => 'pdf',
 664                         'pdf2' => 'pdf2',
 665                         'ps' => 'ps',
 666                         'utf8' => 'tty',
 667                        );
 668             if ($Opt{'DEVICE'} =~ /^X.*/) {
 669               $Opt{'MODE'} = 'x';
 670             } elsif ( exists $modes{ $Opt{'DEVICE'} } ) {
 671               if ( $modes{ $Opt{'DEVICE'} } eq 'tty' ) {
 672                 $Opt{'MODE'} = 'tty'
 673                   unless ($Opt{'MODE'} eq 'text');
 674               } else {
 675                 $Opt{'MODE'} = $modes{ $Opt{'DEVICE'} };
 676               }
 677             } else {
 678               # for all elements not in %modes
 679               $Opt{'MODE'} = 'groff';
 680             }
 681           },
 682 ### main_parse_params()
 683      '--version' => sub { &version(); $Opt{'DO_NOTHING'} = 1; },
 684      '--intermediate-output' => sub { $Opt{'Z'} = 1; },
 685      '--all' => sub { $Opt{'ALL'} = 1; },
 686      '--apropos' =>             # run apropos
 687      sub { $Opt{'APROPOS'} = 1;
 688            delete $Opt{'APROPOS_SECTIONS'};
 689            delete $Opt{'WHATIS'}; },
 690      '--apropos-data' =>        # run apropos for data sections
 691      sub { $Opt{'APROPOS'} = 1;
 692            $Opt{'APROPOS_SECTIONS'} = '457';
 693            delete $Opt{'WHATIS'}; },
 694      '--apropos-devel' =>       # run apropos for devel sections
 695      sub { $Opt{'APROPOS'} = 1;
 696            $Opt{'APROPOS_SECTIONS'} = '239';
 697            delete $Opt{'WHATIS'}; },
 698      '--apropos-progs' =>       # run apropos for prog sections
 699      sub { $Opt{'APROPOS'} = 1;
 700            $Opt{'APROPOS_SECTIONS'} = '168';
 701            delete $Opt{'WHATIS'}; },
 702      '--ascii' =>
 703      sub { push @Addopts_Groff, '-mtty-char';
 704            $Opt{'MODE'} = 'text' unless $Opt{'MODE'}; },
 705      '--auto' =>                # the default automatic mode
 706      sub { delete $Opt{'MODE'}; },
 707      '--bordercolor' =>         # border color for viewers, arg
 708      sub { $Opt{'BD'} = &_get_arg(); },
 709      '--background' =>          # background color for viewers, arg
 710      sub { $Opt{'BG'} = &_get_arg(); },
 711 ### main_parse_params()
 712      '--borderwidth' =>         # border width for viewers, arg
 713      sub { $Opt{'BW'} = &_get_arg(); },
 714      '--default' =>             # reset variables to default
 715      sub { %Opt = (); },
 716      '--default-modes' =>       # sequence of modes in auto mode; arg
 717      sub { $Opt{'DEFAULT_MODES'} = &_get_arg(); },
 718      '--display' =>             # set X display, arg
 719      sub { $Opt{'DISPLAY'} = &_get_arg(); },
 720      '--do-nothing' => sub { $Opt{'DO_NOTHING'} = 1; },
 721      '--dvi' => sub { $Opt{'MODE'} = 'dvi'; },
 722      '--extension' =>           # the extension for man pages, arg
 723      sub { $Opt{'EXTENSION'} = &_get_arg(); },
 724      '--foreground' =>          # foreground color for viewers, arg
 725      sub { $Opt{'FG'} = &_get_arg(); },
 726      '--font' =>                # set font for viewers, arg
 727      sub { $Opt{'FN'} = &_get_arg(); },
 728      '--geometry' =>            # window geometry for viewers, arg
 729      sub { $Opt{'GEOMETRY'} = &_get_arg(); },
 730      '--groff' => sub { $Opt{'MODE'} = 'groff'; },
 731      '--html' => sub { $Opt{'MODE'} = 'html'; },
 732      '--iconic' =>              # start viewers as icons
 733      sub { $Opt{'ICONIC'} = 1; },
 734      '--locale' =>              # set language for man pages, arg
 735      # argument is xx[_territory[.codeset[@modifier]]] (ISO 639,...)
 736      sub { $Opt{'LANG'} = &_get_arg(); },
 737      '--local-file' =>          # force local files; same as `--no-man'
 738      sub { delete $Man{'ENABLE'}; delete $Man{'FORCE'}; },
 739      '--location' =>            # print file locations to stderr
 740      sub { $Opt{'LOCATION'} = 1; },
 741 ### main_parse_params()
 742      '--man' =>                 # force all file params to be man pages
 743      sub { $Man{'ENABLE'} = 1; $Man{'FORCE'} = 1; },
 744      '--manpath' =>             # specify search path for man pages, arg
 745      # arg is colon-separated list of directories
 746      sub { $Opt{'MANPATH'} = &_get_arg(); },
 747      '--mode' =>                # display mode
 748      sub { my $arg = &_get_arg();
 749            my %modes = ( '' => '',
 750                          'auto' => '',
 751                          'groff' => 'groff',
 752                          'html' => 'html',
 753                          'www' => 'html',
 754                          'dvi' => 'dvi',
 755                          'pdf' => 'pdf',
 756                          'pdf2' => 'pdf2',
 757                          'ps' => 'ps',
 758                          'text' => 'text',
 759                          'tty' => 'tty',
 760                          'X' => 'x',
 761                          'x' => 'x',
 762                          'Q' => 'source',
 763                          'source' => 'source',
 764                        );
 765            if ( exists $modes{$arg} ) {
 766              if ( $modes{$arg} ) {
 767                $Opt{'MODE'} = $modes{$arg};
 768              } else {
 769                delete $Opt{'MODE'};
 770              }
 771            } else {
 772              warn "Unknown mode in `$arg' for --mode\n";
 773            }
 774          },
 775 ### main_parse_params()
 776      '--no-location' =>         # disable former call to `--location'
 777      sub { delete $Opt{'LOCATION'}; },
 778      '--no-man' =>              # disable search for man pages
 779      sub { delete $Man{'ENABLE'}; delete $Man{'FORCE'}; },
 780      '--no-special' =>          # disable some special former calls
 781      sub { delete $Opt{'ALL'}; delete $Opt{'APROPOS'};
 782            delete $Opt{'WHATIS'}; },
 783      '--pager' =>               # set paging program for tty mode, arg
 784      sub { $Opt{'PAGER'} = &_get_arg(); },
 785      '--pdf' => sub { $Opt{'MODE'} = 'pdf'; },
 786      '--pdf2' => sub { $Opt{'MODE'} = 'pdf2'; },
 787      '--print' =>               # print argument, for argument test
 788      sub { my $arg = &_get_arg; print STDERR $arg . "\n"; },
 789      '--ps' => sub { $Opt{'MODE'} = 'ps'; },
 790      '--resolution' =>          # set resolution for X devices, arg
 791      sub { my $arg = &_get_arg();
 792            my %res = ( '75' => 75,
 793                        '75dpi' => 75,
 794                        '100' => 100,
 795                        '100dpi' => 100,
 796                      );
 797            if (exists $res{$arg}) {
 798              $Opt{'RESOLUTION'} = $res{$arg};
 799            } else {
 800              warn "--resolution allows only 75, 75dpi, " .
 801                "100, 100dpi as argument.\n";
 802            }
 803          },
 804 ### main_parse_params()
 805      '--rv' => sub { $Opt{'RV'} = 1; },
 806      '--sections' =>            # specify sections for man pages, arg
 807      # arg is a `:'-separated (colon) list of section names
 808      sub { my $arg = &_get_arg();
 809            my @arg = split /:/, $arg;
 810            my $s;
 811            foreach (@arg) {
 812              /^(.)/;
 813              my $c = $1;
 814              if ($Man{'AUTO_SEC_CHARS'} =~ /$c/) {
 815                $s .= $c;
 816              } else {
 817                warn "main_parse_params(): not a man section `$c';";
 818              }
 819            }
 820            $Opt{'SECTIONS'} = $s; },
 821      '--systems' =>             # man pages for different OS's, arg
 822      # argument is a comma-separated list
 823      sub { $Opt{'SYSTEMS'} = &_get_arg(); },
 824      '--text' =>                # text mode without pager
 825      sub { $Opt{'MODE'} = 'text'; },
 826      '--title' =>               # title for X viewers; arg
 827      sub { my $arg = &_get_arg();
 828            if ($arg) {
 829              if ( $Opt{'TITLE'} ) {
 830                $Opt{'TITLE'} = "$Opt{'TITLE'} $arg";
 831              } else {
 832                $Opt{'TITLE'} = $arg;
 833              }
 834            }
 835          },
 836      '--text-device' =>         # device for tty mode; arg
 837      sub { $Opt{'TEXT_DEVICE'} = &_get_arg(); },
 838      '--to-stdout' =>           # print mode file without display
 839      sub { $Opt{'STDOUT'} = 1; },
 840      '--tty' =>                 # tty mode, text with pager
 841      sub { $Opt{'MODE'} = 'tty'; },
 842      '--viewer' =>              # viewer for actiual mode
 843      sub { $Opt{'VIEWER'} = &_get_arg(); },
 844      '--whatis' => sub { delete $Opt{'APROPOS'}; $Opt{'WHATIS'} = 1; },
 845      '--x' => sub { $Opt{'MODE'} = 'x'; },
 846 ### main_parse_params()
 847      '--xrm' =>                 # pass X resource string, arg
 848      sub { my $arg = &_get_arg(); push @{$Opt{'XRM'}}, $arg if $arg; },
 849     );
 850
 851 #     '--dvi-viewer' =>         # viewer program for dvi mode; arg
 852 #     sub { $Opt{'VIEWER_DVI'} = &_get_arg(); },
 853 #     '--html-viewer' =>                # viewer program for html mode; arg
 854 #     sub { $Opt{'VIEWER_HTML'} = &_get_arg(); },
 855 #     '--pdf-viewer' =>         # viewer program for pdf and pdf2 mode; arg
 856 #     sub { $Opt{'VIEWER_PDF'} = &_get_arg(); },
 857 #     '--ps-viewer' =>          # viewer program for ps mode; arg
 858 #     sub { $Opt{'VIEWER_PS'} = &_get_arg(); },
 859 #     '--x-viewer' =>           # viewer program for x mode; arg
 860 #     sub { $Opt{'VIEWER_X'} = &_get_arg(); },
 861
 862   my %short_opts = (
 863                     '-V' => sub { $Opt{'V'} = 1; },
 864                     '-X' => sub { $Opt{'X'} = 1; },
 865                    );
 866
 867   if (0) {
 868     # check if all options are handled in parse parameters
 869
 870     # short options
 871     my %these_opts = (%ignored_opts, %short_opts, %Opts_Groff_Short,
 872                       %Opts_Cmdline_Double);
 873     foreach my $key (keys %Opts_Cmdline_Short) {
 874       warn "unused option: $key" unless exists $these_opts{$key};
 875     }
 876
 877     # long options
 878     %these_opts = (%ignored_opts, %long_opts, %Opts_Cmdline_Double);
 879     foreach my $key (keys %Opts_Cmdline_Long) {
 880       warn "unused option: $key" unless exists $these_opts{$key};
 881     }
 882   }                             # if (0)
 883
 884 ### main_parse_params()
 885  OPTION: while ($i <= $n) {
 886     my $opt = $Options[$i];
 887     ++$i;
 888     if ($opt =~ /^-([^-])$/) {  # single minus for short option
 889       if (exists $short_opts{$opt}) { # short option handled by hash
 890         $short_opts{$opt}->();
 891         next OPTION;
 892       } else {                  # $short_opts{$opt} does not exist
 893         my $c = $1;             # the option character
 894         next OPTION unless $c;
 895         if ( exists $Opts_Groff_Short{ $opt } ) { # groff short option
 896           if ( $Opts_Groff_Short{ $opt } ) { # option has argument
 897             my $arg = $Options[$i];
 898             ++$i;
 899             push @Addopts_Groff, $opt, $arg;
 900             next OPTION;
 901           } else {              # no argument for this option
 902             push @Addopts_Groff, $opt;
 903             next OPTION;
 904           }
 905         } elsif ( exists $Opts_Cmdline_Short{ $opt } ) {
 906           # is a groffer short option
 907           warn "Groffer option $opt not handled " .
 908             "in parameter parsing";
 909         } else {
 910           warn "$opt is not a groffer option.\n";
 911         }
 912       }                         # if (exists $short_opts{$opt})
 913     }                           # if ($opt =~ /^-([^-])$/)
 914     # now it is a long option
 915
 916     # handle ignored options
 917     if ( exists $ignored_opts{ $opt } ) {
 918       ++$i if ( $ignored_opts{ $opt } );
 919       next OPTION;
 920     }
 921 ### main_parse_params()
 922
 923     # handle normal long options
 924     if (exists $long_opts{$opt}) {
 925       $long_opts{$opt}->();
 926     } else {
 927       warn "Unknown option $opt.\n";
 928     }
 929     next OPTION;
 930   }                             # while ($i <= $n)
 931
 932   if ($Debug{'PARAMS'}) {
 933     print STDERR '$MANOPT: ' . $ENV{'MANOPT'} . "\n" if $ENV{'MANOPT'};
 934     foreach (@Starting_Conf) {
 935       print STDERR "configuration: " . $_ . "\n";
 936     }
 937     print STDERR '$GROFFER_OPT: ' . $ENV{'GROFFER_OPT'} . "\n"
 938       if $ENV{'GROFFER_OPT'};
 939     print STDERR "command line: @Starting_ARGV\n";
 940     print STDERR "parameters: @ARGV\n";
 941   }
 942
 943   if ( $Opt{'WHATIS'} ) {
 944     die "main_parse_params(): cannot handle both `whatis' and `apropos';"
 945       if $Opt{'APROPOS'};
 946     $Man{'ALL'} = 1;
 947     delete $Opt{'APROPOS_SECTIONS'};
 948   }
 949
 950   if ( $Opt{'DO_NOTHING'} ) {
 951     exit;
 952   }
 953
 954   if ( $Opt{'DEFAULT_MODES'} ) {
 955     @Default_Modes = split /,/, $Opt{'DEFAULT_MODES'};
 956   }
 957 }                               # main_parse_params()
 958
 959
 960 sub _get_arg {
 961   our $i;
 962   our $n;
 963   our @Options;
 964   if ($i > $n) {
 965     die '_get_arg(): No argument left for last option;';
 966   }
 967   my $arg = $Options[$i];
 968   ++$i;
 969   $arg;
 970 }                               # _get_arg() of main_parse_params()
 971
 972
 973 ########################################################################
 974 # main_set_mode()
 975 ########################################################################
 976
 977 sub main_set_mode {
 978   our %Opt;
 979
 980   our @Default_Modes;
 981   our @Addopts_Groff;
 982
 983   our $Viewer_Background;
 984   our $PDF_Did_Not_Work;
 985   our $PDF_Has_gs;
 986   our $PDF_Has_ps2pdf;
 987   our %Display = ('MODE' => '',
 988                   'PROG' => '',
 989                   'ARGS' => ''
 990                  );
 991
 992   my @modes;
 993
 994   # set display
 995   $ENV{'DISPLAY'} = $Opt{'DISPLAY'} if $Opt{'DISPLAY'};
 996
 997   push @Addopts_Groff, '-V' if $Opt{'V'};
 998
 999   if ( $Opt{'X'} ) {
1000     $Display{'MODE'} = 'groff';
1001     push @Addopts_Groff, '-X';
1002   }
1003
1004   if ( $Opt{'Z'} ) {
1005     $Display{'MODE'} = 'groff';
1006     push @Addopts_Groff, '-Z';
1007   }
1008
1009   $Display{'MODE'} = 'groff' if $Opt{'MODE'} and $Opt{'MODE'} eq 'groff';
1010
1011   return 1 if $Display{'MODE'} and $Display{'MODE'} eq 'groff';
1012
1013 ### main_set_mode()
1014   if ($Opt{'MODE'}) {
1015     if ($Opt{'MODE'} =~ /^(source|text|tty)$/) {
1016       $Display{'MODE'} = $Opt{'MODE'};
1017       return 1;
1018     }
1019     $Display{'MODE'} = $Opt{'MODE'} if $Opt{'MODE'} =~ /^html$/;
1020     @modes = ($Opt{'MODE'});
1021   } else {                      # empty mode
1022     if ($Opt{'DEVICE'}) {
1023       if ($Opt{'DEVICE'} =~ /^X/) {
1024         &is_X() || die "no X display found for device $Opt{'DEVICE'}";
1025         $Display{'MODE'} = 'x';
1026         return 1;
1027       }
1028       ;
1029       if ($Opt{'DEVICE'} =~ /^(ascii|cp1047|latin1|utf8)$/) {
1030         $Display{'MODE'} ne 'text' and $Display{'MODE'} = 'tty';
1031         return 1;
1032       }
1033       ;
1034       unless (&is_X) {
1035         $Display{'MODE'} = 'tty';
1036         return 1;
1037       }
1038     }                           # check device
1039     @modes = @Default_Modes;
1040   }                             # check mode
1041
1042 ### main_set_mode()
1043  LOOP: foreach my $m (@modes) {
1044     $Viewer_Background = 0;
1045     if ($m =~ /^(test|tty|X)$/) {
1046       $Display{'MODE'} = $m;
1047       return 1;
1048     } elsif ($m eq 'pdf') {
1049       &_get_prog_args($m) ? return 1: next LOOP;
1050     } elsif ($m eq 'pdf2') {
1051       next LOOP if $PDF_Did_Not_Work;
1052       $PDF_Has_gs = &where_is_prog('gs') ? 1 : 0
1053         unless (defined $PDF_Has_gs);
1054       $PDF_Has_ps2pdf = &where_is_prog('ps2pdf') ? 1 : 0
1055         unless (defined $PDF_Has_ps2pdf);
1056       if ( (! $PDF_Has_gs) and (! $PDF_Has_ps2pdf) ) {
1057         $PDF_Did_Not_Work = 1;
1058         next LOOP;
1059       }
1060
1061       if (&_get_prog_args($m)) {
1062         return 1;
1063       } else {
1064         $PDF_Did_Not_Work = 1;
1065         next LOOP;
1066       }
1067     } else {                    # other modes
1068       &_get_prog_args($m) ? return 1 : next LOOP;
1069     }                           # if $m
1070   }                             # loop: foreach
1071   die 'set mode: no suitable display mode found under ' .
1072     join(', ', @modes) . ';' unless $Display{'MODE'};
1073   die 'set mode: no viewer available for mode ' . $Display{'MODE'} . ';'
1074     unless $Display{'PROG'};
1075   0;
1076 } # main_set_mode()
1077
1078
1079 ########################################################################
1080 # functions to main_set_mode()
1081 ########################################################################
1082
1083 ##########
1084 # _get_prog_args(<MODE>)
1085 #
1086 # Simplification for loop in set mode.
1087 #
1088 # Globals in/out: $Viewer_Background
1089 # globals in    : $Opt{VIEWER}, $VIEWER_X{<MODE>},
1090 #                 $Viewer_tty{<MODE>}
1091 #
1092 ## globals in    : $Opt{VIEWER_<MODE>}, $VIEWER_X{<MODE>},
1093 ##                 $Viewer_tty{<MODE>}
1094 ##
1095 sub _get_prog_args {
1096   our %Opt;
1097   our %Display;
1098   our %Viewer_X;
1099   our %Viewer_tty;
1100
1101   our $Viewer_Background;
1102   my $n = @_;
1103   die "_get_prog_args(): one argument is needed; you used $n;"
1104     unless $n == 1;
1105
1106   my $mode = lc($_[0]);
1107   my $MODE = uc($mode);
1108   $MODE = 'PDF' if ( $MODE =~ /^PDF2$/ );
1109
1110   my $xlist = $Viewer_X{$MODE};
1111   my $ttylist = $Viewer_tty{$MODE};
1112
1113 #  my $vm = "VIEWER_${MODE";
1114   my $vm = "VIEWER";
1115   my $opt = $Opt{$vm};
1116
1117   if ($opt) {
1118     my %prog = &where_is_prog($opt);
1119     my $prog_ref = \%prog;
1120     unless (%prog) {
1121       warn "_get_prog_args(): `$opt' is not an existing program;";
1122       return 0;
1123     }
1124
1125     # $prog from $opt is an existing program
1126
1127 ### _get_prog_args() of main_set_mode()
1128     if (&is_X) {
1129       if ( &_check_prog_on_list($prog_ref, $xlist) ) {
1130         $Viewer_Background = 1;
1131       } else {
1132         $Viewer_Background = 0;
1133         &_check_prog_on_list($prog_ref, $ttylist);
1134       }
1135     } else {                    # is not X
1136       $Viewer_Background = 0;
1137       &_check_prog_on_list($prog_ref, $ttylist);
1138     }                           # if is X
1139   } else {                      # $opt is empty
1140     $Viewer_Background = 0;
1141     my $x;
1142     if (&is_X) {
1143       $x = &_get_first_prog($xlist);
1144       $Viewer_Background = 1 if $x;
1145     } else {                    # is not X
1146       $x = &_get_first_prog($ttylist);
1147     }                           # test on X
1148     $Display{'MODE'} = $mode if $x;
1149     return $x;
1150   }
1151   $Display{'MODE'} = $mode;
1152   return 1;
1153 } # _get_prog_args() of main_set_mode()
1154
1155
1156 ##########
1157 # _get_first_prog(<prog_list_ref>)
1158 #
1159 # Retrieve from the elements of the list in the argument the first
1160 # existing program in $PATH.
1161 #
1162 # Local function of main_set_mode().
1163 #
1164 # Return  : `0' if not a part of the list, `1' if found in the list.
1165 #
1166 sub _get_first_prog {
1167   our %Display;
1168   my $n = @_;
1169   die "_get_first_prog(): one argument is needed; you used $n;"
1170     unless $n == 1;
1171
1172   foreach my $i (@{$_[0]}) {
1173     next unless $i;
1174     my %prog = &where_is_prog($i);
1175     if (%prog) {
1176       $Display{'PROG'} = $prog{'fullname'};
1177       $Display{'ARGS'} = $prog{'args'};
1178       return 1;
1179     }
1180   }
1181   return 0;
1182 } # _get_first_prog() of main_set_mode()
1183
1184
1185 ##########
1186 # _check_prog_on_list (<prog-hash-ref> <prog_list_ref>)
1187 #
1188 # Check whether the content of <prog-hash-ref> is in the list
1189 # <prog_list_ref>.
1190 # The globals are set correspondingly.
1191 #
1192 # Local function for main_set_mode().
1193 #
1194 # Arguments: 2
1195 #
1196 # Return  : `0' if not a part of the list, `1' if found in the list.
1197 # Output  : none
1198 #
1199 # Globals in    : $Viewer_X{<MODE>}, $Viewer_tty{<MODE>}
1200 # Globals in/out: $Display{'PROG'}, $Display{'ARGS'}
1201 #
1202 sub _check_prog_on_list {
1203   our %Display;
1204   my $n = @_;
1205   die "_get_first_prog(): 2 arguments are needed; you used $n;"
1206     unless $n == 2;
1207
1208   my %prog = %{$_[0]};
1209
1210   $Display{'PROG'} = $prog{'fullname'};
1211   $Display{'ARGS'} = $prog{'args'};
1212
1213   foreach my $i (@{$_[1]}) {
1214     my %p = &where_is_prog($i);
1215     next unless %p;
1216     next unless $Display{'PROG'} eq $p{'fullname'};
1217     if ($p{'args'}) {
1218       if ($Display{'ARGS'}) {
1219         $Display{'ARGS'} = $p{'args'};
1220       } else {
1221         $Display{'ARGS'} = "$p{'args'} $Display{'ARGS'}";
1222       }
1223     }                           # if args
1224     return 1;
1225   }                             # foreach $i
1226   # prog was not in the list
1227   return 0;
1228 } # _check_prog_on_list() of main_set_mode()
1229
1230
1231 ########################################################################
1232 # groffer temporary directory, main_temp()
1233 ########################################################################
1234
1235 sub main_temp {
1236   our %Debug;
1237   our $tmpdir;
1238   our $fh_cat;
1239   our $fh_stdin;
1240   our $tmp_cat;
1241   our $tmp_stdin;
1242   my $template = 'groffer_' . "$$" . '_XXXX';
1243   foreach ($ENV{'GROFF_TMPDIR'}, $ENV{'TMPDIR'}, $ENV{'TMP'}, $ENV{'TEMP'},
1244            $ENV{'TEMPDIR'}, File::Spec->catfile($ENV{'HOME'}, 'tmp')) {
1245     if ($_ && -d $_ && -w $_) {
1246       if ($Debug{'KEEP'}) {
1247         eval { $tmpdir = tempdir( $template, DIR => "$_" ); };
1248       } else {
1249         eval { $tmpdir = tempdir( $template,
1250                                   CLEANUP => 1, DIR => "$_" ); };
1251       }
1252       last if $tmpdir;
1253     }
1254   }
1255   $tmpdir = tempdir( $template, CLEANUP => 1, DIR => File::Spec->tmpdir )
1256     unless ($tmpdir);
1257
1258   # see Lerning Perl, page 205, or Programming Perl, page 413
1259   # $SIG{'INT'} is for Ctrl-C interruption
1260   $SIG{'INT'} = sub { &clean_up(); die "interrupted..."; };
1261   $SIG{'QUIT'} = sub { &clean_up(); die "quit..."; };
1262
1263   if ($Debug{'TMPDIR'}) {
1264     if ( $Debug{'KEEP'}) {
1265       print STDERR "temporary directory is kept: " . $tmpdir . "\n";
1266     } else {
1267       print STDERR "temporary directory will be cleaned: " .
1268         $tmpdir . "\n";
1269     }
1270   }
1271
1272   # further argument: SUFFIX => '.sh'
1273   if ($Debug{'KEEP'}) {
1274     ($fh_cat, $tmp_cat) = tempfile(',cat_XXXX', DIR => $tmpdir);
1275     ($fh_stdin, $tmp_stdin) = tempfile(',stdin_XXXX', DIR => $tmpdir);
1276   } else {
1277     ($fh_cat, $tmp_cat) = tempfile(',cat_XXXX', UNLINK => 1,
1278                                    DIR => $tmpdir);
1279     ($fh_stdin, $tmp_stdin) = tempfile(',stdin_XXXX', UNLINK => 1,
1280                                        DIR => $tmpdir);
1281   }
1282 }                               # main_temp()
1283
1284
1285 ########################################################################
1286 # subs needed for main_do_fileargs()
1287 ########################################################################
1288
1289 ##########
1290 # register_file(<filename>)
1291 #
1292 # Write a found file and register the title element.
1293 #
1294 # Arguments: 1: a file name
1295 # Output: none
1296 #
1297 sub register_file {
1298   our $tmp_stdin;
1299   my $n = @_;
1300   die "register_file(): one argument is needed; you used $n;"
1301     unless $n == 1;
1302   die 'register_file(): file name is empty;' unless $_[0];
1303
1304   if ($_[0] eq '-') {
1305     &to_tmp($tmp_stdin) && &register_title('stdin');
1306   } else {
1307     &to_tmp($_[0]) && &register_title($_[0]);
1308   }
1309   1;
1310 }                               # register_file()
1311
1312
1313 ##########
1314 # register_title(<filespec>)
1315 #
1316 # Create title element from <filespec> and append to $_REG_TITLE_LIST.
1317 # Basename is created.
1318 #
1319 # Globals in/out: @REG_TITLE
1320 #
1321 # Variable prefix: rt
1322 #
1323 sub register_title {
1324   our @REG_TITLE;
1325   our %Debug;
1326   my $n = @_;
1327   die "register_title(): one argument is needed; you used $n;"
1328     unless $n == 1;
1329   return 1 unless $_[0];
1330
1331   return 1 if scalar @REG_TITLE > 3;
1332
1333   my $title = &get_filename($_[0]);
1334   $title =~ s/\s/_/g;
1335   $title =~ s/\.bz2$//g;
1336   $title =~ s/\.gz$//g;
1337   $title =~ s/\.Z$//g;
1338
1339   if ($Debug{'FILENAMES'}) {
1340     if ($_[0] eq 'stdin') {
1341       print STDERR "register_title(): file title is stdin\n";
1342     } else {
1343       print STDERR "register_title(): file title is $title\n";
1344     }
1345   }                             # if ($Debug{'FILENAMES'})
1346
1347   return 1 unless $title;
1348   push @REG_TITLE, $title;
1349   1;
1350 }                               # register_title()
1351
1352
1353 ##########
1354 # save_stdin()
1355 #
1356 # Store standard input to temporary file (with decompression).
1357 #
1358 sub save_stdin {
1359   our $tmp_stdin;
1360   our $fh_stdin;
1361   our $tmpdir;
1362
1363   our %Debug;
1364
1365   my ($fh_input, $tmp_input);
1366   $tmp_input = File::Spec->catfile($tmpdir, ',input');
1367   open $fh_input, ">$tmp_input" or
1368     die "save_stdin(): could not open $tmp_input";
1369   foreach (<STDIN>) {
1370     print $fh_input $_;
1371   }
1372   close $fh_input;
1373   open $fh_stdin, ">$tmp_stdin" or
1374     die "save_stdin(): could not open $tmp_stdin";
1375   foreach ( &cat_z("$tmp_input") ) {
1376     print $fh_stdin $_;
1377   }
1378   close $fh_stdin;
1379   unlink $tmp_input unless $Debug{'KEEP'};
1380 }       # save_stdin()
1381
1382
1383 ########################################################################
1384 # main_do_fileargs()
1385 ########################################################################
1386
1387 sub main_do_fileargs {
1388   our %Man;
1389   our %Opt;
1390
1391   our @Filespecs;
1392
1393   our $Filespec_Arg;
1394   our $Filespec_Is_Man;
1395   our $Special_Filespec;
1396   our $No_Filespecs;
1397   our $Macro_Pkg;
1398   our $Manspec;
1399
1400   &special_setup();
1401   if ($Opt{'APROPOS'}) {
1402     if ($No_Filespecs) {
1403       &apropos_filespec();
1404       return 1;
1405     }
1406   } else {
1407     foreach (@Filespecs) {
1408       if (/^-$/) {
1409         &save_stdin();
1410         last;
1411       }
1412     }                           # foreach (@Filespecs)
1413   }                             # if ($Opt{'APROPOS'})
1414
1415   my $section = '';
1416   my $ext = '';
1417   my $twoargs = 0;
1418   my $filespec;
1419   my $former_arg;
1420
1421  FILESPEC: foreach (@Filespecs) {
1422     $filespec = $_;
1423     $Filespec_Arg = $_;
1424     $Filespec_Is_Man = 0;
1425     $Manspec = '';
1426     $Special_Filespec = 0;
1427
1428     next FILESPEC unless $filespec;
1429
1430 ### main_do_fileargs()
1431     if ($twoargs) {             # second run
1432       $twoargs = 0;
1433       # $section and $ext are kept from earlier run
1434       my $h = { 'name' => $filespec, 'sec' => $section, 'ext' => $ext };
1435       &man_setup();
1436       if ( &is_man($h) ) {
1437         $Filespec_Arg = "$former_arg $Filespec_Arg";
1438         &special_filespec();
1439         $Filespec_Is_Man = 1;
1440         &man_get($h);
1441         next FILESPEC;
1442       } else {
1443         warn "main_do_fileargs(): $former_arg is neither a file nor a " .
1444           "man page nor a section argument for $filespec;";
1445       }
1446     }
1447     $twoargs = 0;
1448
1449     if ( $Opt{'APROPOS'} ) {
1450       &apropos_filespec();
1451       next FILESPEC;
1452     }
1453
1454     if ($filespec eq '-') {
1455       &register_file('-');
1456       &special_filespec();
1457       next FILESPEC;
1458     } elsif ( &get_filename($filespec) ne $filespec ) { # path with dir
1459       &special_filespec();
1460       if (-f $filespec && -r $filespec) {
1461         &register_file($filespec)
1462       } else {
1463         warn "main_do_fileargs: the argument $filespec is not a file;";
1464       }
1465       next FILESPEC;
1466     } else {                    # neither `-' nor has dir
1467       # check whether filespec is an existing file
1468       unless ( $Man{'FORCE'} ) {
1469         if (-f $filespec && -r $filespec) {
1470           &special_filespec();
1471           &register_file($filespec);
1472           next FILESPEC;
1473         }
1474       }
1475     }                           # if ($filespec eq '-')
1476
1477 ### main_do_fileargs()
1478     # now it must be a man page pattern
1479
1480     if ($Macro_Pkg and $Macro_Pkg ne '-man') {
1481       warn "main_do_fileargs(): $filespec is not a file, " .
1482         "man pages are ignored due to $Macro_Pkg;";
1483       next FILESPEC;
1484     }
1485
1486     # check for man page
1487     &man_setup();
1488     unless ( $Man{'ENABLE'} ) {
1489       warn "main_do_fileargs(): the argument $filespec is not a file;";
1490       next FILESPEC;
1491     }
1492     my $errmsg;
1493     if ( $Man{'FORCE'} ) {
1494       $errmsg = 'is not a man page';
1495     } else {
1496       $errmsg = 'is neither a file nor a man page';
1497     }
1498
1499     $Filespec_Is_Man = 1;
1500
1501 ### main_do_fileargs()
1502     # test filespec with `man:...' or `...(...)' on man page
1503
1504     my @names = ($filespec);
1505     if ($filespec =~ /^man:(.*)$/) {
1506       push @names, $1;
1507     }
1508
1509     foreach my $i (@names) {
1510       next unless $i;
1511       my $h = { 'name' => $i };
1512       if ( &is_man($h) ) {
1513         &special_filespec();
1514         &man_get($h);
1515         next FILESPEC;
1516       }
1517       if ( $i =~ /^(.*)\(([$Man{'AUTO_SEC_CHARS'}])(.*)\)$/ ) {
1518         $h = { 'name' => $1, 'sec' => $2, 'ext' => $3 };
1519         if ( &is_man($h) ) {
1520           &special_filespec();
1521           &man_get($h);
1522           next FILESPEC;
1523         }
1524       }                         # if //
1525       if ( $i =~ /^(.*)\.([$Man{'AUTO_SEC_CHARS'}])(.*)$/ ) {
1526         $h = { 'name' => $1, 'sec' => $2, 'ext' => $3 };
1527         if ( &is_man($h) ) {
1528           &special_filespec();
1529           &man_get($h);
1530           next FILESPEC;
1531         }
1532       }                         # if //
1533     }                           # foreach (@names)
1534
1535 ### main_do_fileargs()
1536     # check on "s name", where "s" is a section with or without an extension
1537     if ($filespec =~ /^([$Man{'AUTO_SEC_CHARS'}])(.*)$/) {
1538       unless ( $Man{'ENABLE'} ) {
1539         warn "main_do_fileargs(): $filespec $errmsg;";
1540         next FILESPEC;
1541       }
1542       $twoargs = 1;
1543       $section = $1;
1544       $ext = $2;
1545       $former_arg = $filespec;
1546       next FILESPEC;
1547     } else {
1548       warn "main_do_fileargs(): $filespec $errmsg;";
1549       next FILESPEC;
1550     }
1551   }     # foreach (@Filespecs)
1552
1553   if ( $twoargs ) {
1554     warn "main_do_fileargs(): no filespec arguments left for second run;";
1555     return 0;
1556   }
1557   1;
1558 }       # main_do_fileargs()
1559
1560
1561 ########################################################################
1562 # main_set_resources()
1563 ########################################################################
1564
1565 ##########
1566 # main_set_resources ()
1567 #
1568 # Determine options for setting X resources with $_DISPLAY_PROG.
1569 #
1570 # Globals: $Display{PROG}, $Output_File_Name
1571 #
1572 sub main_set_resources {
1573   our %Opt;
1574   our %Display;
1575   our %Debug;
1576
1577   our @REG_TITLE;
1578
1579   our $Default_Resolution;
1580   our $tmp_stdin;
1581   our $tmpdir;
1582   our $Output_File_Name;
1583
1584   # $prog   viewer program
1585   # $rl     resource list
1586   unlink $tmp_stdin unless $Debug{'KEEP'};
1587   $Output_File_Name = '';
1588
1589   my @title = @REG_TITLE;
1590   @title = ($Opt{'TITLE'}) unless @title;
1591   @title = () unless @title;
1592
1593   foreach my $n (@title) {
1594     next unless $n;
1595     $n =~ s/^,+// if $n =~ /^,/;
1596     next unless $n;
1597     $Output_File_Name = $Output_File_Name . ',' if $Output_File_Name;
1598     $Output_File_Name = "$Output_File_Name$n";
1599   }                             # foreach (@title)
1600
1601   $Output_File_Name =~ s/^,+//;
1602   $Output_File_Name = '-' unless $Output_File_Name;
1603   $Output_File_Name = File::Spec->catfile($tmpdir, $Output_File_Name);
1604
1605 ### main_set_resources()
1606   unless ($Display{'PROG'}) {   # for example, for groff mode
1607     $Display{'ARGS'} = '';
1608     return 1;
1609   }
1610
1611   my %h = &where_is_prog($Display{'PROG'});
1612   my $prog = $h{'file'};
1613   if ($Display{'ARGS'}) {
1614     $Display{'ARGS'} = "$h{'args'} $Display{'ARGS'}";
1615   } else {
1616     $Display{'ARGS'} = $h{'args'};
1617   }
1618
1619   my @rl = ();
1620
1621   if ($Opt{'BD'}) {
1622     if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
1623       push @rl, '-bd', $Opt{'BD'};
1624     }
1625   }
1626
1627   if ($Opt{'BG'}) {
1628     if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
1629       push @rl, '-bg', $Opt{'BG'};
1630     } elsif ($prog eq 'kghostview') {
1631       push @rl, '--bg', $Opt{'BG'};
1632     } elsif ($prog eq 'xpdf') {
1633       push @rl, '-papercolor', $Opt{'BG'};
1634     }
1635   }
1636
1637 ### main_set_resources()
1638   if ($Opt{'BW'}) {
1639     if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
1640       push @rl, '-bw', $Opt{'BW'};
1641     }
1642   }
1643
1644   if ($Opt{'FG'}) {
1645     if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
1646       push @rl, '-fg', $Opt{'FG'};
1647     } elsif ($prog eq 'kghostview') {
1648       push @rl, '--fg', $Opt{'FG'};
1649     }
1650   }
1651
1652   if ($Opt{'FN'}) {
1653     if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
1654       push @rl, '-fn', $Opt{'FN'};
1655     } elsif ($prog eq 'kghostview') {
1656       push @rl, '--fn', $Opt{'FN'};
1657     }
1658   }
1659
1660   if ($Opt{'GEOMETRY'}) {
1661     if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
1662       push @rl, '-geometry', $Opt{'GEOMETRY'};
1663     } elsif ($prog eq 'kghostview') {
1664       push @rl, '--geometry', $Opt{'GEOMETRY'};
1665     }
1666   }
1667
1668 ### main_set_resources()
1669   if ($Opt{'RESOLUTION'}) {
1670     if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
1671       push @rl, '-resolution', $Opt{'RESOLUTION'};
1672     } elsif ($prog eq 'xpdf') {
1673       if ($Display{'PROG'} !~ / -z/) { # if xpdf does not have option -z
1674         if ($Default_Resolution == 75) {
1675           push @rl, '-z', 104;
1676         } elsif ($Default_Resolution == 100) { # 72dpi is '100'
1677           push @rl, '-z', 139;
1678         }
1679       }
1680     }                           # if $prog
1681   } else {                      # empty $Opt{RESOLUTION}
1682     $Opt{'RESOLUTION'} = $Default_Resolution;
1683     if ($prog =~ /^(gxditview|xditview)$/) {
1684       push @rl, '-resolution', $Default_Resolution;
1685     } elsif ($prog eq 'xpdf') {
1686       if ($Display{'PROG'} !~ / -z/) { # if xpdf does not have option -z
1687         if ($Default_Resolution == 75) {
1688           push @rl, '-z', 104;
1689         } elsif ($Default_Resolution == 100) { # 72dpi is '100'
1690           push @rl, '-z', 139;
1691         }
1692       }
1693     }                           # if $prog
1694   }                             # if $Opt{RESOLUTION}
1695
1696   if ($Opt{'ICONIC'}) {
1697     if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
1698       push @rl, '-iconic';
1699     }
1700   }
1701
1702 ### main_set_resources()
1703   if ($Opt{'RV'}) {
1704     if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
1705       push @rl, '-rv';
1706     }
1707   }
1708
1709   if (@{$Opt{'XRM'}}) {
1710     if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi|xpdf)$/) {
1711       foreach (@{$Opt{'XRM'}}) {
1712         push @rl, '-xrm', $_;
1713       }
1714     }
1715   }
1716
1717   if (@title) {
1718     if ($prog =~ /^(gxditview|xditview)$/) {
1719       push @rl, '-title', $Output_File_Name;
1720     }
1721   }
1722
1723   my $args = join ' ', @rl;
1724   if ($Display{'ARGS'}) {
1725     $Display{'ARGS'} = "$args $Display{'ARGS'}";
1726   } else {
1727     $Display{'ARGS'} = $args;
1728   }
1729
1730   1;
1731 }                               # main_set_resources()
1732
1733
1734 ########################################################################
1735 # set resources
1736 ########################################################################
1737
1738 ##########
1739 # main_display ()
1740 #
1741 # Do the actual display of the whole thing.
1742 #
1743 # Globals:
1744 #   in: $Display{MODE}, $Opt{DEVICE}, @Addopts_Groff,
1745 #       $fh_cat, $tmp_cat, $Opt{PAGER}, $Output_File_Name
1746 #
1747 sub main_display {
1748   our ( %Display, %Opt, %Debug, %Viewer_tty, %Viewer_X );
1749
1750   our @Addopts_Groff;
1751
1752   our ( $groggy, $modefile, $addopts, $fh_cat, $tmp_cat, $tmpdir );
1753   our ( $Output_File_Name, $Default_tty_Device );
1754
1755   $addopts = join ' ', @Addopts_Groff;
1756
1757   if (-z $tmp_cat) {
1758     warn "groffer: empty input\n";
1759     &clean_up();
1760     return 1;
1761   }
1762
1763   $modefile = $Output_File_Name;
1764
1765   # go to the temporary directory to be able to access internal data files
1766   chdir $tmpdir;
1767
1768 ### main_display()
1769  SWITCH: foreach ($Display{'MODE'}) {
1770     /^groff$/ and do {
1771       push @Addopts_Groff, "-T$Opt{'DEVICE'}" if $Opt{'DEVICE'};
1772       $addopts = join ' ', @Addopts_Groff;
1773       $groggy = `cat $tmp_cat | grog`;
1774       die "main_display(): grog error;" if $?;
1775       chomp $groggy;
1776       print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
1777       &_do_opt_V();
1778       unlink $modefile;
1779       rename $tmp_cat, $modefile;
1780       system("cat $modefile | $groggy $addopts");
1781       &clean_up();
1782       next SWITCH;
1783     };                          # /groff/
1784
1785     /^(text|tty)$/ and do {
1786       my $device;
1787       if (! $Opt{'DEVICE'}) {
1788         $device = $Opt{'TEXT_DEVICE'};
1789         $device = $Default_tty_Device unless $device;
1790       } elsif ($Opt{'DEVICE'} =~ /^(ascii||cp1047|latin1|utf8)$/) {
1791         $device = $Opt{'DEVICE'};
1792       } else {
1793         warn "main_display(): wrong device for $Display{'MODE'} mode: " .
1794           "$Opt{'DEVICE'}";
1795       }
1796       $groggy = `cat $tmp_cat | grog -T$device`;
1797       die "main_display(): grog error;" if $?;
1798       chomp $groggy;
1799       print STDERR "grog output: " . $groggy . "\n" if $Debug{'GROG'};
1800       if ($Display{'MODE'} eq 'text') {
1801         &_do_opt_V();
1802         system("cat $tmp_cat | $groggy $addopts");
1803         &clean_up();
1804         next SWITCH;
1805       }
1806
1807 ### main_display()
1808       # mode is not 'text', but `tty'
1809       my %pager;
1810       my @p;
1811       push @p, $Opt{'PAGER'} if $Opt{'PAGER'};
1812       push @p, $ENV{'PAGER'} if $ENV{'PAGER'};
1813       foreach (@p) {
1814         %pager = &where_is_prog($_);
1815         next unless %pager;
1816         if ($pager{'file'} eq 'less') {
1817           if ($pager{'args'}) {
1818             $pager{'args'} = "-r -R $pager{'args'}";
1819           } else {
1820             $pager{'args'} = '-r -R';
1821           }
1822         }
1823         last if $pager{'file'};
1824       }                         # foreach @p
1825       unless (%pager) {
1826         foreach (@{$Viewer_tty{'TTY'}}, @{$Viewer_X{'TTY'}}, 'cat') {
1827           next unless $_;
1828           %pager = &where_is_prog($_);
1829           last if %pager;
1830         }
1831       }
1832       die "main_display(): no pager program found for tty mode;"
1833         unless %pager;
1834       &_do_opt_V();
1835       system("cat $tmp_cat | $groggy $addopts | " .
1836              "$pager{'fullname'} $pager{'args'}");
1837       &clean_up();
1838       next SWITCH;
1839     };                          # /text|tty/
1840
1841     /^source$/ and do {
1842       open $fh_cat, "<$tmp_cat";
1843       foreach (<$fh_cat>) {
1844         print "$_";
1845       }
1846       &clean_up();
1847       next SWITCH;
1848     };
1849
1850 ### main_display()
1851     /^dvi$/ and do {
1852       if ($Opt{'DEVICE'} && $Opt{'DEVICE'} ne 'dvi') {
1853         warn "main_display(): " .
1854           "wrong device for $Display{'MODE'} mode: $Opt{'DEVICE'};"
1855       }
1856       $modefile .= '.dvi';
1857       $groggy = `cat $tmp_cat | grog -Tdvi`;
1858       die "main_display(): grog error;" if $?;
1859       chomp $groggy;
1860       print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
1861       &_do_display();
1862       next SWITCH;
1863     };
1864
1865     /^html$/ and do {
1866       if ($Opt{'DEVICE'} && $Opt{'DEVICE'} ne 'html') {
1867         warn "main_display(): " .
1868           "wrong device for $Display{'MODE'} mode: $Opt{'DEVICE'};"
1869       }
1870       $modefile .= '.html';
1871       $groggy = `cat $tmp_cat | grog -Thtml`;
1872       die "main_display(): grog error;" if $?;
1873       chomp $groggy;
1874       print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
1875       &_do_display();
1876       next SWITCH;
1877     };
1878
1879     /^pdf$/ and do {
1880       $modefile .= '.pdf';
1881       $groggy = `cat $tmp_cat | grog -Tpdf --ligatures`;
1882       die "main_display(): grog error;" if $?;
1883       chomp $groggy;
1884       print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
1885       &_do_display();
1886       next SWITCH;
1887     };
1888
1889
1890     /^pdf2$/ and do {
1891       if ($Opt{'DEVICE'} && $Opt{'DEVICE'} ne 'ps') {
1892         warn "main_display(): " .
1893           "wrong device for $Display{'MODE'} mode: $Opt{'DEVICE'};"
1894       }
1895       $modefile .= '.ps';
1896       $groggy = `cat $tmp_cat | grog -Tps`;
1897       die "main_display(): grog error;" if $?;
1898       chomp $groggy;
1899       print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
1900       &_do_display(\&_make_pdf2);
1901       next SWITCH;
1902     };
1903
1904 ### main_display()
1905     /^ps$/ and do {
1906       if ($Opt{'DEVICE'} && $Opt{'DEVICE'} ne 'ps') {
1907         warn "main_display(): " .
1908           "wrong device for $Display{'MODE'} mode: $Opt{'DEVICE'};"
1909       }
1910       $modefile .= '.ps';
1911       $groggy = `cat $tmp_cat | grog -Tps`;
1912       die "main_display(): grog error;" if $?;
1913       chomp $groggy;
1914       print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
1915       &_do_display();
1916       next SWITCH;
1917     };
1918
1919     /^x$/ and do {
1920       my $device;
1921       if ($Opt{'DEVICE'} && $Opt{'DEVICE'} =~ /^X/) {
1922         $device = $Opt{'DEVICE'};
1923       } else {
1924         if ($Opt{'RESOLUTION'} == 100) {
1925           if ( $Display{'PROG'} =~ /^(g|)xditview$/ ) {
1926             # add width of 800dpi for resolution of 100dpi to the args
1927             $Display{'ARGS'} .= ' -geometry 800';
1928             $Display{'ARGS'} =~ s/^ //;
1929           }
1930         } else {                # RESOLUTIOM != 100
1931           $device = 'X75-12';
1932         }                       # if RESOLUTIOM
1933       }                         # if DEVICE
1934       $groggy = `cat $tmp_cat | grog -T$device -Z`;
1935       die "main_display(): grog error;" if $?;
1936       chomp $groggy;
1937       print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
1938       &_do_display();
1939       next SWITCH;
1940     };
1941
1942 ### main_display()
1943     /^X$/ and do {
1944       if (! $Opt{'DEVICE'}) {
1945         $groggy = `cat $tmp_cat | grog -X`;
1946         die "main_display(): grog error;" if $?;
1947         chomp $groggy;
1948         print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
1949       } elsif ($Opt{'DEVICE'} =~ /^(X.*|dvi|html|lbp|lj4|ps)$/) {
1950         # these devices work with
1951         $groggy = `cat $tmp_cat | grog -T$Opt{'DEVICE'} -X`;
1952         die "main_display(): grog error;" if $?;
1953         chomp $groggy;
1954         print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
1955       } else {
1956         warn "main_display(): wrong device for " .
1957           "$Display{'MODE'} mode: $Opt{'DEVICE'};";
1958         $groggy = `cat $tmp_cat | grog -Z`;
1959         die "main_display(): grog error;" if $?;
1960         chomp $groggy;
1961         print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
1962       }                         # if DEVICE
1963       &_do_display();
1964       next SWITCH;
1965     };
1966
1967     /^.*$/ and do {
1968       die "main_display(): unknown mode `$Display{'MODE'}';";
1969     };
1970
1971   }                             # SWITCH
1972   1;
1973 } # main_display()
1974
1975
1976 ########################
1977 # _do_display ([<prog>])
1978 #
1979 # Perform the generation of the output and view the result.  If an
1980 # argument is given interpret it as a function name that is called in
1981 # the midst (actually only for `pdf').
1982 #
1983 sub _do_display {
1984   our ( %Display, %Debug, %Opt );
1985
1986   our ( $modefile, $tmpdir, $tmp_cat, $addopts, $groggy );
1987   our ( $Viewer_Background );
1988
1989   &_do_opt_V();
1990   unless ($Display{'PROG'}) {
1991     system("$groggy $addopts $tmp_cat");
1992     &clean_up();
1993     return 1;
1994   }
1995   unlink $modefile;
1996   die "_do_display(): empty output;" if -z $tmp_cat;
1997   system("cat $tmp_cat | $groggy $addopts >$modefile");
1998   die "_do_display(): empty output;" if -z $modefile;
1999   &print_times("before display");
2000   if ($_[0] && ref($_[0]) eq 'CODE') {
2001     $_[0]->();
2002   }
2003   unlink $tmp_cat unless $Debug{'KEEP'};
2004
2005   if ( $Opt{'STDOUT'} ) {
2006     my $fh;
2007     open $fh, "<$modefile";
2008     foreach (<$fh>) {
2009       print;
2010     }
2011     close $fh;
2012     return 1;
2013   }
2014
2015   if ( $Viewer_Background ) {
2016     if ($Debug{'KEEP'}) {
2017       exec "$Display{'PROG'} $Display{'ARGS'} $modefile &";
2018     } else {
2019       exec "{ $Display{'PROG'} $Display{'ARGS'} $modefile; " .
2020         "rm -rf $tmpdir; } &";
2021     }
2022   } else {
2023     system("$Display{'PROG'} $Display{'ARGS'} $modefile");
2024     &clean_up();
2025   }
2026 } # _do_display() of main_display()
2027
2028
2029 #############
2030 # _do_opt_V ()
2031 #
2032 # Check on option `-V'; if set print the corresponding output and leave.
2033 #
2034 # Globals: @ARGV, $Display{MODE}, $Display{PROG},
2035 #          $Display{ARGS}, $groggy,  $modefile, $addopts
2036 #
2037 sub _do_opt_V {
2038   our %Opt;
2039   our %Display;
2040   our @ARGV;
2041
2042   our ($groggy, $modefile, $addopts);
2043
2044   if ($Opt{'V'}) {
2045     $Opt{'V'} = 0;
2046     print "Parameters: @ARGV\n";
2047     print "Display Mode: $Display{'MODE'}\n";
2048     print "Output file: $modefile\n";
2049     print "Display prog: $Display{'PROG'} $Display{'ARGS'}\n";
2050     print "Output of grog: $groggy $addopts\n";
2051     my $res = `$groggy $addopts\n`;
2052     chomp $res;
2053     print "groff -V: $res\n";
2054     exit 0;
2055   }
2056   1;
2057 } # _do_opt_V() of main_display()
2058
2059
2060 ##############
2061 # _make_pdf2 ()
2062 #
2063 # Transform to ps/pdf format; for pdf2 mode in _do_display().
2064 #
2065 # Globals: $md_modefile (from main_display())
2066 #
2067 sub _make_pdf2 {
2068   our %Debug;
2069   our %Opt;
2070
2071   our $PDF_Did_Not_Work;
2072   our $PDF_Has_gs;
2073   our $PDF_Has_ps2pdf;
2074   our $Dev_Null;
2075   our $modefile;
2076
2077   die "_make_pdf2(): pdf2 mode did not work;" if $PDF_Did_Not_Work;
2078   my $psfile = $modefile;
2079   die "_make_pdf2(): empty output;" if -z $modefile;
2080   $modefile =~ s/\.ps$/.pdf/;
2081   unlink $modefile;
2082   my $done;
2083   if ($PDF_Has_ps2pdf) {
2084     system("ps2pdf $psfile $modefile 2>$Dev_Null");
2085     $done = ! $?;
2086   }
2087   if (! $done && $PDF_Has_gs) {
2088     system("gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite " .
2089        "-sOutputFile=$modefile -c save pop -f $psfile 2>$Dev_Null");
2090     $done = ! $?;
2091   }
2092   if (! $done) {
2093     $PDF_Did_Not_Work = 1;
2094     warn '_make_pdf2(): Could not transform into pdf format, ' .
2095       'the Postscript mode (ps) is used instead;';
2096     $Opt{'MODE'} = 'ps';
2097     &main_set_mode();
2098     &main_set_resources();
2099     &main_display();
2100     exit 0;
2101   }
2102   unlink $psfile unless $Debug{'KEEP'};
2103   1;
2104 } # _make_pdf2() of main_display()
2105
2106
2107 1;
2108 ########################################################################
2109 ### Emacs settings
2110 # Local Variables:
2111 # mode: CPerl
2112 # End: