summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2013-07-10 02:01:22 -0400
committerJesse Luehrs <doy@tozt.net>2013-07-10 02:01:22 -0400
commit43d07d2dfe91121e48f74fc5a125d44018a9ba82 (patch)
tree3f69fd9cf60ce87f72f5999e3de73b71063f13ba
parentfc5b07b397d83c123440c78f6d61fb08b5005e2b (diff)
downloadreply-43d07d2dfe91121e48f74fc5a125d44018a9ba82.tar.gz
reply-43d07d2dfe91121e48f74fc5a125d44018a9ba82.zip
handle this a better way
look through the stash for packages rather than combining %INC and watching for packages
-rw-r--r--lib/Reply/Plugin/Autocomplete/Packages.pm30
-rw-r--r--lib/Reply/Util.pm18
2 files changed, 20 insertions, 28 deletions
diff --git a/lib/Reply/Plugin/Autocomplete/Packages.pm b/lib/Reply/Plugin/Autocomplete/Packages.pm
index c0a81a9..91306c4 100644
--- a/lib/Reply/Plugin/Autocomplete/Packages.pm
+++ b/lib/Reply/Plugin/Autocomplete/Packages.pm
@@ -7,6 +7,8 @@ use base 'Reply::Plugin';
use Module::Runtime '$module_name_rx';
+use Reply::Util 'all_packages';
+
=head1 SYNOPSIS
; .replyrc
@@ -30,33 +32,7 @@ sub tab_handler {
return if $before =~ /->\s*$/; # method call
return if $before =~ /[\$\@\%\&\*]\s*$/;
- my $file_fragment = $package_fragment;
- $file_fragment =~ s{::}{/}g;
-
- my $re = qr/^\Q$file_fragment/;
-
- my @results;
- for my $inc (keys %INC) {
- if ($inc =~ $re) {
- $inc =~ s{/}{::}g;
- $inc =~ s{\.pm$}{};
- push @results, $inc;
- }
- }
-
- push @results,
- grep m/^\Q$package_fragment/,
- @{$self->{moar_packages}||=[]};
-
- return @results;
-}
-
-# listen for events from the Packages plugin, for its wise wisdom
-# can teach us about packages that are not in %INC
-sub package {
- my $self = shift;
- my ($pkg) = @_;
- push @{$self->{moar_packages}||=[]}, $pkg;
+ return sort grep { index($_, $package_fragment) == 0 } all_packages();
}
1;
diff --git a/lib/Reply/Util.pm b/lib/Reply/Util.pm
index e6d193a..69d32c5 100644
--- a/lib/Reply/Util.pm
+++ b/lib/Reply/Util.pm
@@ -17,7 +17,7 @@ use Scalar::Util 'blessed';
use Exporter 'import';
our @EXPORT_OK = qw(
$ident_rx $varname_rx $fq_ident_rx $fq_varname_rx
- methods
+ methods all_packages
);
# XXX this should be updated for unicode
@@ -49,4 +49,20 @@ sub methods {
return @methods;
}
+sub all_packages {
+ my ($root) = @_;
+ $root ||= \%::;
+
+ my @packages;
+ for my $fragment (grep { /::$/ } keys %$root) {
+ next if ref($root) && $root == \%:: && $fragment eq 'main::';
+ push @packages, (
+ $fragment,
+ map { $fragment . $_ } all_packages($root->{$fragment})
+ );
+ }
+
+ return map { s/::$//; $_ } @packages;
+}
+
1;