#  Copyright (c) 1997-2010
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Darmstadt, Germany)
#  http://www.polymake.de
#
#  This program 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, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#-------------------------------------------------------------------------------
#  $Project: polymake $$Id: configure.rules 9559 2010-03-10 23:53:06Z gawrilow $

require Term::ReadLine;

#
#  Utilities used only in CONFIGURE clauses
#

sub init_term {
   unless ($Readline) {
      print "\n";
      $Readline=Term::ReadLine::Gnu->new("polymake");
      Core::defuse_environ_bug();
      Term::ReadLine::Gnu::XS::ornaments('md,me,,');	# bold prompt
   }
}

function enter_string {
   my ($value, $prompt, $check, $empty_allowed)=@_;
   local $Core::Customize::configure_state=$Core::Customize::state_config|$Core::Customize::state_changed|$Core::Customize::state_saved;

   if (is_code($check)) {
      $empty_allowed= $empty_allowed !~ /!/;
   } else {
      $empty_allowed= $check !~ /!/;
   }

   unless (-t STDIN) {
      return if defined($value) && $value ne "none";
      if ($empty_allowed) {
	 $_[0]=undef;
	 return;
      }
   }
   init_term;
   if ($empty_allowed && (is_code($check) || $check !~ / /)) {
      print "$prompt; disable with empty input or `none':\n";
   } else {
      print "$prompt\n";
   }
   for (;;) {
      STDOUT->flush;
      $value=$Readline->readline("==> ", $value);
      $value=~s/^\s+//;  $value=~s/\s+$//;
      if (!length($value) || $value eq "none") {
	 if ($empty_allowed) {
	    $_[0]= is_code($check) || $check !~ / / ? undef : " ";
	    return;
	 } else {
	    print "Please enter some value.\n";
	    next;
	 }
      }
      if (!is_code($check) || $check->($value)) {
	 $_[0]=$value;
	 return 1;
      }
   }
}

function enter_filename {
   init_term;
   local @{$Readline->Attribs}{qw( completion_entry_function
				      completer_word_break_characters
				      completion_append_character )}
         =( $Readline->Attribs->{filename_completion_function},
            $Readline->Attribs->{basic_word_break_characters},
   	    "" );
   my ($check, $empty_allowed)= is_code($_[2]) ? @_[2,3] : @_[2,2];
   enter_string($_[0], $_[1], sub {
		   $_[0] =~ s/\$(\w+)/$ENV{$1}/g;
		   $_[0] =~ s/~(\w+)/(getpwnam($1))[7]/eg;
		   $_[0] =~ s/~/$ENV{HOME}/g;

		   if (is_code($check)) {
		      $check->($_[0])
		   } elsif (-e $_[0]) {
		      if ($check =~ /d/ && !-d _) {
			 print "$_[0] is not a directory\n";
			 0
		      } else {
			 1
		      }
		   } elsif ($check !~ /-/) {
		      print "$_[0] does not exist\n";
		      0
		   } else {
		      1
		   }
		}, $empty_allowed);
}

function locate_in_path {
   my ($file)=@_;
   foreach (split /:/, $ENV{PATH}) {
      if (-x "$_/$file" && !-d _) {
	 return Cwd::abs_path("$_/$file");
      }
   }
   undef
}

function enter_executable_path {
   my ($check, $empty_allowed)= @_==4 ? @_[2,3] : (undef, $_[2]);
   enter_filename($_[0], $_[1], sub {
		     my $path=$_[0];
		     if ($path =~ m|^/|) {
			if (-e $path) {
			   if (!-x _ || -d _) {
			      print "$path is not executable\n";
			      return;
			   }
			} else {
			   print "$path does not exist\n";
			   return;
			}
		     } elsif (defined ($path=locate_in_path($path))) {
			$empty_allowed =~ /A/ and $_[0]=$path;
		     } else {
			print "$_[0] not found in your PATH\n";
			return;
		     }
		     !defined($check) || $check->($_[0])
		  }, $empty_allowed);
}

function find_via_path {
   my ($prompt, $empty_allowed);
   if (@_>2 && length($_[-1])<=2 && $_[-1] =~ /^[!A]+$/) {
      $empty_allowed=pop;
   }
   if (@_>2) { ($prompt)=splice @_,1,1; }
   foreach my $progname (@_[1..$#_]) {
      if (defined (my $path=locate_in_path($progname))) {
	 $_[0]= $empty_allowed =~ /A/ ? $path : $progname;
	 return 1;
      }
   }
   enter_executable_path($_[0],
			 length($prompt) ? $prompt :
			 @_>2 ? "Please enter a full path to one of the programs: ".join(",",@_[1..$#_])
			      : "Please enter a full path to the `$_[1]' program",
			 $empty_allowed);
}

function enter_yes_no {
   my ($value, $prompt)=@_;
   -t STDIN or return $value;
   init_term;
   print $prompt;
   $prompt= $value ? " (Y/n) ? " : " (y/N) ? ";
   for (;;) {
      STDOUT->flush;
      my $answer=$Readline->readline($prompt, "");
      return 1 if $answer =~ /^\s*y(es?)?\s*$/i;
      return 0 if $answer =~ /^\s*no?\s*$/i;
      return $value if $answer =~ /^\s*$/;
      print "Please answer `yes' or `no'\n";
   }
}

# Local Variables:
# mode: perl
# c-basic-offset:3
# End:
