Vim Patior

Edit file

File name : main_subs.pl

Content :

#! /usr/bin/perl

# groffer - display groff files

# Source file position: <groff-source>/contrib/groffer/subs.pl
# Installed position: <prefix>/lib/groff/groffer/subs.pl

# Last update: 27 Aug 2015

# This file is part of 'groffer', which is part of 'groff'.

# 'groff' is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.

# 'groff' is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see
# <http://www.gnu.org/licenses/gpl-2.0.html>.

########################################################################
# This file contains the main functions formerly in 'groff.pl'

use strict;
use warnings;

########################################################################
# main_set_options()
########################################################################

sub main_set_options {
  our %Opts_Cmdline_Short;
  our %Opts_Cmdline_Long;
  our $Opts_Cmdline_Long_Str;
  our %Opts_Cmdline_Double;
  our %Opts_Groff_Short;

# the following options are ignored in groffer.pl, but are kept from
  # groffer.sh: --shell arg, --debug-shell

my @opts_ignored_short_na = ();
  my @opts_ignored_short_arg = ();

my @opts_ignored_long_na = ('debug-shell');

my @opts_ignored_long_arg = ('shell');

###### groffer native options

my @opts_groffer_short_na = ('h', 'Q', 'v', 'V', 'X', 'Z');
  my @opts_groffer_short_arg = ('T');

my @opts_groffer_long_na = ('auto', 'apropos', 'apropos-data',
  'apropos-devel', 'apropos-progs', 'debug', 'debug-all',
  'debug-filenames', 'debug-func', 'debug-grog', 'debug-not-func',
  'debug-keep', 'debug-lm', 'debug-params', 'debug-stacks',
  'debug-tmpdir', 'debug-user', 'default', 'do-nothing', 'dvi',
  'groff', 'help', 'intermediate-output', 'html', 'latin1', 'man',
  'no-location', 'no-man', 'no-special', 'pdf', 'pdf2', 'ps', 'rv',
  'source', 'text', 'to-stdout', 'text-device', 'tty', 'tty-device',
  'utf8', 'version', 'whatis', 'where', 'www', 'x', 'X', 'xhtml');

### main_set_options()
  my @opts_groffer_long_arg =
    ('default-modes', 'device', 'extension', 'fg', 'fn', 'font',
     'foreground', 'mode', 'print', 'title', 'viewer',
     # tty viewers are ignored
     'dvi-viewer-tty', 'html-viewer-tty', 'pdf-viewer-tty',
     'ps-viewer-tty', 'tty-viewer-tty', 'www-viewer-tty',
     'X-viewer-tty', 'x-viewer-tty', 'xhtml-viewer-tty',,
     # viewers for modes are ignored
     'dvi-viewer', 'html-viewer', 'pdf-viewer', 'ps-viewer', 'tty-viewer',
     'www-viewer', 'X-viewer', 'x-viewer', 'xhtml-viewer',
    );

##### groffer options inhereted from groff

my @opts_groff_short_na = ('a', 'b', 'c', 'C', 'e', 'E', 'g', 'G',
  'i', 'j', 'J', 'k', 'l', 'N', 'p', 'R', 's', 'S', 't', 'U', 'z');

my @opts_groff_short_arg = ('d', 'f', 'F', 'I', 'K', 'L', 'm', 'M', 'n',
  'o', 'P', 'r', 'w', 'W');

my @opts_groff_long_na = ();
  my @opts_groff_long_arg = ();

##### groffer options inhereted from the X Window toolkit

my @opts_x_short_na = ();
  my @opts_x_short_arg = ();

my @opts_x_long_na = ('iconic', 'rv');

my @opts_x_long_arg = ('background', 'bd', 'bg', 'bordercolor',
  'borderwidth', 'bw', 'display', 'fg', 'fn', 'font', 'foreground',
  'ft', 'geometry', 'resolution', 'title', 'xrm');

### main_set_options()
  ###### groffer options inherited from man

my @opts_man_short_na = ();
  my @opts_man_short_arg = ();

my @opts_man_long_na = ('all', 'ascii', 'catman', 'ditroff',
  'local-file', 'location', 'troff', 'update');

my @opts_man_long_arg = ('locale', 'manpath', 'pager',
  'preprocessor', 'prompt', 'sections', 'systems', 'troff-device');

###### additional options for parsing evironment variable $MANOPT only

my @opts_manopt_short_na = ('7', 'a', 'c', 'd', 'D', 'f', 'h', 'k',
  'l', 't', 'u', 'V', 'w', 'Z');

my @opts_manopt_short_arg = ('e', 'L', 'm', 'M', 'p', 'P', 'r', 'S',
  'T');

my @opts_manopt_long_na = (@opts_man_long_na, 'apropos', 'debug',
  'default', 'help', 'html', 'ignore-case', 'location-cat',
  'match-case', 'troff', 'update', 'version', 'whatis', 'where',
  'where-cat');

my @opts_manopt_long_arg = (@opts_man_long_na, 'config_file',
  'encoding', 'extension', 'locale');

### main_set_options()
  ###### collections of command-line options

# There are two hashes that control the whole of the command-line
  # options, one for short and one for long options.  Options without
  # and with arguments are mixed by advicing a value of 0 for an option
  # without argument and a value of 1 for an option with argument.
  # The options are with leading minus.

foreach (@opts_groffer_short_na, @opts_groff_short_na,
	   @opts_x_short_na, @opts_man_short_na, @opts_ignored_short_na) {
    $Opts_Cmdline_Short{"-$_"} = 0 if $_;
  }
  foreach (@opts_groffer_short_arg, @opts_groff_short_arg,
	   @opts_x_short_arg, @opts_man_short_arg, @opts_ignored_short_arg) {
    $Opts_Cmdline_Short{"-$_"} = 1 if $_;
  }

foreach (@opts_groffer_long_na, @opts_groff_long_na,
	   @opts_x_long_na, @opts_man_long_na, @opts_ignored_long_na) {
    $Opts_Cmdline_Long{"--$_"} = 0 if $_;
  }
  foreach (@opts_groffer_long_arg, @opts_groff_long_arg,
	   @opts_x_long_arg, @opts_man_long_arg, @opts_ignored_long_arg) {
    $Opts_Cmdline_Long{"--$_"} = 1 if $_;
  }

# For determining abbreviations of an option take two spaces as join
  # for better check.
  # The options are without leading minus.
  $Opts_Cmdline_Long_Str = join '  ', keys %Opts_Cmdline_Long;
  if ($Opts_Cmdline_Long_Str) {
    $Opts_Cmdline_Long_Str = " $Opts_Cmdline_Long_Str ";
    $Opts_Cmdline_Long_Str =~ s/--//g;
  }

### main_set_options()
  # options with equal meaning are mapped to a single option name
  # all of these have leading minus characters
  %Opts_Cmdline_Double = ('-h' => '--help',
			  '-Q' => '--source',
			  '-T' => '--device',
			  '-v' => '--version',
			  '-Z' => '--intermediate-output',
			  '--bd' => '--bordercolor',
			  '--bg' => '--background',
			  '--bw' => '--borderwidth',
			  '--debug-all' => '--debug',
			  '--ditroff' => '--intermediate-output',
			  '--fg' => '--foreground',
			  '--fn' => '--font',
			  '--ft' => '--font',
			  '--latin1' => '--tty',
			  '--troff-device' => '--device',
			  '--tty-device' => '--text-device',
			  '--viewer' => '--viewer',
			  '--where' => '--location',
			  '--www' => '--html',
			  '--X' => '--x',
			  '--xhtml' => '--html',
			  # '--dvi-viewer' => '--viewer',
			  '--dvi-viewer-tty' => '--viewer',
			  '--html-viewer-tty' => '--viewer',
			  '--xhtml-viewer-tty' => '--pager',
			  '--pdf-viewer-tty' => '--viewer',
			  '--ps-viewer-tty' => '--viewer',
			  '--tty-viewer' => '--pager',
			  '--tty-viewer-tty' => '--pager',
			  '--www-viewer' => '--viewer',
			  '--www-viewer-tty' => '--pager',
			  '--X-viewer' => '--viewer', '--X-viewer-tty'
			  => '--pager', '--x-viewer' => '--viewer',
			  '--x-viewer-tty' => '--pager', );

# groff short options with leading minus
  foreach (@opts_groff_short_na) {
    $Opts_Groff_Short{"-$_"} = 0;
  }
  foreach (@opts_groff_short_arg) {
    $Opts_Groff_Short{"-$_"} = 1;
  }

} # main_set_options()

########################################################################
# main_parse_MANOPT
########################################################################

