add completion for globals

2 files changed, 110 insertions, 0 deletions

diff --git a/dist.ini b/dist.ini
index f431c0b..cd5cda3 100644
--- a/dist.ini
+++ b/dist.ini
@@ -28,6 +28,7 @@ skip = ^Data::Printer$
 skip = ^Proc::InvokeEditor$
 skip = ^Win32::Console::ANSI$
 skip = ^B::Keywords$
+skip = ^Package::Stash$
 
 [Prereqs / RuntimeRecommends]
 App::Nopaste = 0
@@ -37,6 +38,7 @@ Data::Printer = 0
 Proc::InvokeEditor = 0
 Term::ReadLine::Gnu = 0
 B::Keywords = 0
+Package::Stash = 0
 
 ; XXX it'd be nice if we could make this recommended instead of required
 [OSPrereqs / MSWin32]
diff --git a/lib/Reply/Plugin/Autocomplete/Globals.pm b/lib/Reply/Plugin/Autocomplete/Globals.pm
new file mode 100644
index 0000000..4346544
--- /dev/null
+++ b/lib/Reply/Plugin/Autocomplete/Globals.pm
@@ -0,0 +1,108 @@
+package Reply::Plugin::Autocomplete::Globals;
+use strict;
+use warnings;
+# ABSTRACT: tab completion for global variables
+
+use base 'Reply::Plugin';
+
+use Package::Stash;
+
+=head1 SYNOPSIS
+
+  ; .replyrc
+  [ReadLine]
+  [Autocomplete::Globals]
+
+=head1 DESCRIPTION
+
+This plugin registers a tab key handler to autocomplete global variables in
+Perl code.
+
+=cut
+
+sub new {
+    my $class = shift;
+
+    my $self = $class->SUPER::new(@_);
+
+    return $self;
+}
+
+sub tab_handler {
+    my $self = shift;
+    my ($line) = @_;
+
+    my ($maybe_var) = $line =~ /([\$\@\%\&\*]\s*[0-9A-Z_a-z:]*)$/;
+    return unless $maybe_var;
+    $maybe_var =~ s/\s+//g;
+
+    my ($sigil, $rest) = $maybe_var =~ /(.)(.*)/;
+
+    my @parts = split '::', $rest, -1;
+    return if grep { /:/ } @parts;
+    return if $parts[0] =~ /^[0-9]/;
+
+    my $var_prefix = pop @parts;
+
+    my $stash_name = join('::', @parts);
+    my $stash = eval {
+        Package::Stash->new(@parts ? $stash_name : 'main')
+    };
+    return unless $stash;
+
+    my @symbols = map { s/^(.)main::/$1/; $_ } _recursive_symbols($stash);
+
+    my $prefix = $stash_name
+        ? $stash_name . '::' . $var_prefix
+        : $var_prefix;
+
+    my @results;
+    for my $global (@symbols) {
+        my ($global_sigil, $global_name) = $global =~ /(.)(.*)/;
+        next unless index($global_name, $prefix) == 0;
+
+        # this is weird, not sure why % gets stripped but not $ or @
+        if ($sigil eq $global_sigil) {
+            push @results, $sigil eq '%' ? $global : $global_name;
+        }
+        elsif ($global_sigil eq '@' && $sigil eq '$') {
+            push @results, "$global_name\[";
+        }
+        elsif ($global_sigil eq '%') {
+            push @results, "$global_name\{";
+        }
+    }
+
+    return @results;
+}
+
+sub _recursive_symbols {
+    my ($stash) = @_;
+
+    my $stash_name = $stash->name;
+
+    my @symbols;
+    for my $name ($stash->list_all_symbols) {
+        if ($name =~ s/::$//) {
+            my $next = Package::Stash->new(join('::', $stash_name, $name));
+            next if $next->namespace == $stash->namespace;
+            push @symbols, _recursive_symbols($next);
+        }
+        else {
+            push @symbols, "\$${stash_name}::$name"
+                if $stash->has_symbol("\$$name");
+            push @symbols, "\@${stash_name}::$name"
+                if $stash->has_symbol("\@$name");
+            push @symbols, "\%${stash_name}::$name"
+                if $stash->has_symbol("\%$name");
+            push @symbols, "\&${stash_name}::$name"
+                if $stash->has_symbol("\&$name");
+            push @symbols, "\*${stash_name}::$name"
+                if $stash->has_symbol($name);
+        }
+    }
+
+    return @symbols;
+}
+
+1;