--HG--

branch : pmacs2

tools/iperl

@@ -12,12 +12,14 @@ use Perl6::Slurp qw(slurp);
 use Scalar::Util qw();
 use Term::ReadLine qw();
 
+# globals
 Getopt::Long::Configure('bundling');
-
 $| = 1;
 $Data::Dumper::Terse  = 1;
 $Data::Dumper::Indent = 1;
+my $PIPE;
 
+# usage function
 sub usage {
     my($status) = @_;
     my $prog = File::Basename::basename($0);
@@ -26,35 +28,14 @@ usage: $prog [options]
     -h,--help            show this message
     -e,--eval STR        eval STR before interaction
     -p,--pipe            run in pipe mode (as a subprocess)
-    -q,--quiet           do not output eval results
     -r,--run PATH        run PATH before interaction
-    -v,--verbose         output eval results (default)
 
 perl needs a good interpreter.
 EOT
     exit($status);
 }
 
-my @OLDARGV = @ARGV;
+# handy function for inspecting the symbol table
-my $verbose = 'yes';
-my $pipe;
-my @preload;
-Getopt::Long::GetOptions(
-    'help|h'    => sub { usage(0); },
-    'eval|e=s'  => sub { push(@preload, ['eval', $_[1]]); },
-    'pipe|p'    => sub { $pipe = 'line' },
-    'quiet|q'   => sub { $verbose = 0 },
-    'run|r=s'   => sub { push(@preload, ['run', $_[1]]); },
-    'use|u=s'   => sub { push(@preload, ['use', $_[1]]); },
-    'verbose|v' => sub { $verbose = 'please'; },
-) || usage(1);
-
-my ($prompt, $input) = (">>>", "");
-unless($pipe) {
-    print "Welcome to Erik's Perl Interpreter\n";
-    print "(Type \"help\", \"exit\", or something else)\n";
-}
-
 my $pkgregex  = qr/^(?:[a-zA-Z_][a-zA-Z0-9_]*::)+$/;
 my $nameregex = qr/^[a-zA-Z_][a-zA-Z0-9_]*$/;
 sub sigilfind {
@@ -76,7 +57,8 @@ sub sigilfind {
     return @results;
 }
 
-sub _repr {
+# handy function for printing nice representations of data
+sub repr {
     my ($item) = @_;
     if(!defined($item)) {
         return 'undef';
@@ -91,36 +73,9 @@ sub _repr {
     }
 }
 
-sub repr {
+# use sigilfind to get completions for particular word(s)
-    my @output;
-    foreach my $item (@_) {
-        push(@output, _repr($item));
-    }
-    return join("\n", @output);
-}
-
-sub escape {
-    my($s) = @_;
-    $s =~ s/\\/\\\\/g;
-    $s =~ s/\n/\\n/g;
-    return $s;
-}
-
-sub draw_prompt {
-    my($p) = @_;
-    print $pipe ? "$prefix:" . escape($p) . "\n" : $p;
-}
-sub draw_completions {
-    my (@items) = @_;
-    if($pipe) {
-        print 'COMPLETIONS:' . join('|', @items) . "\n";
-    } else {
-        print join("\n", @items) . "\n";
-    }
-}
-
 sub complete {
-    my ($word) = @_;
+    my ($word, $line, $x) = @_;
     $word =~ m/^([&\$%@\*]?)(.*)$/;
     my $sigil = $1 ? $1 : '&';
     my $name = $2;
@@ -130,24 +85,51 @@ sub complete {
     return map { "${1}$_" } sort(@candidates);
 }
 
+# display completions to the user
+sub draw_completions {
+    my (@items) = @_;
+    my($prefix, $delim) = $pipe ? ("COMPLETIONS", "|") : ("", "\n");
+    print $prefix . join($delim, @items) . "\n";
+}
+
+# some help text
 my $HELP = <<EOT;
 Greetings!
 
 I'm program is designed to help you write Perl. Like the "perl" command,
 I can parse and execute Perl code. Unlike it, I can execute perl code
 interactively, allowing you to call functions, save their results, inspect
-the results, and repeat.
+the results, and repeat. I also support tab-completion!
 
 I contain a lot of tricky functionality.
 
 One side-note: I can't be run under the "strict" pragma; thus, you don't
 need to use my() or our() to declare variables. The reaon for this has to
-do with the way I evaluate blocks you enter. Sorry.
+do with the way I evaluate blocks. Sorry.
 EOT
 
-my $term;
+# the big one!
-
 sub main {
+    # process the arguments provided; save original @ARGV for use later
+    my @preload;
+    my @oldargv = @ARGV;
+    Getopt::Long::GetOptions(
+        'help|h'    => sub { usage(0); },
+        'eval|e=s'  => sub { push(@preload, ['eval', $_[1]]); },
+        'pipe|p'    => sub { $pipe = 'line' },
+        'run|r=s'   => sub { push(@preload, ['run', $_[1]]); },
+        'use|u=s'   => sub { push(@preload, ['use', $_[1]]); },
+    ) || usage(1);
+
+    # let's display a nice banner to the user
+    my ($prompt, $input, $term) = (">>>", "", undef);
+    unless($pipe) {
+        print "Welcome to Erik's Perl Interpreter\n";
+        print "(Type \":help\", \":exit\", or something else)\n";
+    }
+
+    # for every file or perl string we were given, eval them in order; we should
+    # die if any of them fail to load.
     foreach my $pair (@preload) {
         if($pair->[0] eq 'eval') {
             eval $pair->[1];
@@ -163,20 +145,20 @@ sub main {
         }
     }
 
+    # set up readline if necessary
     unless($pipe) {
         $term = Term::ReadLine->new('IPERL');
         my $attribs = $term->Attribs();
         $attribs->{special_prefixes} = '$@%*&';
-        $attribs->{completion_function} = sub {
+        $attribs->{completion_function} = sub { return complete(@_) };
-            my ($word, $line, $x) = @_;
-            return complete($word);
-        };
     }
 
+    # the mighty read-exec-print loop!
     while(1) {
+        # display the prompt and read some input
         my $line;
         if($pipe) {
-            draw_prompt($prompt);
+            print "PROMPT:$prompt\n";
             $line = <STDIN>;
         } else {
             $line = $term->readline("$prompt ");
@@ -184,36 +166,36 @@ sub main {
         last unless defined($line);
         chomp($line);
 
+        # if we're in pipe-mode then we expect input in a special form
         if($pipe) {
             if($line =~ m/ENTER:(.*)$/) {
                 $line = $1;
+            } elsif($line =~ m/COMPLETE:(.*)$/) {
+                draw_completions(complete($1));
+                next;
             } else {
-                if($line =~ m/COMPLETE:(.*)$/) {
+                print "malformed pipe input line\n";
-                    draw_completions(complete($1));
-                } else {
-                    print "malformed pipe input line\n";
-                }
                 next;
             }
         }
 
+        # process the line of input
         if($line eq '') {
-        } elsif($line eq 'exit') {
+        } elsif($line eq ':exit' || $line eq ':quit') {
             last;
-        } elsif($line eq 'help') {
+        } elsif($line eq ':help') {
             ($input, $prompt) = ("", ">>>");
             print $HELP;
-        } elsif($line eq 'reload') {
+        } elsif($line eq ':reload') {
             ($input, $prompt) = ("", ">>>");
             print "reloading...\n";
-            exec($0, @OLDARGV);
+            exec($0, @oldargv);
-        } elsif($line eq 'sh') {
+        } elsif($line eq ':sh') {
             ($input, $prompt) = ("", ">>>");
             system("bash") unless $pipe;
-        } elsif($line =~ m/^sh (.+)$/) {
+        } elsif($line =~ m/^:sh (.+)$/) {
             ($input, $prompt) = ("", ">>>");
             system($1) unless $pipe;
-        } elsif($line =~ m/^:tab *(.*)$/) {
         } elsif($line eq ':code') {
             draw_completions(sigilfind('main::', '&'));
         } elsif($line eq ':scalar') {
@@ -224,20 +206,20 @@ sub main {
             draw_completions(sigilfind('main::', '@'));
         } elsif($line eq ':glob') {
             draw_completions(sigilfind('main::', '*'));
-        } elsif($line =~ m/^[\t ]/ || $line =~ m/\{ *$/) {
+        } elsif($line =~ m/^[\t ]/ || $line =~ m/\{ *$/ || m/\\ *$/) {
-            $input .= $line;
+            # we're dealing with an incomplete statement, so defer execution
-            $prompt = "..>";
-        } elsif($line =~ m/\\ *$/) {
             $line =~ s/\\ *$//;
             $input .= $line;
             $prompt = "..>";
         } else {
+            # we're dealing with a complete statement, so execute and display
             $input .= $line;
-            my @results = map { $_ =~ s/\n$//; repr($_); } eval($input);
+            my @results = map { repr($_) } eval($input);
             if($@) {
                 print $@;
-            } elsif(scalar(@results) < 2) {
+            } elsif(scalar(@results) == 0) {
-                print $results[0] . "\n";
+            } elsif(scalar(@results) == 1) {
+                print $results[0] . "\n" unless $results[0] eq 'undef';
             } else {
                 print join(", ", @results) . "\n";
             }