sub main_parse_MANOPT {
  our @Manopt;
  our $File_split_env_sh;

if ( $ENV{'MANOPT'} ) {
    @Manopt = `sh $File_split_env_sh MANOPT`;
    chomp @Manopt;

my @manopt;
    # %opts stores options that are used by groffer for $MANOPT
    # All options not in %opts are ignored.
    # Check options used with %Opts_Cmdline_Double.
    # 0: option used ('' for ignore), 1: has argument or not
    ### main_parse_MANOPT()
    my %opts = ('-7' => ['--ascii', 0],
		'-L' => ['--locale', 1],
		'-M' => ['--manpath', 1],
		'-P' => ['--pager', 1],
		'-S' => ['--sections', 1],
		'-T' => ['-T', 1],
		'-w' => ['--location', 0],
		'-a' => ['--all', 0],
		'-c' => ['', 1],
		'-e' => ['--extension', 1],
		'-f' => ['--whatis', 1],
		'-m' => ['--systems', 1],
		'-p' => ['', 1],
		'-r' => ['', 1],
		'-manpath' => ['--manpath', 1],
		'-pager' => ['--pager', 1],
		'-prompt' => ['', 1],
		'-sections' => ['--sections', 1],
		'--all' => ['--all', 0],
		'--ascii' => ['--ascii', 0],
		'--catman' => ['', 1],
		'--device' => ['-T', 1],
		'--extension' => ['--extension', 1],
		'--locale' => ['--locale', 1],
		'--location' => ['--location', 0],
		'--manpath' => ['--manpath', 1],
		'--preprocessor' => ['', 1],
		'--systems' => ['--systems', 1],
		'--whatis' => ['--whatis', 1],
		'--where' => ['--location', 0],
	       );

### main_parse_MANOPT()
    my ($opt, $has_arg);
    my $i = 0;
    my $n = $#Manopt;
    while ($i <= $n) {
      my $o = $Manopt[$i];
      ++$i;
      # ignore, when not in %opts
      next unless (exists $opts{$o});
      if (($o eq '-D') or ($o eq '--default')) {
	@manopt = ();
	next;
      }
      $opt = $opts{$o}[0];
      $has_arg = $opts{$o}[1];
      # ignore, when empty in %opts
      unless ($opt) {
	# ignore without argument
	next unless ($has_arg);
	# ignore the argument as well
	++$i;
	next;
      }
      if ($has_arg) {
	last if ($i > $n);
	push @manopt, $opt, $Manopt[$i];
	++$i;
	next;
      } else {
	push @manopt, $opt;
	next;
      }
    }
    @Manopt = @manopt;
  }
}				# main_parse_MANOPT()

########################################################################
# configuration files, $GROFFER_OPT, and command line, main_config_params()
########################################################################

