#  Copyright (c) 1997-2011
#  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 10030 2011-01-29 12:54:44Z gawrilow $

use strict;
use namespaces;
use re 'eval';

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

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' => '"$PrivateDir/history"' ],
   '@remove_hist_lines',        # [ start..end ], ...
);

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

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

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

sub interactive { 1 }

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

sub interactive_INC {
   if ($_[1] eq "input:") { 
      (\&get_line, $Shell)
   } 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;

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

   print "\rPress F1 or enter 'help;' for basic instructions.\n";
   STDOUT->flush();
   do {
      $Shell->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();
      $Shell->term->crlf();
      if ($@) {
         if ($Shell->state>1) {
            if ($Shell->line_cnt>1) {
               $@ =~ s{(input line \d+), <.*?> line \d+}{$1}g;
            } else {
               $@ =~ s{ at input line 1, <.*?> line \d+}{}g;
            }
            err_print($@);
         }
         if ($Shell->line_cnt>0) {
            push @{$Shell->remove_hist_lines}, [$Shell->first_hist_index, $Shell->term->Attribs->{history_length}-1];
         }
         $Shell->last_error_was_in_history=0;
      }
   } while ($Shell->state >= 0);
   sigaction SIGINT, $sa_INT_save;
}

sub save_history {
   my ($self, $filename)=@_;
   my $hi=$self->term->Attribs->{history_length}-1;
   if (!defined($filename) && $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->remove_hist_lines}=-1;
   unless (defined $filename) {
      $self->term->StifleHistory($User::history_size);
      $filename=$self->histfile;
   }
   $self->term->WriteHistory($filename);
}

sub DESTROY {
   my $self=shift;
   save_history($self);
   $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) {
         User::show_credits(1);
         if ($User::application->declared & 8) {
            print <<'.';

Warning: some rulefiles could not be configured automatically
due to lacking third-party software and/or other issues.
To see the complete list: show_unconfigured;
.
         }
         $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 { $Shell->input_line=shift; $Shell->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;
   }
}

*read_input=\&readline;

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

sub completion_entry {
   my ($word, $state)=@_;
   if (!$state) {
      undef $Shell->completion;
      $Shell->term->Attribs->{completion_append_character}="";
      $Shell->term->Attribs->{filename_quoting_desired}=0;
      $Shell->completion_words=[];
      $Shell->try_completion->($word);
      if (substr($Shell->term->Attribs->{line_buffer}, $Shell->term->Attribs->{point}, 1) eq $Shell->term->Attribs->{completion_append_character}) {
         $Shell->term->Attribs->{completion_append_character}="";
      }
   }
   $Shell->completion ? $Shell->completion->(@_) : $Shell->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 matching_rulefiles {
   my ($app, $cmd, $prefix)=@_;
   if ($cmd eq "include") {
      map { $_ =~ $filename_re } map { glob("$_/$prefix*") } @{$app->rulepath}
   } elsif ($cmd eq "reconfigure") {
      grep { /^\Q$prefix\E/ } keys %{$app->configured}
   } elsif ($cmd eq "unconfigure") {
      grep { $app->configured->{$_} } grep { /^\Q$prefix\E/ } keys %{$app->configured}
   }
}

sub try_property_completion {
   my ($type, $prefix, $allow_auto_cast)=@_;
   my @path=split /\./, $prefix;
   $prefix= substr($prefix,-1,1) eq "." ? "" : pop @path;
   foreach (@path) {
      my $prop=$type->lookup_property($_) || ($allow_auto_cast && $type->lookup_auto_cast($_)) or return;
      instanceof ObjectType($type=$prop->type) or return;
   }
   sorted_uniq(sort( grep { /^$prefix/ } map { keys %{$_->properties} }
                     map { ($_, $allow_auto_cast ? 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 try_label_completion {
   my ($expr)=@_;
   sorted_uniq(sort( grep { !/\bnonexistent\b/ }
                     map { $_->list_completions($expr) } $User::application->prefs, @{$User::application->prefs->imported} ))
}

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

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

# start of a method call chain: a variable or a function call
# captured groups: var, app, func
my $var_or_func_re=qr{ ($var_re) | (?:($id_re)::)?($id_re) (?(?=\s*\() $confined_re)? }xo;

# intermediate expression in a method call chain
my $intermed_re=qr{ \s*->\s* (?: $id_re (?(?=\s*\() $confined_re)? | (?(?=\s*\[) $confined_re ) ) }xo;

# the same, with captured method name
my $intermed_method_re=qr{ \s*->\s* (?: ($id_re) (?(?=\s*\() $confined_re)? | (?(?=\s*\[) $confined_re ) ) }xo;

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

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 dont_save )}=();

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

   if (my ($simple_cmd, $dir_cmd, $par1, $par2, $File, $quote, $prefix)= $line =~
       m{(?: $statement_start_re (?: (require | do | rename | unlink | mkdir | load_commands | save_history | export_configured) |
                                     (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* )
         (?:(['"]) ([^"']*)? )? \G}xogc) {
      # 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)= $line =~
       m{ $statement_start_re application $args_start_re (?:(['"]) ([^"']*)? )? \G}xogc) {
      # 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 ($cmd, $quote, $expr)= $line =~
       m{ $statement_start_re ( prefer(?:_now)? | (?:re)?set_preference ) $args_start_re
          (?:(['"]) (\*\.(?: $hier_id_re (?: \s+ (?: $ids_re (?:\s*,)? )? | \.? )? )? | $hier_id_re\.?)? )? \G}xogc) {
      # commands expecting a label

      if (defined $quote) {
         $self->completion_words=[ try_label_completion($expr) ];
         $self->term->Attribs->{completion_append_character}=
            $cmd ne "reset_preference" && $expr =~ /^\*\.$hier_id_re\s*$/o
            ? " " : $quote;
      } else {
         $self->completion_words=[ '"' ];
      }
      return;
   }

   if (my ($quote, $prefix)= $line =~
       m{ $statement_start_re forget_extension $args_start_re (?: (['"]) (.*) )? \G}xogc) {
      # command expecting a directory or URI

      if (defined $quote) {
         if ($prefix =~ m{^/}) {
            my @list=grep { /^\Q$prefix\E/ } keys %Extension::by_dir;
            my $vor=length($prefix)-length($word);
            $self->completion_words=[ map { substr($_,$vor) } sort @list ];
         } elsif ($prefix ne "") {
            $self->completion_words=[ sort( grep { /^\Q$prefix\E/ } keys %Extension::by_URI ) ];
         } else {
            $self->completion_words=[ sort( grep { ! m{^file://} } keys %Extension::by_URI ), sort( keys %Extension::by_dir ) ];
         }
         $self->term->Attribs->{completion_append_character}=$quote;
      } else {
         $self->completion_words=[ '"' ];
      }
      return;
   }

   if (my ($cmd, $quote, $app_name, $prefix)= $line =~
       m{ $statement_start_re (reconfigure|unconfigure|include) $args_start_re (?: (['"]) (?: ($id_re) ::)? (.*) )? \G}xogc) {
      # command expecting a rulefile

      if (defined $quote) {
         my @list;
         if (defined $app_name) {
            if (defined (my $app=lookup Application($app_name))) {
               @list=map { "$app_name\::$_" } matching_rulefiles($app, $cmd, $prefix);
            }
         } else {
            @list=matching_rulefiles($User::application, $cmd, $prefix);
            while (my ($app_name, $app)=each %{$User::application->used}) {
               if ($app_name =~ /^\Q$prefix\E/ and
                   $cmd eq "include" ? glob($app->rulepath->[0]."/*") : keys %{$app->configured}) {
                  push @list, "$app_name\::";
               }
            }
         }

         my $vor=length($prefix)-length($word);
         $vor += length($app_name)+2 if defined($app_name);
         $self->completion_words=[ map { substr($_,$vor) } sort @list ];
         if ($#{$self->completion_words}==0 && $self->completion_words->[0] !~ /::$/) {
            $self->term->Attribs->{completion_append_character}=$quote;
         }
      } else {
         $self->completion_words=[ '"' ];
      }
      return;
   }

   if (my ($par, $quote, $prefix)= $line =~
       m{ $op_re script ($args_start_re) (?:(['"]) ([^"']*)? )? \G}xogc) {
      # 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 ($var, $mult_word, $mult_arg, $quote, $prefix)= $line =~
       m{ ($var_re) \s*->\s* (?: (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\.?)?)? \G}xogc) {
      # 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($type, $prefix, 1);
            $self->term->Attribs->{completion_append_character}=$quote;
         }
      } else {
         $self->completion_words=[ '"' ];
      }
      return;
   }

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

      if (defined $quote) {
         $var=do { package Polymake::User; eval "$var" };
         if (is_object($var) && instanceof Core::Object($var)) {
            $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)= $line =~
       m{ $statement_start_re help $args_start_re (?:(['"]) (.*/)? ([^/]*))? \G}xogc) {
      # 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="/";
         }
         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, $varname, undef, $keyquote, $key)= $line =~
       m{ (?: $statement_start_re (local | (?:re)?set_custom) $args_start_re)?
          ([\$\@%]) (?: ($qual_id_re(::)?) (?(?{ $2 eq '$' && !$4 }) \s*\{\s* (['"])?([\w-]*) )?)? \G}xogc) {
      # a qualified variable name

      if (defined $key) {
         # completing a hash key
         my $i=0;
         my @list=grep { defined } map { $_->custom->find("%$varname", ++$i >= 3) }
                  $User::application, $Prefs, values %{$User::application->imported};
         if (@list) {
            $self->completion_words=[ sorted_uniq(sort( grep { index($_,$key)==0 } map { keys %{$_->default_value} } @list)) ];
         } elsif (defined (my $user_hash=find_user_variable('%',$varname))) {
            $self->completion_words=[ sort( grep { index($_,$key)==0 } keys %$user_hash ) ];
         }

         if ($#{$self->completion_words}==0) {
            $self->term->Attribs->{completion_append_character}=$keyquote || '}';
         }

      } else {
         # completing variable name
         my $i=0;
         my @list=map { $_->custom->list_completions($type, $varname, ++$i >= 3) }
                  $User::application, $Prefs, values %{$User::application->imported};
         if ($cmd eq "" || $cmd eq "local" and
             !@list || $varname !~ /::/) {
            push @list, complete_user_variable_name($type,$varname);
         }
         $self->completion_words=[ sort(@list) ];
         if ($cmd && $#{$self->completion_words}==0 && substr($self->completion_words->[0],-1) ne ":") {
            $self->term->Attribs->{completion_append_character}= $cmd eq "reset_custom" ? ";" : "=";
            if ($type eq '$') {
               foreach $type (qw(% @)) {
                  $i=0;
                  if (grep { defined } map { $_->custom->find($type.$self->completion_words->[0], ++$i >= 3) }
                      $User::application, $Prefs, values %{$User::application->imported}) {
                     $self->term->Attribs->{completion_append_character}= $type eq '%' ? "{" : "[";
                     last;
                  }
               }
            }
         }
      }
      return;
   }

   if (my ($var, $app, $func, $intermed, $method_name, $paren, $preceding_args, $prefix)= $line =~
       m{ $op_re $var_or_func_re ((?:$intermed_re)*) \s*->\s*
          (?: ($id_re) (?: (\s*\() ((?:$expression_re ,\s*)*) ($id_re)? )? )? \G}xogc) {

      # a method call, possible in a longer chain
      if (defined (my $type=retrieve_method_owner_type($var, $app, $func, $intermed))) {

         if (defined $paren) {
            # completing the keyword argument
            my $n_preceding_args=0;
            ++$n_preceding_args while $preceding_args =~ /\G $expression_re ,\s* /xog;
            my @list=map { $_->keyword_completions($n_preceding_args, $type, $prefix) }
                     retrieve_method_topics($type, $method_name, "find");
            $self->completion_words=[ map { "$_=>" } sorted_uniq(sort(@list)) ];

         } else {
            # completing the method name
            my @list=retrieve_method_topics($type, $method_name, "list_completions");
            if (ref($type) && instanceof ObjectType($type)) {
               push @list, grep { /^$method_name/ } keys %object_methods;
            }

            $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, $prop_name, $quote, $chain)= $line =~
       m{ \bnew \s+ ($type_re) \s*\(\s* (?: $expression_re ,\s* )* (?: ($id_re) | (['"]) ($hier_id_re \.?)? )? \G}xogc) {
      # a constructor call with property names?

      if (defined ($type=eval { $User::application->eval_type($type) }) &&
          instanceof ObjectType($type)) {
         $self->completion_words=[ try_property_completion($type, $prop_name || $chain) ];
         if (defined $prop_name) {
            $_ .= "=>" for @{$self->completion_words};
         } else {
            $self->term->Attribs->{completion_append_character}=$quote;
         }
         return;
      }
   }

   if (my ($cmd, $before, $prefix)= $line =~
       m{ $op_re ( new | typeof | instanceof ) \s+ ((?: $qual_id_re \s*[<>,]\s* )*) ($qual_id_re (?: ::)?)? \G}xogc) {
      # 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" &&
          $line !~ m{\G \s*>}xgc) {
         $self->completion_words->[0].=">";
         $self->term->Attribs->{completion_append_character}="(";
      }
      return;
   }

   if (my ($cmd, $before, $prefix)= $line =~
       m{ $op_re ($qual_id_re) \s*<\s* ((?: $qual_id_re \s*[<>,]\s* )*) ($qual_id_re (?: ::)?)? \G}xogc) {
      # 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}=",";
         } elsif ($line !~ m{\G \s*>}xgc) {
            $self->completion_words->[0].=">";
            $self->term->Attribs->{completion_append_character}="(";
         }
      }
      return;
   }

   if (my ($quote, $prefix)= $line =~
       m{(?: \$Visual::Color::$id_re \s*=\s* | Color \s*=>\s* ) (?:(['"])(?!\d)([^"']*))? \G}xogc) {
      # 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 ($app, $func, $paren, $preceding_args, $prefix)= $line =~
       m{ $op_re (?:($id_re)::)?($id_re) (?:(?=\s*<) $confined_re)? (?: (\s*\() ((?:$expression_re ,\s*)*) ($id_re)? )? \G}xogc) {
      # a user function or "popular" perl function

      my @list;
      if (defined $paren) {
         # completing the keyword argument
         my $n_preceding_args=0;
         ++$n_preceding_args while $preceding_args =~ /\G $expression_re ,\s* /xog;
         if (defined $app) {
            $app=User::application($app);
            @list=map { $_->keyword_completions($n_preceding_args, $app, $prefix) }
                  $app->help->find("!rel", "functions", $func);
         } else {
            @list=map { $_->keyword_completions($n_preceding_args, $User::application, $prefix) }
                  $User::application->help->find("functions", $func);
         }

         if (@list) {
            $self->completion_words=[ map { "$_=>" } sorted_uniq(sort(@list)) ];
            return;
         } elsif (length($prefix)) {
            # maybe a nested function call?
            undef $app;
            $func=$prefix;
         } else {
            return;
         }
      }

      # completing the function name
      if (defined $app) {
         push @list, map { "$app\::$_" } User::application($app)->help->list_completions("!rel", "functions", $func);
      } else {
         push @list, $User::application->help->list_completions("functions", $func);
         if ($line =~ m{ $statement_start_re $id_re \G}xogc) {
            push @list, grep { /^$func/ } 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|show_(?:preferences|unconfigured|credits))$/
            ? ";" :
            defined($h) && $h->expects_template_params
            ? "<" :
            exists $popular_perl_keywords{$cmd} ||
            $cmd =~ /^(?:application|help|apropos|include|prefer(?:_now)?|(?:re)?set_(?:custom|preference)|(?:re|un)configure)$/
            ? " " : "(";
      }
      return;
   }

   if (my ($quote, $prefix)= $line =~
       m{(['"]) ([^"']*) \G}xogc) {
      # 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 find_user_variable {
   my ($type, $name)=@_;
   my $glob=do {
      if ((my $pkg_end=rindex($name,"::"))>0) {
         my $pkg=get_pkg("Polymake::User::" . substr($name,0,$pkg_end)) or return;
         $pkg->{substr($name,$pkg_end+2)};
      } else {
         $Polymake::User::{$name};
      }
   } or return;

   $type eq '%'
   ? *{$glob}{HASH} :
   $type eq '@'
   ? *{$glob}{ARRAY} :
   $type eq '$'
   ? *{$glob}{SCALAR}
   : $glob
}

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

sub retrieve_method_owner_type {
   my ($var, $app, $func, $intermed)=@_;
   my ($type, $topic, @how);

   if (defined $var) {
      package Polymake::User;
      $type=eval "$var->type";

   } else {
      if (defined $app) {
         $app=eval { User::application($app) } or return;
         @how=qw(!rel);
      } else {
         $app=$User::application;
      }
      if (defined ($func=$app->help->find(@how, "functions", $func))) {
         if (!defined ($type=retrieve_return_type($func)) &&
             $func->parent->category &&
             $func->parent->name =~ /^\s* (?: producing | transforming ) /xi) {
            $type=$app->default_type;
         }
      }
   }

   if (defined($type)) {
      while ($intermed =~ m{\G $intermed_method_re }gxo) {
         next unless defined $1;        # a bracketed index expression 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 {
            return;
         }
      }
   }

   $type
}

sub retrieve_method_topics {
   my ($type, $name, $help_method)=@_;
   if (ref($type)) {
      if (instanceof ObjectType($type)) {
         return map { $_->$help_method("!rel", "properties", "methods", $name) }
                grep { defined } map { $_->help_topic }
                ($type, @{$type->super}, keys %{$type->auto_casts});
      }

      my @list;
      do {
         if (defined (my $topic=$type->help_topic)) {
            push @list, $topic->$help_method("!rel", "methods", $name);
         }      
         $type=$type->super;
      } while (defined $type);
      return @list;
   }

   no strict 'refs';
   map {
      map { $_->$help_method("!rel", "methods", $name) } $User::application->help->find("objects", $_)
   } $type, @{"$type\::ISA"};
}

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

sub guess_topics_from_context {
   my $line=shift;
   my ($var, $app, $func, $intermed, $name, @how);
   my $match=0;

   if ($line =~
       m{ (?: (?: $op_re (?:new|typeof|instanceof)) \s+ | [<,] \s* ) (?:($id_re)::)?($id_re) \s* $ }xo) {
      ($app, $name)=($1, $2);
      if (defined($app)) {
         $app=eval { User::application($app) } or return;
         @how=qw(!rel);
      } else {
         $app=$User::application;
      }
      if (my @topics=$app->help->find(@how, "objects", "property_types", $name)) {
         return @topics;
      }
   }

   if (my ($varname, $elem)= $line =~
       m{ (?:re)?set_custom \s+ ([\$\@%] $qual_id_re ) \s* (?(?=[\{\[]) ($balanced_re) \s* )? (?: = (?:$balanced_re)?)? $}xo) {
      if (substr($elem,0,1) eq '[') {
         substr($varname,0,1)='@';
      } elsif (substr($elem,0,1) eq '{') {
         substr($varname,0,1)='%';
      }
      if (my @topics=$User::application->help->find($varname)) {
         return @topics;
      }
   }
   # find the rightmost match, which can't be expressed directly in one regexp
   while ($line =~ m{ $op_re $var_or_func_re ((?:$intermed_re)*) \s*->\s* ($id_re) \s*
                    (?: \( ($open_balanced_re) )? $ }xogc) {
      $match=1;
      ($var, $app, $func, $intermed, $name, $line)=($1, $2, $3, $4, $5, $6);
      defined($line) or last;
   }
   if ($match) {
      if (defined (my $type=retrieve_method_owner_type($var, $app, $func, $intermed))) {
         return retrieve_method_topics($type, $name, "find");
      } else {
         return;
      }
   }

   while ($line =~
          m{ $op_re (?:($id_re)::)?($id_re) (?:(?=\s*<) $confined_re)? (?: \s*\( ($open_balanced_re) )? $ }xogc) {
      $match=1;
      ($app, $name, $line)=($1, $2, $3);
      defined($line) or last;
   }
   if ($match) {
      if (defined($app)) {
         $app=eval { User::application($app) } or return;
         @how=qw(!rel);
      } else {
         $app=$User::application;
      }
      return $app->help->find(@how, "functions", $name);
   }

   return;
}

my ($last_F1_line, $last_F1_point);

sub context_help {
   print "\n";
   my $line=$Shell->term->Attribs->{line_buffer};
   if ($line =~ /\S/) {
      my $pt=pos($line)=$Shell->term->Attribs->{point};
      my $full_text= $last_F1_point == $pt && $last_F1_line eq $line;

      # move before the end of the statement if nothing follows
      $line =~ m{(?: \)\s* (?: ;\s*)? | \s*;\s* ) \G \s*$ }xgc and pos($line)=$-[0];

      # move before the trailing spaces
      $line =~ m{\s+ \G}xgc and pos($line)=$-[0];

      # move behind the name if currently pointing in its middle
      $line =~ m{($qual_id_re)? \G (?(1) [\w:]* | $qual_id_re) (?: \s*\( )?}xgc;

      my @topics;
      until (@topics=guess_topics_from_context(substr($line, 0, pos($line)))) {
         # try to move behind the next name
         $line =~ m{\G .*? (?<! [\$\@%]) $id_re (?: \s*\( )?}xgc or last;
      }

      if (@topics) {
         my $n=0;
         my $tell_about_full;
         foreach (@topics) {
            print $n>0 && $help_delim,
                  $full_text && substr($_->full_path,1).":\n",
                  $_->display_text($full_text, $tell_about_full);
         }
         if ($tell_about_full) {
            print "Press F1 again for more details\n";
         }
         $last_F1_line=$line;
         $last_F1_point=$pt;
      } else {
         print "Sorry, no suitable context help found; try moving cursor towards a name of interest.\n";
      }

   } else {
      User::help();
   }

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

###############################################################################################
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=$Shell->term->Attribs->{history_length}-1;
   if ($Shell->term->history_get($last) =~ /^\s*history\s*;\s*/) {
      $Shell->term->remove_history($last);
   }
   my ($err, $last_err)=(0, $#{$Shell->remove_hist_lines}-$Shell->last_error_was_in_history);
   for (my $i=0; $i<$last; ++$i) {
      if ($err > $last_err || $i < $Shell->remove_hist_lines->[$err]->[0]) {
         print $hf $Shell->term->history_get($i), "\n";
      } else {
         $i=$Shell->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();
         $Shell->term->crlf();
         err_print($@);
         $with_error=1;
      }
      open $hf, $scriptfile;
      while (<$hf>) {
         chomp;
         last if $_ eq "__END__";
         next if /^\s*(?:\#|$)/;
         $Shell->term->add_history($_);
      }
      close $hf;
      if ($with_error) {
         push @{$Shell->remove_hist_lines}, [$Shell->first_hist_index, $Shell->term->Attribs->{history_length}-1];
         $Shell->last_error_was_in_history=1;
      }
   } else {
      warn_print("no new commands found");
   }
}
###############################################################################################
my $replay_mode_startup=sub {
   $Shell->term->history_set_pos($Shell->within_history);
   $Shell->term->insert_text($Shell->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($Shell, 0, grep { ! /$nonsignificant_line_re/o } <$in>)
      or warn_print( "no commands found" );
}
###############################################################################################
sub Polymake::User::replay_history {
   my $last=$Shell->term->Attribs->{history_length}-1;
   if ($Shell->term->history_get($last) =~ /^\s*replay_history\s*;\s*/) {
      $Shell->term->remove_history($last--);
   }
   $Shell->within_history=$last;
   $Shell->within_history_begin=0;
   $Shell->term->Attribs->{startup_hook}=$replay_mode_startup;
}
###############################################################################################
sub Polymake::User::save_history {
   $Shell->save_history(shift);
}
###############################################################################################
sub Polymake::User::help {
   my ($subject)=@_;
   if (my @topics=uniq( $User::application->help->get_topics($subject || "top") )) {
      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($Shell, 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 enter_filename {
   my ($self, $text, $opts)=@_;  $opts ||= { };
   my $prompt=$opts->{prompt} || "filename";
   my $check_code=$opts->{check};

   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 { $self->term->insert_text($text) } );
   local $self->term->{MinLength}=1;
   my $response;
   for (;;) {
      $response=$self->read_input("[$prompt] > ");
      last unless length($response);
      replace_special_paths($response);
      if ($check_code and my $error=$check_code->($response)) {
         print "Invalid input: $error\n",
               "Please enter an alternative location or an empty string to abort.\n";
      } else {
         last
      }
   }
   $response;
}
###############################################################################################
# utilities for auto-configuration

sub program_completion : method {
   my ($self, $word)=@_;
   if ($word =~ m{^[/~]}) {
      $self->completion=$self->term->Attribs->{filename_completion_function};
   } elsif ($word =~ /\S/) {
      $self->completion_words=[ sorted_uniq(sort( map { /$filename_re/ } map { glob "$_/$word*" } split /:/, $ENV{PATH} )) ];
   }
}

sub enter_program {
   my ($self, $text, $opts)=@_;
   my $check_code= ref($opts) eq "HASH" && $opts->{check};
   local_sub($self->try_completion, \&program_completion);
   local @{$self->term->Attribs}{qw( completer_word_break_characters
                                     startup_hook )}
         =( $self->term->Attribs->{basic_word_break_characters},
            sub { $self->term->insert_text($text) } );
   local $self->term->{MinLength}=1;
   my ($error, $response);
   for (;;) {
      $response=$self->read_input("[program path] > ");
      undef $response, last if !length($response);
      $response =~ s/^\s+//;  $response =~ s/\s+$//;
      last if $response eq $text;
      if ($response =~ m{^[/~]}) {
         replace_special_paths($response);
         if (-x $response && -f _) {
            if ($check_code and $error=$check_code->($response)) {
               print "Program $response did not met the requirements: $error\n",
                     "Please enter an alternative location or an empty string to abort.\n";
            } else {
               last;
            }
         } elsif (-e _) {
            print "$response is not a regular file\n",
                  "Please enter a correct location or an empty string to abort.\n";
         } else {
            print "File $response does not exist\n",
                  "Please enter a correct location or an empty string to abort.\n";
         }
      } else {
         my ($first_shot, $full_path, $error)=find_program_in_path($response, $check_code ? $check_code : ());
         if (defined $first_shot) {
            $response=$full_path unless $first_shot;
            last;
         }
         if (defined $error) {
            print "Program $response found at location $full_path, but did not met the requirements: $error\n",
                  "Please enter an alternative location or an empty string to abort.\n";
         } else {
            print "Program $response not found anywhere along your PATH.\n",
                  "Please enter the full path or an empty string to abort.\n";
         }
      }
      $text="";
   }
   $response;
}
###############################################################################################
#  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 $@;
   }
   $@='';
}

=cut

1

# Local Variables:
# cperl-indent-level:3
# indent-tabs-mode:nil
# End:
