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

PDL documentation Contained in the PDL distribution.

Index

Code Index:

NAME

Top

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

SYNOPSIS

Top

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

    Perldl2 Shell v0.004
          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:

      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.4.7

    pdl>

DESCRIPTION

Top

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

SEE ALSO

Top

Devel::REPL, Devel::REPL::Profile, and PDL::Perldl.

AUTHOR

Top

Chris Marshall, <chm at cpan dot org>

COPYRIGHT AND LICENSE

Top

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.

PDL documentation Contained in the PDL distribution. 
package PDL::Perldl2::Profile::Perldl2;
#
# Created on: Sun 25 Apr 2010 03:09:34 PM
# Last saved: Tue 29 Mar 2011 12:50:05 PM 
#

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

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

with 'Devel::REPL::Profile';

sub plugins {
   qw(
      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::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::TERM = $_REPL->term;
            ] );

   # print alias
   $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 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'
            );

            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);
      }
      $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__