sub main_config_params {	# handle configuration files
  our @Options;
  our @Filespecs;
  our @Starting_Conf;
  our @Starting_ARGV = @ARGV;

our %Opts_Cmdline_Short;
  our %Opts_Cmdline_Long;
  our $Opts_Cmdline_Long_Str;
  our %Opts_Cmdline_Double;
  our %Opts_Groff_Short;

our $File_split_env_sh;
  our @Manopt;
  our @Conf_Files;

# options may not be abbreviated, but must be exact
  my @conf_args;
  foreach my $f ( @Conf_Files ) {
    if (-s $f) {
      my $fh;
      open $fh, "<$f" || next;
      my $nr = 0;
    LINE: foreach my $line (<$fh>) {
	++ $nr;
	chomp $line;
	# remove starting and ending whitespace
	$line =~ s/^\s+|\s+$//g;
	# replace whitespace by single space
	$line =~ s/\s+/ /g;
	# ignore all lines that do not start with minus
	next unless $line =~ /^-/;
	# three minus
	if ($line =~ /^---/) {
	  warn "Wrong option $line in configuration file $f.\n";
	  next;
	}
	if ( $line =~ /^--[ =]/ ) {
	  warn "No option name in '$line' in configuration " .
	    "file $f.\n";
	  next;
	}
	push @Starting_Conf, $line;
	# -- or -
	if ($line =~ /^--?$/) {
	  warn "'$line' is not allowed in configuration files.\n";
	  next; }
### main_config_params()
	if ($line =~ /^--/) {		# line is long option
	  my ($name, $arg);
	  if ($line =~ /[ =]/) {	# has arg on line $line =~
	    /^(--[^ =]+)[ =] ?(.*)$/;
	    ($name, $arg) = ($1, $2);
	    $arg =~ s/[\'\"]//g;
	  } else {			# does not have an argument on line
	    $name = $line;
	  } $name =~ s/[\'\"]//g;
	  unless (exists $Opts_Cmdline_Long{$name}) {
	    # option does not exist
	    warn "Option '$name' does not exist.\n";
	    next LINE;
	  }
	  # option exists
	  if ( $Opts_Cmdline_Long{$name} ) { # option has arg
	    if (defined $arg) {
	      push @conf_args, $name, $arg;
	      next LINE;
	    } else { warn "Option '$name' needs an argument in " .
		       "configuration file $f\n";
		     next LINE;
		   }
	  } else { # option has no arg
	    if (defined $arg) {
	      warn "Option '$name' may not have an argument " .
		"in configuration file $f\n";
	      next LINE;
	    } else {
	      push @conf_args, $name; next LINE;
	    }
	  }
### main_config_params()
	} else {			# line is short option or cluster
	  $line =~ s/^-//;
	  while ($line) {
	    $line =~ s/^(.)//;
	    my $opt = "-$1";
	    next if ($opt =~ /\'\"/);
	    if ($opt =~ /- /) {
	      warn "Option '$conf_args[$#conf_args]' does not " .
		"have an argument.\n";
	      next LINE;
	    }
	    if ( exists $Opts_Cmdline_Short{$opt} ) {
	      # short opt exists
	      push @conf_args, $opt;
	      if ( $Opts_Cmdline_Short{$opt} ) { # with arg
		my $arg = $line;
		$arg =~ s/^ //;
		$arg =~ s/\'\"//g;
		push @conf_args, "$arg";
		next LINE;
	      } else { # no arg
		next;
	      }
	    } else { # short option does not exist
	      warn "Wrong short option '-$opt' from " .
		"configuration.  Rest of line ignored.\n";
	      next LINE;
	    }
	  }
	}
      }
      close $fh;
    }
  }

### main_config_params()
  #handle environment variable $GROFFER_OPT
  my @GROFFER_OPT;
  if ( $ENV{'GROFFER_OPT'} ) {
    @GROFFER_OPT = `sh $File_split_env_sh GROFFER_OPT`;
    chomp @GROFFER_OPT;
  }

# Handle command-line parameters together with $GROFFER_OPT.
  # Options can be abbreviated, with each - as abbreviation place.
  {
    my @argv0 = (@GROFFER_OPT, @ARGV);
    my @argv;
    my $only_files = 0;
    my $n = $#argv0;		# last element
    my $n1 = scalar @GROFFER_OPT; # first element of @ARGV
    my $i = 0;			# number of the element
    my @s = ('the environment variable $GROFFER_OPT', 'the command line');
    my $j = 0;			# index in @s, 0 before $n1, 1 then
  ELT: while ($i <= $n) {
      my $elt = $argv0[$i];
      $j = 1 if $i >= $n1;
      ++$i;
      # remove starting and ending whitespace
      $elt =~ s/^\s+|\s+$//g;
      # replace whitespace by single space
      $elt =~ s/\s+/ /g;

if ($only_files) {
	push @Filespecs, $elt;
	next ELT;
      }

### main_config_params()
      if ( $elt =~ /^-$/ ) { # -
	push @Filespecs, $elt;
	next ELT;
      }
      if ($elt =~ /^--$/) { # --
	$only_files = 1;
	next ELT;
      }

if ($elt =~ /^--[ =]/) { # no option name
	warn "No option name in '$elt' at $s[$j].\n";
	next ELT;
      }
      if ($elt =~ /^---/) { # wrong with three minus
	warn "Wrong option '$elt' at $s[$j].\n";
	next ELT;
      }

if ($elt =~ /^--[^-]/) { # long option
	my ($name, $opt, $abbrev, $arg);
	if ($elt =~ /[ =]/) { # has arg on elt
	  $elt =~ /^--([^ =]+)[ =] ?(.*)$/;
	  ($name, $arg) = ($1, $2);
	  $opt = "--$name";
	  $abbrev = $name;
	  $arg =~ s/[\'\"]//g;
	} else {		# does not have an argument in the element
	  $opt = $name = $elt;
	  $name =~ s/^--//;
	  $abbrev = $name;
	}
### main_config_params()
	# remove quotes in name
	$name =~ s/[\'\"]//g;
	my $match = $name;
	$match =~ s/-/[^- ]*-/g;
	if ( exists $Opts_Cmdline_Long{$opt} ) {
	  # option exists exactly
	} elsif	( $Opts_Cmdline_Long_Str =~ / (${match}[^- ]*?) / ) {
	  # option is an abbreviation without further -
	  my $n0 = $1;
	  if ( $Opts_Cmdline_Long_Str =~
	       /\s(${match}[^-\s]*)\s.*\s(${match}[^-\s]*) / ) {
	    warn "Option name '--$abbrev' is not unique: " .
	      "--$1 --$2 \n";
	    next ELT;
	  }
	  $name = $n0;
	  $opt = "--$n0";
	} elsif ( $Opts_Cmdline_Long_Str =~ /\s(${match}[^\s]*)\s/ ) {
	  # option is an abbreviation with further -
	  my $n0 = $1;
	  if ( $Opts_Cmdline_Long_Str =~
	       /\s(${match}[^\s]*)\s.*\s(${match}[^\s]*)\s/ ) {
	    warn "Option name '--$abbrev' is not unique: " .
	      "--$1 --$2 \n";
	    next ELT;
	  }
	  $name = $n0;
	  $opt = "--$n0";
	} else {
	  warn "Option '--$abbrev' does not exist.\n";
	  next ELT;
	}
### main_config_params()
	if ( $Opts_Cmdline_Long{$opt} ) { # option has arg
	  if (defined $arg) {
	    push @argv, "--$name", $arg;
	    next ELT;
	  } else { # $arg not defined, argument at next	element
	    if (($i == $n1) || ($i > $n)) {
	      warn "No argument left for option " .
		"'$elt' at $s[$j].\n";
	      next ELT; }
	    # add argument as next element
	    push @argv, "--$name", $argv0[$i];
	    ++$i;
	    next ELT;
	  }		# if (defined $arg)
	} else {	# option has no arg
	  if (defined $arg) {
	    warn "Option '$abbrev' may not have an argument " .
	      "at $s[$j].\n";
	    next ELT;
	  } else {
	    push @argv, "--$name";
	    next ELT;
	  }
	}		# if ($Opts_Cmdline_Long{$opt})
### main_config_params()
      } elsif ( $elt =~ /^-[^-]/ ) { # short option or cluster
	my $cluster = $elt;
	$cluster =~ s/^-//;
	while ($cluster) {
	  $cluster =~ s/^(.)//;
	  my $opt = "-$1";
	  if ( exists $Opts_Cmdline_Short{$opt} ) {	# opt exists
	    if ( $Opts_Cmdline_Short{$opt} ) {		# with arg
	      if ($cluster) {	# has argument in this element
		$cluster =~ s/^\s//;
		$cluster =~ s/\'\"//g;
		# add argument as rest of this element
		push @argv, $opt, $cluster;
		next ELT;
	      } else { # argument at next element
		if (($i == $n1) || ($i > $n)) {
		  warn "No argument left for option " .
		    "'$opt' at $s[$j].\n";
		  next ELT; }
### main_config_params()
		# add argument as next element
		push @argv, $opt, $argv0[$i];
		++$i;
		next ELT;
	      }
	    } else { # no arg
	      push @argv, $opt; next;
	    }
	  } else { # short option does not exist
	    warn "Wrong short option '$opt' at $s[$j].\n";
	    next ELT;
	  }		# if (exists $Opts_Cmdline_Short{$opt})
	}		# while ($cluster)
      } else {		# not an option, file name
	push @Filespecs, $elt;
	next;
      }
    }
### main_config_params()
    @Options = (@Manopt, @conf_args, @argv);
    foreach my $i ( 0..$#Options ) {
      if ( exists $Opts_Cmdline_Double{$Options[$i]} ) {
	$Options[$i] = $Opts_Cmdline_Double{ $Options[$i] };
      }
    } @Filespecs = ('-') unless (@Filespecs);
    @ARGV = (@Options, '--', @Filespecs);
  }
} # main_config_params()

########################################################################
# main_parse_params()
########################################################################

sub main_parse_params {
  # options that are ignored in this part
  # shell version of groffer: --debug*, --shell
  # man options: --catman (only special in man),
  #		 --preprocessor (force groff preproc., handled by grog),
  #		 --prompt (prompt for less, ignored),
  #		 --troff (-mandoc, handled by grog),
  #		 --update (inode check, ignored)
  our %Opt;
  our %Man;
  our %Debug;
  our %Opts_Cmdline_Short;
  our %Opts_Cmdline_Double;
  our %Opts_Cmdline_Long;
  our %Opts_Groff_Short;
  our $i;
  our $n;
  our @Starting_ARGV;
  our @Starting_Conf;
  our @Default_Modes;
  our @Addopts_Groff;
  our @Options;

my %ignored_opts = (
		      '--catman' => 0,
		      '--debug-func' => 0,
		      '--debug-not-func' => 0,
		      '--debug-lm' => 0,
		      '--debug-shell' => 0,
		      '--debug-stacks' => 0,
		      '--debug-user' => 0,
		      '--preprocessor' => 1,
		      '--prompt' => 1,
		      '--shell' => 1,
		      '--troff' => 0,
		      '--update' => 0,
		     );

### main_parse_params()
  my %long_opts =
    (
     '--debug' =>
     sub { $Debug{$_} = 1 foreach (qw/FILENAMES GROG KEEP PARAMS TMPDIR/); },
     '--debug-filenames' => sub { $Debug{'FILENAMES'} = 1; },
     '--debug-grog' => sub { $Debug{'GROG'} = 1; },
     '--debug-keep' => sub { $Debug{'KEEP'} = 1; $Debug{'PARAMS'} = 1; },
     '--debug-params' => sub { $Debug{'PARAMS'} = 1; },
     '--debug-tmpdir' => sub { $Debug{'TMPDIR'} = 1; },
     '--help' => sub { &usage(); $Opt{'DO_NOTHING'} = 1; },
     '--source' => sub { $Opt{'MODE'} = 'source'; },
     '--device' =>
     sub { $Opt{'DEVICE'} = &_get_arg();
	   my %modes = (
			'ascii' => 'tty',
			'cp1047' => 'tty',
			'dvi'=> 'dvi',
			'html' => 'html',
			'xhtml' => 'html',
			'latin1' => 'tty',
			'lbp' => 'groff',
			'lj4' => 'groff',
			'pdf' => 'pdf',
			'pdf2' => 'pdf2',
			'ps' => 'ps',
			'utf8' => 'tty',
		       );
	    if ($Opt{'DEVICE'} =~ /^X.*/) {
	      $Opt{'MODE'} = 'x';
	    } elsif ( exists $modes{ $Opt{'DEVICE'} } ) {
	      if ( $modes{ $Opt{'DEVICE'} } eq 'tty' ) {
		$Opt{'MODE'} = 'tty'
		  unless ($Opt{'MODE'} eq 'text');
	      } else {
		$Opt{'MODE'} = $modes{ $Opt{'DEVICE'} };
	      }
	    } else {
	      # for all elements not in %modes
	      $Opt{'MODE'} = 'groff';
	    }
	  },
### main_parse_params()
     '--version' => sub { &version(); $Opt{'DO_NOTHING'} = 1; },
     '--intermediate-output' => sub { $Opt{'Z'} = 1; },
     '--all' => sub { $Opt{'ALL'} = 1; },
     '--apropos' =>		# run apropos
     sub { $Opt{'APROPOS'} = 1;
	   delete $Opt{'APROPOS_SECTIONS'};
	   delete $Opt{'WHATIS'}; },
     '--apropos-data' =>	# run apropos for data sections
     sub { $Opt{'APROPOS'} = 1;
	   $Opt{'APROPOS_SECTIONS'} = '457';
	   delete $Opt{'WHATIS'}; },
     '--apropos-devel' =>	# run apropos for devel sections
     sub { $Opt{'APROPOS'} = 1;
	   $Opt{'APROPOS_SECTIONS'} = '239';
	   delete $Opt{'WHATIS'}; },
     '--apropos-progs' =>	# run apropos for prog sections
     sub { $Opt{'APROPOS'} = 1;
	   $Opt{'APROPOS_SECTIONS'} = '168';
	   delete $Opt{'WHATIS'}; },
     '--ascii' =>
     sub { push @Addopts_Groff, '-mtty-char';
	   $Opt{'MODE'} = 'text' unless $Opt{'MODE'}; },
     '--auto' =>		# the default automatic mode
     sub { delete $Opt{'MODE'}; },
     '--bordercolor' =>		# border color for viewers, arg
     sub { $Opt{'BD'} = &_get_arg(); },
     '--background' =>		# background color for viewers, arg
     sub { $Opt{'BG'} = &_get_arg(); },
### main_parse_params()
     '--borderwidth' =>		# border width for viewers, arg
     sub { $Opt{'BW'} = &_get_arg(); },
     '--default' =>		# reset variables to default
     sub { %Opt = (); },
     '--default-modes' =>	# sequence of modes in auto mode; arg
     sub { $Opt{'DEFAULT_MODES'} = &_get_arg(); },
     '--display' =>		# set X display, arg
     sub { $Opt{'DISPLAY'} = &_get_arg(); },
     '--do-nothing' => sub { $Opt{'DO_NOTHING'} = 1; },
     '--dvi' => sub { $Opt{'MODE'} = 'dvi'; },
     '--extension' =>		# the extension for man pages, arg
     sub { $Opt{'EXTENSION'} = &_get_arg(); },
     '--foreground' =>		# foreground color for viewers, arg
     sub { $Opt{'FG'} = &_get_arg(); },
     '--font' =>		# set font for viewers, arg
     sub { $Opt{'FN'} = &_get_arg(); },
     '--geometry' =>		# window geometry for viewers, arg
     sub { $Opt{'GEOMETRY'} = &_get_arg(); },
     '--groff' => sub { $Opt{'MODE'} = 'groff'; },
     '--html' => sub { $Opt{'MODE'} = 'html'; },
     '--iconic' =>		# start viewers as icons
     sub { $Opt{'ICONIC'} = 1; },
     '--locale' =>		# set language for man pages, arg
     # argument is xx[_territory[.codeset[@modifier]]] (ISO 639,...)
     sub { $Opt{'LANG'} = &_get_arg(); },
     '--local-file' =>		# force local files; same as '--no-man'
     sub { delete $Man{'ENABLE'}; delete $Man{'FORCE'}; },
     '--location' =>		# print file locations to stderr
     sub { $Opt{'LOCATION'} = 1; },
### main_parse_params()
     '--man' =>			# force all file params to be man pages
     sub { $Man{'ENABLE'} = 1; $Man{'FORCE'} = 1; },
     '--manpath' =>		# specify search path for man pages, arg
     # arg is colon-separated list of directories
     sub { $Opt{'MANPATH'} = &_get_arg(); },
     '--mode' =>		# display mode
     sub { my $arg = &_get_arg();
	   my %modes = ( '' => '',
			 'auto' => '',
			 'groff' => 'groff',
			 'html' => 'html',
			 'www' => 'html',
			 'dvi' => 'dvi',
			 'pdf' => 'pdf',
			 'pdf2' => 'pdf2',
			 'ps' => 'ps',
			 'text' => 'text',
			 'tty' => 'tty',
			 'X' => 'x',
			 'x' => 'x',
			 'Q' => 'source',
			 'source' => 'source',
		       );
	   if ( exists $modes{$arg} ) {
	     if ( $modes{$arg} ) {
	       $Opt{'MODE'} = $modes{$arg};
	     } else {
	       delete $Opt{'MODE'};
	     }
	   } else {
	     warn "Unknown mode in '$arg' for --mode\n";
	   }
	 },
### main_parse_params()
     '--no-location' =>		# disable former call to '--location'
     sub { delete $Opt{'LOCATION'}; },
     '--no-man' =>		# disable search for man pages
     sub { delete $Man{'ENABLE'}; delete $Man{'FORCE'}; },
     '--no-special' =>		# disable some special former calls
     sub { delete $Opt{'ALL'}; delete $Opt{'APROPOS'};
	   delete $Opt{'WHATIS'}; },
     '--pager' =>		# set paging program for tty mode, arg
     sub { $Opt{'PAGER'} = &_get_arg(); },
     '--pdf' => sub { $Opt{'MODE'} = 'pdf'; },
     '--pdf2' => sub { $Opt{'MODE'} = 'pdf2'; },
     '--print' =>		# print argument, for argument test
     sub { my $arg = &_get_arg; print STDERR $arg . "\n"; },
     '--ps' => sub { $Opt{'MODE'} = 'ps'; },
     '--resolution' =>		# set resolution for X devices, arg
     sub { my $arg = &_get_arg();
	   my %res = ( '75' => 75,
		       '75dpi' => 75,
		       '100' => 100,
		       '100dpi' => 100,
		     );
	   if (exists $res{$arg}) {
	     $Opt{'RESOLUTION'} = $res{$arg};
	   } else {
	     warn "--resolution allows only 75, 75dpi, " .
	       "100, 100dpi as argument.\n";
	   }
	 },
### main_parse_params()
     '--rv' => sub { $Opt{'RV'} = 1; },
     '--sections' =>		# specify sections for man pages, arg
     # arg is a ':'-separated (colon) list of section names
     sub { my $arg = &_get_arg();
	   my @arg = split /:/, $arg;
	   my $s;
	   foreach (@arg) {
	     /^(.)/;
	     my $c = $1;
	     if ($Man{'AUTO_SEC_CHARS'} =~ /$c/) {
	       $s .= $c;
	     } else {
	       warn "main_parse_params(): not a man section '$c';";
	     }
	   }
	   $Opt{'SECTIONS'} = $s; },
     '--systems' =>		# man pages for different OS's, arg
     # argument is a comma-separated list
     sub { $Opt{'SYSTEMS'} = &_get_arg(); },
     '--text' =>		# text mode without pager
     sub { $Opt{'MODE'} = 'text'; },
     '--title' =>		# title for X viewers; arg
     sub { my $arg = &_get_arg();
	   if ($arg) {
	     if ( $Opt{'TITLE'} ) {
	       $Opt{'TITLE'} = "$Opt{'TITLE'} $arg";
	     } else {
	       $Opt{'TITLE'} = $arg;
	     }
	   }
	 },
     '--text-device' =>		# device for tty mode; arg
     sub { $Opt{'TEXT_DEVICE'} = &_get_arg(); },
     '--to-stdout' =>		# print mode file without display
     sub { $Opt{'STDOUT'} = 1; },
     '--tty' =>			# tty mode, text with pager
     sub { $Opt{'MODE'} = 'tty'; },
     '--viewer' =>		# viewer for actiual mode
     sub { $Opt{'VIEWER'} = &_get_arg(); },
     '--whatis' => sub { delete $Opt{'APROPOS'}; $Opt{'WHATIS'} = 1; },
     '--x' => sub { $Opt{'MODE'} = 'x'; },
### main_parse_params()
     '--xrm' =>			# pass X resource string, arg
     sub { my $arg = &_get_arg(); push @{$Opt{'XRM'}}, $arg if $arg; },
    );

#     '--dvi-viewer' =>		# viewer program for dvi mode; arg
#     sub { $Opt{'VIEWER_DVI'} = &_get_arg(); },
#     '--html-viewer' =>		# viewer program for html mode; arg
#     sub { $Opt{'VIEWER_HTML'} = &_get_arg(); },
#     '--pdf-viewer' =>		# viewer program for pdf and pdf2 mode; arg
#     sub { $Opt{'VIEWER_PDF'} = &_get_arg(); },
#     '--ps-viewer' =>		# viewer program for ps mode; arg
#     sub { $Opt{'VIEWER_PS'} = &_get_arg(); },
#     '--x-viewer' =>		# viewer program for x mode; arg
#     sub { $Opt{'VIEWER_X'} = &_get_arg(); },

my %short_opts = (
		    '-V' => sub { $Opt{'V'} = 1; },
		    '-X' => sub { $Opt{'X'} = 1; },
		   );

if (0) {
    # check if all options are handled in parse parameters

# short options
    my %these_opts = (%ignored_opts, %short_opts, %Opts_Groff_Short,
		      %Opts_Cmdline_Double);
    foreach my $key (keys %Opts_Cmdline_Short) {
      warn "unused option: $key" unless exists $these_opts{$key};
    }

# long options
    %these_opts = (%ignored_opts, %long_opts, %Opts_Cmdline_Double);
    foreach my $key (keys %Opts_Cmdline_Long) {
      warn "unused option: $key" unless exists $these_opts{$key};
    }
  }				# if (0)

### main_parse_params()
 OPTION: while ($i <= $n) {
    my $opt = $Options[$i];
    ++$i;
    if ($opt =~ /^-([^-])$/) {	# single minus for short option
      if (exists $short_opts{$opt}) { # short option handled by hash
	$short_opts{$opt}->();
	next OPTION;
      } else {			# $short_opts{$opt} does not exist
	my $c = $1;		# the option character
	next OPTION unless $c;
	if ( exists $Opts_Groff_Short{ $opt } ) { # groff short option
	  if ( $Opts_Groff_Short{ $opt } ) { # option has argument
	    my $arg = $Options[$i];
	    ++$i;
	    push @Addopts_Groff, $opt, $arg;
	    next OPTION;
	  } else {		# no argument for this option
	    push @Addopts_Groff, $opt;
	    next OPTION;
	  }
	} elsif ( exists $Opts_Cmdline_Short{ $opt } ) {
	  # is a groffer short option
	  warn "Groffer option $opt not handled " .
	    "in parameter parsing";
	} else {
	  warn "$opt is not a groffer option.\n";
	}
      }				# if (exists $short_opts{$opt})
    }				# if ($opt =~ /^-([^-])$/)
    # now it is a long option

# handle ignored options
    if ( exists $ignored_opts{ $opt } ) {
      ++$i if ( $ignored_opts{ $opt } );
      next OPTION;
    }
### main_parse_params()

# handle normal long options
    if (exists $long_opts{$opt}) {
      $long_opts{$opt}->();
    } else {
      warn "Unknown option $opt.\n";
    }
    next OPTION;
  }				# while ($i <= $n)

if ($Debug{'PARAMS'}) {
    print STDERR '$MANOPT: ' . $ENV{'MANOPT'} . "\n" if $ENV{'MANOPT'};
    foreach (@Starting_Conf) {
      print STDERR "configuration: " . $_ . "\n";
    }
    print STDERR '$GROFFER_OPT: ' . $ENV{'GROFFER_OPT'} . "\n"
      if $ENV{'GROFFER_OPT'};
    print STDERR "command line: @Starting_ARGV\n";
    print STDERR "parameters: @ARGV\n";
  }

if ( $Opt{'WHATIS'} ) {
    die "main_parse_params(): cannot handle both 'whatis' and 'apropos';"
      if $Opt{'APROPOS'};
    $Man{'ALL'} = 1;
    delete $Opt{'APROPOS_SECTIONS'};
  }

if ( $Opt{'DO_NOTHING'} ) {
    exit;
  }

if ( $Opt{'DEFAULT_MODES'} ) {
    @Default_Modes = split /,/, $Opt{'DEFAULT_MODES'};
  }
}				# main_parse_params()

sub _get_arg {
  our $i;
  our $n;
  our @Options;
  if ($i > $n) {
    die '_get_arg(): No argument left for last option;';
  }
  my $arg = $Options[$i];
  ++$i;
  $arg;
}				# _get_arg() of main_parse_params()

########################################################################
# main_set_mode()
########################################################################

sub main_set_mode {
  our %Opt;

our @Default_Modes;
  our @Addopts_Groff;

our $Viewer_Background;
  our $PDF_Did_Not_Work;
  our $PDF_Has_gs;
  our $PDF_Has_ps2pdf;
  our %Display = ('MODE' => '',
		  'PROG' => '',
		  'ARGS' => ''
		 );

my @modes;

# set display
  $ENV{'DISPLAY'} = $Opt{'DISPLAY'} if $Opt{'DISPLAY'};

push @Addopts_Groff, '-V' if $Opt{'V'};

if ( $Opt{'X'} ) {
    $Display{'MODE'} = 'groff';
    push @Addopts_Groff, '-X';
  }

if ( $Opt{'Z'} ) {
    $Display{'MODE'} = 'groff';
    push @Addopts_Groff, '-Z';
  }

$Display{'MODE'} = 'groff' if $Opt{'MODE'} and $Opt{'MODE'} eq 'groff';

return 1 if $Display{'MODE'} and $Display{'MODE'} eq 'groff';

### main_set_mode()
  if ($Opt{'MODE'}) {
    if ($Opt{'MODE'} =~ /^(source|text|tty)$/) {
      $Display{'MODE'} = $Opt{'MODE'};
      return 1;
    }
    $Display{'MODE'} = $Opt{'MODE'} if $Opt{'MODE'} =~ /^x?html$/;
    @modes = ($Opt{'MODE'});
  } else {			# empty mode
    if ($Opt{'DEVICE'}) {
      if ($Opt{'DEVICE'} =~ /^X/) {
	&is_X() || die "no X display found for device $Opt{'DEVICE'}";
	$Display{'MODE'} = 'x';
	return 1;
      }
      ;
      if ($Opt{'DEVICE'} =~ /^(ascii|cp1047|latin1|utf8)$/) {
	$Display{'MODE'} ne 'text' and $Display{'MODE'} = 'tty';
	return 1;
      }
      ;
      unless (&is_X) {
	$Display{'MODE'} = 'tty';
	return 1;
      }
    }				# check device
    @modes = @Default_Modes;
  }				# check mode

### main_set_mode()
 LOOP: foreach my $m (@modes) {
    $Viewer_Background = 0;
    if ($m =~ /^(test|tty|X)$/) {
      $Display{'MODE'} = $m;
      return 1;
    } elsif ($m eq 'pdf') {
      &_get_prog_args($m) ? return 1: next LOOP;
    } elsif ($m eq 'pdf2') {
      next LOOP if $PDF_Did_Not_Work;
      $PDF_Has_gs = &where_is_prog('gs') ? 1 : 0
	unless (defined $PDF_Has_gs);
      $PDF_Has_ps2pdf = &where_is_prog('ps2pdf') ? 1 : 0
	unless (defined $PDF_Has_ps2pdf);
      if ( (! $PDF_Has_gs) and (! $PDF_Has_ps2pdf) ) {
	$PDF_Did_Not_Work = 1;
	next LOOP;
      }

if (&_get_prog_args($m)) {
	return 1;
      } else {
	$PDF_Did_Not_Work = 1;
	next LOOP;
      }
    } else {			# other modes
      &_get_prog_args($m) ? return 1 : next LOOP;
    }				# if $m
  }				# loop: foreach
  die 'set mode: no suitable display mode found under ' .
    join(', ', @modes) . ';' unless $Display{'MODE'};
  die 'set mode: no viewer available for mode ' . $Display{'MODE'} . ';'
    unless $Display{'PROG'};
  0;
} # main_set_mode()

########################################################################
# functions to main_set_mode()
########################################################################

##########
# _get_prog_args(<MODE>)
#
# Simplification for loop in set mode.
#
# Globals in/out: $Viewer_Background
# globals in    : $Opt{VIEWER}, $VIEWER_X{<MODE>},
#                 $Viewer_tty{<MODE>}
#
## globals in    : $Opt{VIEWER_<MODE>}, $VIEWER_X{<MODE>},
##                 $Viewer_tty{<MODE>}
##
sub _get_prog_args {
  our %Opt;
  our %Display;
  our %Viewer_X;
  our %Viewer_tty;

our $Viewer_Background;
  my $n = @_;
  die "_get_prog_args(): one argument is needed; you used $n;"
    unless $n == 1;

my $mode = lc($_[0]);
  my $MODE = uc($mode);
  $MODE = 'PDF' if ( $MODE =~ /^PDF2$/ );

my $xlist = $Viewer_X{$MODE};
  my $ttylist = $Viewer_tty{$MODE};

#  my $vm = "VIEWER_${MODE";
  my $vm = "VIEWER";
  my $opt = $Opt{$vm};

if ($opt) {
    my %prog = &where_is_prog($opt);
    my $prog_ref = \%prog;
    unless (%prog) {
      warn "_get_prog_args(): '$opt' is not an existing program;";
      return 0;
    }

# $prog from $opt is an existing program

### _get_prog_args() of main_set_mode()
    if (&is_X) {
      if ( &_check_prog_on_list($prog_ref, $xlist) ) {
	$Viewer_Background = 1;
      } else {
	$Viewer_Background = 0;
	&_check_prog_on_list($prog_ref, $ttylist);
      }
    } else {			# is not X
      $Viewer_Background = 0;
      &_check_prog_on_list($prog_ref, $ttylist);
    }				# if is X
  } else {			# $opt is empty
    $Viewer_Background = 0;
    my $x;
    if (&is_X) {
      $x = &_get_first_prog($xlist);
      $Viewer_Background = 1 if $x;
    } else {			# is not X
      $x = &_get_first_prog($ttylist);
    }				# test on X
    $Display{'MODE'} = $mode if $x;
    return $x;
  }
  $Display{'MODE'} = $mode;
  return 1;
} # _get_prog_args() of main_set_mode()

##########
# _get_first_prog(<prog_list_ref>)
#
# Retrieve from the elements of the list in the argument the first
# existing program in $PATH.
#
# Local function of main_set_mode().
#
# Return  : '0' if not a part of the list, '1' if found in the list.
#
sub _get_first_prog {
  our %Display;
  my $n = @_;
  die "_get_first_prog(): one argument is needed; you used $n;"
    unless $n == 1;

foreach my $i (@{$_[0]}) {
    next unless $i;
    my %prog = &where_is_prog($i);
    if (%prog) {
      $Display{'PROG'} = $prog{'fullname'};
      $Display{'ARGS'} = $prog{'args'};
      return 1;
    }
  }
  return 0;
} # _get_first_prog() of main_set_mode()

##########
# _check_prog_on_list (<prog-hash-ref> <prog_list_ref>)
#
# Check whether the content of <prog-hash-ref> is in the list
# <prog_list_ref>.
# The globals are set correspondingly.
#
# Local function for main_set_mode().
#
# Arguments: 2
#
# Return  : '0' if not a part of the list, '1' if found in the list.
# Output  : none
#
# Globals in    : $Viewer_X{<MODE>}, $Viewer_tty{<MODE>}
# Globals in/out: $Display{'PROG'}, $Display{'ARGS'}
#
sub _check_prog_on_list {
  our %Display;
  my $n = @_;
  die "_get_first_prog(): 2 arguments are needed; you used $n;"
    unless $n == 2;

my %prog = %{$_[0]};

$Display{'PROG'} = $prog{'fullname'};
  $Display{'ARGS'} = $prog{'args'};

foreach my $i (@{$_[1]}) {
    my %p = &where_is_prog($i);
    next unless %p;
    next unless $Display{'PROG'} eq $p{'fullname'};
    if ($p{'args'}) {
      if ($Display{'ARGS'}) {
	$Display{'ARGS'} = $p{'args'};
      } else {
	$Display{'ARGS'} = "$p{'args'} $Display{'ARGS'}";
      }
    }				# if args
    return 1;
  }				# foreach $i
  # prog was not in the list
  return 0;
} # _check_prog_on_list() of main_set_mode()

########################################################################
# groffer temporary directory, main_temp()
########################################################################

sub main_temp {
  our %Debug;
  our $tmpdir;
  our $fh_cat;
  our $fh_stdin;
  our $tmp_cat;
  our $tmp_stdin;
  my $template = 'groffer_' . "$$" . '_XXXX';
  foreach ($ENV{'GROFF_TMPDIR'}, $ENV{'TMPDIR'}, $ENV{'TMP'}, $ENV{'TEMP'},
	   $ENV{'TEMPDIR'}, File::Spec->catfile($ENV{'HOME'}, 'tmp')) {
    if ($_ && -d $_ && -w $_) {
      if ($Debug{'KEEP'}) {
	eval { $tmpdir = tempdir( $template, DIR => "$_" ); };
      } else {
	eval { $tmpdir = tempdir( $template,
				  CLEANUP => 1, DIR => "$_" ); };
      }
      last if $tmpdir;
    }
  }
  $tmpdir = tempdir( $template, CLEANUP => 1, DIR => File::Spec->tmpdir )
    unless ($tmpdir);

# see Lerning Perl, page 205, or Programming Perl, page 413
  # $SIG{'INT'} is for Ctrl-C interruption
  $SIG{'INT'} = sub { &clean_up(); die "interrupted..."; };
  $SIG{'QUIT'} = sub { &clean_up(); die "quit..."; };

if ($Debug{'TMPDIR'}) {
    if ( $Debug{'KEEP'}) {
      print STDERR "temporary directory is kept: " . $tmpdir . "\n";
    } else {
      print STDERR "temporary directory will be cleaned: " .
	$tmpdir . "\n";
    }
  }

# further argument: SUFFIX => '.sh'
  if ($Debug{'KEEP'}) {
    ($fh_cat, $tmp_cat) = tempfile(',cat_XXXX', DIR => $tmpdir);
    ($fh_stdin, $tmp_stdin) = tempfile(',stdin_XXXX', DIR => $tmpdir);
  } else {
    ($fh_cat, $tmp_cat) = tempfile(',cat_XXXX', UNLINK => 1,
				   DIR => $tmpdir);
    ($fh_stdin, $tmp_stdin) = tempfile(',stdin_XXXX', UNLINK => 1,
				       DIR => $tmpdir);
  }
}				# main_temp()

########################################################################
# subs needed for main_do_fileargs()
########################################################################

##########
# register_file(<filename>)
#
# Write a found file and register the title element.
#
# Arguments: 1: a file name
# Output: none
#
sub register_file {
  our $tmp_stdin;
  my $n = @_;
  die "register_file(): one argument is needed; you used $n;"
    unless $n == 1;
  die 'register_file(): file name is empty;' unless $_[0];

if ($_[0] eq '-') {
    &to_tmp($tmp_stdin) && &register_title('stdin');
  } else {
    &to_tmp($_[0]) && &register_title($_[0]);
  }
  1;
}				# register_file()

##########
# register_title(<filespec>)
#
# Create title element from <filespec> and append to $_REG_TITLE_LIST.
# Basename is created.
#
# Globals in/out: @REG_TITLE
#
# Variable prefix: rt
#
sub register_title {
  our @REG_TITLE;
  our %Debug;
  my $n = @_;
  die "register_title(): one argument is needed; you used $n;"
    unless $n == 1;
  return 1 unless $_[0];

return 1 if scalar @REG_TITLE > 3;

my $title = &get_filename($_[0]);
  $title =~ s/\s/_/g;
  $title =~ s/\.bz2$//g;
  $title =~ s/\.gz$//g;
  $title =~ s/\.Z$//g;

if ($Debug{'FILENAMES'}) {
    if ($_[0] eq 'stdin') {
      print STDERR "register_title(): file title is stdin\n";
    } else {
      print STDERR "register_title(): file title is $title\n";
    }
  }				# if ($Debug{'FILENAMES'})

return 1 unless $title;
  push @REG_TITLE, $title;
  1;
}				# register_title()

##########
# save_stdin()
#
# Store standard input to temporary file (with decompression).
#
sub save_stdin {
  our $tmp_stdin;
  our $fh_stdin;
  our $tmpdir;

our %Debug;

my ($fh_input, $tmp_input);
  $tmp_input = File::Spec->catfile($tmpdir, ',input');
  open $fh_input, ">$tmp_input" or
    die "save_stdin(): could not open $tmp_input";
  foreach (<STDIN>) {
    print $fh_input $_;
  }
  close $fh_input;
  open $fh_stdin, ">$tmp_stdin" or
    die "save_stdin(): could not open $tmp_stdin";
  foreach ( &cat_z("$tmp_input") ) {
    print $fh_stdin $_;
  }
  close $fh_stdin;
  unlink $tmp_input unless $Debug{'KEEP'};
}	# save_stdin()

########################################################################
# main_do_fileargs()
########################################################################

sub main_do_fileargs {
  our %Man;
  our %Opt;

our @Filespecs;

our $Filespec_Arg;
  our $Filespec_Is_Man;
  our $Special_Filespec;
  our $No_Filespecs;
  our $Macro_Pkg;
  our $Manspec;

&special_setup();
  if ($Opt{'APROPOS'}) {
    if ($No_Filespecs) {
      &apropos_filespec();
      return 1;
    }
  } else {
    foreach (@Filespecs) {
      if (/^-$/) {
	&save_stdin();
	last;
      }
    }				# foreach (@Filespecs)
  }				# if ($Opt{'APROPOS'})

my $section = '';
  my $ext = '';
  my $twoargs = 0;
  my $filespec;
  my $former_arg;

FILESPEC: foreach (@Filespecs) {
    $filespec = $_;
    $Filespec_Arg = $_;
    $Filespec_Is_Man = 0;
    $Manspec = '';
    $Special_Filespec = 0;

next FILESPEC unless $filespec;

### main_do_fileargs()
    if ($twoargs) {		# second run
      $twoargs = 0;
      # $section and $ext are kept from earlier run
      my $h = { 'name' => $filespec, 'sec' => $section, 'ext' => $ext };
      &man_setup();
      if ( &is_man($h) ) {
	$Filespec_Arg = "$former_arg $Filespec_Arg";
	&special_filespec();
	$Filespec_Is_Man = 1;
	&man_get($h);
	next FILESPEC;
      } else {
	warn "main_do_fileargs(): $former_arg is neither a file nor a " .
	  "man page nor a section argument for $filespec;";
      }
    }
    $twoargs = 0;

if ( $Opt{'APROPOS'} ) {
      &apropos_filespec();
      next FILESPEC;
    }

if ($filespec eq '-') {
      &register_file('-');
      &special_filespec();
      next FILESPEC;
    } elsif ( &get_filename($filespec) ne $filespec ) { # path with dir
      &special_filespec();
      if (-f $filespec && -r $filespec) {
	&register_file($filespec)
      } else {
	warn "main_do_fileargs: the argument $filespec is not a file;";
      }
      next FILESPEC;
    } else {			# neither '-' nor has dir
      # check whether filespec is an existing file
      unless ( $Man{'FORCE'} ) {
	if (-f $filespec && -r $filespec) {
	  &special_filespec();
	  &register_file($filespec);
	  next FILESPEC;
	}
      }
    }				# if ($filespec eq '-')

### main_do_fileargs()
    # now it must be a man page pattern

if ($Macro_Pkg and $Macro_Pkg ne '-man') {
      warn "main_do_fileargs(): $filespec is not a file, " .
	"man pages are ignored due to $Macro_Pkg;";
      next FILESPEC;
    }

# check for man page
    &man_setup();
    unless ( $Man{'ENABLE'} ) {
      warn "main_do_fileargs(): the argument $filespec is not a file;";
      next FILESPEC;
    }
    my $errmsg;
    if ( $Man{'FORCE'} ) {
      $errmsg = 'is not a man page';
    } else {
      $errmsg = 'is neither a file nor a man page';
    }

$Filespec_Is_Man = 1;

### main_do_fileargs()
    # test filespec with 'man:...' or '...(...)' on man page

my @names = ($filespec);
    if ($filespec =~ /^man:(.*)$/) {
      push @names, $1;
    }

foreach my $i (@names) {
      next unless $i;
      my $h = { 'name' => $i };
      if ( &is_man($h) ) {
	&special_filespec();
	&man_get($h);
	next FILESPEC;
      }
      if ( $i =~ /^(.*)$([$Man{'AUTO_SEC_CHARS'}])(.*)$$/ ) {
	$h = { 'name' => $1, 'sec' => $2, 'ext' => $3 };
	if ( &is_man($h) ) {
	  &special_filespec();
	  &man_get($h);
	  next FILESPEC;
	}
      }				# if //
      if ( $i =~ /^(.*)\.([$Man{'AUTO_SEC_CHARS'}])(.*)$/ ) {
	$h = { 'name' => $1, 'sec' => $2, 'ext' => $3 };
	if ( &is_man($h) ) {
	  &special_filespec();
	  &man_get($h);
	  next FILESPEC;
	}
      }				# if //
    }				# foreach (@names)

### main_do_fileargs()
    # check on "s name", where "s" is a section with or without an extension
    if ($filespec =~ /^([$Man{'AUTO_SEC_CHARS'}])(.*)$/) {
      unless ( $Man{'ENABLE'} ) {
	warn "main_do_fileargs(): $filespec $errmsg;";
	next FILESPEC;
      }
      $twoargs = 1;
      $section = $1;
      $ext = $2;
      $former_arg = $filespec;
      next FILESPEC;
    } else {
      warn "main_do_fileargs(): $filespec $errmsg;";
      next FILESPEC;
    }
  }	# foreach (@Filespecs)

if ( $twoargs ) {
    warn "main_do_fileargs(): no filespec arguments left for second run;";
    return 0;
  }
  1;
}	# main_do_fileargs()

########################################################################
# main_set_resources()
########################################################################

##########
# main_set_resources ()
#
# Determine options for setting X resources with $_DISPLAY_PROG.
#
# Globals: $Display{PROG}, $Output_File_Name
#
sub main_set_resources {
  our %Opt;
  our %Display;
  our %Debug;

our @REG_TITLE;

our $Default_Resolution;
  our $tmp_stdin;
  our $tmpdir;
  our $Output_File_Name;

# $prog   viewer program
  # $rl     resource list
  unlink $tmp_stdin unless $Debug{'KEEP'};
  $Output_File_Name = '';

my @title = @REG_TITLE;
  @title = ($Opt{'TITLE'}) unless @title;
  @title = () unless @title;

foreach my $n (@title) {
    next unless $n;
    $n =~ s/^,+// if $n =~ /^,/;
    next unless $n;
    $Output_File_Name = $Output_File_Name . ',' if $Output_File_Name;
    $Output_File_Name = "$Output_File_Name$n";
  }				# foreach (@title)

$Output_File_Name =~ s/^,+//;
  $Output_File_Name = '-' unless $Output_File_Name;
  $Output_File_Name = File::Spec->catfile($tmpdir, $Output_File_Name);

### main_set_resources()
  unless ($Display{'PROG'}) {	# for example, for groff mode
    $Display{'ARGS'} = '';
    return 1;
  }

my %h = &where_is_prog($Display{'PROG'});
  my $prog = $h{'file'};
  if ($Display{'ARGS'}) {
    $Display{'ARGS'} = "$h{'args'} $Display{'ARGS'}";
  } else {
    $Display{'ARGS'} = $h{'args'};
  }

my @rl = ();

if ($Opt{'BD'}) {
    if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
      push @rl, '-bd', $Opt{'BD'};
    }
  }

if ($Opt{'BG'}) {
    if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
      push @rl, '-bg', $Opt{'BG'};
    } elsif ($prog eq 'kghostview') {
      push @rl, '--bg', $Opt{'BG'};
    } elsif ($prog eq 'xpdf') {
      push @rl, '-papercolor', $Opt{'BG'};
    }
  }

### main_set_resources()
  if ($Opt{'BW'}) {
    if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
      push @rl, '-bw', $Opt{'BW'};
    }
  }

if ($Opt{'FG'}) {
    if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
      push @rl, '-fg', $Opt{'FG'};
    } elsif ($prog eq 'kghostview') {
      push @rl, '--fg', $Opt{'FG'};
    }
  }

if ($Opt{'FN'}) {
    if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
      push @rl, '-fn', $Opt{'FN'};
    } elsif ($prog eq 'kghostview') {
      push @rl, '--fn', $Opt{'FN'};
    }
  }

if ($Opt{'GEOMETRY'}) {
    if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
      push @rl, '-geometry', $Opt{'GEOMETRY'};
    } elsif ($prog eq 'kghostview') {
      push @rl, '--geometry', $Opt{'GEOMETRY'};
    }
  }

