contrib/groffer/subs.pl

   1 #! /usr/bin/env perl
   2
   3 # groffer - display groff files
   4
   5 # Source file position: <groff-source>/contrib/groffer/subs.pl
   6 # Installed position: <prefix>/lib/groff/groffer/subs.pl
   7
   8 # Copyright (C) 2006-2014  Free Software Foundation, Inc.
   9 # Written by Bernd Warken <groff-bernd.warken-72@web.de>.
  10
  11 # This file is part of `groffer', which is part of `groff'.
  12
  13 # `groff' is free software; you can redistribute it and/or modify it
  14 # under the terms of the GNU General Public License as published by
  15 # the Free Software Foundation, either version 2 of the License, or
  16 # (at your option) any later version.
  17
  18 # `groff' is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program. If not, see
  25 # <http://www.gnu.org/licenses/gpl-2.0.html>.
  26
  27 ########################################################################
  28
  29 use strict;
  30 use warnings;
  31
  32 ########################################################################
  33 # some functions
  34 ########################################################################
  35
  36 ##########
  37 # cat_z(<file>)
  38 #
  39 # Decompress or cat the <file>.
  40 #
  41 # Return: the decompressed file as array
  42 #
  43 sub cat_z {
  44   my $n = @_;
  45   die "cat_z(): one argument is needed; you used $n;"
  46     unless $n == 1;
  47
  48   my $file = $_[0];
  49   die "cat_z(): `$file' is not a readable file;" unless -f $file && -r $file;
  50   return () if -z $file;
  51
  52   my @res;
  53   if ($main::Has_Compression) {
  54     if ($main::Has_bzip) {
  55       # test whether bz2 compressed, shell return must be inverted
  56       unless ( system("bzip2 -t $file 2>$main::Dev_Null") ) {
  57         @res = `bzip2 -c -d $file 2>$main::Dev_Null`;
  58         return @res;
  59       }
  60       # if not compressed with gz, gzip will act like `cat'
  61       @res = `gzip -c -d -f $file 2>$main::Dev_Null`;
  62       return @res;
  63     }
  64   } else {
  65     my $fh;
  66     open $fh, "<$file" or die "cat_z(): could not open $file";
  67     @res = <$fh>;
  68     close $fh;
  69     return @res;
  70   }
  71   ();
  72 } # cat_z()
  73
  74
  75 ##########
  76 # clean_up()
  77 #
  78 # Remove the temporary directory and restore the system.
  79 #
  80 sub clean_up {
  81   umask $main::Umask;
  82   chdir $main::Start_Dir;
  83   if ($main::Debug{'KEEP'} && -d $main::tmpdir) {
  84     my $glob = File::Spec->catfile($main::tmpdir, '*');
  85     unlink glob($glob);         # rm $tmpdir/*
  86     rmdir $main::tmpdir;
  87   }
  88 } # clean_up()
  89
  90
  91 ##########
  92 # get_dirname(<path>)
  93 #
  94 # Split the path and return the directory name part
  95 #
  96 # Return: string of directory name
  97 #
  98 sub get_dirname {
  99   my $n = @_;
 100   die "get_filename(): one argument is needed; you used $n;" unless $n == 1;
 101   return '' unless $_[0];
 102
 103   my ($dirname, $filename) = &split_path($_[0]);
 104   $dirname;
 105 }                               # get_dirname()
 106
 107
 108 ##########
 109 # get_filename(<path>)
 110 #
 111 # Split the path and return the file name part
 112 #
 113 # Return: string of file name
 114 #
 115 sub get_filename {
 116   my $n = @_;
 117   die "get_dirname(): one argument is needed; you used $n;" unless $n == 1;
 118   return '' unless $_[0];
 119
 120   my ($dirname, $filename) = &split_path($_[0]);
 121   $filename;
 122 }                               # get_filename()
 123
 124
 125 ##########
 126 # is_X()
 127 #
 128 # Test whether X Windows is running.
 129 #
 130 sub is_X {
 131   return 1 if $ENV{'DISPLAY'};
 132   return 0;
 133 }                               # is_X()
 134
 135
 136 ##########
 137 # list_has(<list_ref>, <string>)
 138 #
 139 # Determine if <list_ref> has <string> as element.
 140 #
 141 sub list_has {
 142   my $n = @_;
 143   die "list_has(): 2 arguments are needed; you used $n;"
 144     unless $n == 2;
 145
 146   my $list_ref = $_[0];
 147   my $string = $_[1];
 148   die "list_has(): first argument must be an array reference;"
 149     unless ref($list_ref) eq 'ARRAY';
 150
 151   foreach ( @$list_ref ) {
 152     return 1 if $_ eq $string;
 153   }
 154   0;
 155 }
 156
 157
 158 ##########
 159 # path_uniq(<dir>...)
 160 #
 161 # make path having unique existing directories
 162 #
 163 sub path_uniq {
 164   my @a;
 165   my %h;
 166   foreach (@_) {
 167     next if exists $h{$_};
 168     next unless -d $_;
 169     push @a, $_;
 170     $h{$_} = 1;
 171   }
 172   @a;
 173 }                               # path_uniq()
 174
 175
 176 ##########
 177 # print_hash(<hash_or_ref>)
 178 #
 179 # print the elements of a hash or hash reference
 180 #
 181 sub print_hash {
 182   my $hr;
 183   my $n = scalar @_;
 184   if ($n == 0) {
 185     print "empty hash\n;";
 186     return 1;
 187   } elsif ($n == 1) {
 188     if (ref($_[0]) eq 'HASH') {
 189       $hr = $_[0];
 190     } else {
 191       warn 'print_hash(): the argument is not a hash or hash reference;';
 192       return 0;
 193     }
 194   } else {
 195     if ($n % 2) {
 196       warn 'print_hash(): the arguments are not a hash;';
 197       return 0;
 198     } else {
 199       my %h = @_;
 200       $hr = \%h;
 201     }
 202   }
 203
 204 ### print_hash()
 205   unless (%$hr) {
 206     print "empty hash\n";
 207     return 1;
 208   }
 209   print "hash (ignore the ^ characters):\n";
 210   for my $k (sort keys %$hr) {
 211     my $hk = $hr->{$k};
 212     print "  $k => ";
 213     if (defined $hk) {
 214       print "^$hk^";
 215     } else {
 216       print "undef";
 217     }
 218     print "\n";
 219   }
 220
 221   1;
 222 }                               # print_hash()
 223
 224
 225 ##########
 226 # print_times(<string>)
 227 #
 228 # print the time, result: user, system, child process user, child system
 229 #
 230 sub print_times {
 231   my @t = times;
 232   my $s = '';
 233   $s = $_[0] if $_[0];
 234 #  print STDERR "$s: @t\n";
 235 }                               # print_times()
 236
 237 BEGIN { &print_times("start"); }
 238 END { &print_times("end"); }
 239
 240
 241 ##########
 242 # split_path(<path>)
 243 #
 244 # Split the path into directory and file name parts
 245 #
 246 # Return: array with 2 elements consisting of directory and file name
 247 #
 248 sub split_path {
 249   my $n = @_;
 250   die "split_path(): one argument is needed; you used $n;" unless $n == 1;
 251   my $arg = $_[0];
 252   return () unless $arg;
 253
 254   my $basename = basename($arg);
 255   if ( $basename ne $arg ) { # path with dir
 256     # fileparse() is from File::Basename
 257     my($filename, $dirname, $suffix) = fileparse($arg);
 258     return ($dirname, $basename);
 259   }
 260   return ('', $arg);
 261 }
 262
 263
 264 {
 265   my $nr_file = 0;
 266   my $nr_so = 0;
 267
 268   my $tmp_file_base;
 269   my $tmp_so_base;
 270
 271   my $soelim_r = '';
 272   $soelim_r = '-r'
 273     if ! system("echo -n '' | soelim -r 2>$main::Dev_Null >$main::Dev_Null");
 274
 275   ##########
 276   # to_tmp (<filename>)
 277   #
 278   # Print file (decompressed) to the temporary cat file with handling .SO
 279   # for man pages.
 280   #
 281   sub to_tmp {
 282     my $n = @_;
 283     die "to_tmp(): one argument is needed; you used $n;"
 284       unless $n == 1;
 285
 286     my $arg = $_[0];
 287     return 1 unless $arg;
 288     die "to_tmp(): $arg is not an existing file;" unless -f $arg;
 289     die "to_tmp(): could not read file $arg;" unless -r $arg;
 290     return 1 if -z $arg;
 291
 292     $tmp_file_base = File::Spec->catfile($main::tmpdir, ',file')
 293       unless $tmp_file_base;
 294     $tmp_so_base = File::Spec->catfile($main::tmpdir, ',so')
 295       unless $tmp_so_base;
 296
 297     open $main::fh_cat, ">>$main::tmp_cat" or
 298       die "to_tmp(): could not open temporary cat file";
 299
 300     if ($main::Opt{'WHATIS'}) {
 301       &whatis_filename($arg);
 302       return 1;
 303     }
 304
 305     ### to_tmp()
 306     my $dir = &get_dirname($arg);
 307
 308     my ($fh_file, $tmp_file, $fh_tmp, $tmp_tmp);
 309     ++$nr_file;
 310     $tmp_file = $tmp_file_base . $nr_file;
 311     $tmp_tmp = File::Spec->catfile($main::tmpdir, ',tmp');
 312
 313     print STDERR "file: $arg\n" if $main::Debug{'FILENAMES'};
 314
 315     if ($main::Filespec_Is_Man) {
 316       my ($fh_so, $tmp_so);
 317
 318       open $fh_file, ">$tmp_file" or
 319         die "to_tmp(): could not open $tmp_file;";
 320       foreach ( &cat_z($arg) ) {
 321         print $fh_file "$_";
 322       }
 323       close $fh_file;
 324
 325       open $fh_file, "<$tmp_file" or
 326         die "to_tmp(): could not open $tmp_file;";
 327       my @list;
 328       foreach (<$fh_file>) {
 329         if (/^[\.']\s*so\s/) {
 330           chomp;
 331           s/^[\.']\s*so\s*//;
 332           push @list, $_;
 333         }
 334       }
 335       close $fh_file;
 336
 337       if ( @list && $main::Debug{'KEEP'} ) {
 338         my $f = $tmp_file . '+man';
 339         copy($tmp_file, $f);
 340       }
 341
 342       ### to_tmp()
 343     DO_MAN_SO:  foreach (@list) {
 344         # start of _do_man_so() in shell version
 345         my $so = $_;
 346         my $soname = $so;
 347         $soname =~ s/\\\s/ /g;
 348
 349         my $sofound;
 350         my $path = File::Spec->rootdir();
 351         if ($soname =~ m#^$path#) {       # absolute path name
 352           next DO_MAN_SO if -f $soname;
 353           foreach ('.gz', '.Z', '.bz2') {
 354             my $name = $soname . $_;
 355             if (-f $name) {
 356               $sofound = $name;
 357               last;
 358             }
 359           }                     # foreach
 360           next DO_MAN_SO unless $sofound;
 361         } else {                # relative to man path
 362         LOOP: foreach my $ext ('', '.gz', '.Z', '.bz2') {
 363             foreach my $p ( @{$main::Man{'PATH'}} ) {
 364               my $f = File::Spec->catfile($p, "$soname$ext");
 365               if (-f $f) {
 366                 $sofound = $f if -f $f;
 367                 last LOOP;
 368               }
 369             }                   # foreach
 370           }                     # LOOP:
 371           next DO_MAN_SO unless $sofound;
 372         }                       # if on path
 373
 374         print STDERR "file from .so: $so\n" if $main::Debug{'FILENAMES'};
 375
 376         ### to_tmp()
 377         ++$nr_so;
 378         $tmp_so = $tmp_so_base . $nr_so;
 379         unlink $tmp_so if -e $tmp_so;
 380         open $fh_so, ">$tmp_so" or
 381           die "to_tmp(): could not open $tmp_so;";
 382         foreach ( &cat_z($sofound) ) {
 383           print $fh_so $_;
 384         }
 385         close $fh_so;
 386
 387         my $esc = $so;
 388         $esc =~ s/\\/\\\\/g;
 389         open $fh_file, "<$tmp_file" or
 390           die "to_tmp(): could not open $tmp_file;";
 391         open $fh_tmp, ">$tmp_tmp" or
 392           die "to_tmp(): could not open $tmp_tmp;";
 393         foreach (<$fh_file>) {
 394           s#^([\.'])\s*so\s+($so|$esc|$soname)\s*\n$#${1}so $tmp_so\n#s;
 395           print $fh_tmp $_;
 396         }
 397         ### to_tmp()
 398         close $fh_tmp;
 399         close $fh_file;
 400         unlink $tmp_file if -e $tmp_file;
 401         rename $tmp_tmp, $tmp_file;
 402         # end of _do_man_so() in shell version
 403       }                         # foreach (@list)
 404
 405       if ( @list && $main::Debug{'KEEP'} ) {
 406         my $f = $tmp_file . '+tmp';
 407         copy($tmp_file, $f);
 408       }
 409
 410       unlink $tmp_tmp if -e $tmp_tmp;
 411       rename $tmp_file, $tmp_tmp;
 412       system("soelim -I$dir $soelim_r $tmp_tmp >$tmp_file");
 413       unlink $tmp_tmp if -e $tmp_tmp;
 414
 415     } else {                    # $Filespec_Is_Man is empty
 416       open $fh_tmp, ">$tmp_tmp" or
 417         die "to_tmp(): could not open $tmp_tmp;";
 418       foreach (cat_z $arg) {
 419         print $fh_tmp $_;
 420       }
 421       close $fh_tmp;
 422       if ($dir) {
 423         system("soelim -I$dir $soelim_r $tmp_tmp >$tmp_file");
 424       } else {
 425         system("soelim $soelim_r $tmp_tmp >$tmp_file");
 426       }
 427       unlink $tmp_tmp;
 428     }                           # if ($Filespec_Is_Man)
 429
 430     ### to_tmp()
 431     my $grog = `grog $tmp_file`;
 432     die "to_tmp(): grog error on $tmp_file;" if $?;
 433     chomp $grog;
 434     print STDERR "grog output: $grog\n" if $main::Debug{'GROG'};
 435     if ($grog =~ /^.*\s-m.*$/) {
 436       $grog =~ s/\s+/ /g;
 437       $grog =~ s/ -m / -m/g;
 438       $grog =~ s/ -mm([^ ]) / -m$1/g;
 439       foreach my $g (split / /, $grog) {
 440         if ($g =~ /^-m/) {
 441           my $ref = \@main::Macro_Packages;
 442           if ( &list_has($ref, $g) ) {
 443             if (! $main::Macro_Pkg) {
 444               $main::Macro_Pkg = $g;
 445             } elsif ($main::Macro_Pkg eq $g) {
 446               1;
 447             } elsif ($main::Macro_Pkg =~ /^-m/) {
 448               warn "to_tmp(): Ignore $arg because it needs $g " .
 449                 "instead of $main::Macro_Pkg";
 450               unlink $tmp_file unless $main::Debug{'KEEP'};
 451               return 0;
 452             } elsif ($main::Macro_Pkg ne $g) {
 453               die "to_tmp(): \$Macro_Pkg does not start with -m: " .
 454                 "$main::Macro_Pkg";
 455             }                   # if (! $main::Macro_Pkg)
 456           }                     # if (&list_has
 457         }                       # if (/^-m/)
 458       }                         # foreach my $g
 459     }                           # if $grog
 460
 461     open $fh_file, "<$tmp_file" or
 462       die "to_tmp(): could not open $tmp_file for reading;";
 463     open $main::fh_cat, ">>$main::tmp_cat" or
 464       die "to_tmp(): could not open $main::tmp_cat for appending;";
 465     foreach (<$fh_file>) {
 466       print $main::fh_cat $_;
 467     }
 468     close $main::fh_cat;
 469     close $fh_file;
 470
 471     unless ( $main::Debug{'KEEP'} ) {
 472       unlink $tmp_file;
 473       foreach ( glob("$tmp_so_base*") ) {
 474         unlink $_;
 475       }
 476     }
 477     1;
 478   }                             # to_tmp()
 479 }
 480
 481 ##########
 482 # to_tmp_line (<text>...)
 483 #
 484 # Print array of lines with <text> to the temporary cat file.  \n is added
 485 # if a line does not end with \n.
 486 #
 487 sub to_tmp_line {
 488   my $n = @_;
 489   return 1 if $n == 0;
 490   open $main::fh_cat, ">>$main::tmp_cat" or
 491     die "to_tmp_line(): could not open temporary cat file";
 492   foreach (@_) {
 493     my $line = $_;
 494     chomp($line);
 495     print $main::fh_cat "$line\n";
 496   }
 497   close $main::fh_cat;
 498   1;
 499 } # to_tmp_line()
 500
 501
 502 ##########
 503 # usage()
 504 #
 505 # Print usage information for --help.
 506 #
 507 sub usage {
 508   print "\n";
 509   &version();
 510   print <<EOF;
 511
 512 Usage: groffer [option]... [filespec]...
 513
 514 Display roff files, standard input, and/or Unix manual pages with an X
 515 Window viewer or in several text modes.  All input is decompressed
 516 on-the-fly with all formats that gzip can handle.
 517
 518 "filespec" is one of
 519   "filename"    name of a readable file
 520   "-"           for standard input
 521   "man:name(n)" man page "name" in section "n"
 522   "man:name.n"  man page "name" in section "n"
 523   "man:name"    man page "name" in first section found
 524   "name(n)"     man page "name" in section "n"
 525   "name.n"      man page "name" in section "n"
 526   "n name"      man page "name" in section "n"
 527   "name"        man page "name" in first section found
 528 where `section' is a single character out of [1-9on], optionally followed
 529 by some more letters that are called the `extension'.
 530
 531 -h --help         print this usage message.
 532 -T --device=name  pass to groff using output device "name".
 533 -v --version      print version information.
 534 -V                display the groff execution pipe instead of formatting.
 535 -X                display with "gxditview" using groff -X.
 536 -Z --ditroff --intermediate-output
 537                   generate groff intermediate output without
 538                   post-processing and viewing, like groff -Z.
 539 All other short options are interpreted as "groff" formatting options.
 540
 541 The most important groffer long options are
 542
 543 --apropos=name  start man's "apropos" program for "name".
 544 --apropos-data=name
 545                 "apropos" for "name" in man's data sections 4, 5, 7.
 546 --apropos-devel=name
 547                 "apropos" for "name" in development sections 2, 3, 9.
 548 --apropos-progs=name
 549                 "apropos" for "name" in man's program sections 1, 6, 8.
 550 --auto          choose mode automatically from the default mode list.
 551 --default       reset all options to the default value.
 552 --default-modes=mode1,mode2,...
 553                 set sequence of automatically tried modes.
 554 --dvi           display in a viewer for TeX device independent format.
 555 --groff         process like groff, disable viewing features.
 556 --help          display this helping output.
 557 --html          display in a web browser.
 558 --man           check file parameters first whether they are man pages.
 559 --mode=auto|dvi|groff|html|pdf|ps|source|text|tty|utf8|www|x|X
 560                 choose display mode.
 561 --no-man        disable man-page facility.
 562 --no-special    disable --all, --apropos*, and --whatis
 563 --pager=program preset the paging program for tty mode.
 564 --pdf           display in a PDF viewer.
 565 --ps            display in a Postscript viewer.
 566 --source        output as roff source.
 567 --text          output in a text device without a pager.
 568 --to-stdout     output the content of the mode file without display.
 569 --tty           display with a pager on text terminal even when in X.
 570 --utf8          unicode text mode
 571 --viewer        choose a viewer for the actual device mode
 572 --whatis        display the file name and description of man pages
 573 --www           same as --html.
 574 --x --X         display with "gxditview" using an X* device.
 575
 576 The usual X Windows toolkit options transformed into GNU long options:
 577 --background=color, --bd=size, --bg=color, --bordercolor=color,
 578 --borderwidth=size, --bw=size, --display=Xdisplay, --fg=color,
 579 --fn=font, --font=font, --foreground=color, --geometry=geom, --iconic,
 580 --resolution=dpi, --rv, --title=text, --xrm=resource
 581
 582 Long options of GNU "man":
 583 --all, --ascii, --ditroff, --extension=suffix, --locale=language,
 584 --local-file=name, --location, --manpath=dir1:dir2:...,
 585 --sections=s1:s2:..., --systems=s1,s2,..., --where, ...
 586
 587 Development options that are not useful for normal usage:
 588 --debug, --debug-filenames, --debug-grog, --debug-keep, --debug-params,
 589 --debug-tmpdir, --do-nothing, --print=text
 590
 591 EOF
 592
 593 # The following mode-viewer options were replaced by a single --viewer
 594 # option.  The old options are only ignored:
 595 # --dvi-viewer=prog choose the viewer program for dvi mode.
 596 # --html-viewer=program
 597 #                  choose the web browser for html mode.
 598 # --pdf-viewer=prog choose the viewer program for pdf mode.
 599 # --ps-viewer=prog  choose the viewer program for ps mode.
 600 # --tty-viewer=prog select a pager for tty mode; same as --pager.
 601 # --www-viewer=prog same as --html-viewer
 602 # --x-viewer=prog   choose viewer program for x mode (X mode).
 603 # --X-viewer=prog   same as "--xviewer".
 604
 605 } # usage()
 606
 607
 608 ##########
 609 # version()
 610 #
 611 # Get version information from version.sh and print a text with this.
 612 #
 613 sub version {
 614   my $groff_version;
 615   my $program_version = '';
 616   my $last_update = '';
 617   my $groff_version_preset = '';
 618
 619   die "$main::File_version_sh does not exist;"
 620     unless -f "$main::File_version_sh";
 621   my $fh;
 622   open $fh, "<$main::File_version_sh";
 623   foreach (<$fh>) {
 624     chomp;
 625     if (/^\s*_PROGRAM_VERSION\s*=\s*['"]*([^'"]*)['"]*\s*;?\s*$/) {
 626       $program_version = $1;
 627       next;
 628     }
 629     if (/^\s*_GROFF_VERSION_PRESET\s*=\s*['"]*([^'"]*)['"]*\s*;?\s*$/) {
 630       # this setting of the groff version is only used before make is run,
 631       # otherwise @VERSION@ will set it, see groffer.sh.
 632       $groff_version_preset = $1;
 633       next;
 634     }
 635   }
 636   close $fh;
 637
 638   if ($main::Groff_Version) {
 639     $groff_version = $main::Groff_Version;
 640   } else {
 641     $groff_version = $groff_version_preset;
 642   }
 643   print <<EOF;
 644 groffer $program_version is part of groff version $groff_version.
 645 GNU groff and groffer come with ABSOLUTELY NO WARRANTY.
 646 You may redistribute copies of groff and its subprograms
 647 under the terms of the GNU General Public License.
 648 EOF
 649 } # version()
 650
 651
 652 ##########
 653 # where_is_prog(<program>)
 654 #
 655 # Test whether <program> without its arguments exists or is a program
 656 # in $PATH.
 657 #
 658 # Arguments : 1, <program> can have spaces and arguments.
 659 # Return    : a hash with `dir', `file', `fullname', `args' if
 660 #             argument exists or is a program in $PATH, empty hash else.
 661 #
 662 sub where_is_prog {
 663   scalar @_ eq 1 or die "where_is_prog(): only one argument is allowed";
 664   my $p1 = $_[0];
 665   return () unless $p1;
 666
 667   $p1 =~ s/\s+/ /g;
 668   $p1 =~ s/(\\)+ / /g;
 669   $p1 =~ s/^ | $//g;
 670   return () unless $p1;
 671
 672   my $noarg = $p1;
 673   $noarg =~ s/ -.*$//;
 674   return () unless $noarg;
 675
 676   my $args;
 677   if ($p1 =~ /^.* -.*$/) {
 678     $args = $p1;
 679     $args =~ s#^$noarg ##;
 680   }
 681   $args = '' unless defined $args;
 682
 683   my %result;
 684
 685   # test whether $noarg has directory, so it is not tested with $PATH
 686   my ($dir, $name) = &split_path($noarg);
 687   $result{'dir'} = $dir;
 688
 689 ### where_is_prog()
 690   if (-f $noarg && -x $noarg) {
 691     $result{'args'} = $args;
 692     $result{'file'} = $name;
 693     $result{'fullname'} = File::Spec->catfile($dir, $name);
 694     return %result;
 695   }
 696
 697   if ($dir) {                   # $noarg has name with directory
 698     # now $wip_noarg (with directory) is not an executable file
 699
 700     # test name with space
 701     if ($name =~ / /) {
 702       my @base = split(/ /, $name);
 703       my $n = pop @base;
 704       my @baseargs = ($n);
 705       while (@base) {
 706         my $base = join(' ', @base);
 707         my $file = File::Spec->catpath($dir, $base);
 708         if (-f $file && -x $file) {
 709           my $baseargs = join(' ', @baseargs);
 710           ### where_is_prog()
 711           if ($args) {
 712             $args = "$baseargs $args";
 713           } else {
 714             $args = $baseargs;
 715           }
 716           $result{'args'} = $args;
 717           $result{'file'} = $base;
 718           $result{'fullname'} = $file;
 719           return %result;
 720         }                       # file test $file
 721         $n = pop @base;
 722         unshift(@baseargs, $n);
 723       }                         # while (@base)
 724     }                           # end of test name with space
 725     return ();
 726   }                             # test on $dir
 727
 728   # now $noarg doesn't have a directory part
 729
 730   $name = $noarg;
 731
 732   # check with $PATH
 733
 734   # test path with $win_noarg as a whole, evt. with spaces
 735   foreach my $d (@main::Path) {
 736     my $file = File::Spec->catfile($d, $name);
 737     if (-f $file && -x $file) {
 738       $result{'args'} = $args;
 739       $result{'fullname'} = $file;
 740       ($result{'dir'}, $result{'file'}) = &split_path($file);
 741       return %result;
 742     }                           # file test $file
 743   }                             # foreach (@main::Path)
 744
 745 ### where_is_prog()
 746   if ($name =~ / /) {
 747     my @base = split(/ /, $name);
 748     my $n = pop @base;
 749     my @baseargs = ($n);
 750     while (@base) {
 751       my $base = join(' ', @base);
 752       foreach my $d (@maon::Path) {
 753         my $file = File::Spec->catfile($d, $base);
 754         if (-f $file && -x $file) {
 755           my $baseargs = join(' ', @baseargs);
 756           if ($args) {
 757             $args = "$baseargs $args";
 758           } else {
 759             $args = $baseargs;
 760           }
 761           $result{'args'} = $args;
 762           $result{'fullname'} = $file;
 763           ($result{'dir'}, $result{'file'}) = &split_path($file);
 764           return %result;
 765         }                       # file test $file
 766       }                         # foreach (@main::Path)
 767       $n = pop @base;
 768       unshift(@baseargs, $n);
 769     }                           # while (@base)
 770   }                             # test $name on space
 771   return ();
 772 } # where_is_prog()
 773
 774
 775 ##########
 776 # wait()
 777 #
 778 # stop for checking temp files, etc.
 779 #
 780 sub wait {
 781   print "push Ctrl-D";
 782   my @x = <STDIN>;
 783   print "\n";
 784 }                               # wait()
 785
 786
 787 1;
 788 ########################################################################
 789 ### Emacs settings
 790 # Local Variables:
 791 # mode: CPerl
 792 # End: