lib/Sepia/ReadLine.pm

   1 package Sepia::ReadLine;
   2 use Term::ReadLine;
   3 use Sepia;
   4 require Exporter;
   5 @ISA='Exporter';
   6 @EXPORT='repl';
   7
   8 sub rl_complete
   9 {
  10     my ($text, $line, $start) = @_;
  11     my @xs;
  12     if (substr($line, 0, $start) =~ /^\s*$/ && $text =~ /^,(\S*)$/) {
  13         my $x = qr/^\Q$1\E/;
  14         @xs = map ",$_", grep /$x/, keys %Sepia::REPL;
  15     } else {
  16         my ($type, $str) = (substr $line, $start ?(($start-1), length($text)+1)
  17                                 : ($start, length($text)))
  18             =~ /^([\$\@\%\&]?)(.*)/;
  19         my %h = qw(@ ARRAY % HASH & CODE * IO $ VARIABLE);
  20         @xs = Sepia::completions $h{$type||'&'}, $str;
  21     }
  22     @xs;
  23 }
  24
  25 sub repl
  26 {
  27     { package main; do $_ for @ARGV }
  28     $TERM = new Term::ReadLine $0;
  29     my $rl = Term::ReadLine->ReadLine;
  30     if ($rl =~ /Gnu/) {
  31         my $attr = $TERM->Attribs;
  32         $attr->{completion_function} = \&rl_complete;
  33     } elsif ($rl =~ /Perl/) {
  34         $readline::rl_completion_function = \&rl_complete;
  35         $readline::var_TcshCompleteMode = 1;
  36     # XXX: probably helpful...
  37     # } elsif (grep -x "$_/rlwrap", split ':', $ENV{PATH}) {
  38     #     warn "Sepia::ReadLine: Falling back to rlwrap.\n";
  39     } else {
  40         warn "Sepia::ReadLine: No completion with $rl.\n";
  41     }
  42     $Sepia::READLINE = sub { $TERM->readline(Sepia::prompt()) };
  43     goto &Sepia::repl;
  44 }
  45
  46 1;