### main_set_resources()
  if ($Opt{'RESOLUTION'}) {
    if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
      push @rl, '-resolution', $Opt{'RESOLUTION'};
    } elsif ($prog eq 'xpdf') {
      if ($Display{'PROG'} !~ / -z/) { # if xpdf does not have option -z
	if ($Default_Resolution == 75) {
	  push @rl, '-z', 104;
	} elsif ($Default_Resolution == 100) { # 72dpi is '100'
	  push @rl, '-z', 139;
	}
      }
    }				# if $prog
  } else {			# empty $Opt{RESOLUTION}
    $Opt{'RESOLUTION'} = $Default_Resolution;
    if ($prog =~ /^(gxditview|xditview)$/) {
      push @rl, '-resolution', $Default_Resolution;
    } elsif ($prog eq 'xpdf') {
      if ($Display{'PROG'} !~ / -z/) { # if xpdf does not have option -z
	if ($Default_Resolution == 75) {
	  push @rl, '-z', 104;
	} elsif ($Default_Resolution == 100) { # 72dpi is '100'
	  push @rl, '-z', 139;
	}
      }
    }				# if $prog
  }				# if $Opt{RESOLUTION}

if ($Opt{'ICONIC'}) {
    if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
      push @rl, '-iconic';
    }
  }

