├── README.mkd └── perldoc-complete /README.mkd: -------------------------------------------------------------------------------- 1 | # A bash completion helper for perldoc 2 | 3 | Check [the back story][1] if you want the details about this. 4 | 5 | Using it as as simple as saving it somewhere in your `$PATH` 6 | and adding the following line to your `.bashrc`: 7 | 8 | complete -C perldoc-complete -o nospace -o default perldoc 9 | 10 | Or do as I do, and add the following *two* lines: 11 | 12 | alias pod=perldoc 13 | complete -C perldoc-complete -o nospace -o default pod 14 | 15 | That’s all; now you can hit the Tab key at some point after 16 | typing `perldoc` or `pod` and get some sensible suggestions. 17 | Or hit the Tab key just to browse your module library. 18 | 19 | Have fun. 20 | 21 | [1]: http://blogs.perl.org/mt/mt-search.fcgi?blog_id=15;tag=perldoc-complete 22 | -------------------------------------------------------------------------------- /perldoc-complete: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # Copyright (c) 2010 Aristotle Pagaltzis {{{ 3 | # 4 | # Permission is hereby granted, free of charge, to any person obtaining 5 | # a copy of this software and associated documentation files (the 6 | # "Software"), to deal in the Software without restriction, including 7 | # without limitation the rights to use, copy, modify, merge, publish, 8 | # distribute, sublicense, and/or sell copies of the Software, and to 9 | # permit persons to whom the Software is furnished to do so, subject to 10 | # the following conditions: 11 | # 12 | # The above copyright notice and this permission notice shall be 13 | # included in all copies or substantial portions of the Software. 14 | # 15 | # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 16 | # EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 17 | # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 18 | # IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 19 | # CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 20 | # TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 21 | # SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE." 22 | # }}} 23 | 24 | use strict; 25 | use File::Spec::Functions qw( rel2abs catdir catfile no_upwards ); 26 | 27 | sub uniq { my %seen; grep { not $seen{$_}++ } @_ } 28 | 29 | sub get_command_line { 30 | my $comp = substr $ENV{'COMP_LINE'}, 0, $ENV{'COMP_POINT'}; 31 | return split /[ \t]+/, $comp, -1; # if not good enough, use Text::ParseWords 32 | } 33 | 34 | sub slurp_dir { 35 | opendir my $dir, shift or return; 36 | no_upwards readdir $dir; 37 | } 38 | 39 | sub suggestion_from_name { 40 | my ( $file_rx, $path, $name ) = @_; 41 | return if not $name =~ /$file_rx/; 42 | return $name.'::' if -d catdir $path, $name; 43 | return $1; 44 | } 45 | 46 | sub suggestions_from_path { 47 | my ( $file_rx, $path ) = @_; 48 | map { suggestion_from_name $file_rx, $path, $_ } slurp_dir $path; 49 | } 50 | 51 | sub get_package_suggestions { 52 | my ( $pkg ) = @_; 53 | 54 | my @segment = split /::|:\z/, $pkg, -1; 55 | my $file_rx = qr/\A(${\quotemeta pop @segment}\w*)(?:\.pm|\.pod)?\z/; 56 | 57 | my $home = rel2abs $ENV{'HOME'}; 58 | my $cwd = rel2abs do { require Cwd; Cwd::cwd() }; 59 | 60 | my @suggestion = 61 | map { suggestions_from_path $file_rx, $_ } 62 | uniq map { catdir $_, @segment } 63 | grep { $home ne $_ and $cwd ne $_ } 64 | map { $_, ( catdir $_, 'pods' ), ( catdir $_, 'pod' ) } 65 | map { rel2abs $_ } 66 | @INC; 67 | 68 | # fixups 69 | if ( $pkg eq '' ) { 70 | my $total = @suggestion; 71 | @suggestion = grep { not /^perl/ } @suggestion; 72 | my $num_hidden = $total - @suggestion; 73 | push @suggestion, "perl* ($num_hidden hidden)" if $num_hidden; 74 | } 75 | elsif ( $pkg =~ /(? ) { 99 | next if 1 .. /^=head2 Alphabetical Listing of Perl Functions$/; 100 | ++$nest_level if /^=over/; 101 | --$nest_level if /^=back/; 102 | next if $nest_level; 103 | push @suggestion, /^=item (-?\w+)/; 104 | } 105 | 106 | my $func_rx = qr/\A${\quotemeta $func}/; 107 | 108 | return grep { /$func_rx/ } @suggestion; 109 | } 110 | 111 | sub usage { 112 | die map "\n$_\n", ( 113 | "To use, issue the following command in bash:", 114 | "\tcomplete -C perldoc-complete -o nospace -o default perldoc", 115 | "You probably want to put that line in your ~/.bashrc file.\n", 116 | ); 117 | } 118 | 119 | usage() if not exists $ENV{'COMP_LINE'}; 120 | 121 | my ( $cmd, @arg ) = get_command_line(); 122 | my $word = pop @arg; 123 | 124 | print "$_\n" for ( @arg and @arg[-1] eq '-f' ) 125 | ? get_function_suggestions( $word ) 126 | : get_package_suggestions( $word ); 127 | 128 | # vim: ts=4 sts=4 sw=4 sr fdm=marker 129 | --------------------------------------------------------------------------------