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