--HG--

branch : pmacs2

buffer.py

@@ -478,8 +478,8 @@ class IperlBuffer(InterpreterBuffer):
             return ('iperl', '-p')
     def get_env(self):
         return {'PERL5LIB': self.application.config.get('perl.lib', '.')}
-    def get_completions(self, x1, x2, line):
+    def readline_completions(self, x1, x2, line):
-        self.pipe.stdin.write("COMPLETE:%d:%d:%s\n" % (x1, x2, line))
+        self.pipe.stdin.write("READLINE:%d:%d:%s\n" % (x1, x2, line))
         self.pipe.stdin.flush()
         (typ_, value) = self.pipe_readline()
         assert typ_ == 'COMPLETIONS', '%r %r' % (typ_, value)

mode/iperlmini.py

@@ -27,7 +27,8 @@ class IperlExec(method.Method):
         b.pipe.stdin.write("ENTER:%s\n" % s)
         b.pipe.stdin.flush()
         output = b.pipe_read()
-        b.insert_string(b.get_buffer_end(), output, force=True)
+        if output:
+            b.insert_string(b.get_buffer_end(), output, force=True)
 
 class IperlTab(method.Method):
     def execute(self, w, **vargs):
@@ -47,12 +48,11 @@ class IperlTab(method.Method):
             x1 -= 1
         word = line[x1:x2]
 
-        candidates = b.get_completions(x1, x2, s)
+        candidates = b.readline_completions(x1, x2, s)
         if candidates:
             s = completer.find_common_string(candidates)
-            w.buffer.delete(Point(x1, 0), Point(x2, 0), force=True)
             w.insert_string_at_cursor(s)
-            mode.mini.use_completion_window(a, s, candidates)
+            mode.mini.use_completion_window(a, s, [word+s for s in candidates])
 
 class IperlPathStart(method.Method):
     '''Interactively run perl statements in the context of a buffer'''

mode/perl.py

@@ -496,7 +496,7 @@ class PerlSemanticComplete(method.introspect.TokenComplete):
 
         line = w.buffer.lines[t.y]
         (x1, x2) = (t.x, t.end_x())
-        candidates = b.get_completions(x1, x2, line)
+        candidates = [t.string + s for s in b.readline_completions(x1, x2, line)]
 
         minlen = None
         for candidate in candidates:

tools/iperl

@@ -14,6 +14,7 @@ use Scalar::Util qw();
 # NOTE: some Term::ReadLine implementations don't support features that we sort
 # of need. Term::ReadLine::Gnu is recommended.
 use Term::ReadLine qw();
+use Term::ReadLine::Gnu qw();
 
 # globals
 Getopt::Long::Configure('bundling');
@@ -21,6 +22,7 @@ $| = 1;
 $Data::Dumper::Terse  = 1;
 $Data::Dumper::Indent = 1;
 my $PIPE;
+my $PKG = __PACKAGE__;
 
 # usage function
 sub usage {
@@ -40,88 +42,6 @@ EOT
     exit($status);
 }
 
-# handy function for inspecting the symbol table
-my $pkgregex  = qr/^(?:[a-zA-Z_][a-zA-Z0-9_]*::)+$/;
-my $nameregex = qr/^[a-zA-Z_][a-zA-Z0-9_]*$/;
-
-# get all the objects of a particular sigil-type rooted in a package
-sub sigilread {
-    my ($pkg, $sigil, $base, $proc) = @_;
-    my $base = $pkg eq 'main::' ? '' : $pkg;
-    $proc = {$pkg => 1} unless $proc;
-    my @results;
-    foreach my $item (eval("keys(\%${pkg})")) {
-        my $item2 = $base . $item;
-        next if $proc->{$item2};
-        if($item =~ m/$nameregex/) {
-            if($sigil eq '$') {
-                if(eval("defined(\$::${item2})")) {
-                    push(@results, $item2);
-                } elsif(eval("defined(\@::${item2})")) {
-                    push(@results, $item2 . "[");
-                } elsif(eval("defined(\%::${item2})")) {
-                    push(@results, $item2 . "{");
-                }
-            } elsif(eval("defined(${sigil}::${item2})")) {
-                push(@results, $item2);
-            }
-        } elsif($item =~ m/$pkgregex/) {
-            $proc->{$item2} = 1;
-            push(@results, sigilread($item2, $sigil, $item2, $proc));
-            my $pkgname = substr($item2, 0, -2);
-        }
-    }
-    return @results;
-}
-
-# find single-step completions for a particular package/name
-sub sigilfind {
-    my ($pkg, $name, $proc) = @_;
-    my $base = $pkg eq 'main::' ? '' : $pkg;
-    $proc = {$pkg => 1} unless $proc;
-    my @results;
-    foreach my $item (eval("keys(\%${pkg})")) {
-        my $item2 = $base . $item;
-        next if $proc->{$item2};
-        if($item2 =~ m/^$name/) {
-            if($item =~ m/$nameregex/ && eval("defined(&::${item2})")) {
-                push(@results, $item2);
-            } elsif($item =~ m/$pkgregex/) {
-                $proc->{$item2} = 1;
-                my $pkgname = substr($item2, 0, -2);
-                if($name eq $pkgname) {
-                    push(@results, "$pkgname->");
-                    push(@results, sigilfind($item2, $name, $proc));
-                } else {
-                    push(@results,  $pkgname);
-                }
-            }
-        }
-    }
-    return @results;
-}
-
-# find all functions accessible via a package's @ISA array. this could probably
-# be implemented in a more efficient manner.
-sub isafind {
-    my ($pkg, $proc, $names) = @_;
-    return if $proc && $proc->{$pkg};
-    $proc = {$pkg => 1} unless $proc;
-    $names = {} unless $names;
-
-    my @pkgs = eval("\@${pkg}::ISA");
-    foreach my $pkg2 (@pkgs) {
-        isafind($pkg2, $proc, $names);
-    } 
-
-    foreach my $item (eval("keys(\%${pkg}::)")) {
-        if($item =~ m/$nameregex/) {
-            $names->{$item} = 1 if eval("defined(&::${pkg}::${item})");
-        }
-    }
-    return keys(%$names);
-}
-
 # handy function for printing nice representations of data
 sub repr {
     my ($item) = @_;
@@ -148,75 +68,170 @@ sub resolve_ref {
     return ($obj, $reftype, $package);
 }
 
-# use sigilfind to get completions for particular word(s)
+# the completer used by readline
-sub complete {
+sub readline_complete {
     my ($word, $line, $x) = @_;
+    #return complete($word, $line, $x);
+    my $full_word = readline_full_word($word, $line, $x);
+    my $delta = $x - length($word) + length($full_word);
+    my @candidates = complete($full_word);
+    return map { substr($_, $delta) } @candidates;
+    
+}
 
-    #print STDERR "'$word' '$line' $x\n";
+# some handy regexs
+my $name_re    = qr/[a-zA-Z_][a-zA-Z0-9_]*/;
+my $name2_re   = qr/(?:[a-zA-Z_][a-zA-Z0-9_]*)?/;
+my $sub_pkg_re = qr/(?:${name_re}::)*/;
+my $pkg_re     = qr/(?:${name_re}::)*${name_re}/;
 
-    $word =~ m/^([&\$%@\*]?)(.*)$/;
+my $hash_re       = qr/\$(${pkg_re}){/;
-    my $sigil = $1;
+my $hash_ref_re   = qr/\$(${pkg_re})->{/;
-    my $name = $2;
+my $obj_method_re = qr/(\$${pkg_re})->/;
-    my $pre = substr($line, 0, $x);
+my $cls_method_re = qr/(${pkg_re})->/;
+my $default_re1   = qr/([\@\$\%\&\*]?)()()(${name_re})/;
+my $default_re2   = qr/([\@\$\%\&\*]?)(${pkg_re})(::)(${name_re})/;
+my $default_re3   = qr/([\@\$\%\&\*]?)(${pkg_re})(:{0,2})()/;
 
-    if(length($line) == $x && $pre =~ m/^[ \t]*$/) {
+# XYZ
-        # hack to handle the case where we really do want a tab
+sub isa_complete {
-        return ("\t");
+    my ($var_name, $pkg, $method_name) = @_;
+    my $names = {};
+    _isa_complete($pkg, $method_name, {}, $names);
+    return map { "${var_name}->$_" } keys(%$names);
+}
+sub _isa_complete {
+    my ($pkg, $name, $proc, $names) = @_;
+    return if $proc->{$pkg};
+    $proc->{$pkg} = 1;
+    map { _isa_complete($_, $name, $proc, $names) } (eval("\@${pkg}::ISA"));
+    foreach my $item (eval("keys(\%${pkg}::)")) {
+        next unless $item =~ m/^${name_re}$/;
+        if(!$names->{$item} && $item =~ m/^$name/) {
+            $names->{$item} = 1 if eval("defined(&::${pkg}::${item})");
+        }
     }
+}
+sub sigil_complete {
+    my ($type, $sigil, $pkg, $sep, $name) = @_;
+    my $base = $pkg . $sep . $name;
+    my @names;
+    my @pkgs = _pkg_complete($pkg, $sep, $name, 1);
+    foreach my $pkg2 (@pkgs) {
+        #print "  XYZ '$type' '$name' '$pkg2'\n";
+        foreach my $item (eval("\%${pkg2}::")) {
+            next unless $item =~ m/^${name_re}$/;
+            my $base2 = $pkg2 . ($pkg2 ? '::' : '') . $item;
+            next unless $base2 =~ m/^$base/;
+            #print "    OOP defined(${type}::${base2})\n";
+            if(eval("defined(${type}::${base2})\n")) {
+                #print "    YES ${sigil}${base2}\n";
+                push(@names, $sigil . $base2);
+            }
+        }
+    }
+    return @names;
+}
+sub pkg_complete {
+    my ($pkg, $sep, $name) = @_;
+    my @pkgs = _pkg_complete($pkg, $sep, $name, !($pkg && $sep));
+    my $base = $pkg . $sep . $name;
+    return grep {$_ =~ m/^$base/ } @pkgs;
+}
+sub _pkg_complete {
+    my ($pkg, $sep, $name, $returnself) = @_;
+    my @pkgs = $returnself ? ($pkg) : ();
+    foreach my $item (eval("\%${pkg}::")) {
+        next unless $item =~ m/^(${name_re})::$/;
+        my $item2 = $1;
+        next if $pkg =~ m/::$item2$/;
+        if($item =~ m/^$name/) {
+            my $pkg2 = ($pkg ? "${pkg}::" : "") . $item2;
+            push(@pkgs, _pkg_complete($pkg2, undef, "", 1));
+        }
+    }
+    return @pkgs;
+}
 
-    if($pre =~ m/(\$(?:[a-zA-Z_][a-zA-Z0-9_]*::)*[a-zA-Z_][a-zA-Z0-9_]*)->$/) {
+sub complete {
-        # ref dereference
+    my ($word) = @_;
-        my($obj, $reftype, $package) = resolve_ref($1);
+
+    my @words;
+    if($word =~ m/^${obj_method_re}(${name2_re})$/) {
+        # obj dereference
+        my ($obj_name, $method_name) = ($1, $2);
+        my($obj, $reftype, $package) = resolve_ref($obj_name);
         if($reftype eq $package) {
-            if($reftype eq 'CODE') {
+            unless($method_name) {
-                return ("$word\(");
+                if($reftype eq 'CODE') {
-            } elsif($reftype eq 'HASH') {
+                    @words = ("$word\(");
-                return ("$word\{");
+                } elsif($reftype eq 'HASH') {
-            } elsif($reftype eq 'ARRAY') {
+                    @words = ("$word\{");
-                return ("$word\[");
+                } elsif($reftype eq 'ARRAY') {
-            } else {
+                    @words = ("$word\[");
-                return ();
+                }
             }
         } else {
-            my @names = isafind($package);
+            @words = isa_complete($obj_name, $package, $method_name);
-            return grep { $_ =~ m/^$word/ } @names;
         }
-    } elsif($pre =~ m/((?:[a-zA-Z_][a-zA-Z0-9_]*::)*[a-zA-Z_][a-zA-Z0-9_]*)->$/) {
+    } elsif($word =~ m/^${cls_method_re}(${name2_re})$/) {
         # package dereference
-        my @names = isafind($1);
+        my ($cls_name, $method_name) = ($1, $2);
-        return grep { $_ =~ m/^$word/ } @names;
+        @words = isa_complete($cls_name, $cls_name, $method_name);
-    } elsif($pre =~ m/\$((?:[a-zA-Z_][a-zA-Z0-9_]*::)*[a-zA-Z_][a-zA-Z0-9_]*){$/) {
+    } elsif($word =~ m/^${hash_re}(.*)$/) {
-        # hash keys
+        # literal hash
-        my $obj = eval("\\\%$1");
+        my ($hash, $key) = ($1, $2);
-        return $obj ? grep { $_ =~ m/^$word/ } keys(%$obj) : ();
+        my $obj = eval("\\\%$hash");
-    } elsif($pre =~ m/(\$(?:[a-zA-Z_][a-zA-Z0-9_]*::)*[a-zA-Z_][a-zA-Z0-9_]*)->{$/) {
+        if($obj) {
-        # hashref keys
+            @words = map { "\$${hash}{$_" } grep { $_ =~ m/^$key/ } keys(%$obj);
-        my $obj = eval("$1");
-        return $obj ? grep { $_ =~ m/^$word/ } keys(%$obj) : ();
-    } else {
-        # literals and ambiguous cases
-        $name =~ m/^((?:[a-zA-Z_][a-zA-Z0-9_]*::)*)/;
-        my $pkgname = $1 ? $1 : 'main::';
-        my @candidates;
-        if($sigil) {
-            # if we have a sigil, then we can just jump to the actual object
-            # completions.
-            @candidates = map {
-                "${sigil}${_}"
-            } grep {
-                $_ =~ m/^$name/
-            } sigilread($pkgname, $sigil);
-        } else {
-            # if we don't have a sigil, the user might wanna call a function,
-            # or complete a package to make an object-oriented call. so complete
-            # step-by-step to avoid annoying the user.
-            @candidates = map {
-                "${sigil}${_}"
-            } grep {
-                $_ =~ m/^$name/
-            } sigilfind($pkgname, $name);
         }
-        return sort(@candidates);
+    } elsif($word =~ m/^${hash_ref_re}(.*)$/) {
+        # hashref
+        my ($hash, $key) = ($1, $2);
+        my $obj = eval("\$$hash");
+        if($obj) {
+            @words = map { "\$${hash}->{$_" } grep { $_ =~ m/^$key/ } keys(%$obj);
+        }
+    } elsif($word =~ m/^${default_re1}$/ || $word =~ m/^${default_re2}$/ || $word =~ m/^${default_re3}$/) {
+        # package or simple var
+        my($sigil, $pkg, $sep, $name) = ($1, $2, $3, $4);
+        my($oldpkg, $oldsep) = ($pkg, $sep);
+        if($PKG && $pkg eq '' && $sep eq '') {
+            ($pkg, $sep) = ($PKG, '::');
+        }
+        if($sigil eq '$') {
+            push(@words, sigil_complete('$', '$', $pkg, $sep, $name));
+            push(@words, map {"$_\["} sigil_complete('@', '$', $pkg, $sep, $name));
+            push(@words, map {"$_\{"} sigil_complete('%', '$', $pkg, $sep, $name));
+        } elsif($sigil) {
+            @words = sigil_complete($sigil, $sigil, $pkg, $sep, $name);
+        } else {
+            push(@words, pkg_complete($pkg, $sep, $name));
+            push(@words, sigil_complete('&', '', $pkg, $sep, $name));
+        }
+        if($oldpkg ne $pkg) {
+            @words = map { $_ =~ s/^${pkg}${sep}//; $_ } @words;
+        }
+    }
+    return sort(@words);
+}
+
+# use sigilfind to get completions for particular word(s)
+sub readline_full_word {
+    my ($word, $line, $x) = @_;
+    my $pre = substr($line, 0, $x);
+    if(length($line) == $x && $pre =~ m/^[ \t]*$/) {
+        return undef;
+    } elsif($pre =~ m/$obj_method_re$/) {
+        return $1 . "->" . $word;
+    } elsif($pre =~ m/$cls_method_re$/) {
+        return $1 . "->" . $word;
+    } elsif($pre =~ m/$hash_re$/) {
+        return '$' . $1 . "{" . $word;
+    } elsif($pre =~ m/$hash_ref_re$/) {
+        return '$' . $1 . "->{" . $word;
+    } else {
+        return $word;
     }
 }
 
@@ -264,7 +279,6 @@ sub run {
     ) || usage(1);
 
     # let's display a nice banner to the user
-    #my ($prompt, $input, $term) = (">>>", "", undef);
     my ($prompt, $input, $term) = ($prompt1, "", undef);
     unless($pipe) {
         print "Welcome to Erik's Perl Interpreter\n";
@@ -275,12 +289,12 @@ sub run {
     # die if any of them fail to load.
     foreach my $pair (@preload) {
         if($pair->[0] eq 'eval') {
-            eval $pair->[1];
+            $PKG = eval "$pair->[1]; return __PACKAGE__";
             die "failed to eval '$pair->[1]': $@" if $@;
         } elsif($pair->[0] eq 'run') {
             die "no path named $pair->[1] found" unless -e $pair->[1];
             my $data = slurp($pair->[1]);
-            eval $data;
+            $PKG = eval "$data; return __PACKAGE__";
             die "failed to run $pair->[1]: $@" if $@;
         } elsif($pair->[0] eq 'use') {
             eval "use $pair->[1]";
@@ -293,7 +307,7 @@ sub run {
         $term = Term::ReadLine->new('IPERL');
         my $attribs = $term->Attribs();
         $attribs->{special_prefixes} = '$@%*&';
-        $attribs->{completion_function} = \&complete;
+        $attribs->{completion_function} = \&readline_complete;
         $attribs->{completion_append_character} = '';
     }
 
@@ -314,11 +328,16 @@ sub run {
         if($pipe) {
             if($line =~ m/^ENTER:(.*)$/) {
                 $line = $1;
-            } elsif($line =~ m/^COMPLETE:(\d+):(\d+):(.*)$/) {
+            } elsif($line =~ m/^COMPLETE:(.*)$/) {
+                my @candidates = complete($1);
+                draw_completions(@candidates);
+                next;
+            } elsif($line =~ m/^READLINE:(\d+):(\d+):(.*)$/) {
                 my $x = $2;
                 my $line = $3;
                 my $word = substr($line, $1, $x - $1);
-                draw_completions(complete($line, $word, $x));
+                my @candidates = readline_complete($line, $word, $x);
+                draw_completions(@candidates);
                 next;
             } else {
                 print "malformed pipe input line: $line\n";
@@ -344,17 +363,17 @@ sub run {
             ($input, $prompt) = ("", $prompt1);
             system($1) unless $pipe;
         } elsif($line eq ':code') {
-            draw_completions(sort(sigilread('main::', '&')));
+            draw_completions(sort(sigil_complete('&', '&', $PKG, '', '')));
         } elsif($line eq ':scalar') {
-            draw_completions(sort(sigilread('main::', '$')));
+            draw_completions(sort(sigil_complete('$', '$', $PKG, '', '')));
         } elsif($line eq ':hash') {
-            draw_completions(sort(sigilread('main::', '%')));
+            draw_completions(sort(sigil_complete('%', '%', $PKG, '', '')));
         } elsif($line eq ':array') {
-            draw_completions(sort(sigilread('main::', '@')));
+            draw_completions(sort(sigil_complete('@', '@', $PKG, '', '')));
         } elsif($line eq ':glob') {
-            draw_completions(sort(sigilread('main::', '*')));
+            draw_completions(sort(sigil_complete('*', '*', $PKG, '', '')));
-        } elsif($line =~ m/^:isa (.+)$/) {
+        } elsif($line =~ m/^\:isa (${pkg_re})$/) {
-            draw_completions(sort(isafind($1)));
+            draw_completions(sort(isa_complete($1, $1, '')));
         } elsif($line =~ m/^[\t ]/ || $line =~ m/\{ *$/ || m/\\ *$/) {
             # we're dealing with an incomplete statement, so defer execution
             $line =~ s/\\ *$//;