From 132d488c5db67c6d528c8d6cbac0ffa9e7642c12 Mon Sep 17 00:00:00 2001 From: moculus Date: Fri, 30 May 2008 06:27:42 +0000 Subject: [PATCH] --HG-- branch : pmacs2 --- buffer.py | 4 +- mode/iperlmini.py | 8 +- mode/perl.py | 2 +- tools/iperl | 323 ++++++++++++++++++++++++---------------------- 4 files changed, 178 insertions(+), 159 deletions(-) diff --git a/buffer.py b/buffer.py index 7e642a7..f596956 100644 --- a/buffer.py +++ b/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): - self.pipe.stdin.write("COMPLETE:%d:%d:%s\n" % (x1, x2, line)) + def readline_completions(self, 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) diff --git a/mode/iperlmini.py b/mode/iperlmini.py index b10d528..ed8d432 100644 --- a/mode/iperlmini.py +++ b/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''' diff --git a/mode/perl.py b/mode/perl.py index 325f3c1..409ceac 100644 --- a/mode/perl.py +++ b/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: diff --git a/tools/iperl b/tools/iperl index 80760d9..5bf457c 100755 --- a/tools/iperl +++ b/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) -sub complete { +# the completer used by readline +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 $sigil = $1; - my $name = $2; - my $pre = substr($line, 0, $x); +my $hash_re = qr/\$(${pkg_re}){/; +my $hash_ref_re = qr/\$(${pkg_re})->{/; +my $obj_method_re = qr/(\$${pkg_re})->/; +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]*$/) { - # hack to handle the case where we really do want a tab - return ("\t"); +# XYZ +sub isa_complete { + 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_]*)->$/) { - # ref dereference - my($obj, $reftype, $package) = resolve_ref($1); +sub complete { + my ($word) = @_; + + 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') { - return ("$word\("); - } elsif($reftype eq 'HASH') { - return ("$word\{"); - } elsif($reftype eq 'ARRAY') { - return ("$word\["); - } else { - return (); + unless($method_name) { + if($reftype eq 'CODE') { + @words = ("$word\("); + } elsif($reftype eq 'HASH') { + @words = ("$word\{"); + } elsif($reftype eq 'ARRAY') { + @words = ("$word\["); + } } } else { - my @names = isafind($package); - return grep { $_ =~ m/^$word/ } @names; + @words = isa_complete($obj_name, $package, $method_name); } - } 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); - return grep { $_ =~ m/^$word/ } @names; - } elsif($pre =~ m/\$((?:[a-zA-Z_][a-zA-Z0-9_]*::)*[a-zA-Z_][a-zA-Z0-9_]*){$/) { - # hash keys - my $obj = eval("\\\%$1"); - return $obj ? grep { $_ =~ m/^$word/ } keys(%$obj) : (); - } elsif($pre =~ m/(\$(?:[a-zA-Z_][a-zA-Z0-9_]*::)*[a-zA-Z_][a-zA-Z0-9_]*)->{$/) { - # hashref keys - 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); + my ($cls_name, $method_name) = ($1, $2); + @words = isa_complete($cls_name, $cls_name, $method_name); + } elsif($word =~ m/^${hash_re}(.*)$/) { + # literal hash + my ($hash, $key) = ($1, $2); + my $obj = eval("\\\%$hash"); + if($obj) { + @words = map { "\$${hash}{$_" } grep { $_ =~ m/^$key/ } keys(%$obj); } - 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::', '*'))); - } elsif($line =~ m/^:isa (.+)$/) { - draw_completions(sort(isafind($1))); + draw_completions(sort(sigil_complete('*', '*', $PKG, '', ''))); + } elsif($line =~ m/^\:isa (${pkg_re})$/) { + 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/\\ *$//;