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