### main_set_resources()
  if ($Opt{'RV'}) {
    if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi)$/) {
      push @rl, '-rv';
    }
  }

if (@{$Opt{'XRM'}}) {
    if ($prog =~ /^(ghostview|gv|gxditview|xditview|xdvi|xpdf)$/) {
      foreach (@{$Opt{'XRM'}}) {
	push @rl, '-xrm', $_;
      }
    }
  }

if (@title) {
    if ($prog =~ /^(gxditview|xditview)$/) {
      push @rl, '-title', $Output_File_Name;
    }
  }

my $args = join ' ', @rl;
  if ($Display{'ARGS'}) {
    $Display{'ARGS'} = "$args $Display{'ARGS'}";
  } else {
    $Display{'ARGS'} = $args;
  }

1;
}				# main_set_resources()

########################################################################
# set resources
########################################################################

##########
# main_display ()
#
# Do the actual display of the whole thing.
#
# Globals:
#   in: $Display{MODE}, $Opt{DEVICE}, @Addopts_Groff,
#       $fh_cat, $tmp_cat, $Opt{PAGER}, $Output_File_Name
#
sub main_display {
  our ( %Display, %Opt, %Debug, %Viewer_tty, %Viewer_X );

our @Addopts_Groff;

our ( $groggy, $modefile, $addopts, $fh_cat, $tmp_cat, $tmpdir );
  our ( $Output_File_Name, $Default_tty_Device );

$addopts = join ' ', @Addopts_Groff;

if (-z $tmp_cat) {
    warn "groffer: empty input\n";
    &clean_up();
    return 1;
  }

$modefile = $Output_File_Name;

# go to the temporary directory to be able to access internal data files
  chdir $tmpdir;

### main_display()
 SWITCH: foreach ($Display{'MODE'}) {
    /^groff$/ and do {
      push @Addopts_Groff, "-T$Opt{'DEVICE'}" if $Opt{'DEVICE'};
      $addopts = join ' ', @Addopts_Groff;
      $groggy = `cat $tmp_cat | grog`;
      die "main_display(): grog error;" if $?;
      chomp $groggy;
      print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
      &_do_opt_V();
      unlink $modefile;
      rename $tmp_cat, $modefile;
      system("cat $modefile | $groggy $addopts");
      &clean_up();
      next SWITCH;
    };				# /groff/

/^(text|tty)$/ and do {
      my $device;
      if (! $Opt{'DEVICE'}) {
	$device = $Opt{'TEXT_DEVICE'};
	$device = $Default_tty_Device unless $device;
      } elsif ($Opt{'DEVICE'} =~ /^(ascii||cp1047|latin1|utf8)$/) {
	$device = $Opt{'DEVICE'};
      } else {
	warn "main_display(): wrong device for $Display{'MODE'} mode: " .
	  "$Opt{'DEVICE'}";
      }
      $groggy = `cat $tmp_cat | grog -T$device`;
      die "main_display(): grog error;" if $?;
      chomp $groggy;
      print STDERR "grog output: " . $groggy . "\n" if $Debug{'GROG'};
      if ($Display{'MODE'} eq 'text') {
	&_do_opt_V();
	system("cat $tmp_cat | $groggy $addopts");
	&clean_up();
	next SWITCH;
      }

### main_display()
      # mode is not 'text', but 'tty'
      my %pager;
      my @p;
      push @p, $Opt{'PAGER'} if $Opt{'PAGER'};
      push @p, $ENV{'PAGER'} if $ENV{'PAGER'};
      foreach (@p) {
	%pager = &where_is_prog($_);
	next unless %pager;
	if ($pager{'file'} eq 'less') {
	  if ($pager{'args'}) {
	    $pager{'args'} = "-r -R $pager{'args'}";
	  } else {
	    $pager{'args'} = '-r -R';
	  }
	}
	last if $pager{'file'};
      }				# foreach @p
      unless (%pager) {
	foreach (@{$Viewer_tty{'TTY'}}, @{$Viewer_X{'TTY'}}, 'cat') {
	  next unless $_;
	  %pager = &where_is_prog($_);
	  last if %pager;
	}
      }
      die "main_display(): no pager program found for tty mode;"
	unless %pager;
      &_do_opt_V();
      system("cat $tmp_cat | $groggy $addopts | " .
	     "$pager{'fullname'} $pager{'args'}");
      &clean_up();
      next SWITCH;
    };				# /text|tty/

/^source$/ and do {
      open $fh_cat, "<$tmp_cat";
      foreach (<$fh_cat>) {
	print "$_";
      }
      &clean_up();
      next SWITCH;
    };

### main_display()
    /^dvi$/ and do {
      if ($Opt{'DEVICE'} && $Opt{'DEVICE'} ne 'dvi') {
	warn "main_display(): " .
	  "wrong device for $Display{'MODE'} mode: $Opt{'DEVICE'};"
      }
      $modefile .= '.dvi';
      $groggy = `cat $tmp_cat | grog -Tdvi`;
      die "main_display(): grog error;" if $?;
      chomp $groggy;
      print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
      &_do_display();
      next SWITCH;
    };

/^html$/ and do {
      if ($Opt{'DEVICE'} && $Opt{'DEVICE'} ne 'html') {
	warn "main_display(): " .
	  "wrong device for $Display{'MODE'} mode: $Opt{'DEVICE'};"
      }
      $modefile .= '.html';
      $groggy = `cat $tmp_cat | grog -Thtml`;
      die "main_display(): grog error;" if $?;
      chomp $groggy;
      print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
      &_do_display();
      next SWITCH;
    };

/^xhtml$/ and do {
      if ($Opt{'DEVICE'} && $Opt{'DEVICE'} ne 'xhtml') {
	warn "main_display(): " .
	  "wrong device for $Display{'MODE'} mode: $Opt{'DEVICE'};"
      }
      $modefile .= '.xhtml';
      $groggy = `cat $tmp_cat | grog -Txhtml`;
      die "main_display(): grog error;" if $?;
      chomp $groggy;
      print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
      &_do_display();
      next SWITCH;
    };

/^pdf$/ and do {
      $modefile .= '.pdf';
      $groggy = `cat $tmp_cat | grog -Tpdf --ligatures`;
      die "main_display(): grog error;" if $?;
      chomp $groggy;
      print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
      &_do_display();
      next SWITCH;
    };

/^pdf2$/ and do {
      if ($Opt{'DEVICE'} && $Opt{'DEVICE'} ne 'ps') {
	warn "main_display(): " .
	  "wrong device for $Display{'MODE'} mode: $Opt{'DEVICE'};"
      }
      $modefile .= '.ps';
      $groggy = `cat $tmp_cat | grog -Tps`;
      die "main_display(): grog error;" if $?;
      chomp $groggy;
      print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
      &_do_display(\&_make_pdf2);
      next SWITCH;
    };

### main_display()
    /^ps$/ and do {
      if ($Opt{'DEVICE'} && $Opt{'DEVICE'} ne 'ps') {
	warn "main_display(): " .
	  "wrong device for $Display{'MODE'} mode: $Opt{'DEVICE'};"
      }
      $modefile .= '.ps';
      $groggy = `cat $tmp_cat | grog -Tps`;
      die "main_display(): grog error;" if $?;
      chomp $groggy;
      print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
      &_do_display();
      next SWITCH;
    };

/^x$/ and do {
      my $device;
      if ($Opt{'DEVICE'} && $Opt{'DEVICE'} =~ /^X/) {
	$device = $Opt{'DEVICE'};
      } else {
	if ($Opt{'RESOLUTION'} == 100) {
	  if ( $Display{'PROG'} =~ /^(g|)xditview$/ ) {
	    # add width of 800dpi for resolution of 100dpi to the args
	    $Display{'ARGS'} .= ' -geometry 800';
	    $Display{'ARGS'} =~ s/^ //;
	  }
	} else {		# RESOLUTIOM != 100
	  $device = 'X75-12';
	}			# if RESOLUTIOM
      }				# if DEVICE
      $groggy = `cat $tmp_cat | grog -T$device -Z`;
      die "main_display(): grog error;" if $?;
      chomp $groggy;
      print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
      &_do_display();
      next SWITCH;
    };

### main_display()
    /^X$/ and do {
      if (! $Opt{'DEVICE'}) {
	$groggy = `cat $tmp_cat | grog -X`;
	die "main_display(): grog error;" if $?;
	chomp $groggy;
	print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
      } elsif ($Opt{'DEVICE'} =~ /^(X.*|dvi|html|xhtml|lbp|lj4|ps)$/) {
	# these devices work with
	$groggy = `cat $tmp_cat | grog -T$Opt{'DEVICE'} -X`;
	die "main_display(): grog error;" if $?;
	chomp $groggy;
	print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
      } else {
	warn "main_display(): wrong device for " .
	  "$Display{'MODE'} mode: $Opt{'DEVICE'};";
	$groggy = `cat $tmp_cat | grog -Z`;
	die "main_display(): grog error;" if $?;
	chomp $groggy;
	print STDERR "grog output: $groggy\n" if $Debug{'GROG'};
      }				# if DEVICE
      &_do_display();
      next SWITCH;
    };

/^.*$/ and do {
      die "main_display(): unknown mode '$Display{'MODE'}';";
    };

}				# SWITCH
  1;
} # main_display()

########################
# _do_display ([<prog>])
#
# Perform the generation of the output and view the result.  If an
# argument is given interpret it as a function name that is called in
# the midst (actually only for 'pdf').
#
sub _do_display {
  our ( %Display, %Debug, %Opt );

our ( $modefile, $tmpdir, $tmp_cat, $addopts, $groggy );
  our ( $Viewer_Background );

&_do_opt_V();
  unless ($Display{'PROG'}) {
    system("$groggy $addopts $tmp_cat");
    &clean_up();
    return 1;
  }
  unlink $modefile;
  die "_do_display(): empty output;" if -z $tmp_cat;
  system("cat $tmp_cat | $groggy $addopts >$modefile");
  die "_do_display(): empty output;" if -z $modefile;
  &print_times("before display");
  if ($_[0] && ref($_[0]) eq 'CODE') {
    $_[0]->();
  }
  unlink $tmp_cat unless $Debug{'KEEP'};

if ( $Opt{'STDOUT'} ) {
    my $fh;
    open $fh, "<$modefile";
    foreach (<$fh>) {
      print;
    }
    close $fh;
    return 1;
  }

if ( $Viewer_Background ) {
    if ($Debug{'KEEP'}) {
      exec "$Display{'PROG'} $Display{'ARGS'} $modefile &";
    } else {
      exec "{ $Display{'PROG'} $Display{'ARGS'} $modefile; " .
	"rm -rf $tmpdir; } &";
    }
  } else {
    system("$Display{'PROG'} $Display{'ARGS'} $modefile");
    &clean_up();
  }
} # _do_display() of main_display()

