#  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: User.pm 9516 2010-03-03 10:28:02Z gawrilow $

use strict;
use namespaces;

package Polymake::UserSettings;

BEGIN {
   declare $dir=$ENV{POLYMAKE_USER_DIR} || "$ENV{HOME}/.polymake";

   if (!-d $dir) {
      CORE::mkdir($dir, 0755)
      or die "can't create per-user directory $dir: $!\n";
      warn_print( "directory $dir created for keeping personal user settings" );
   }
}
##################################################################################
package Polymake::User;

declare $application;

sub application {
   if (@_>1) {
      die "usage: application [ \"name\" ]\n";
   } elsif (@_) {
      my $new_app=shift;
      if (defined wantarray) {
	 if (ref($new_app)) {
	    warn_print( "application() call without effect as the application ", $new_app->name, " already loaded" );
	    $new_app;
	 } else {
	    add Core::Application($new_app);
	 }
      } else {
	 $new_app=add Core::Application($new_app) unless ref($new_app);
	 if (defined($application)) {
	    return if $application == $new_app;
	    readwrite($application);
	 }
	 $application=$new_app;
	 readonly($application);
	 namespaces::import_subs_from($_->eval_expr) for ($application, values %{$application->used});
      }
   } else {
      # tell the current application
      $application;
   }
}

####################################################################################
sub include {
   $application->include_rules(@_);
}
#################################################################################
sub load {
   my ($name)=@_;
   my $filename=$name;
   replace_special_paths($filename);
   unless (-f $filename
	   or
	   defined($application)  &&  $filename !~ /\.\w+$/  &&
	   -f ($filename .= "." . $application->file_suffix)) {
      croak( "no such file: $name" );
   }
   my $obj=load Core::Object($filename);
   application $obj->type->application if !defined $application;
   $obj;
}
#################################################################################
sub save {
   my ($obj, $filename)=@_;
   if (!is_object($obj) || !instanceof Core::Object($obj)) {
      croak( "only polymake Objects can be stored with the function save()" );
   }
   if (defined($obj->parent)) {
      croak( "A sub-object can't be saved without its parent" );
   }
   if (!$obj->persistent || defined($filename)) {
      if (defined $filename) {
	 replace_special_paths($filename);
	 if ($filename !~ /\.\w+$/) {
	    $filename .= "." . $obj->type->application->file_suffix;
	 }

      } else {
	 if (!length($obj->name)) {
	    $obj->name=Core::name_of_arg_var(0);
	 }
	 if (length($obj->name)) {
	    $filename=$obj->name.".".$obj->type->application->file_suffix;
	    if (-f $filename) {
	       if (defined $Core::Shell::interactive) {
		  print "The file $filename already exists.\n",
	                "Please specify another file name or confirm it with <ENTER> to be overwritten:\n";
		  $filename=$Core::Shell::interactive->enter_filename($filename);
	       } else {
		  croak( "Can't save an object '", $obj->name, "' since the file $filename already exists.\n",
			 "Please specify the explicit file name as the second argument to save() or delete the existing file (unlink \"$filename\")" );
	       }
	    }
	 } else {
	    if (defined $Core::Shell::interactive) {
	       print "Please specify the file name for the anonymous ", $obj->type->full_name, " object:\n";
	       $filename=$Core::Shell::interactive->enter_filename("");
	    } else {
	       my $i=1;
	       while (-f ($filename=($obj->name=$obj->type->name."_$i".".".$obj->type->application->file_suffix))) { ++$i }
	       warn_print( "saving object as $filename" );
	    }
	 }
      }
      $obj->persistent=new Core::XMLfile($filename);
      $obj->changed=1;

   } elsif (! $obj->changed) {
      warn_print( "no changes need to be saved" );
      return;
   }

   $obj->save;
}

#################################################################################
sub load_data {
   my $filename=shift;
   replace_special_paths($filename);
   my $xf=new Core::XMLfile($filename);
   scalar($xf->load_data);
}

