#  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: Shell.pm 9581 2010-03-16 19:33:46Z herr $

use strict;
use namespaces;

require Term::ReadLine;
require Term::Cap;
require Polymake::Core::InteractiveHelp;

package Polymake::Core::Shell;

use Polymake::Ext;
use POSIX qw( :signal_h );

use Polymake::Struct (
   [ '@ISA' => 'Selector::Member' ],
   [ '$term' => 'Term::ReadLine::Gnu->new("polymake")' ],
   [ '$state' => '0' ],
   '$input_line',		# for callback interface
   '$line_cnt',			# in the current input group
   '$first_hist_index',		# where in the history list the first line of the current input portion will go
   [ '$within_history' => 'undef' ],	# when defined: position in the history list to be copied to the pre-put
   '$within_history_begin',	# the index of the history line preceding the injected portion (for display in prompt)
   '$last_error_was_in_history',
   '&try_completion',		# method choosing the completion list
   '&completion',		# method iterating over the completion list
   '@completion_words',
   [ '$histfile' => '"$UserSettings::dir/history"' ],
   '@remove_hist_lines',	# [ start..end ], ...
);

declare $interactive;

sub start {
   undef $Readline;
   $interactive=new Shell(\*STDIN);
   defuse_environ_bug();
   $interactive->term->Attribs->{completion_append_character}="";
   $interactive->term->Attribs->{completer_word_break_characters}.="+-*/.%})[]?!,";
   $interactive->term->Attribs->{special_prefixes}="";
   $interactive->term->Attribs->{completion_entry_function}=\&completion_entry;
   $interactive->term->Attribs->{filename_quoting_desired}=0;
   $interactive->term->Attribs->{history_base}=0;
   $interactive->term->variable_bind("show-all-if-unmodified","on");
   $interactive->term->ornaments('md,me,,');	# bold prompt
   $interactive->try_completion=\&all_completions;

   my $F1=Term::Cap->Tgetent->{_k1};
   $interactive->term->bind_keyseq($F1, $interactive->term->add_defun("context_help", \&context_help));

   *Polymake::Core::PlainFile::consume_unknown_property=\&consume_unknown_property;
   *Polymake::Core::Extension::locate_unknown=\&locate_unknown_extension;

   add AtEnd("Shell", sub { undef $interactive });
}

# stuff for TAB completion and context-sensitive help

my $statement_start_re=qr{(?: ^ | [;\}] )\s*}x;

my $interactive_preamble="$warn_options; use application undef, \$namespaces::auto_declare;\n";

my $canceled=sub {
   if ($interactive->state==3 || $interactive->term->Attribs->{line_buffer} =~ /\S/) {
      $interactive->term->delete_text;
      $interactive->term->redisplay;
      print STDERR "Canceled\n";
   } else {
      print STDERR "Type 'exit;' to leave polymake\n";
   }
   $interactive->state=0;
   $interactive->term->callback_handler_remove unless defined($interactive->input_line);
   $interactive->term->cleanup_after_signal;
   if (defined $interactive->within_history) {
      undef $interactive->within_history;
      $interactive->term->history_set_pos($interactive->term->Attribs->{history_length}-1);
      $interactive->term->Attribs->{startup_hook}=undef;
   }
   die "1\n";
};

sub interactive_INC {
   if ($_[1] eq "input:") { 
      (\&get_line, $interactive)
   } elsif ($_[1] =~ /^history:/) {
      open my $hf, $';
      new ScriptFilter($hf, [ $interactive_preamble, "#line 1 \"history\"\n" ],
		       sub { $_[0] =~ s{ ($statement_start_re) (application (?: (\s*\(\s*) | \s+) (['"]) $id_re \4) ((?(3) \s*\)\s* | \s*);) }{$1 use $2,1$5}xo; });
   } else {
      $User::application->INC($_[1]);
   }
}

sub run {
   local_unshift(\@INC, \&interactive_INC);

   local $SIG{__WARN__}=sub {
      my $msg=shift;
      if ($msg =~ /input line \d+/) {
         die $msg;
      } else {
         warn_print($msg);
      }
   };
   my $sa_INT_save=new POSIX::SigAction('DEFAULT');
   my $sa_INT=new POSIX::SigAction($canceled, new POSIX::SigSet(SIGQUIT, SIGALRM, SIGPIPE), SA_NODEFER);
   sigaction SIGINT, $sa_INT, $sa_INT_save;

   $interactive->term->ReadHistory($interactive->histfile) if -f $interactive->histfile;
   undef $interactive->term->{MinLength};	# don't automatically add to history

   #local $Polymake::Console=Polymake::Core::PendingConsole->new if $User::enable_console;

   print "\rPress F1 or enter 'help;' for basic instructions.\n";
   STDOUT->flush();
   do {
      $interactive->state=0;
      # the funny trailing '1;' provides all temporaries created in the eval'd expression be destroyed prior to the Scope object.
      {  local $Scope=new Scope(); package Polymake::User; do "input:"; 1; }
      STDOUT->flush();
      $interactive->term->crlf();
      if ($@) {
	 if ($interactive->state>1) {
	    if ($interactive->line_cnt>1) {
	       $@ =~ s{(input line \d+), <.*?> line \d+}{$1}g;
	    } else {
	       $@ =~ s{ at input line 1, <.*?> line \d+}{}g;
            }
	    err_print($@);
	 }
	 if ($interactive->line_cnt>0) {
	    push @{$interactive->remove_hist_lines}, [$interactive->first_hist_index, $interactive->term->Attribs->{history_length}-1];
	 }
	 $interactive->last_error_was_in_history=0;
      }
   } while ($interactive->state >= 0);
   sigaction SIGINT, $sa_INT_save;
}

sub DESTROY {
   my $self=shift;

   my $hi=$self->term->Attribs->{history_length}-1;
   if ($self->term->history_get($hi) =~ /^\s*exit\s*;\s*$/) {
      push @{$self->remove_hist_lines}, [$hi,$hi];
   }
   foreach (reverse @{$self->remove_hist_lines}) {
      for ($hi=$_->[1]; $hi>=$_->[0]; --$hi) {
	 $self->term->remove_history($hi);
      }
   }
   $self->term->StifleHistory($User::history_size);
   $self->term->WriteHistory($self->histfile);
   $self->SUPER::DESTROY;
}

sub get_line {
   my ($l, $self)=@_;
   if ($self->state==0) {
      $self->state=1;
      $_ .= $interactive_preamble;
   } elsif ($self->state==1) {
      $self->state=2;
      $self->first_hist_index=$self->term->Attribs->{history_length};
      $self->line_cnt=0;
      $_ .= "#line 1 \"input\"\n";
   } elsif ($self->state!=3 || defined ($l=line_continued())) {
      namespaces::temp_disable();
      unless ($User::application->declared & 4) {
	 if (my @credits=$User::application->help->get_topics("credits")) {
	    print "\nApplication ", $User::application->name, " uses following third-party software packages:\n",
	          join(", ", sort map { @{$_->toc} } @credits),
		  "\nFor more details: help 'credits';\n";
	 }
	 $User::application->declared |= 4;
      }
      my $prompt=$User::application->name." ";
      if (defined($self->within_history)) {
	 $prompt.="[".($self->within_history-$self->within_history_begin)."]";
      }
      if ($l>0) {
	 ++$l;
	 $self->line_cnt=$l;
      }
      if ($self->line_cnt>1) {
	 $prompt.="(".$self->line_cnt.")";
      }
      my $line;
      do {
	 $line=$self->readline("$prompt> ");
      } until ($line =~ /\S/);
      $self->state=3;
      if (defined($self->within_history)) {
	 $self->within_history=$self->term->where_history;
	 $self->term->replace_history_entry($self->within_history, $line);
	 if (++$self->within_history >= $self->first_hist_index) {
	    undef $self->within_history;
	    $self->term->Attribs->{startup_hook}=undef;
	 }
      } elsif ($self->line_cnt>1 && $line =~ /^\s*;\s*$/) {
	 my $hi=$self->term->Attribs->{history_length}-1;
	 $self->term->replace_history_entry($hi, $self->term->history_get($hi).";");
      } else {
	 $self->term->add_history($line);
      }
      $_ .= $line."\n";
   } else {
      $self->state=2;
      $self->line_cnt++;
   }
   return length;
}

# the hooks and callbacks here should not copy $self during closure cloning as it defers the destruction of the Shell object!

sub readline {
   my ($self, $prompt)=@_;
   if (keys %active==1) {
      $self->term->readline($prompt);
   } else {
      $self->term->CallbackHandlerInstall($prompt, sub { $interactive->input_line=shift; $interactive->term->callback_handler_remove; });
      undef $self->input_line;
      do {
	 try_read($self) or return;
	 $self->term->callback_read_char;
      } until (defined $self->input_line);
      $self->input_line;
   }
}

sub in_avail { (shift)->term->callback_read_char; }

sub enter_filename {
   my ($self, $text, $prompt)=(@_, "filename");
   local @{$self->term->Attribs}{qw( completion_entry_function
				     completer_word_break_characters
 				     startup_hook )}
         =( $self->term->Attribs->{filename_completion_function},
            $self->term->Attribs->{basic_word_break_characters},
            sub { $interactive->term->insert_text($text) } );
   local $self->term->{MinLength}=1;
   my $response=$self->readline("[$prompt] >");
   replace_special_paths($response);
   $response;
}

sub completion_entry {
   my ($word, $state)=@_;
   if (!$state) {
      undef $interactive->completion;
      $interactive->term->Attribs->{completion_append_character}="";
      $interactive->completion_words=[];
      $interactive->try_completion->($word);
      if (substr($interactive->term->Attribs->{line_buffer}, $interactive->term->Attribs->{point}, 1) eq $interactive->term->Attribs->{completion_append_character}) {
	 $interactive->term->Attribs->{completion_append_character}="";
      }
   }
   $interactive->completion ? $interactive->completion->(@_) : $interactive->completion_words->[$state];
}

sub postprocess_file_list {
   my ($self, $word, $quote, $prefix, $dir_cmd, $list)=@_;
   my $vor=length($prefix)-length($word);
   my $dir_seen;
   if ($dir_cmd) {
      unshift @$list, ".." if length($prefix)==0 || $prefix =~ /^\.\.?$/;
      $self->completion_words=[ map { substr($_,$vor) } grep { m|^~/| ? -d "$ENV{HOME}/$'" : -d $_ } @$list ];
      $self->term->Attribs->{completion_append_character}="/";
   } else {
      $self->completion_words=[ map { substr($_,$vor).( m|^~/| ? -d "$ENV{HOME}/$'" : -d $_ and $dir_seen="/") } @$list ];
      $self->term->Attribs->{completion_append_character}=$quote unless $dir_seen;
   }
   $self->term->Attribs->{filename_completion_desired}=0;
}

sub try_filename_completion {
   my ($self, $word, $quote, $prefix, $dir_cmd)=@_;
   if (length($prefix)>length($word)) {
      if (my @list=$self->term->completion_matches($prefix,$self->term->Attribs->{filename_completion_function})) {
	 shift @list if $#list;
	 postprocess_file_list(@_,\@list);
      }
   } else {
      $self->completion=$self->term->Attribs->{filename_completion_function};
   }
}

sub try_property_completion {
   my ($self, $word, $type, $prefix)=@_;
   my @path=split /\./, $prefix;
   $prefix= substr($prefix,-1,1) eq "." ? "" : pop @path;
   foreach (@path) {
      defined (my $prop=$type->lookup_property($_) || $type->lookup_auto_cast($_)) or return;
      instanceof ObjectType($type=$prop->type) or return;
   }
   sorted_uniq(sort( grep { /^$prefix/ } map { keys %{$_->properties} } map { ($_, keys %{$_->auto_casts}) } $type, @{$type->super} ));
}

sub try_type_completion {
   my ($self, $word, $prefix, $before, $is_object_type)=@_;
   my @list;
   my $char="";
   my $maybe_object_type= !( $prefix =~ s/\bprops::// ) && (!defined($is_object_type) || $is_object_type);
   my $maybe_prop_type= !( $prefix =~ s/\bobjects::// ) && !$is_object_type;
   my $has_app_prefix= $prefix =~ s/^($id_re):://;
   my $app= $has_app_prefix ? eval { User::application($1) } || return ($User::application, $char) : $User::application;
   if ($maybe_object_type) {
      push @list, grep { /^$prefix/ } map { $_->name } map { @{$_->object_types} }
	          ($app, $has_app_prefix ? () : values %{$app->used});
   }
   if ($maybe_prop_type) {
      push @list, map { /^(.*)::$/ } map { complete_variable_name_in_pkg(get_pkg($_->pkg."::props"), " ", $prefix) }
	          ($app, $has_app_prefix ? () : values %{$app->used});
   }
   @list=sorted_uniq(sort(@list));

   my $vor=length($word)-length($prefix);
   if ($vor>0) {
      substr($_,0,0)=substr($word,0,$vor) for @list;
   }

   if ($#list==0) {
      my $pkg=namespaces::lookup_class($app->pkg, $list[0]);
      if (do { no strict 'refs'; exists &{"$pkg\::_min_params"} }) {
	 $pkg->_min_params and $char="<";
      } else {
	 $char="(";
	 if (length($before)) {
	    my $cnt=1;
	    ++$cnt while $before =~ s/$type_re \s*,\s* $//xo;
	    if (my ($outer_type)= $before =~ /($qual_id_re) \s*<\s* $/xo) {
	       $app= $outer_type =~ s/^(?! props:: | objects::) ($id_re)::// ? (add Application($1)) : $User::application;
	       $pkg=namespaces::lookup_class($app->pkg, $outer_type);
	       if (do { no strict 'refs'; exists &{"$pkg\::_min_params"} }) {
		  $char= $pkg->_min_params <= $cnt ? ">" : ",";
	       }
	    }
	 }
      }
   } elsif (!$vor) {
      push @list, map { "$_\::" } grep { /^$prefix/ } known Application;
   }

   $self->completion_words=\@list;
   $self->term->Attribs->{completion_append_character}=$char;

   ($app, $char);
}

sub list_custom_completions {
   my ($type, $prefix)=@_; 
   ( $User::application->custom->list_completions($type,$prefix),
     map { $_->custom->list_completions($type,$prefix,1) } values %{$User::application->imported} )
}

# the term is NOT a method call, if preceded by:
my $op_re=qr{(?:[-+*/.,<=;({}]| (?<!-)> | ^ )\s* | \w\s+ }x;

my $args_start_re=qr{(?: \s+ | \s*\(\s* )}x;

# a variable or array element
my $var_re=qr{\$ $id_re (?:(?=\s*\[) $balanced_re )?}xo;

my (%popular_perl_keywords, %object_methods);
@popular_perl_keywords{qw( local print require chdir rename unlink mkdir rmdir declare exit )}=();
@object_methods{qw( name description give take add remove type provide lookup list_properties get_schedule
		    get_attachment remove_attachment list_attachments attach )}=();

sub all_completions : method {
   my ($self, $word)=@_;
   my $text=substr($self->term->Attribs->{line_buffer}, 0, $self->term->Attribs->{point});

   if (my ($simple_cmd,$dir_cmd,$par1,$par2,$File,$quote,$prefix)= $text =~
       m{(?: $statement_start_re (?: (include | require | do | rename | unlink | mkdir | load_commands) |
	                             (chdir | rmdir | found_extension | import_extension)) $args_start_re
	   | $op_re (?: load | load_data | glob ) ($args_start_re)
	   | $statement_start_re (?: save | save_data ) ($args_start_re) $expression_re ,\s*
	   | \b(File) \s*=>\s* )
	 (?:(['"]) ([^"']*)? )? $}xo) {
      # commands expecting a filename argument

      if (defined $quote) {
	 try_filename_completion($self,$word,$quote,$prefix,$dir_cmd);
      } else {
	 $self->completion_words=[ $simple_cmd || $dir_cmd || $par1 =~ /\(/ || $par2 =~ /\(/ || $File ? '"' : '(' ];
      }
      return;
   }

   if (my ($quote,$prefix)= $text =~
       m{$statement_start_re application $args_start_re (?:(['"]) ([^"']*)? )? $}xo) {
      # command expecting an application name

      if (defined $quote) {
	 $self->term->Attribs->{completion_append_character}=$quote;
	 $self->completion_words=[ sorted_uniq(sort( map { m{([^/]+)/$} } map { glob "$_/apps/$prefix*/" } $InstallTop, @User::lookup_applications )) ];
      } else {
	 $self->completion_words=[ '"' ];
      }
      return;
   }

   if (my ($par,$quote,$prefix)= $text =~
       m{$statement_start_re script ($args_start_re) (?:(['"]) ([^"']*)? )? $}xo) {
      # command expecting a script file

      if (defined $quote) {
         if ($prefix =~ m|^[./~]|) {
            try_filename_completion($self,$word,$quote,$prefix,0);
         } else {
            my @list=$self->term->completion_matches($prefix,$self->term->Attribs->{filename_completion_function});
            foreach my $dir ((map { @{$_->scriptpath} } $User::application, values %{$User::application->imported}),
                             @User::lookup_scripts, "$InstallTop/scripts") {
               if (my @sublist=$self->term->completion_matches("$dir/$prefix",$self->term->Attribs->{filename_completion_function})) {
                  shift @sublist if $#sublist;
                  my $tail=length($dir)+1;
                  push @list, map { substr($_,$tail) } @sublist;
               }
            }
            if (@list) {
               postprocess_file_list($self, $word, $quote, $prefix, 0, \@list);
            }
         }
      } else {
	 $self->completion_words=[ $par =~ /\(/ ? '"' : '(' ];
      }
      return;
   }

   if (my ($quote,$prefix)= $text =~
       m{$statement_start_re (?: prefer(?:_now)? | (?:re)?set_preference ) $args_start_re (?:(['"]) ($hier_id_re\.?)?)? $}xo) {
      # commands expecting a label

      if (defined $quote) {
	 $self->term->Attribs->{completion_append_character}=$quote;
	 $self->completion_words=[ sorted_uniq(sort( $User::application->prefs->list_completions($prefix) )) ];
      } else {
	 $self->completion_words=[ '"' ];
      }
      return;
   }

   if (my ($var,$mult_word,$mult_arg,$quote,$prefix)= $text =~
       m{($var_re)->(?: (give | lookup | (provide | get_schedule)) | take | add | remove )
	            \s*\(\s* (?(3) (?: (?: '$hier_id_alt_re'|"$hier_id_alt_re" )\s*,\s*)* )
	                     (?:(['"]) (?(2) (?: $hier_id_re \s*\|\s*)* ) ($hier_id_re\.?)?)? $}xo) {
      # methods expecting a property name

      if (defined $quote) {
	 my $type=do { package Polymake::User; eval "$var->type" };
	 if (defined($type) && instanceof ObjectType($type)) {
	    push @{$self->completion_words}, try_property_completion($self,$word,$type,$prefix);
	    $self->term->Attribs->{completion_append_character}=$quote;
	 }
      } else {
	 $self->completion_words=[ '"' ];
      }
      return;
   }

   if (my ($var,$quote,$prefix)= $text =~
       m{(?:\$($id_re))? ->(?: get_attachment | remove_attachment ) \s*\(\s* (?:(['"]) ($id_re)?)? $}xo) {
      # methods expecting an attachment name

      if (defined $quote) {
	 $var=do { no strict 'refs'; ${"Polymake::User::$var"} };
	 return unless is_object($var) && UNIVERSAL::isa($var,"Polymake::Core::Object");
	 $self->completion_words=[ sort( grep { /^$prefix/ } keys %{$var->attachments} ) ];
         $self->term->Attribs->{completion_append_character}=$quote;
      } else {
	 $self->completion_words=[ '"' ];
      }
      return;
   }

   if (my ($quote,$path,$prefix)= $text =~
       m{$statement_start_re help $args_start_re (?:(['"]) (.*/)? ([^/]*))? $}xo) {
      # help topic

      if (defined $quote) {
         if (defined $path) {
            $self->completion_words=[ sorted_uniq(sort( map { $_->list_toc_completions($prefix) } $User::application->help->get_topics($path) )) ];
         } else {
            $self->completion_words=[ sorted_uniq(sort( $User::application->help->list_completions($prefix) )) ];
         }
         if (@{$self->completion_words}==1 &&
             grep { @{$_->toc} } $User::application->help->get_topics($path.$self->completion_words->[0])) {
	    $quote="/";
	    $self->term->Attribs->{completion_suppress_quote}=1;
         }
	 if ((my $vor=length($prefix)-length($word))>0) {
	    substr($_,0,$vor)="" for @{$self->completion_words};
	 }
	 $self->term->Attribs->{completion_append_character}=$quote;
      } else {
	 $self->completion_words=[ "'" ];
      }
      return;
   }

   if (my ($cmd, $type, $prefix)= $text =~
       m{$statement_start_re (local | (?:re)?set_custom) $args_start_re (?: ([\$\@%]) ($qual_id_re(?: ::)?)? )? $}xo) {
      # commands expecting a qualified variable name

      if (defined $type) {
	 my @list=list_custom_completions($type,$prefix);
	 if ($cmd eq "local") {
	    if (!@list || $prefix !~ /::/) {
	       push @list, complete_user_variable_name($type,$prefix);
	    }
	 } else {
	    push @list, $Prefs->custom->list_completions($type,$prefix);
	 }
	 $self->completion_words=[ sort(@list) ];
	 if ($#{$self->completion_words}==0 && substr($self->completion_words->[0],-1) ne ":") {
	    $self->term->Attribs->{completion_append_character}= $cmd eq "reset_custom" ? ";" : "=";
	 }
      } else {
	 $self->completion_words=[ qw( $ @ % ) ];
      }
      return;
   }

   if (my ($type, $prefix)= $text =~
       m{([\$\@\%]) ($qual_id_re(?: ::)?)? $}xo) {
      # similar case: a variable reference

      my @list=list_custom_completions($type,$prefix);
      if (!@list || $prefix !~ /::/) {
	 push @list, complete_user_variable_name($type,$prefix);
      }
      $self->completion_words=[ sort(@list) ];
      return;
   }

   if (my ($var,$func,$intermed,$prefix)= $text =~
       m{(?: (?: ($var_re) | ($id_re) (?(?=\s*\() $balanced_re )? )
	     ((?: \s*->\s* (?: $id_re (?(?=\s*\() $balanced_re )? | (?(?=\s*\[) $balanced_re ) ))*) )?
	 \s*->\s* ($id_re)? $}xo) {
      # a method call, possible in a longer chain

      my ($type, $topic, @list);
      if (defined $var) {
	 package Polymake::User;
	 $type=eval "$var->type";
      } elsif (defined ($func &&= $User::application->help->find("functions", $func))) {
	 if (!defined ($type=retrieve_return_type($func)) &&
	     $func->parent->category &&
	     $func->parent->name =~ /^\s* (?: producing | transforming ) /xi) {
	    $type=$User::application->default_type;
	 }
      }

      if (defined $intermed) {
	 while (defined($type) &&
		$intermed =~ s/^ \s*->\s* (?: ($id_re) (?(?=\s*\() $balanced_re )? | (?(?=\s*\[) $balanced_re ))//xo) {
	    next unless defined($1);	# skip brackets with index expression as it can't change the expected type
	    if (instanceof ObjectType($type) and defined (my $prop=$type->lookup_property($1, 1))) {
	       $type=$prop->type;
	    } elsif (defined ($func= ref($type) ? ($topic=$type->help_topic and $topic->find("methods", $1))
                                                : $User::application->help->find("objects", $type)->find("methods", $1))) {
	       if (defined (my $ret_type=retrieve_return_type($func))) {
		  $type=$ret_type;
	       }
	       # otherwise let's just suppose the method returns the same object
	    } else {
	       undef $type; last;
	    }
	 }
      }

      if (defined $type) {
	 if (ref($type)) {
	    if (instanceof ObjectType($type)) {
	       push @list,
	            (grep { /^$prefix/ } keys %object_methods),
		    map { $_->list_completions("!rel", "properties", "methods", $prefix) }
		    grep { $_ } map { $_->help_topic }
		    ($type, @{$type->super}, keys %{$type->auto_casts});
	    } else {
	       do {
		  if (defined ($topic=$type->help_topic)) {
		     push @list, $topic->list_completions("!rel", "methods", $prefix);
		  }
		  $type=$type->super;
	       } while (defined $type);
	    }
	 } else {
	    no strict 'refs';
	    push @list, map {
	                   map { $_->list_completions("!rel", "methods", $prefix) } $User::application->help->find("objects", $_)
			} $type, @{"$type\::ISA"};
         }

	 $self->completion_words=[ sorted_uniq(sort(@list)) ];
	 if ($#{$self->completion_words}==0 && ref($type) &&
	     $self->completion_words->[0] !~ /^name|description|list_attachments$/ &&
	     exists $object_methods{$self->completion_words->[0]}) {
	    $self->term->Attribs->{completion_append_character}="(";
	 }
      }
      return;
   }

   if (my ($type,$prefix)= $text =~
       m{\bnew \s+ ($type_re) \s*\(\s* (?: $expression_re \s*,\s* )* ($id_re)? $}xo) {
      # a constructor call with property names?

      if (defined ($type=eval { $User::application->eval_type($type) }) &&
	  instanceof ObjectType($type)) {
	 my @list=map { grep { /^$prefix/ } keys %{$_->properties} } $type, @{$type->super};
	 $self->completion_words=[ map { "$_=>" } sorted_uniq(sort(@list)) ];
	 return;
      }
   }

   if (my ($cmd,$before,$prefix)= $text =~
       m{$op_re ( new | typeof | instanceof ) \s+ ((?: $qual_id_re \s*[<>,]\s* )*) ($qual_id_re (?: ::)?)? $}xo) {
      # a type expression

      if ($before =~ /[<>]/ && $before !~ /,\s*$/ && $before =~ /^ $balanced_re $/xo) {
	 if (length($prefix)==0 && $cmd ne "typeof") {
	    $self->completion_words=[ "(" ];
	 }
	 return;
      }

      if (try_type_completion($self,$word,$prefix,$before) eq ">" && $cmd ne "typeof") {
	 $self->completion_words->[0].=">";
	 $self->term->Attribs->{completion_append_character}="(";
      }
      return;
   }

   if (my ($cmd,$before,$prefix)= $text =~
       m{$op_re ($qual_id_re) \s*<\s* ((?: $qual_id_re \s*[<>,]\s* )*) ($qual_id_re (?: ::)?)? $}xo) {
      # a function with explicit template arguments

      if ($before =~ /[^\s,]\s*$/ && $before =~ /^ $balanced_re \s*>\s* $/xo) {
	 if (length($prefix)==0) {
	    $self->completion_words=[ "(" ];
	 }
	 return;
      }
      # FIXME: don't list the functions expecting ObjectType literally (how to detect ???)
      my $only_objects= $cmd eq "cast" && $before !~ /\S/ || undef;
      my ($app,$char)=try_type_completion($self,$word,$prefix,$before,$only_objects);
      if ($char eq ">" || $char eq "(") {
	 # type complete: check for the number of parameters
	 my $h=$app->help->find("functions", $cmd);
	 my $cnt=defined($h) && $h->expects_template_params;
	 $self->completion_words->[0].=">" if $char eq ">";
	 my $given=$before.$self->completion_words->[0];
	 --$cnt while $cnt>0 && $given =~ /\G $type_re \s* (?: ,\s* | $)/gox;
	 if ($cnt>0) {
	    $self->term->Attribs->{completion_append_character}=",";
	 } else {
	    $self->completion_words->[0].=">";
	    $self->term->Attribs->{completion_append_character}="(";
	 }
      }
      return;
   }

   if (my ($quote,$prefix)= $text =~
       m{(?: \$Visual::Color::$id_re \s*=\s* | Color \s*=>\s* ) (?:(['"])(?!\d)([^"']*))? $}xo) {
      # symbolic color name

      if (defined $quote) {
	 $self->completion_words=[ sort( Visual::list_color_completions($prefix) ) ];
	 if ((my $vor=length($prefix)-length($word))>0) {
	    substr($_,0,$vor)="" for @{$self->completion_words};
	 }
	 $self->term->Attribs->{completion_append_character}=$quote;
      } else {
	 $self->completion_words=[ '"' ];
      }
      return;
   }

   if (my ($func,$prefix)= $text =~
       m{($id_re) \s*\(\s* (?: $expression_re \s*,\s* )* ($id_re)? $}xo) {
      # keyword argument of a function or method

      my @list;
      foreach my $topic ($User::application->help->find("functions", $func), 
			 map { $_->find("methods", $func) } $User::application->help->find("objects", ".*")) {
	 if (defined($topic) && defined (my $sig=$topic->topics->{signature})) {
	    while ($sig->text =~ /%($qual_id_re)/go) {
	       my $hash=$1;
	       if ($hash !~ /::/) {
		  my $obj=$topic->parent;
		  $obj=$obj->parent if $obj->category;
		  $obj=$obj->parent;
		  if (my $obj_pkg=namespaces::lookup_class($User::application->pkg,$obj->name)) {
		     $hash="$obj_pkg\::$hash";
		  }
	       }
	       no strict 'refs';
	       push @list, grep { /^$prefix/ } keys %$hash;
	    }
	    while ($sig->text =~ /(?=\{)($balanced_re)/go) {
               my $hash=$1;
               push @list, grep { /^$prefix/ } $hash =~ /($id_re)\s*=>/go;
            }
	 }
      }

      if (@list) {
         $self->completion_words=[ map { "$_=>" } sorted_uniq(sort(@list)) ];
         return;
      }
   }

   if (my (undef,$app,$prefix)= $text =~
       m{((?: -> | ['"]) \s*)? (?:($id_re)::)? ($id_re) $}xo
       and !defined($1)) {
      # a user function or "popular" perl function

      my @list;
      if (defined $app) {
	 push @list, map { "$app\::$_" } User::application($app)->help->list_completions("!rel", "functions", $prefix);
      } else {
	 push @list, $User::application->help->list_completions("functions", $prefix);
	 if ($text =~ m{$statement_start_re $prefix $}xo) {
	    push @list, grep { /^$prefix/ } keys %popular_perl_keywords;
         }
      }
      $self->completion_words=[ sorted_uniq(sort(@list)) ];

      if ($#{$self->completion_words}==0) {
	 my $cmd=$self->completion_words->[0];
	 my $h= (defined($app) ? User::application($app) : $User::application)->help->find("functions", $cmd);

	 $self->term->Attribs->{completion_append_character}=
	    $cmd =~ /^(?:exit|history|replay_history)$/
	    ? ";" :
	    defined($h) && $h->expects_template_params
	    ? "<" :
	    exists $popular_perl_keywords{$cmd} ||
	    $cmd =~ /^(?:application|help|apropos|include|prefer(?:_now)?|(?:re)?set_(?:custom|preference)|(?:found|import)_extension|found_application)$/
	    ? " " : "(";
      }
      return;
   }

   if (my ($quote,$prefix)= $text =~
       m{(['"]) ([^"']*) $}xo) {
      # if nothing else worked out, assume a file name
      try_filename_completion($self,$word,$quote,$prefix,0);
   }
}

sub complete_variable_name_in_pkg {
   my ($pkg, $type, $prefix)=@_;
   my @answer;
   while (my ($name, $glob)=each %$pkg) {
      if (length($prefix) ? index($name,$prefix)==0 : $name !~ /^\./) {
	 if (defined_scalar($glob) && $type eq '$' or
	     defined(*{$glob}{ARRAY}) && ($type eq '@' || $type eq '$') or
	     defined(*{$glob}{HASH}) && ($type eq '%' || $type eq '$' || $name =~ /::$/)) {
	    push @answer, $name;
	 }
      }
   }
   @answer;
}

sub complete_user_variable_name {
   my ($type, $prefix)=@_;
   if ((my $pkg_end=rindex($prefix,"::"))>0) {
      my $pkg_part=substr($prefix,0,$pkg_end);
      my $pkg=get_pkg("Polymake::User::$pkg_part") or return ();
      map { "$pkg_part\::$_" } complete_variable_name_in_pkg($pkg,$type,substr($prefix,$pkg_end+2));
   } else {
      complete_variable_name_in_pkg(\%Polymake::User::,@_);
   }
}

sub retrieve_return_type {
   my $name=(shift)->return_type;
   if (defined($name) and $name !~ /::/) {
      eval { $User::application->eval_type($name) }
   } else {
      $name
   }
}

sub context_help {
   print "\n";
   my $line=$interactive->term->Attribs->{line_buffer};
   if ($line =~ /\S/) {
      my $pt=$self->term->Attribs->{point};
   } else {
      User::help();
   }

   STDOUT->flush;
   $interactive->term->on_new_line;
   $interactive->term->redisplay;
}

###############################################################################################
sub consume_unknown_property {
   my ($prop_name, $value, $object)=@_;
   (my $show_value=$value) =~ s/\A((?:^.*\n){3})^(?s:.+)\Z/$1...\n/m;

   local_sub($interactive->try_completion,
	     sub : method {
		my ($self, $word)=@_;
		my $text=substr($self->term->Attribs->{line_buffer}, 0, $self->term->Attribs->{point});
		if (my ($before, $prefix)= $text =~ m{^\s* ((?: $qual_id_re \s*[<>,]\s* )*) ($qual_id_re (?: ::)?)? $}xo) {
		   try_type_completion(@_,$prefix,$before);
		}
		if (my ($obj_type, $prefix)= $text =~ m{^\s* (?: ($type_qual_re) ::)? ($hier_id_re\.?)? $}xo) {
		   if (defined($obj_type)) {
		      if (defined (my $proto=eval { $User::application->eval_type($obj_type) })) {
			 push @{$self->completion_words}, map { "$obj_type\::$_" } try_property_completion(@_, $proto, $prefix);
		      }
		   } else {
		      push @{$self->completion_words}, try_property_completion(@_, $object->type, $prefix);
		   }
		}
	     });
   local $interactive->term->{MinLength}=1;
   my $obj_type=$object->type->full_name;
   print <<".";
Encountered an unknown section '$prop_name':
$show_value

If you want to treat it as a property with a different name, please specify
the new property name, using the dot notation for a property in a subobject.
If the property belongs to a derived object type and you want to cast the
current object ($obj_type) to this derived type, please specify
the new type and property name as a qualified pair: ObjectType::PROPERTY

If you want to keep the data as an attachment,
please specify a valid property type.

To discard the data completely, just leave the input field empty.
.

   for (;;) {
      my $choice=$interactive->readline(" > ");
      $choice =~ s/^\s+//;
      $choice =~ s/\s+$//;
      length($choice) or last;
      if (my ($obj_type, $prop_name) = $choice =~ m{^ (?: ($type_qual_re) ::)? ($hier_id_re) $}xo) {
	 my $proto;
	 if (defined $obj_type  and
	     defined ($proto=eval { $User::application->eval_type($obj_type) })  and
	     instanceof ObjectType($proto)) {
	    # don't check auto-cast rules here, let's allow the user to do whatever she wants
	    if ($proto->isa($object->type)) {
	       bless $object, $proto->pkg;
	    } else {
	       print "Cast not allowed: ", $proto->full_name, " is not derived from ", $object->type->full_name,
	             "\nPlease choose another object type and/or property or discard the section giving empty input:\n";
	       next;
	    }
	 }
	 if ($prop_name =~ /\./ || $object->type->lookup_property($prop_name)) {
	    eval { $object->take($prop_name, $value) };
	    if ($@) {
	       print "Conversion to a property $prop_name failed: $@\nPlease choose another property or discard the section giving empty input:\n";
	       next;
	    } else {
	       last;
	    }
	 }
      }

      my $x=eval { PropertyType::new_object($User::application->eval_type($choice), $value) };
      if ($@) {
	 print "Conversion to an attachment of type $choice failed: $@\nPlease choose another type or discard the section giving empty input:\n";
      } elsif (instanceof Object($x)) {
	 print "An attachment can only have a property (atomic) data type, not a full object like ", $x->type->name, "\n";
      } else {
	 $object->attach($prop_name, $x);
	 last;
      }
   }
}

sub locate_unknown_extension {
   my ($URI)=@_;
   print <<".";
In order to proceed, you should import a polymake extension with identifier $URI .
Please download and unpack it somewhere, or check it out if it is kept in some
repository, then enter the top directory (one above "apps/") here.

If you don't know where to get this extension or don't want to import it now,
please enter an empty line.
.
   while (1) {
      my $dir=$interactive->enter_filename("","extension dir");
      return "" unless length($dir);
      if (-d $dir && -x _) {
	 my $his_URI;
	 if (-d "$dir/apps" && -f "$dir/URI") {
	    open my $U, "$dir/URI";
	    $his_URI=<$U>; chomp $his_URI;
	    return Cwd::abs_path($dir) if $his_URI eq $URI;
	 }
	 print <<".";
Sorry, the extension installed at $dir has a different id: $his_URI .
Please specify the correct location or quit by entering an empty line.
.
      } else {
	 print <<".";
The directory $dir does not exist or is unaccessible.
Please specify the correct location or quit by entering an empty line.
.
      }
   }
}

###############################################################################################
sub Polymake::User::history {
   my $tempfile=new Tempfile();
   my $scriptfile="$tempfile.pl";
   open my $hf, ">$scriptfile" or die "can't create temporary file $scriptfile: $!\n";
   print $hf <<'.';
#############################################################################
#  Please put the command(s) you want to be executed at the very beginning  #
#  of this file;  everything below this line will be ignored.               #
#############################################################################
__END__
.
   my $last=$interactive->term->Attribs->{history_length}-1;
   if ($interactive->term->history_get($last) =~ /^\s*history\s*;\s*/) {
      $interactive->term->remove_history($last);
   }
   my ($err, $last_err)=(0, $#{$interactive->remove_hist_lines}-$interactive->last_error_was_in_history);
   for (my $i=0; $i<$last; ++$i) {
      if ($err>$last_err || $i<$interactive->remove_hist_lines->[$err]->[0]) {
	 print $hf $interactive->term->history_get($i), "\n";
      } else {
	 $i=$interactive->remove_hist_lines->[$err++]->[1];
      }
   }
   close $hf;
   my $created_at=(stat $scriptfile)[9];
   my $ed_cmd=$User::history_editor;
   $ed_cmd =~ s/%f/$scriptfile/g or $ed_cmd.=" $scriptfile";
   system($ed_cmd);
   if (-f $scriptfile && (stat _)[9]>$created_at) {
      my $with_error;
      { package Polymake::User; do "history:$scriptfile"; }
      if ($@) {
         $@ =~ s{(history line \d+), <.*?> line \d+}{$1}g;
	 STDOUT->flush();
	 $interactive->term->crlf();
	 err_print($@);
	 $with_error=1;
      }
      open $hf, $scriptfile;
      while (<$hf>) {
	 chomp;
	 last if $_ eq "__END__";
	 next if /^\s*(?:\#|$)/;
	 $interactive->term->add_history($_);
      }
      close $hf;
      if ($with_error) {
         push @{$interactive->remove_hist_lines}, [$interactive->first_hist_index, $interactive->term->Attribs->{history_length}-1];
         $interactive->last_error_was_in_history=1;
      }
   } else {
      warn_print("no new commands found");
   }
}
###############################################################################################
my $replay_mode_startup=sub {
   $interactive->term->history_set_pos($interactive->within_history);
   $interactive->term->insert_text($interactive->term->current_history);
};

sub fill_history {
   my ($self, $temporary)=splice @_, 0, 2;
   if (@_) {
      $self->within_history=$self->term->Attribs->{history_length};
      $self->within_history_begin=$self->within_history-1;
      foreach (@_) {
	 chomp;
	 $self->term->add_history($_);
      }
      $self->term->Attribs->{startup_hook}=$replay_mode_startup;
      if ($temporary) {
	 push @{$self->remove_hist_lines}, [$self->first_hist_index, $self->term->Attribs->{history_length}-1];
      }
      1
   } else {
      undef
   }
}

sub Polymake::User::load_commands {
   my $file=shift;
   replace_special_paths($file);
   open my $in, $file or die "can't read from $file: $!\n";
   fill_history($interactive, 0, grep { ! /$nonsignificant_line_re/o } <$in>)
      or warn_print( "no commands found" );
}
###############################################################################################
sub Polymake::User::replay_history {
   my $last=$interactive->term->Attribs->{history_length}-1;
   if ($interactive->term->history_get($last) =~ /^\s*replay_history\s*;\s*/) {
      $interactive->term->remove_history($last--);
   }
   $interactive->within_history=$last;
   $interactive->within_history_begin=0;
   $interactive->term->Attribs->{startup_hook}=$replay_mode_startup;
}

###############################################################################################
my $help_delim="-------------------\n";

sub Polymake::User::help {
   my ($subject)=@_;
   if (my @topics=$User::application->help->get_topics($subject || "top")) {
      if ($subject eq "credits") {
	 print "Application ", $User::application->name, " uses following third-party software packages:\n";
	 foreach my $topic (@topics) {
	    foreach (@{$topic->toc}) {
	       print "\n$_\n", $topic->topics->{$_}->display_text;
	    }
	 }

      } else {
	 my (@subcats, @subtopics, $need_delim);
	 foreach my $topic (@topics) {
	    my $text=$topic->display_text;
	    if (length($text)) {
	       print $help_delim if $need_delim++;
	       print $text, "\n";
	    }
	    foreach (@{$topic->toc}) {
	       if ($topic->topics->{$_}->category & 1) {
		  push @subcats, $_;
	       } else {
		  push @subtopics, $_;
	       }
	    }
	 }
	 if (@subcats || @subtopics) {
	    print $help_delim if $need_delim;
	 }
	 my $fp=substr($topics[0]->full_path,1);
	 $fp &&= " of $fp";
	 if (@subcats) {
	    print "Categories$fp:\n", (join ", ", sort @subcats), "\n";
	 }
	 if (@subtopics) {
	    print "Subtopics$fp:\n", (join ", ", sort @subtopics), "\n";
	 }
      }
   } elsif (length($subject) && index($subject,"/")<0
	    and
	    @topics=$User::application->help->find($subject)) {

      if (@topics==1) {
	 print substr($topics[0]->full_path,1), ":\n", $topics[0]->display_text;
      } else {
	 print "There are ", scalar(@topics), " help topics matching '$subject':\n";
	 my $n=0;
	 if (@topics<5) {
	    foreach (@topics) {
	       print $help_delim, ++$n, ": ", substr($_->full_path,1), ":\n",
	             $_->display_text, "\n";
	    }
	 } else {
	    fill_history($interactive, 1,
	       map {
		  $subject=substr($_->full_path,1);
		  print ++$n, ": $subject\n";
		  "help '$subject';"
	       } @topics);
	    print $help_delim, "Please choose those interesting you via history navigation (ArrowUp/ArrowDown):\n";
	 }
      }
   } elsif ($subject eq "credits") {
      print "Application ", $User::application->name, " does not use any third-party software directly\n";
   } else {
      err_print( "unknown help topic '$subject'" );
   }
}
###############################################################################################
sub Polymake::User::apropos {
   my $expr=shift;
   $expr=qr/$expr/i;
   if (my @list=map { $_->help->list_matching_leaves(sub { length($_[0]->text) && $_[0]->name =~ $expr }) } $User::application, values %{$User::application->imported}) {
      print map { $_->full_path."\n" } @list;
   } else {
      print "No matching help items found\n";
   }
}
###############################################################################################
#  only obsolete stuff below

=pod

# the line is considered as to be continued if it ends with:
# - an opening bracket whatever kind: { ( [
# - a binary operator: + - * / . cmp eq ...
# - a colon or a semicolon
sub is_continued {
   $_[0] =~ m'(?: [{([.,;*/<>=] | (?<!\+)\+ | (?<!-)- | \b (?: cmp | le | lt | ge | gt | eq | ne | x)) \s*$ 'x;
}

sub run_pipe {
   my $pipe=new Pipe(shift);
   my ($cmd, $line, $apps_loaded);
   while (length($cmd=<$pipe>)) {
      while (is_continued($cmd) && length($line=<$pipe>)) {
	 $cmd.=$line;
      }
      if (!$apps_loaded) {
	 if ($cmd !~ /^\s* application (?:\s+|\()['"]\w+/xs) {
	    load_apps;
	 }
	 $apps_loaded=1;
      }
      eval_expr($cmd);
      err_print($@) if $@;
   }
   $@='';
}

###############################################################################################
#
#  Console for error and diagnostic messages
#

package Polymake::PendingConsole;
sub new {
   bless [], shift;
}
use overload '*{}' => sub { User::start_console(); $console }, bool => sub { 1 };

package Polymake::Console;
use Polymake::Struct (
   [ '@ISA' => 'Pipe::WithRedirection' ],
);

sub new {
   my $self=&Pipe::WithRedirection::new;
   Background::Watcher::add_process($self->pid);
   $self->handle;
}

my $console_scope;

sub in_avail {
   my $self=shift;
   my $read=$self->SUPER::in_avail;
   if ($read>0) {
      print STDERR "CONSOLE RESPONSE: <", $self->rbuffer, ">\n";
      $self->rbuffer="";
   } else {
      $self->CLOSE;
      undef $console_scope;
   }
}

package Polymake::User;

sub start_console {
   defined($console_scope) and die "Console already running\n";
   my ($jar_path)=glob("$InstallTop/ja*/console.jar")
      or die "Could not locate console.jar\n";
   $console_scope=new Scope();
   $console_scope->begin_locals;
   local $console=new Console("java", "-cp", $jar_path, "de.tuberlin.polymake.console.Console", "-i",
			      "$InstallTop/java/src/de/tuberlin/polymake/console/console.conf");
   local $err_prefix="polymake_ERROR:";
   local $warn_prefix="polymake_WARN:";
   $console_scope->end_locals;
}

=cut

1

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