#############
# _do_opt_V ()
#
# Check on option '-V'; if set print the corresponding output and leave.
#
# Globals: @ARGV, $Display{MODE}, $Display{PROG},
#          $Display{ARGS}, $groggy,  $modefile, $addopts
#
sub _do_opt_V {
  our %Opt;
  our %Display;
  our @ARGV;

our ($groggy, $modefile, $addopts);

if ($Opt{'V'}) {
    $Opt{'V'} = 0;
    print "Parameters: @ARGV\n";
    print "Display Mode: $Display{'MODE'}\n";
    print "Output file: $modefile\n";
    print "Display prog: $Display{'PROG'} $Display{'ARGS'}\n";
    print "Output of grog: $groggy $addopts\n";
    my $res = `$groggy $addopts\n`;
    chomp $res;
    print "groff -V: $res\n";
    exit 0;
  }
  1;
} # _do_opt_V() of main_display()

##############
# _make_pdf2 ()
#
# Transform to ps/pdf format; for pdf2 mode in _do_display().
#
# Globals: $md_modefile (from main_display())
#
sub _make_pdf2 {
  our %Debug;
  our %Opt;

our $PDF_Did_Not_Work;
  our $PDF_Has_gs;
  our $PDF_Has_ps2pdf;
  our $Dev_Null;
  our $modefile;

die "_make_pdf2(): pdf2 mode did not work;" if $PDF_Did_Not_Work;
  my $psfile = $modefile;
  die "_make_pdf2(): empty output;" if -z $modefile;
  $modefile =~ s/\.ps$/.pdf/;
  unlink $modefile;
  my $done;
  if ($PDF_Has_ps2pdf) {
    system("ps2pdf $psfile $modefile 2>$Dev_Null");
    $done = ! $?;
  }
  if (! $done && $PDF_Has_gs) {
    system("gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite " .
       "-sOutputFile=$modefile -c save pop -f $psfile 2>$Dev_Null");
    $done = ! $?;
  }
  if (! $done) {
    $PDF_Did_Not_Work = 1;
    warn '_make_pdf2(): Could not transform into pdf format, ' .
      'the Postscript mode (ps) is used instead;';
    $Opt{'MODE'} = 'ps';
    &main_set_mode();
    &main_set_resources();
    &main_display();
    exit 0;
  }
  unlink $psfile unless $Debug{'KEEP'};
  1;
} # _make_pdf2() of main_display()

1;
########################################################################
### Emacs settings
# Local Variables:
# mode: CPerl
# End: