package PDL::Perldl2::Profile::Perldl2;
#
# Created on: Sun 25 Apr 2010 03:09:34 PM
# Last saved: Fri 16 Dec 2011 03:19:27 PM 
#

use Moose;
use namespace::clean -except => [ 'meta' ];

$PDL::Perldl2::Profile::Perldl2::VERSION = 0.008;

with 'Devel::REPL::Profile';

sub plugins {
   qw(
      CleanErrors
      Commands
      Completion
      CompletionDriver::INC
      CompletionDriver::Keywords
      CompletionDriver::LexEnv
      CompletionDriver::Methods
      DDS
      History
      LexEnv
      MultiLine::PPI
      Packages
      NiceSlice
      PrintControl
      ReadLineHistory
      PDLCommands
   ); # CompletionDriver::Globals
}

sub apply_profile {
   my ($self, $repl) = @_;

   # check for Term::ReadLine::Stub
   if ($repl->term->ReadLine =~ /Stub/) {
      $repl->print("WARNING:\n Term::ReadLine::Stub does not support pdl2 features.\n");
      $repl->print(" Please install either Term::ReadLine::Perl or Term::ReadLine::Gnu.\n");
      $repl->print(" Falling back to perldl in the meantime...\n");
      $repl->print("------------------------------------------\n\n");
      exec 'perldl';
   }

   # add PDL::Perldl2 for plugin search
   push @{$repl->_plugin_app_ns}, 'PDL::Perldl2';

   foreach my $plug ($self->plugins) {
      if ($plug =~ 'CompletionDriver::INC') {
         eval 'use File::Next';
         next if $@;
      }
      if ($plug =~ 'CompletionDriver::Keywords') {
         eval 'use B::Keywords';
         next if $@;
      }
      $repl->load_plugin($plug);
   }

   # these plugins don't work on win32
   unless ($^O =~ m/win32/i) {
      $repl->load_plugin('Interrupt');
   }

   # enable Term::ReadLine file expansion by default
   $repl->do_readline_filename_completion(1) if $repl->can('do_readline_filename_completion');

   # do perldl stuff here
   $repl->eval('package main');

   $repl->eval('use PDL');
   $repl->eval('use PDL::Config');
   $repl->eval('use PDL::Dbg');
   $repl->eval('use PDL::Doc::Perldl');
   $repl->eval('use PDL::IO::Dumper');
   $repl->eval('use PDL::IO::FlexRaw');
   $repl->eval('use PDL::IO::Pic');
   $repl->eval('use PDL::Image2D');
   $repl->eval('use PDL::AutoLoader');
   $repl->eval('no strict qw(vars)');

   # declare PERLDL package variables
   # most are not used but they are here if needed
   $repl->eval( q[
      @PERLDL::AUTO = ();                                 # code string/refs to run after user enters a new line
      $PERLDL::ESCAPE = '#';                              # Default shell escape character
      $PERLDL::HISTFILESIZE =  $ENV{PERLREPL_HISTLEN};    # Number of lines to keep in history
      $PERLDL::MULTI  = 1;                                # Enable multi-lines by default
      $PERLDL::NO_EOF = 1;                                # Enable EOF protection by default
      $PERLDL::PAGE   = 0;
      $PERLDL::PAGER  = ((exists $ENV{PAGER}) ? $ENV{PAGER} : 'more');
      $PERLDL::PAGING = 0;
      $PERLDL::PROMPT = "pdl> ";                          # string or code reference
      $PERLDL::PREFIX_RE = qr(^\s*(?:pdl|perldl)>\s*);    # RE for shell prompts
      $PERLDL::TERM = $_REPL->term;
      ] );

   #autoflush STDOUT
   $repl->eval('$|=1;');
   # p command (NOTE: this is not an alias for print)
   $repl->eval('sub p { local $, = " "; print @_,"\n" };');

   # list history command
   $repl->eval('sub l {
      my $n = $#_ > -1 ? shift : 20;
      my @h = $_REPL->term->GetHistory();
      my $min = $#h < $n-1 ? 0 : $#h-$n+1;
      map { printf "%d: %s\n", $_+1, $h[$_] } ($min..$#h);
      #map {print  "$_: $h[$_]\n"} ($min..$#h);
      };');

   # preliminary support for PDL demos
   $repl->eval( q{
      sub demo {
      local $_ = lc $_[0] ;
      if(/^$/) {
      print <<EOD;
      Use:
      demo pdl         # general demo

      demo 3d          # 3d demo (requires TriD with OpenGL or Mesa)
      demo 3d2         # 3d demo, part 2. (Somewhat memory-intensive)
      demo 3dgal       # the 3D gallery: make cool images with 3-line scripts

      demo pgplot      # PGPLOT graphics output (Req.: PGPLOT)
      demo OOplot      # PGPLOT OO interface    (Req.: PGPLOT)

      demo gnuplot     # Gnuplot graphics (requires PDL::Graphics::Gnuplot)
      demo prima       # Prima graphics (requires PDL::Graphics::Prima)

      demo transform   # Coordinate transformations (Req.: PGPLOT)
      demo cartography # Cartographic projections (Req.: PGPLOT)

      demo bad         # Bad-value demo (Req.: bad value support)
      demo bad2        # Bad-values, part 2 (Req.: bad value support and PGPLOT)
EOD
      return;
      } # if: /^$/

      my %demos = (
         'pdl' => 'PDL::Demos::General', # have to protect pdl as it means something
         '3d' => 'PDL::Demos::TriD1',
         '3d2' => 'PDL::Demos::TriD2',
         '3dgal' => 'PDL::Demos::TriDGallery',
         'pgplot' => 'PDL::Demos::PGPLOT_demo',
         'ooplot' => 'PDL::Demos::PGPLOT_OO_demo', # note: lowercase
         'bad' => 'PDL::Demos::BAD_demo',
         'bad2' => 'PDL::Demos::BAD2_demo',
         'transform' => 'PDL::Demos::Transform_demo',
         'cartography' => 'PDL::Demos::Cartography_demo',
         'gnuplot' => 'PDL::Demos::Gnuplot_demo',
         'prima' => 'PDL::Demos::Prima',
      );

      if ( exists $demos{$_} ) {
         require PDL::Demos::Screen; # Get the routines for screen demos.
         my $name = $demos{$_};
         eval "require $name;"; # see docs on require for need for eval
         $name .= "::run";
         no strict 'refs';
         &{$name}();
      } else {
         print "No such demo!\n";
      }

   } } );

   if ($repl->can('do_print')) {
      $repl->eval('sub do_print { $_REPL->do_print(@_) };');
   }

   if ($repl->can('exit_repl')) {
      $repl->eval('sub quit { $_REPL->exit_repl(1) };');
   } else {
      $repl->eval('sub quit { $_REPL->print("Use Ctrl-D or exit to quit" };');
   }

   $repl->prompt($PERLDL::PROMPT);  # new prompt

   if ( defined $ENV{TERM} and $ENV{TERM} eq 'dumb' ) {
      $repl->print("\n");
      $repl->print("******************************************\n");
      $repl->print("* Warning: TERM type is dumb!            *\n");
      $repl->print("* Limited ReadLine functionality will be *\n");
      $repl->print("* available.  Please unset TERM or use a *\n");
      $repl->print("* different terminal type.               *\n");
      $repl->print("******************************************\n");
      $repl->print("\n");
   }

   $repl->print("Perldl2 Shell v$PDL::Perldl2::Profile::Perldl2::VERSION
      PDL comes with ABSOLUTELY NO WARRANTY. For details, see the file
      'COPYING' in the PDL distribution. This is free software and you
      are welcome to redistribute it under certain conditions, see
      the same file for details.\n");

   $repl->print("Loaded plugins:\n");
   {
      my @plugins = ();
      foreach my $pl ( $repl->_plugin_locator->plugins ) {
         # print names of ones that have been loaded
         my $plug = $pl;
         $plug =~ s/^.*Plugin::/  /;
         push @plugins, $plug if $repl->does($pl);
      }
      # Need smarter display of plugins, fill out the line
      # and list CompletionDrivers under Completion
      $repl->print(join "\n", sort(@plugins));
      $repl->print("\n");
   }

   $repl->print("Type 'help' for online help\n");
   $repl->print("Type Ctrl-D or quit to exit\n");
   $repl->print("Loaded PDL v$PDL::VERSION\n");
}

1;

__END__

=head1 NAME

PDL::Perldl2::Profile::Perldl2 - profile for Perldl2 shell

=head1 SYNOPSIS

    system> re.pl --profile=PDL::Perldl2::Profile::Perldl2  # unix-ish shell
    system> re    --profile=PDL::Perldl2::Profile::Perldl2  # win32 CMD shell

    Perldl2 Shell v0.008
          PDL comes with ABSOLUTELY NO WARRANTY. For details, see the file
          'COPYING' in the PDL distribution. This is free software and you
          are welcome to redistribute it under certain conditions, see
          the same file for details.
    
    Loaded plugins:
      CleanErrors
      Commands
      Completion
      CompletionDriver::INC
      CompletionDriver::Keywords
      CompletionDriver::LexEnv
      CompletionDriver::Methods
      DDS
      FindVariable
      History
      Interrupt
      LexEnv
      MultiLine::PPI
      NiceSlice
      PDLCommands
      Packages
      PrintControl
      ReadLineHistory
    
    
    Type 'help' for online help
    
    Type Ctrl-D or quit to exit
    
    Loaded PDL v2.006
    
    pdl> 


=head1 DESCRIPTION

This profile is for development of the new PDL shell (version 2).
The preferred method to start the new shell is via the C<pdl2>
command.  This documentation is provided for C<Devel::REPL> coders
that may wish to use this profile directly for their development.

=head1 SEE ALSO

C<Devel::REPL>, C<Devel::REPL::Profile>, and C<PDL::Perldl>.

=head1 AUTHOR

Chris Marshall, C<< <chm at cpan dot org> >>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 by Christopher Marshall

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut