use strict;

use vars qw($VERSION %IRSSI);

use Irssi;

use Irssi::TextUI;

$VERSION = '1.1';

%IRSSI = (

authors => 'cxreg',

contact => '[email protected]',

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',

);

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();

}

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;

}