diff options
Diffstat (limited to 'scripts/go2.pl')
| -rw-r--r-- | scripts/go2.pl | 492 | 
1 files changed, 492 insertions, 0 deletions
| diff --git a/scripts/go2.pl b/scripts/go2.pl new file mode 100644 index 0000000..96d27cd --- /dev/null +++ b/scripts/go2.pl @@ -0,0 +1,492 @@ +use strict; +use vars qw($VERSION %IRSSI); +use Irssi; +use Irssi::TextUI; + +$VERSION = '1.0'; +%IRSSI = ( +    authors     => 'cxreg', +    contact     => 'cxreg@pobox.com', +    name        => 'go2', +    description => 'Switch to the window with the given name or item', +    license     => 'Public Domain', +    url         => 'http://genericorp.net/~count/irssi/go', +    changed     => '2008-02-22', +); + +# Tab complete (0.8.12+) +sub signal_complete_go { +    my ( $complist, $window, $word, $linestart, $want_space ) = @_; + +    # This is cargo culted but I think it's right +    my $k = Irssi::parse_special('$k'); +    return unless ( $linestart =~ /^\Q${k}\Ego/i ); + +    # call the go command +    $window->command("go $word"); + +    # we've come back from the go command and cleaned up the command line, +    # remove previous input and finish up +    @$complist = (); +    Irssi::gui_input_set(''); +    Irssi::signal_stop(); +} + +# Only do this in irssi 0.8.12 or better since input mangling didn't exist until then +if ( Irssi::version >= 20070804 ) { +    Irssi::signal_add_first( 'complete word', 'signal_complete_go' ); +} + +sub cmd_go2 { +    my ($window, $suggestion, @matches); +    my $buf = ''; + +    # get a complete list of current windows +    my @all_windows = Irssi::windows(); + +    # Parse passed in argument +    if ( length $_[0] ) { +        $buf = shift; + +        # this messes up a quick jump to any channel or window named "help", +        # so maybe this should be an option +        if ( $buf eq 'help' ) { +            _help(); +            return; +        } + +        @matches = _match( $buf, @all_windows ); + +        my @non_cur = grep { !$_->{active_win} } @matches; +        if ( @matches and !@non_cur ) { +            # The only match is the current window, bail out +            return; +        } + +        # First look for an (non-current) exact match +        my @exact_matches = grep { $_->{exact} } @non_cur; +        if ( @exact_matches == 1 ) { +            $exact_matches[0]->{window}->set_active; +            return; +        } + +        # Then look for any single (non-current) match +        if ( @non_cur == 1 ) { +            $non_cur[0]->{window}->set_active; +            return; +        } + +        # If there's only 2 matches, we now know neither is current +        # so just pick one.  This is ok because the next call would +        # "toggle" to the other.  More than 2, though, and we'd end up +        # ignoring windows +        if ( @matches == 2 ) { +            $matches[0]->{window}->set_active; +            return; +        } + +        # Otherwise, fall through to normal prompt +        $suggestion = $matches[0]; +    } + +    while (1) { +        # display the current input and suggestion +        _draw_suggestion( $buf, $suggestion ); + +        # read input one character at a time +        my $chr = getc; + +        # break out on Enter +        if ( $chr =~ /[\r\n]/ ) { +            $window = $suggestion; +            last; +        } + +        # Esc means "stop trying" +        elsif ( ord($chr) == 27 ) { +            last; +        } + +        # Tab to cycle through suggestions +        elsif ( ord($chr) == 9 ) { +            if(@matches) { +                # get matches if we don't have any yet +                push @matches, grep { $_ } shift @matches; +            } else { +                # otherwise switch to the next one +                @matches = _match( $buf, @all_windows ); +            } + +            $suggestion = $matches[0]; +        } + +        # ^U means wipe out the input.  we might want to actually read this +        # from the user's keybinding (for erase_line or maybe erase_to_beg_of_line) +        # instead of assuming ^U +        elsif ( ord($chr) == 21 ) { +            $buf = ''; +            @matches = _match( $buf, @all_windows ); +            $suggestion = undef; +        } + +        # handle backspace and delete +        elsif ( ord($chr) == 127 or ord($chr) == 8 ) { +            # remove the last char +            $buf = substr( $buf, 0, length($buf) - 1 ); + +            # get suggestions again +            if ( @matches = _match( $buf, @all_windows ) ) { +                $suggestion = $buf ? $matches[0] : undef; +            } else { +                $suggestion = undef; +            } +        } + +        # regular input +        else { +            # create a temporary new buffer +            my $tmp = $buf . $chr; + +            if ( @matches = _match($tmp, @all_windows) ) { +                # if the new character results in a match, keep it +                $buf = $tmp; +                $suggestion = $buf ? $matches[0] : undef; +            } else { +                # vbell on mistype +                print STDOUT "\a"; +            } +        } +    } + +    # go to the selected window if there is one +    if ($window) { +        $window->{window}->set_active; +    } + +    # refresh the screen to get the regular prompt back if needed +    Irssi::command('redraw') +} + +Irssi::command_bind('go', 'cmd_go2', 'go2.pl'); + +sub _draw_suggestion { +    my ( $b, $s ) = @_; + +    # $b might have a space and a second token which is a tag, remove it +    # since that's getting displayed separately anyway +    my $tag; +    if ( $b =~ s/ (.*)// ) { +        $tag = $1; +    } + +    my $pre = ''; +    my $post = ''; +    if ($s) { +        # No input, entire thing is a suggestion +        if ( !$b ) { +            $pre = '#' . $s->{window}->{refnum} . ' '; +            $post = $s->{string}; +        } +        # Matched window number +        elsif ( $s->{match_obj} eq 'number' and $s->{string} =~ /\Q$b\E/i ) { +            $pre = '#' . $`; +            $post = $' . ' ' . ( $s->{window}->{active}->{name} || $s->{window}->{name} ); +        } +        # Matched 'tag' (network or server) +        elsif ( $s->{match_obj} eq 'tag' and $s->{string} =~ /\Q$b\E/i ) { +            $pre = '#' . $s->{window}->{refnum} . ' ' . +                ( $s->{window}->{active}->{name} || $s->{window}->{name} ) . " ($`"; +            $post = "$')"; +        } +        # Matched window or item name +        elsif ( $s->{string} =~ /\Q$b\E/i ) { +            $pre = '#' . $s->{window}->{refnum} . ' ' . $`; +            $post = $'; +        } + +        # special case 'tag'.  maybe this should be moved up into the case blocks +        unless ( $s->{match_obj} eq 'tag' ) { +            my $window_tag = $s->{window}->{active_server}->{tag}; +            if ( $window_tag ) { +                if ( $tag ) { +                    if ( $window_tag =~ /^\Q$tag\E/i ) { +                        $post .= " ([/i]${tag}[i]$')" +                    } else { +                        print "BUG! Window had tag '$window_tag' and should have matched '$tag' but didn't!"; +                    } +                } else { +                    $post .= " ($window_tag)"; +                } +            } +        } +    } + +    # ANSI escapes +    my $inv    = "\x{1b}[7m"; +    my $no_inv = "\x{1b}[0m"; + +    # Fix up inverse for pre and post text +    if($pre) { +        $pre = "[i]${pre}[/i]"; +        $pre =~ s/\[i\]/$inv/ig; +        $pre =~ s/\[\/i\]/$no_inv/ig; +    } +    if($post) { +        $post = "[i]${post}[/i]"; +        $post =~ s/\[i\]/$inv/ig; +        $post =~ s/\[\/i\]/$no_inv/ig; +    } + +    # FIXME - there has to be a "right way" to do this. +    # it looks like the fe-text/gui-readline.c and gui-entry.c +    # (and other gui-*) are not XS wrapped for whatever reason. +    print STDOUT "\r" . ' 'x40 . "\rGoto: "; + +    print STDOUT $pre if $pre;   # before +    print STDOUT $b;             # the matched string +    print STDOUT $post if $post; # after +} + +sub _match { +    my ( $name, @wins ) = @_; +    my @matches; + +    # $name might have a space and a second token which is a tag, remove it +    # and try to match the window tag +    my $tag; +    if ( $name =~ s/ (.*)// ) { +        $tag = $1; +    } + +    my $awr = Irssi::active_win()->{refnum}; +    for (@wins) { +        # Only add each window once, and prefer item, name, number, then tag +        my @c; + +        # items +        if ( +                length $_->{active}->{name} +                and ( +                    ( +                        @c = $_->{active}->{name} =~ /(^(#)?)?\Q$name\E($)?/i +                        and ( +                            # Match the network token if one was entered +                            !$tag +                            or ( +                                defined $_->{active_server}->{tag} +                                and $_->{active_server}->{tag} =~ /^\Q$tag\E/i +                            ) +                        ) +                    ) +                    # If we have an item name but no input, use the item name as the match string +                    or !length($name) +                ) +        ) { +            push @matches, { +                string        => $_->{active}->{name}, +                window        => $_, +                match_obj     => 'item', +                anchored      => ( defined $c[0] and !defined $c[1] ), +                near_anchored => ( defined $c[0] and defined $c[1] ), +                exact         => ( defined $c[0] and !defined $c[1] and defined $c[2] ), +                active_win    => ( $awr == $_->{refnum} ), +                # ignore non-chat activity +                activity      => ( $_->{data_level} > 1 ? $_->{data_level} : 0 ), +            }; +            next; +        } + +        # window names +        if ( +                length $_->{name} +                and ( +                    ( +                        @c = $_->{name} =~ /(^(#)?)?\Q$name\E($)?/i +                        and ( +                            # Match the network token if one was entered +                            !$tag +                            or ( +                                defined $_->{active_server}->{tag} +                                and $_->{active_server}->{tag} =~ /^\Q$tag\E/i +                            ) +                        ) +                    ) +                    # If we have an window name but no input, use the window name as the match string +                    or !length($name) +                ) +        ) { +            push @matches, { +                string        => $_->{name}, +                window        => $_, +                match_obj     => 'name', +                anchored      => ( defined $c[0] and !defined $c[1] ), +                # this is not really so useful for names, but it doesn't really hurt either +                near_anchored => ( defined $c[0] and defined $c[1] ), +                exact         => ( defined $c[0] and !defined $c[1] and defined $c[2] ), +                active_win    => ( $awr == $_->{refnum} ), +                # ignore non-chat activity +                activity      => ( $_->{data_level} > 1 ? $_->{data_level} : 0 ), +            }; +            next; +        } + +        # window numbers +        if ( +                defined $_->{refnum} +                and @c = $_->{refnum} =~ /(^)?\Q$name\E($)?/i +                and ( +                    # Match the network token if one was entered +                    !$tag +                    or ( +                        defined $_->{active_server}->{tag} +                        and $_->{active_server}->{tag} =~ /^\Q$tag\E/i +                    ) +                ) +        ) { +            push @matches, { +                string     => $_->{refnum}, +                window     => $_, +                match_obj  => 'number', +                anchored   => defined $c[0], +                exact      => ( defined $c[0] and defined $c[1] ), +                active_win => ( $awr == $_->{refnum} ), +                # ignore non-chat activity +                activity   => ( $_->{data_level} > 1 ? $_->{data_level} : 0 ), +            }; +            next; +        } + +        # network names +        if ( +                defined $_->{active_server}->{tag} +                and @c = $_->{active_server}->{tag} =~ /(^)?\Q$name\E($)?/i + +                # This doesn't seem to make a lot of sense but it makes for a +                # weird user experience without it, particularly on tab +                # cycling +                and ( +                    !$tag +                    or $_->{active_server}->{tag} =~ /^\Q$tag\E/i +                ) +        ) { +            # don't add by tag if we've already got +            push @matches, { +                string     => $_->{active_server}->{tag}, +                window     => $_, +                match_obj  => 'tag', +                anchored   => defined $c[0], +                exact      => ( defined $c[0] and defined $c[1] ), +                active_win => ( $awr == $_->{refnum} ), +                # ignore non-chat activity +                activity   => ( $_->{data_level} > 1 ? $_->{data_level} : 0 ), +            }; +            next; +        } +    } + +    # Try to sort intelligently.  Without input, order by window number.  Otherwise, +    # put exact matches in front, then anchored matches, then alpha sort.  However, +    # try not to suggest the currently selected window as the first choice.  In addition, +    # we'll give preference to active windows. +    # +    # Here is a chart of the currently implemented sorting behavior: +    # +    #  * exact match (items, names, and numbers) +    #    - activity level +    #       - items, then names, then numbers +    # +    #  * anchored (items, names, and numbers) +    #    - activity level +    #       - items, then names, then numbers +    # +    #  * near-anchored (without leading #) (items and names) +    #    - activity level +    #       - items, then names +    # +    #  * exact for networks +    #    - activity level +    # +    #  * anchored for networks +    #    - activity level +    # +    #  * activity level +    # +    #  * alphabetical +    # +    @matches = sort { +        my $which; +        if ( !length($name) ) { +            # no input, sort by number with preference to active windows +            $which = +                $b->{activity} <=> $a->{activity} || +                $a->{window}->{refnum} <=> $b->{window}->{refnum}; +        } else { +            COMPARE: for my $objects ( [ 'item', 'name', 'number' ], [ 'tag' ] ) { +                my $i; +                my %object_rank = map { $_ => ++$i } @$objects; +                for my $match ( 'exact', 'anchored', 'near_anchored' ) { + +                    # Make sure at least one is one of the desired match objects +                    my $a_mo = grep { $_ eq $a->{match_obj} } @$objects; +                    my $b_mo = grep { $_ eq $b->{match_obj} } @$objects; +                    next unless $a_mo || $b_mo; + +                    # Make sure at least one is the current match type +                    next unless $a->{$match} || $b->{$match}; + +                    last COMPARE if $which = +                        # if only one is a preferred match object +                        $b_mo <=> $a_mo || + +                        # if only one is the current match type +                        $b->{$match} <=> $a->{$match} || + +                        # Since both are the same level of match, bump up more active windows +                        $b->{activity} <=> $a->{activity} || + +                        # Same activity, order by object ranking (lower is better) +                        $object_rank{$a->{match_obj}} <=> $object_rank{$b->{match_obj}}; +                } +            } +            # If we couldn't differentiate by now, bump current window to the bottom, +            # sort by activity, and then alphabetically +            $which = +                $a->{active_win} <=> $b->{active_win} || +                $b->{activity} <=> $a->{activity} || +                $a->{string} cmp $b->{string} +                unless $which; + +        } +        $which; +    } @matches; + +    return @matches; +} + +sub _help { +    print<<HELP; +Go - jump directly to the correct destination + +Usage: +    /go [destination] + +    The argument is optional, and if it is not provided or is ambiguous, you will be +    sent to a prompt where you type in a few numbers or letters of the window name, +    item (channel, nickname), window number, or connected network.  Once you have input +    that matches one or more possible destinations, Go will print in inverse text what +    it thinks you are looking for.  If there are multiple, the tab key will cycle through +    them.  Press enter when you see the correct window to switch to it. + +    If you are using irssi 0.8.12 or better, you can tab complete from the input line +    without having to press enter first. + +    If your destination has a second word (/go foo bar), then the second word (eg 'bar') +    is assumed to be the network name, which is useful for disambiguation.  This works +    both with input to /go and for text typed at the Goto: prompt. + +    You may find it useful to bind this action to a keystroke to expedite movement, which +    will forego any argument and take you directly to the prompt: + +        /bind meta-w /go +HELP +} | 