sub save_data {
   my ($data, $filename, $description)=@_;
   if (!is_object($data)) {
      croak( "only complex data types can be saved in separate files" );
   }
   if (instanceof Core::Object($data)) {
      croak( "an object of type ", $data->type->full_name, " can't be saved with save_data: please use save() instead" );
   }
   if (defined (my $type=UNIVERSAL::can($data,"type"))) {
      $type=$type->();
      if (instanceof Core::PropertyType($type)) {
	 replace_special_paths($filename);
	 my $xf=new Core::XMLfile($filename);
	 $xf->save_data($data, $description);
	 return;
      }
   }
   croak( "can't save ", ref($data), ": it does not belong to any declared property type" );
}
#################################################################################
use subs qw(rename unlink mkdir chdir rmdir);

sub rename { my ($from,$to)=@_; replace_special_paths($from,$to); CORE::rename($from,$to) or die "rename failed: $!\n"; }
sub unlink { my @list=@_; replace_special_paths(@list); CORE::unlink(@list) or die "unlink failed: $!\n"; }
sub mkdir { my ($path,$mask)=@_; replace_special_paths($path); CORE::mkdir($path,$mask || 0755) or die "mkdir failed: $!\n"; }
sub rmdir { my ($path)=@_; replace_special_paths($path); CORE::rmdir($path) or die "rmdir failed: $!\n"; }

sub chdir {
   my $path;
   if (my ($path)=@_) {
      replace_special_paths($path) if is_string($path);
      CORE::chdir($path) or die "chdir failed: $!\n";
   } else {
      CORE::chdir;
   }
}

sub pwd { print Cwd::cwd }

#################################################################################
sub prefer {
   $application->prefer(@_);
}

sub prefer_now {
   $application->prefer_now(@_);
}

# an alias, for the sake of symmetry
*set_preference=\&prefer;

sub reset_preference {
   $application->reset_preference(@_);
}

sub set_custom {
   $application->_set_custom(Core::name_of_custom_var(1), $Prefs->custom);
}

sub reset_custom {
   $application->_reset_custom(Core::name_of_custom_var(0), $Prefs->custom);
}

###############################################################################################
sub script {
   my $name=shift;
   replace_special_paths($name);
   my ($code, $full_path, $in_app)=find Core::StoredScript($name);
   if (defined $code) {
      local *ARGV=\@_;
      &$code;
   } else {
      local @ARGV=@_;
      defined($in_app) ? $in_app != $User::application && (local $User::application=$in_app,  local $INC[0]=$in_app)
                       : local_save_scalar($User::application);
      $name="script" . (defined($in_app) ? ":" : "=") . $full_path;
      if (wantarray) {
	 my @ret=do $name;
	 die $@ if $@;
	 @ret
      } elsif (defined wantarray) {
	 my $ret=do $name;
	 die $@ if $@;
	 $ret
      } else {
	 do $name;
	 die $@ if $@;
      }
   }
}
####################################################################################
sub choose_extension_tree {
   my ($ext_dir)=@_;
   if (defined $ext_dir) {
      replace_special_paths($ext_dir);
      -d $ext_dir or die "directory $ext_dir does not exist\n";
      -w _ && -x _ or die "you don't have enough permissions to use directory $ext_dir\n";
      $ext_dir=Cwd::abs_path($ext_dir);
      if ($ext_dir =~ m{^(?:$InstallTop|$InstallArch)(?:/|$)}) {
	 die "An extension may not reside within the polymake core tree.\n",
	     "Please choose a different location.\n";
      }
      ($ext_dir, 1);
   } else {
      foreach (@lookup_applications) {
	 if (-w $_ && -x _) {
	    warn_print( "using extension base directory $_\n" );
	    return ($_, 0);
	 }
      }
      die "please specify the extension base directory\n";
   }
}

sub found_extension {
   $application->found_extension(add Core::Extension(&choose_extension_tree));
}

sub found_application {
   my $app_name=shift;
   defined(lookup Core::Application($app_name)) and die "application $app_name already loaded\n";
   foreach ($InstallTop, @lookup_applications) {
      -d "$_/apps/$app_name" and die "application $app_name seems to be already created: look at $_/apps\n";
   }
   found Core::Application($app_name,add Core::Extension(&choose_extension_tree));
}

sub import_extension {
   my $ext_dir=shift;
   replace_special_paths($ext_dir);
   $ext_dir=Cwd::abs_path($ext_dir);
   if (lookup Core::Extension($ext_dir)) {
      die "extension $ext_dir already imported\n";
   }
   -d $ext_dir or die "directory $ext_dir does not exist\n";
   my $ext=add Core::Extension($ext_dir,1);
   $ext->load_contents;
}
####################################################################################
# prepare for custom variables and preferences

$Custom=new Core::Customize("$UserSettings::dir/customize.pl");
$Prefs=new Core::Preference("$UserSettings::dir/prefer.pl");

$Core::Customize::configure_state=$Core::Customize::state_default;

declare (@start_applications, @lookup_applications, @lookup_scripts);
declare $default_application="polytope";
declare $enable_console=1;
declare $history_size=200;
declare $history_editor=$ENV{VISUAL} || $ENV{EDITOR} || "vi";

package Polymake::User::Verbose;
*Polymake::Verbose::=get_pkg(__PACKAGE__);

declare $credits=1;
declare $rules=1;
declare $scheduler=0;
declare $cpp=0;
declare $files=1;
declare $external=0;

$Core::Customize::configure_state=0;

package Polymake::User;

my $ch=$Prefs->custom;
$ch->add('@start_applications', <<'.');
always load these applications at the beginning:
.
$ch->add('$default_application', <<'.');
start with this application as the current one:
.
$ch->add('@lookup_applications', <<'.');
look for applications and extensions in the following directories:
.
$ch->add('@lookup_scripts', <<'.');
look for scripts in the following directories:
.
$ch->add('$enable_console', <<'.');
display error and informational messages in a separate console window
.
$ch->add('$history_size', <<'.');
maximal number of commands stored in the interactive shell's history.
If set to undef, history list grows unlimited.
.
$ch->add('$history_editor', <<'.');
editor for 'history' command
Must be a complete shell command. If the temporary file name is expected somewhere in the middle
of the arguments, please use the placeholder %f.
.
$ch->add_package_help('Polymake::User::Verbose', <<'.');
The following variables control the display of various informational message classes.
.
$ch->add('$Polymake::User::Verbose::credits', <<'.');
display the copyright notices and URLs of third-party software:
0 - never, 1 - at the first use in the current session, 2 - always
.
$ch->add('$Polymake::User::Verbose::rules', <<'.');
display the information about the rules:
0 - nothing, 1 - significant failures, 2 - summary and all failed preconditions, 3 - each executed rule
.
$ch->add('$Polymake::User::Verbose::scheduler', <<'.');
reveal the internals of the rule scheduler:
0 - nothing, 1 - summary and statistics, 2 - initial rule selection,
3 - shortest path search (overwhelming amount of data)
.
$ch->add('$Polymake::User::Verbose::cpp', <<'.');
tell about the actions of the perl/C++ interface generator:
0 - nothing, 1 - compiler calls and source file updates, 2 - generated source code
.
$ch->add('$Polymake::User::Verbose::files', <<'.');
notify about nontrivial actions during data file processing
.
$ch->add('$Polymake::User::Verbose::external', <<'.');
notify about external programs starting in the background
(not to be mixed with credits!)
.
$ch->cleanup;

# treat relative paths as starting at $HOME
if (grep { substr($_,0,1) ne "/" } @lookup_applications) {
   $ch->set('@lookup_applications', map { s{^(?:~/|(?!/))}{$ENV{HOME}/}; $_ } @lookup_applications);
}
if (grep { substr($_,0,1) ne "/" } @lookup_scripts) {
   $ch->set('@lookup_scripts', map { s{^(?:~/|(?!/))}{$ENV{HOME}/}; $_ } @lookup_scripts);
}

if ($Prefs->need_save && !@start_applications) {
### FIXME:
###      $ch->set('@start_applications', map { m{apps/([^/]+)/rules} } glob("$InstallTop/apps/*/rules/main.rules"));
### until all applications migrated
      $ch->set('@start_applications', grep { /^(?:polytope|topaz|matroid|tropical)$/ } map { m{apps/([^/]+)/rules} } glob("$InstallTop/apps/*/rules/main.rules"));
}


1
