summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2013-06-27 16:22:05 -0400
committerJesse Luehrs <doy@tozt.net>2013-06-27 16:25:15 -0400
commitb4ec08d4bd0c77aefc7b450afbeba510b2e533bd (patch)
tree2e9331f90bf58343c26e97034e3806bf009dcb66
parent1f5d099d0cba3cb2d61f595c2476e7f4e36c2422 (diff)
downloadreply-b4ec08d4bd0c77aefc7b450afbeba510b2e533bd.tar.gz
reply-b4ec08d4bd0c77aefc7b450afbeba510b2e533bd.zip
add a (sort of hacked together) plugin to tab complete lexicals
-rw-r--r--lib/Reply/Plugin/Autocomplete/Lexicals.pm90
1 files changed, 90 insertions, 0 deletions
diff --git a/lib/Reply/Plugin/Autocomplete/Lexicals.pm b/lib/Reply/Plugin/Autocomplete/Lexicals.pm
new file mode 100644
index 0000000..47f9a95
--- /dev/null
+++ b/lib/Reply/Plugin/Autocomplete/Lexicals.pm
@@ -0,0 +1,90 @@
+package Reply::Plugin::Autocomplete::Lexicals;
+use strict;
+use warnings;
+# ABSTRACT: tab completion for lexical variables
+
+use base 'Reply::Plugin';
+
+use PadWalker 'peek_sub';
+
+=head1 SYNOPSIS
+
+ ; .replyrc
+ [ReadLine]
+ [Autocomplete::Lexicals]
+
+=head1 DESCRIPTION
+
+This plugin registers a tab key handler to autocomplete lexical variables in
+Perl code.
+
+=cut
+
+# XXX unicode?
+my $var_name_rx = qr/[\$\@\%]([A-Z_a-z][0-9A-Z_a-z]*)?/;
+
+sub new {
+ my $class = shift;
+
+ my $self = $class->SUPER::new(@_);
+ $self->{env} = {};
+
+ return $self;
+}
+
+sub compile {
+ my $self = shift;
+ my ($next, @args) = @_;
+
+ my ($code) = $next->(@args);
+
+ # XXX this is just copied from LexicalPersistence, which sucks first
+ # because of copying and pasting code, and second because it doesn't catch
+ # anything that wouldn't be caught by LexicalPersistence (setting lexicals
+ # via Devel::StackTrace::WithLexicals (Carp::Reply), setting extra lexicals
+ # (ResultCache))
+ # we really need a way to broadcast various bits of information among
+ # plugins
+ $self->{env} = {
+ %{ $self->{env} },
+ %{ peek_sub($code) },
+ };
+
+ return $code;
+}
+
+sub tab_handler {
+ my $self = shift;
+ my ($line) = @_;
+
+ my ($var) = $line =~ /($var_name_rx)$/;
+ return unless $var;
+
+ my ($sigil, $name_prefix) = $var =~ /(.)(.*)/;
+
+ my @results;
+ for my $env_var (keys %{ $self->{env} }) {
+ my ($env_sigil, $env_name) = $env_var =~ /(.)(.*)/;
+
+ next unless index($env_name, $name_prefix) == 0;
+
+ if ($sigil eq $env_sigil) {
+ push @results, $env_name;
+ }
+ elsif ($env_sigil eq '@' && $sigil eq '$') {
+ push @results, "$env_name\[";
+ }
+ elsif ($env_sigil eq '%') {
+ push @results, "$env_name\{";
+ }
+ }
+
+ return @results;
+}
+
+=for Pod::Coverage
+ tab_handler
+
+=cut
+
+1;