Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
496 lines (432 sloc) 16.6 KB
use strict;
use vars qw($VERSION %IRSSI);
use Irssi;
use Irssi::TextUI;
$VERSION = '1.1';
%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 => '2017-05-02',
);
# 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 );
# before we call the go command, remove the input, or else scripts like
# per_window_prompt.pl will save the /go call, which we don't want.
Irssi::gui_input_set('');
# call the go command
$window->command("go $word");
# we've come back from the go command and cleaned up the command line,
# now finish up
@$complist = ();
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
}