[glilypond]: Make script stand alone.

* contrib/glilypond/args.pl:
* contrib/glilypond/oop_fh.pl
* contrib/glilypond/subs.pl: Delete, moving their content into...
* contrib/glilypond/glilypond.pl: ...here.  Also bump overall license to
  GPLv3 from GPLv2 because all of the deleted files were GPLv3.
* contrib/glilypond/glilypond.am (dist_glilypond_DATA): Delete.

1 files changed, 1151 insertions, 7 deletions

diff --git a/contrib/glilypond/glilypond.pl b/contrib/glilypond/glilypond.pl
index 1cde0be5e..daf3bdd1d 100755
--- a/contrib/glilypond/glilypond.pl
+++ b/contrib/glilypond/glilypond.pl
@@ -26,7 +26,7 @@ our $Legalese;
 {
   use constant VERSION => 'v1.3.1'; # version of glilypond
 
-### This constant 'LICENSE' is the license for this file 'GPL' >= 2
+### This constant 'LICENSE' is the license for this file 'GPL' >= 3
   use constant LICENSE => q*
 glilypond - integrate 'lilypond' into 'groff' files
 
@@ -37,7 +37,7 @@ This file is part of 'GNU groff'.
 
   'GNU groff' is free software: you can redistribute it and/or modify it
 under the terms of the 'GNU General Public License' as published by the
-'Free Software Foundation', either version 2 of the License, or (at your
+'Free Software Foundation', either version 3 of the License, or (at your
 option) any later version.
 
   'GNU groff' is distributed in the hope that it will be useful, but
@@ -134,7 +134,427 @@ BEGIN {
     umask 0077; # octal output: 'printf "%03o", umask;'
   }
 
-  require 'subs.pl';
+  use integer;
+  use utf8;
+  use feature 'state';
+
+  my $P_PIC;
+  # $P_PIC = '.PDFPIC';
+  $P_PIC = '.PSPIC';
+
+  ######################################################################
+  # subs for using several times
+  ######################################################################
+
+  sub create_ly2eps {		       # '--ly2eps' default
+    our ( $out, $Read, $Temp );
+
+    my $prefix = $Read->{'file_numbered'};   # w/ dir change to temp dir
+
+    # '$ lilypond --ps -dbackend=eps -dgs-load-fonts \
+    #      output=file_without_extension file.ly'
+    # extensions are added automatically
+    my $opts = '--ps -dbackend=eps -dinclude-eps-fonts -dgs-load-fonts'
+      . " --output=$prefix $prefix";
+    &run_lilypond("$opts");
+
+    Cwd::chdir $Temp->{'cwd'} or
+	die "Could not change to former directory '" .
+	  $Temp->{'cwd'} . "': $!";
+
+    my $eps_dir = $Temp->{'eps_dir'};
+    my $dir = $Temp->{'temp_dir'};
+    opendir( my $dh, $dir ) or
+      die "could not open temporary directory '$dir': $!";
+
+    my $re = qr<
+		 ^
+		 $prefix
+		 -
+		 .*
+		 \.eps
+		 $
+	       >x;
+    my $file;
+    while ( readdir( $dh ) ) {
+      chomp;
+      $file = $_;
+      if ( /$re/ ) {
+	my $file_path = File::Spec->catfile($dir, $file);
+	if ( $eps_dir ) {
+	  my $could_copy = FALSE;
+	  File::Copy::copy($file_path, $eps_dir)
+	      and $could_copy = TRUE;
+	  if ( $could_copy ) {
+	    unlink $file_path;
+	    $file_path = File::Spec->catfile($eps_dir, $_);
+	  }
+	}
+	$out->print( $P_PIC . ' ' . $file_path );
+      }
+    }				# end while readdir
+    closedir( $dh );
+  }				# end sub create_ly2eps()
+
+
+  sub create_pdf2eps {		       # '--pdf2eps'
+    our ( $v, $stdout, $stderr, $out, $Read, $Temp );
+
+    my $prefix = $Read->{'file_numbered'};   # w/ dir change to temp dir
+
+    &run_lilypond("--pdf --output=$prefix $prefix");
+
+    my $file_pdf = $prefix . '.pdf';
+    my $file_ps = $prefix . '.ps';
+
+    # pdf2ps in temp dir
+    my $temp_file = &next_temp_file;
+    $v->print( "\n##### run of 'pdf2ps'" );
+    # '$ pdf2ps file.pdf file.ps'
+    my $output = `pdf2ps $file_pdf $file_ps 2> $temp_file`;
+    die 'Program pdf2ps does not work.' if ( $? );
+    &shell_handling($output, $temp_file);
+    $v->print( "##### end run of 'pdf2ps'\n" );
+
+    # ps2eps in temp dir
+    $temp_file = &next_temp_file;
+    $v->print( "\n##### run of 'ps2eps'" );
+    # '$ ps2eps file.ps'
+    $output = `ps2eps $file_ps 2> $temp_file`;
+    die 'Program ps2eps does not work.' if ( $? );
+    &shell_handling($output, $temp_file);
+    $v->print( "##### end run of 'ps2eps'\n" );
+
+    # change back to former dir
+    Cwd::chdir $Temp->{'cwd'} or
+	die "Could not change to former directory '" .
+	  $Temp->{'cwd'} . "': $!";
+
+    # handling of .eps file
+    my $file_eps = $prefix . '.eps';
+    my $eps_path = File::Spec->catfile($Temp->{'temp_dir'}, $file_eps);
+    if ( $Temp->{'eps_dir'} ) {
+      my $has_copied = FALSE;
+      File::Copy::copy( $eps_path, $Temp->{'eps_dir'} )
+	  and $has_copied = TRUE;
+      if ( $has_copied ) {
+	unlink $eps_path;
+	$eps_path = File::Spec->catfile( $Temp->{'eps_dir'}, $file_eps );
+      } else {
+	$stderr->print( "Could not use EPS-directory." );
+      } # end Temp->{'eps_dir'}
+    }
+    # print into groff output
+    $out->print( $P_PIC . ' ' . $eps_path );
+  }				# end sub create_pdf2eps()
+
+
+  sub is_subdir {		# arg1 is subdir of arg2 (is longer)
+    my ( $dir1, $dir2 ) = @_;
+    $dir1 = &path2abs( $dir1 );;
+    $dir2 = &path2abs( $dir2 );;
+    my @split1 = File::Spec->splitdir($dir1);
+    my @split2 = File::Spec->splitdir($dir2);
+    for ( @split2 ) {
+      next if ( $_ eq shift @split1 );
+      return FALSE;
+    }
+    return TRUE;
+  }
+
+
+  sub license {
+    our ( $Legalese, $stdout );
+    &version;
+    $stdout->print( $Legalese->{'license'} );
+  } # end sub license()
+
+
+  sub make_dir {		# make directory or check if it exists
+    our ( $v, $Args );
+
+    my $dir_arg = shift;
+    chomp $dir_arg;
+    $dir_arg =~ s/^\s*(.*)\s*$/$1/;
+
+    unless ( $dir_arg ) {
+      $v->print( "make_dir(): empty argument" );
+      return FALSE;
+    }
+
+    unless ( File::Spec->file_name_is_absolute($dir_arg) ) {
+      my $res = Cwd::realpath($dir_arg);
+      $res = File::Spec->canonpath($dir_arg) unless ( $res );
+      $dir_arg = $res if ( $res );
+    }
+
+    return $dir_arg if ( -d $dir_arg && -w $dir_arg );
+
+
+    # search thru the dir parts
+    my @dir_parts = File::Spec->splitdir($dir_arg);
+    my @dir_grow;
+    my $dir_grow;
+    my $can_create = FALSE;	# dir could be created if TRUE
+
+   DIRPARTS: for ( @dir_parts ) {
+      push @dir_grow, $_;
+      next DIRPARTS unless ( $_ ); # empty string for root directory
+
+      # from array to path dir string
+      $dir_grow = File::Spec->catdir(@dir_grow);
+
+      next DIRPARTS if ( -d $dir_grow );
+
+      if ( -e $dir_grow ) {  # exists, but not a dir, so must be removed
+	die "Couldn't create dir '$dir_arg', it is blocked by "
+	  . "'$dir_grow'." unless ( -w $dir_grow );
+
+	# now it's writable, but not a dir, so it can be removed
+	unlink ( $dir_grow ) or
+	  die "Couldn't remove '$dir_grow', " .
+	    "so I cannot create dir '$dir_arg': $!";
+      }
+
+      # $dir_grow no longer exists, so the former dir must be writable
+      # in order to create the directory
+      pop @dir_grow;
+      $dir_grow = File::Spec->catdir(@dir_grow);
+
+      die "'$dir_grow' is not writable, " .
+	"so directory '$dir_arg' can't be createdd."
+	  unless ( -w $dir_grow );
+
+      # former directory is writable, so '$dir_arg' can be created
+
+      File::Path::make_path( $dir_arg,
+			     {
+			      mask => oct('0700'),
+			      verbose => $Args->{'verbose'},
+			     }
+			   )	#  'mkdir -P'
+	  or die "Could not create directory '$dir_arg': $!";
+
+      last DIRPARTS;
+    }
+
+    die "'$dir_arg' is not a writable directory"
+      unless ( -d $dir_arg && -w $dir_arg );
+
+    return $dir_arg;
+
+  } # end sub make_dir()
+
+
+  my $number = 0;
+  sub next_temp_file {
+    our ( $Temp, $v, $Args );
+    ++$number;
+    my $temp_basename = $Args->{'prefix'} . '_temp_' . $number;
+    my $temp_file = File::Spec->catfile( $Temp->{'temp_dir'} ,
+					 $temp_basename );
+    $v->print( "next temporary file: '$temp_file'" );
+    return $temp_file;
+  }				# end sub next_temp_file()
+
+
+  sub path2abs {
+    our ( $Temp, $Args );
+
+    my $path = shift;
+    $path =~ s/
+		^
+		\s*
+		(
+		  .*
+		)
+		\s*
+		$
+	      /$1/x;
+
+    die "path2abs(): argument is empty." unless ( $path );
+
+    # Perl does not support shell '~' for home dir
+    if ( $path =~ /
+		    ^
+		    ~
+		  /x ) {
+      if ( $path eq '~' ) {	# only own home
+	$path = File::HomeDir->my_home;
+      } elsif ( $path =~ m<
+			    ^
+			    ~ /
+			    (
+			      .*
+			    )
+			    $
+			  >x ) {	# subdir of own home
+	$path = File::Spec->catdir( $Temp->{'cwd'}, $1 );
+      } elsif ( $path =~ m<
+			    ^
+			    ~
+			    (
+			      [^/]+
+			    )
+			    $
+			  >x ) {	# home of other user
+	$path = File::HomeDir->users_home($1);
+      } elsif ( $path =~ m<
+			    ^
+			    ~
+			    (
+			      [^/]+
+			    )
+			    /+
+			    (
+			      .*
+			    )
+			    $
+			  >x ) {	# subdir of other home
+	$path = File::Spec->
+	  catdir( File::HomeDir->users_home($1), $2 );
+      }
+    }
+
+    $path = File::Spec->rel2abs($path);
+
+    # now $path is absolute
+    return $path;
+  } # end sub path2abs()
+
+
+  sub run_lilypond {
+    # arg is the options collection for 'lilypond' to run
+    # either from ly or pdf
+
+    our ( $Temp, $v );
+
+    my $opts = shift;
+    chomp $opts;
+
+    my $temp_file = &next_temp_file;
+    my $output = EMPTYSTRING;
+
+    # change to temp dir
+    Cwd::chdir $Temp->{'temp_dir'} or
+	die "Could not change to temporary directory '" .
+	  $Temp->{'temp_dir'} . "': $!";
+
+    $v->print( "\n##### run of 'lilypond " . $opts . "'" );
+    $output = `lilypond $opts 2>$temp_file`;
+    die "Program lilypond does not work, see '$temp_file': $?"
+      if ( $? );
+    chomp $output;
+    &shell_handling($output, $temp_file);
+    $v->print( "##### end run of 'lilypond'\n" );
+
+    # stay in temp dir
+  } # end sub run_lilypond()
+
+
+  sub shell_handling {
+    # Handle ``-shell-command output in a string (arg1).
+    # stderr goes to temporary file $TempFile.
+
+    our ( $out, $v, $Args );
+
+    my $out_string = shift;
+    my $temp_file = shift;
+
+    my $a = &string2array($out_string); # array ref
+    for ( @$a ) {
+      $out->print( $_ );
+    }
+
+    $temp_file && -f $temp_file && -r $temp_file ||
+      die "shell_handling(): $temp_file is not a readable file.";
+    my $temp = new FH_READ_FILE($temp_file);
+    my $res = $temp->read_all();
+    for ( @$res ) {
+      chomp;
+      $v->print($_);
+    }
+
+    unlink $temp_file unless ( $Args->{'keep_all'} );
+  } # end sub shell_handling()
+
+
+  sub string2array {
+    my $s = shift;
+    my @a = ();
+    for ( split "\n", $s ) {
+      chomp;
+      push @a, $_;
+    }
+    return \@a;
+  } # end string2array()
+
+
+  sub usage {			# for '--help'
+    our ( $Globals, $Args );
+
+    my $p = $Globals->{'prog'};
+    my $usage = EMPTYSTRING;
+    $usage = '###### usage:' . "\n" if ( $Args->{'verbose'} );
+    $usage .= qq*Options for $p:
+Read a 'roff' file or standard input and transform 'lilypond' parts
+(everything between '.lilypond start' and '.lilypond end') into
+'EPS'-files that can be read by groff using '.PSPIC'.
+
+There is also a command '.lilypond include <file_name>' that can
+include a complete 'lilypond' file into the 'groff' document.
+
+
+# Breaking options:
+$p -?|-h|--help|--usage    # usage
+$p --version               # version information
+$p --license               # the license is GPL >= 3
+
+
+# Normal options:
+$p [options] [--] [filename ...]
+
+There are 2 options for influencing the way how the 'EPS' files for the
+'roff' display are generated:
+--ly2eps           'lilypond' generates 'EPS' files directly (default)
+--pdf2eps          'lilypond' generates a 'PDF' file that is transformed
+
+-k|--keep_all      do not delete any temporary files
+-v|--verbose       print much information to STDERR
+
+Options with an argument:
+-e|--eps_dir=...   use a directory for the EPS files
+-o|--output=...    sent output in the groff language into file ...
+-p|--prefix=...    start for the names of temporary files
+-t|--temp_dir=...  provide the directory for temporary files.
+
+The directories set are created when they do not exist.
+*;
+
+    # old options:
+    # --keep_files       -k: do not delete any temporary files
+    # --file_prefix=...  -p: start for the names of temporary files
+
+    $main::stdout->print( $usage );
+  } # end sub usage()
+
+
+  sub version { # for '--version'
+    our ( $Globals, $Legalese, $stdout, $Args );
+    my $end;
+    if ( $Globals->{'groff_version'} ) {
+      $end = " version $Globals->{'groff_version'}";
+    } else {
+      $end = '.';
+    }
+
+    my $output = EMPTYSTRING;
+    $output = "###### version:\n" if ( $Args->{'verbose'} );
+    $output .= "'" . $Globals->{'prog'} . "' version '" .
+      $Legalese->{'version'} . "' is part of 'GNU groff'" . $end;
+
+    $stdout->print($output);
+  } # end sub version()
 }
 
 #die "test: ";
@@ -142,7 +562,269 @@ BEGIN {
 # OOP declarations for some file handles
 ########################################################################
 
-require 'oop_fh.pl';
+use integer;
+
+########################################################################
+# OOP for writing file handles that are open by default, like STD*
+########################################################################
+
+# -------------------------- _FH_WRITE_OPENED --------------------------
+
+{	# FH_OPENED: base class for all opened file handles, like $TD*
+
+  package _FH_WRITE_OPENED;
+  use strict;
+
+  sub new {
+    my ( $pkg, $std ) = @_;
+    bless {
+	   'fh' => $std,
+	  }
+  }
+
+  sub open {
+  }
+
+  sub close {
+  }
+
+  sub print {
+    my $self = shift;
+    for ( @_ ) {
+      print { $self->{'fh'} } $_;
+    }
+  }
+
+}
+
+
+# ------------------------------ FH_STDOUT ----------------------------
+
+{			     # FH_STDOUT: print to noral output STDOUT
+
+  package FH_STDOUT;
+  use strict;
+  @FH_STDOUT::ISA = qw( _FH_WRITE_OPENED );
+
+  sub new {
+    &_FH_WRITE_OPENED::new( '_FH_WRITE_OPENED', *STDOUT );
+  }
+
+}				# end FH_STDOUT
+
+
+# ------------------------------ FH_STDERR -----------------------------
+
+{				# FH_STDERR: print to STDERR
+
+  package FH_STDERR;
+  use strict;
+  @FH_STDERR::ISA = qw( _FH_WRITE_OPENED );
+
+  sub new {
+    &_FH_WRITE_OPENED::new( 'FH_OPENED', *STDERR );
+  }
+
+}				# end FH_STDERR
+
+
+########################################################################
+# OOP for file handles that write into a file or string
+########################################################################
+
+# ------------------------------- FH_FILE ------------------------------
+
+{	       # FH_FILE: base class for writing into a file or string
+
+  package FH_FILE;
+  use strict;
+
+  sub new {
+    my ( $pkg, $file ) = @_;
+    bless {
+	   'fh' => undef,
+	   'file' => $file,
+	   'opened' => main::FALSE,
+	  }
+  }
+
+  sub DESTROY {
+    my $self = shift;
+    $self->close();
+  }
+
+  sub open {
+    my $self = shift;
+    my $file = $self->{'file'};
+    if ( $file && -e $file ) {
+      die "file $file is not writable" unless ( -w $file );
+      die "$file is a directory" if ( -d $file );
+    }
+    open $self->{'fh'}, ">", $self->{'file'}
+      or die "could not open file '$file' for writing: $!";
+    $self->{'opened'} = main::TRUE;
+  }
+
+  sub close {
+    my $self = shift;
+    close $self->{'fh'} if ( $self->{'opened'} );
+    $self->{'opened'} = main::FALSE;
+  }
+
+  sub print {
+    my $self = shift;
+    $self->open() unless ( $self->{'opened'} );
+    for ( @_ ) {
+      print { $self->{'fh'} } $_;
+    }
+  }
+
+}				# end FH_FILE
+
+
+# ------------------------------ FH_STRING -----------------------------
+
+{				# FH_STRING: write into a string
+
+  package FH_STRING;		# write to \string
+  use strict;
+  @FH_STRING::ISA = qw( FH_FILE );
+
+  sub new {
+    my $pkg = shift;		# string is a reference to scalar
+    bless
+      {
+       'fh' => undef,
+       'string' => '',
+       'opened' => main::FALSE,
+      }
+    }
+
+  sub open {
+    my $self = shift;
+    open $self->{'fh'}, ">", \ $self->{'string'}
+      or die "could not open string for writing: $!";
+    $self->{'opened'} = main::TRUE;
+  }
+
+  sub get { # get string, move to array ref, close, and return array ref
+    my $self = shift;
+    return '' unless ( $self->{'opened'} );
+    my $a = &string2array( $self->{'string'} );
+    $self->close();
+    return $a;
+  }
+
+}				# end FH_STRING
+
+
+# -------------------------------- FH_NULL -----------------------------
+
+{				# FH_NULL: write to null device
+
+  package FH_NULL;
+  use strict;
+  @FH_NULL::ISA = qw( FH_FILE FH_STRING );
+
+  use File::Spec;
+
+  my $devnull = File::Spec->devnull();
+  $devnull = '' unless ( -e $devnull && -w $devnull );
+
+  sub new {
+    my $pkg = shift;
+    if ( $devnull ) {
+      &FH_FILE::new( $pkg, $devnull );
+    } else {
+      &FH_STRING::new( $pkg );
+    }
+  } # end new()
+
+}				# end FH_NULL
+
+
+########################################################################
+# OOP for reading file handles
+########################################################################
+
+# ---------------------------- FH_READ_FILE ----------------------------
+
+{ # FH_READ_FILE: read a file
+
+  package FH_READ_FILE;
+  use strict;
+
+  sub new {
+    my ( $pkg, $file ) = @_;
+    die "File '$file' cannot be read." unless ( -f $file && -r $file );
+    bless {
+	   'fh' => undef,
+	   'file' => $file,
+	   'opened' => main::FALSE,
+	  }
+  }
+
+  sub DESTROY {
+    my $self = shift;
+    $self->close();
+  }
+
+  sub open {
+    my $self = shift;
+    my $file = $self->{'file'};
+    if ( $file && -e $file ) {
+      die "file $file is not writable" unless ( -r $file );
+      die "$file is a directory" if ( -d $file );
+    }
+    open $self->{'fh'}, "<", $self->{'file'}
+      or die "could not read file '$file': $!";
+    $self->{'opened'} = main::TRUE;
+  }
+
+  sub close {
+    my $self = shift;
+    close $self->{'fh'} if ( $self->{'opened'} );
+    $self->{'opened'} = main::FALSE;
+  }
+
+  sub read_line {
+    # Read 1 line of the file into a chomped string.
+    # Do not close the read handle at the end.
+    my $self = shift;
+    $self->open() unless ( $self->{'opened'} );
+
+    my $res;
+    if ( defined($res = CORE::readline($self->{'fh'}) ) ) {
+      chomp $res;
+      return $res;
+    } else {
+      $self->close();
+      return undef;
+    }
+  }
+
+  sub read_all {
+    # Read the complete file into an array reference.
+    # Close the read handle at the end.
+    # Return array reference.
+    my $self = shift;
+    $self->open() unless ( $self->{'opened'} );
+
+    my $res = [];
+    my $line;
+    while ( defined ( $line = CORE::readline $self->{'fh'} ) ) {
+      chomp $line;
+      push @$res, $line;
+    }
+    $self->close();
+    $self->{'opened'} = main::FALSE;
+    return $res;
+  }
+
+}
+
+# end of OOP definitions
+
 
 our $stdout = new FH_STDOUT();
 our $stderr = new FH_STDERR();
@@ -194,7 +876,468 @@ our $Args =
   };
 
 { # 'Args'
-  require 'args.pl';
+  use integer;
+
+  our ( $Globals, $Args, $stderr, $v, $out );
+
+  # ----------
+  # subs for second run, for remaining long options after splitting and
+  # transfer
+  # ----------
+
+  my %opts_with_arg =
+    (
+
+     '--eps_dir' => sub {
+       $Args->{'eps_dir'} = shift;
+     },
+
+     '--output' => sub {
+       $Args->{'output'} = shift;
+     },
+
+     '--prefix' => sub {
+       $Args->{'prefix'} = shift;
+     },
+
+     '--temp_dir' => sub {
+       $Args->{'temp_dir'} = shift;
+     },
+
+    );				# end of %opts_with_arg
+
+
+  my %opts_noarg =
+    (
+
+     '--help' => sub {
+       &usage;
+       exit;
+     },
+
+     '--keep_all' => sub {
+       $Args->{'keep_all'} = TRUE;
+     },
+
+     '--license' => sub {
+       &license;
+       exit;
+     },
+
+     '--ly2eps' => sub {
+       $Args->{'eps_func'} = 'ly';
+     },
+
+     '--pdf2eps' => sub {
+       $Args->{'eps_func'} = 'pdf';
+     },
+
+     '--verbose' => sub {
+       $Args->{'verbose'} = TRUE;
+     },
+
+     '--version' => sub {
+       &version;
+       exit;
+     },
+
+    );				# end of %opts_noarg
+
+
+  # used variables in both runs
+
+  my @files = EMPTYARRAY;
+
+
+  #----------
+  # first run for command-line arguments
+  #----------
+
+  # global variables for first run
+
+  my @splitted_args;
+  my $double_minus = FALSE;
+  my $arg = EMPTYSTRING;
+  my $has_arg = FALSE;
+
+
+  # Split short option collections and transfer these to suitable long
+  # options from above.  Note that '-v' now means '--verbose' in version
+  # 'v1.1', earlier versions had '--version' for '-v'.
+
+  my %short_opts =
+    (
+     '?' => '--help',
+     'e' => '--eps_dir',
+     'h' => '--help',
+     'l' => '--license',
+     'k' => '--keep_all',
+     'o' => '--output',
+     'p' => '--prefix',
+     't' => '--temp_dir',
+     'v' => '--verbose',
+     'V' => '--verbose',
+    );
+
+
+  # transfer long option abbreviations to the long options from above
+
+  my @long_opts;
+
+  $long_opts[3] =
+    {				# option abbreviations of 3 characters
+     '--e' => '--eps_dir',
+     '--f' => '--prefix',		# --f for --file_prefix
+     '--h' => '--help',
+     '--k' => '--keep_all',	# and --keep_files
+     '--o' => '--output',
+     '--p' => '--prefix',		# and --file_prefix
+     '--t' => '--temp_dir',
+     '--u' => '--help',		# '--usage' is mapped to '--help'
+    };
+
+  $long_opts[4] =
+    {				# option abbreviations of 4 characters
+     '--li' => '--license',
+     '--ly' => '--ly2eps',
+     '--pd' => '--pdf2eps',
+     '--pr' => '--prefix',
+    };
+
+  $long_opts[6] =
+    {				# option abbreviations of 6 characters
+     '--verb' => '--verbose',
+     '--vers' => '--version',
+    };
+
+
+  # subs for short splitting and replacing long abbreviations
+
+  my $split_short = sub {
+
+    my @chars = split //, $1;	# omit leading dash
+
+       # if result is TRUE: run 'next SPLIT' afterwards
+
+     CHARS: while ( @chars ) {
+	 my $c = shift @chars;
+
+	 unless ( exists $short_opts{$c} ) {
+	   $stderr->print( "Unknown short option '-$c'." );
+	   next CHARS;
+	 }
+
+	 # short option exists
+
+	 # map or transfer to special long option from above
+	 my $transopt = $short_opts{$c};
+
+	 if ( exists $opts_noarg{$transopt} ) {
+	   push @splitted_args, $transopt;
+	   $Args->{'verbose'}  = TRUE if ( $transopt eq '--verbose' );
+	   next CHARS;
+	 }
+
+	 if ( exists $opts_with_arg{$transopt} ) {
+	   push @splitted_args, $transopt;
+
+	   if ( @chars ) {
+	     # if @chars is not empty, option $transopt has argument
+	     # in this arg, the rest of characters in @chars
+	     push @splitted_args, join "", @chars;
+	     @chars = EMPTYARRAY;
+	     return TRUE;		# use 'next SPLIT' afterwards
+	   }
+
+	   # optarg is the next argument
+	   $has_arg = $transopt;
+	   return TRUE;		# use 'next SPLIT' afterwards
+	 }			# end of if %opts_with_arg
+       }				# end of while CHARS
+       return FALSE;		# do not do anything
+  };				# end of sub for short_opt_collection
+
+
+  my $split_long = sub {
+    my $from_arg = shift;
+    $from_arg =~ /^([^=]+)/;
+    my $opt_part = lc($1);
+    my $optarg = undef;
+    if ( $from_arg =~ /=(.*)$/ ) {
+      $optarg = $1;
+    }
+
+   N: for my $n ( qw/6 4 3/ ) {
+      $opt_part =~ / # match $n characters
+		     ^
+		     (
+		       .{$n}
+		     )
+		   /x;
+      my $argn = $1;		# get the first $n characters
+
+      # no match, so luck for fewer number of chars
+      next N unless ( $argn );
+
+      next N unless ( exists $long_opts[$n]->{$argn} );
+      # not in $n hash, so go on to next loop for $n
+
+      # now $n-hash has arg
+
+      # map or transfer to special long opt from above
+      my $transopt = $long_opts[$n]->{$argn};
+
+      # test on option without arg
+      if ( exists $opts_noarg{$transopt} ) { # opt has no arg
+	$stderr->print( 'Option ' . $transopt . 'has no argument: ' .
+			$from_arg . '.' ) if ( defined($optarg) );
+	push @splitted_args, $transopt;
+	$Args->{'verbose'} = TRUE if ( $transopt eq '--verbose' );
+	return TRUE;		# use 'next SPLIT' afterwards
+      }				# end of if %opts_noarg
+
+      # test on option with arg
+      if ( exists $opts_with_arg{$transopt} ) { # opt has arg
+	push @splitted_args, $transopt;
+
+	# test on optarg in arg
+	if ( defined($optarg) ) {
+	  push @splitted_args, $1;
+	  return TRUE; # use 'next SPLIT' afterwards
+	} # end of if optarg in arg
+
+	# has optarg in next arg
+	$has_arg = $transopt;
+	return TRUE; # use 'next SPLIT' afterwards
+      } # end of if %opts_with_arg
+
+      # not with and without option, so is not permitted
+      $stderr->print( "'" . $transopt .
+		      "' is unknown long option from '" . $from_arg . "'" );
+      return TRUE; # use 'next SPLIT' afterwards
+    } # end of for N
+    return FALSE; # do nothing
+  }; # end of split_long()
+
+
+  #----------
+  # do split and transfer arguments
+  #----------
+  sub run_first {
+
+   SPLIT: foreach (@ARGV) {
+      # Transform long and short options into some given long options.
+      # Split long opts with arg into 2 args (no '=').
+      # Transform short option collections into given long options.
+      chomp;
+
+      if ( $has_arg ) {
+	push @splitted_args, $_;
+	$has_arg = EMPTYSTRING;
+	next SPLIT;
+      }
+
+      if ( $double_minus ) {
+	push @files, $_;
+	next SPLIT;
+      }
+
+      if ( $_ eq '-' ) {		# file arg '-'
+	push @files, $_;
+	next SPLIT;
+      }
+
+      if ( $_ eq '--' ) {		# POSIX arg '--'
+	push @splitted_args, $_;
+	$double_minus = TRUE;
+	next SPLIT;
+      }
+
+      if ( / # short option or collection of short options
+	     ^
+	     -
+	     (
+	       [^-]
+	       .*
+	     )
+	     $
+	   /x ) {
+	$split_short->($1);
+	next SPLIT;
+      }				# end of short option
+
+      if ( /^--/ ) {		# starts with 2 dashes, a long option
+	$split_long->($_);
+	next SPLIT;
+      }				# end of long option
+
+      # unknown option without leading dash is a file name
+      push @files, $_;
+      next SPLIT;
+    }				# end of foreach SPLIT
+
+				  # all args are considered
+    $stderr->print( "Option '$has_arg' needs an argument." )
+      if ( $has_arg );
+
+
+    push @files, '-' unless ( @files );
+    @ARGV = @splitted_args;
+
+  };		    # end of first run, splitting with map or transfer
+
+
+  #----------
+  # open or ignore verbose output
+  #----------
+  sub install_verbose {
+    if ( $Args->{'verbose'} ) { # '--verbose' was used
+      # make verbose output into $v
+      # get content of string so far as array ref, close
+      my $s = $v->get();
+
+      $v = new FH_STDERR(); # make verbose output into STDERR
+      if ( $s ) {
+	for ( @$s ) {
+	  # print the file content into new verbose output
+	  $v->print($_);
+	}
+      }
+      # verbose output is now active (into STDERR)
+      $v->print( "Option '-v' means '--verbose'." );
+      $v->print( "Version information is printed by option"
+	         . " '--version'."
+      );
+      $v->print( "#" x 72 );
+
+    } else { # '--verbose' was not used
+      # do not be verbose, make verbose invisible
+
+      $v->close(); # close and ignore the string content
+
+      $v = new FH_NULL();
+      # this is either into /dev/null or in an ignored string
+
+    } # end if-else about verbose
+    # '$v->print' works now in any case
+
+    $v->print( "Verbose output was chosen." );
+
+    my $s = $Globals->{'prog_is_installed'} ? '' : ' not';
+    $v->print( $Globals->{'prog'} . " is" . $s .
+	       " installed." );
+
+    $v->print( 'The command-line options are:' );
+
+    $s = "  options:";
+    $s .= " '" . $_ . "'" for ( @ARGV );
+    $v->print( $s );
+
+    $s = "  file names:";
+    $s .= " '" . $_ . "'\n" for ( @files );
+    $v->print( $s );
+  } # end install_verbose()
+
+
+  #----------
+  # second run of command-line arguments
+  #----------
+  sub run_second {
+      # Second run of args with new @ARGV from the former splitting.
+      # Arguments are now splitted and transformed into special long
+      # options.
+
+      my $double_minus = FALSE;
+      my $has_arg = FALSE;
+
+    ARGS: for my $arg ( @ARGV ) {
+
+	# ignore '--', file names are handled later on
+	last ARGS if ( $arg eq '--' );
+
+	if ( $has_arg ) {
+	  unless ( exists $opts_with_arg{$has_arg} ) {
+	    $stderr->print( "'\%opts_with_args' does not have key '" .
+			      $has_arg . "'." );
+	    next ARGS;
+	  }
+
+	  $opts_with_arg{$has_arg}->($arg);
+	  $has_arg = FALSE;
+	  next ARGS;
+	} # end of $has_arg
+
+	if ( exists $opts_with_arg{$arg} ) {
+	  $has_arg = $arg;
+	  next ARGS;
+	}
+
+	if ( exists $opts_noarg{$arg} ) {
+	  $opts_noarg{$arg}->();
+	  next ARGS;
+	}
+
+	# not a suitable option
+	$stderr->print( "Wrong option '" . $arg . "'." );
+	next ARGS;
+
+      } # end of for ARGS:
+
+
+      if ( $has_arg ) { # after last argument
+	die "Option '$has_arg' needs an argument.";
+      }
+
+    }; # end of second run
+
+
+  sub handle_args {
+    # handling the output of args
+
+    if ( $Args->{'output'} ) { # '--output' was set in the arguments
+      my $out_path = &path2abs($Args->{'output'});
+      die "Output file name $Args->{'output'} cannot be used."
+	unless ( $out_path );
+
+      my ( $file, $dir );
+      ( $file, $dir ) = File::Basename::fileparse($out_path)
+	or die "Could not handle output file path '" . $out_path
+	  . "': directory name '" . $dir . "' and file name '" . $file
+	  . "'.";
+
+      die "Could not find output directory for '" . $Args->{'output'}
+        . "'" unless ( $dir );
+      die "Could not find output file: '" . $Args->{'output'} .
+	"'" unless ( $file );
+
+      if ( -d $dir ) {
+	die "Could not write to output directory '" . $dir . "'."
+	  unless ( -w $dir );
+      } else {
+	$dir = &make_dir($dir);
+	die "Could not create output directory in: '" . $out_path . "'."
+	  unless ( $dir );
+      }
+
+      # now $dir is a writable directory
+
+      if ( -e $out_path ) {
+	die "Could not write to output file '" . $out_path . "'."
+	  unless ( -w $out_path );
+      }
+
+      $out = new FH_FILE( $out_path );
+      $v->print( "Output goes to file '" . $out_path . "'." );
+    } else { # '--output' was not set
+      $out = new FH_STDOUT();
+    }
+    # no $out is the right behavior for standard output
+
+  #  $Args->{'prefix'} .= '_' . $Args->{'eps_func'} . '2eps';
+
+    @ARGV = @files;
+  }
+
   &run_first();
   &install_verbose();
   &run_second();
@@ -283,7 +1426,8 @@ our $Temp =
       my @tempdirs = EMPTYARRAY;
       {
 	my $tmpdir = File::Spec->tmpdir();
-	push @tempdirs, $tmpdir if ( $tmpdir && -d $tmpdir && -w $tmpdir );
+	push @tempdirs, $tmpdir
+	  if ( $tmpdir && -d $tmpdir && -w $tmpdir );
 
 	my $root_dir = File::Spec->rootdir(); # '/' in Unix
 	my $root_tmp = File::Spec->catdir($root_dir, 'tmp');
@@ -301,7 +1445,7 @@ our $Temp =
       }
 
 
-      my @path_extension = qw( groff ); # TEMPDIR/groff/USER/lilypond/<NUMBER>
+      my @path_extension = qw( groff ); # TEMPDIR/groff/USER/lilypond/N
       {
 	# '$<' is UID of actual user,
 	# 'getpwuid' gets user name in scalar context