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) && ®ister_title('stdin'); 1311 } else { 1312 &to_tmp($_[0]) && ®ister_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 ®ister_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 ®ister_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 ®ister_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