summary refs log blame commit diff stats
path: root/plugins/perl/alt_completion.pl
blob: 2572fb818dfa7f262d7cae615d33075b458cb1f6 (plain) (tree)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507


























































































































































































































































































































































































































































































































                                                                                             
use strict;
use warnings;
use Xchat ();
use File::Spec ();
use File::Basename qw(fileparse);

# if the last time you addressed someone was greater than this many minutes
# ago, ignore it
# this avoids having people you have talked to a long time ago coming up too
# early in the completion list
# Setting this to 0 will disable the check which is effectively the same as
# setting it to infinity
my $last_use_threshold = 10; # 10 minutes

# added to the front of a completion the same way as a suffix, only if
# the word is at the beginning of the line
my $prefix = '';

# ignore leading non-alphanumeric characters: -[\]^_`{|}
# Assuming you have the following nicks in a channel:
# [SomeNick] _SomeNick_ `SomeNick SomeNick SomeOtherNick
# when $ignore_leading_non_alnum is set to 0
#     s<tab> will cycle through SomeNick and SomeOtherNick
# when $ignore_leading_non_alnum is set to 1
#     s<tab> will cycle through [SomeNick] _SomeNick_ `SomeNick SomeNick
#     SomeOtherNick
my $ignore_leading_non_alnum = 0;

# enable path completion
my $path_completion = 1;
my $base_path = '';

Xchat::register(
	"Tab Completion", "1.0401", "Alternative tab completion behavior"
);
Xchat::hook_print( "Key Press", \&complete );
Xchat::hook_print( "Close Context", \&close_context );
Xchat::hook_print( "Focus Tab", \&focus_tab );
Xchat::hook_print( "Part", \&clean_selected );
Xchat::hook_print( "Part with Reason", \&clean_selected );
Xchat::hook_command( "", \&track_selected );

sub SHIFT() { 1 }
sub CTRL() { 4 }
sub ALT() { 8 }

sub TAB() { 0xFF09 }
sub LEFT_TAB() { 0xFE20 }

my %completions;
my %last_visit;
my %selected;
my %escape_map = (
	'[' => qr![\[{]!,
	'{' => qr![\[{]!,
	'}' => qr![\]}]!,
	']' => qr![\]}]!,
	'\\' => qr![\\\|]!,
	'|' => qr![\\\|]!,
	'.' => qr!\.!,
	'^' => qr!\^!,
	'$' => qr!\$!,
	'*' => qr!\*!,
	'+' => qr!\+!,
	'?' => qr!\?!,
	'(' => qr!\(!,
	')' => qr!\)!,
	'-' => qr!\-!,
);

my $escapes = join "", keys %escape_map;
$escapes = qr/[\Q$escapes\E]/;

# used to determine if a word is the start of a path
my $path_pattern = qr{^(?:~|/|[[:alpha:]]:\\)};

sub complete {
	my ($key, $modifiers) = @{$_[0]};
	# if $_[0][0] contains the value of the key pressed
	# $_[0][1] contains modifiers
	# the value for tab is 0xFF09
	# the value for shift-tab(Left Tab) is 0xFE20
	# we don't care about other keys

	# the key must be a tab and left tab
	return Xchat::EAT_NONE unless $key == TAB || $key == LEFT_TAB;

	# if it is a tab then it must not have any modifiers
	return Xchat::EAT_NONE if $key == TAB && $modifiers & (CTRL|ALT|SHIFT);

	# loop backwards for shift+tab/left tab
	my $delta = $modifiers & SHIFT ? -1 : 1;
	my $context = Xchat::get_context;
	$completions{$context} ||= {};
	
	my $completions = $completions{$context};
	$completions->{pos} ||= -1;

	my $suffix = Xchat::get_prefs( "completion_suffix" );
	$suffix =~ s/^\s+//;
	
	my $input = Xchat::get_info( "inputbox" );
	my $cursor_pos = Xchat::get_info( "state_cursor" );
	my $left = substr( $input, 0, $cursor_pos );
	my $right = substr( $input, $cursor_pos );
	my $length = length $left;

	# trim spaces from the end of $left to avoid grabbing the wrong word
	# this is mainly needed for completion at the very beginning where a space
	# is added after the completion
	$left =~ s/\s+$//;

	# always add one to the index because
	# 1) if a space is found we want the position after it
	# 2) if a space isn't found then we get back -1
	my $word_start = rindex( $left, " " ) + 1;
	my $word = substr( $left, $word_start );
	$left = substr( $left, 0, -length $word );

	if( $cursor_pos == $completions->{pos} ) {
		my $previous_word = $completions->{completed};
		my $new_left = $input;
		substr( $new_left, $cursor_pos ) = "";

		if( $previous_word and $new_left =~ s/(\Q$previous_word\E)$// ) {
			$word = $1;
			$word_start = length( $new_left );
			$left = $new_left;
		}
	}

	my $command_char = Xchat::get_prefs( "input_command_char" );
	# ignore commands
	if( ($word !~ m{^[${command_char}]})
		or ( $word =~ m{^[${command_char}]} and $word_start != 0 ) ) {

		if( $cursor_pos == length $input # end of input box
			# not a valid nick char
			&& $input =~ /(?<![\x41-\x5A\x61-\x7A\x30-\x39\x5B-\x60\x7B-\x7D-])$/
			&& $cursor_pos != $completions->{pos} # not continuing a completion
			&& $word !~ m{^(?:[&#/~]|[[:alpha:]]:\\)}  # not a channel or path
		) {
			# check for path completion
			unless( $path_completion and $word =~ $path_pattern ) {
				$word_start = $cursor_pos;
				$left = $input;
				$length = length $length;
				$right = "";
				$word = "";
			}
		}

		if( $word_start == 0 && $prefix && $word =~ /^\Q$prefix/ ) {
			$word =~ s/^\Q$prefix//;
		}

		my $completed; # this is going to be the "completed" word

		# for parital completions and channel names so a : isn't added
		#$completions->{skip_suffix} = ($word =~ /^[&#]/) ? 1 : 0;
		
		# continuing from a previous completion
		if(
			exists $completions->{matches} && @{$completions->{matches}}
			&& $cursor_pos == $completions->{pos}
			&& $word =~ /^\Q$completions->{matches}[$completions->{index}]/
		) {
			$completions->{index} += $delta;

			if( $completions->{index} < 0 ) {
				$completions->{index} += @{$completions->{matches}};
			} else {
				$completions->{index} %= @{$completions->{matches}};
			}

		} else {

			if( $word =~ /^[&#]/ ) {
			# channel name completion
				$completions->{matches} = [ matching_channels( $word ) ];
				$completions->{skip_suffix} = 0;
			} elsif( $path_completion and $word =~ $path_pattern ) {
			# file name completion
				$completions->{matches} = [ matching_files( $word ) ];
				$completions->{skip_suffix} = 1;
			} else {
			# nick completion
				# fix $word so { equals [, ] equals }, \ equals |
				# and escape regex metacharacters
				$word =~ s/($escapes)/$escape_map{$1}/g;

				$completions->{matches} = [ matching_nicks( $word ) ];
				$completions->{skip_suffix} = 0;
			}
			$completions->{index} = 0;

		}
		$completed = $completions->{matches}[ $completions->{index} ];
		$completions->{completed} = $completed;

		my $completion_amount = Xchat::get_prefs( "completion_amount" );
		
		# don't cycle if the number of possible completions is greater than
		# completion_amount
		if(
			@{$completions->{matches}} > $completion_amount
			&& @{$completions->{matches}} != 1
		) {
			# don't print if we tabbed in the beginning and the list of possible
			# completions includes all nicks in the channel
			my $context_type = Xchat::context_info->{type};
			if( $context_type != 2 # not a channel
				or @{$completions->{matches}} < Xchat::get_list("users")
			) {
				Xchat::print( join " ", @{$completions->{matches}}, "\n" );
			}
			
			$completed = lcs( $completions->{matches} );
			$completions->{skip_suffix} = 1;
		}
		
		if( $completed ) {
			
			if( $word_start == 0 && !$completions->{skip_suffix} ) {
				# at the start of the line append completion suffix
				Xchat::command( "settext $prefix$completed$suffix$right");
				$completions->{pos} = length( "$prefix$completed$suffix" );
			} else {
				Xchat::command( "settext $left$completed$right" );
				$completions->{pos} = length( "$left$completed" );
			}
			
			Xchat::command( "setcursor $completions->{pos}" );
		}

=begin
# debugging stuff
		local $, = " ";
		my $input_length = length $input;
		Xchat::print [
			qq{input[$input]},
			qq{input_length[$input_length]},
			qq{cursor[$cursor_pos]},
			qq{start[$word_start]},
			qq{length[$length]},
			qq{left[$left]},
			qq{word[$word]}, qq{right[$right]},
			qq{completed[}. ($completed||""). qq{]},
			qq{pos[$completions->{pos}]},
		];
		use Data::Dumper;
		local $Data::Dumper::Indent = 0;
		Xchat::print Dumper $completions->{matches};
=cut

		return Xchat::EAT_ALL;
	} else {
		return Xchat::EAT_NONE;
	}
}


# all channels starting with $word
sub matching_channels {
	my $word = shift;

	# for use in compare_channels();
	our $current_chan;
	local $current_chan = Xchat::get_info( "channel" );

	my $conn_id = Xchat::get_info( "id" );
	$word =~ s/^[&#]+//;

	return
		map {	$_->[1]->{channel} }
		sort compare_channels map {
			my $chan = $_->{channel};
			$chan =~ s/^[#&]+//;

			# comparisons will be done based only on the name
			# matching name, same connection, only channels
			$chan =~ /^$word/i && $_->{id} == $conn_id ?
			[ $chan, $_ ] :
			()
		} channels();
}

sub channels {
	return grep { $_->{type} == 2 } Xchat::get_list( "channels" );
}

sub compare_channels {
	# package variable, value set in matching_channels()
	our $current_chan;

	# turn off warnings generated from channels that have not yet been visited
	# since the script was loaded
	no warnings "uninitialized";

	# the current channel is always first, then ordered by most recently visited
	return
		$a->[1]{channel} eq $current_chan ? -1 :
		$b->[1]{channel} eq $current_chan ? 1 :
		$last_visit{ $b->[1]{context} } <=> $last_visit{ $a->[1]{context} }
		|| $a->[1]{channel} cmp $b->[1]{channel};

}

sub matching_nicks {
	my $word_re = shift;

	# for use in compare_nicks()
	our ($my_nick, $selections, $now);
	local $my_nick = Xchat::get_info( "nick" );
	local $selections = $selected{ Xchat::get_context() };
	local $now = time;

	my $pattern = $ignore_leading_non_alnum ?
		qr/^[\-\[\]^_`{|}\\]*$word_re/i : qr/^$word_re/i;
	return
		map { $_->{nick} }
		sort compare_nicks grep {
			$_->{nick} =~ $pattern;
		} Xchat::get_list( "users" )

}

sub max {
	return unless @_;
	my $max = shift;
	for(@_) {
		$max = $_ if $_ > $max;
	}
	return $max;
}

sub compare_times {
	# package variables set in matching_nicks()
	our $selections;
	our $now;
	
	for my $nick ( $a->{nick}, $b->{nick} ) {
		# turn off the warnings that get generated from users who have yet
		# to speak since the script was loaded
		no warnings "uninitialized";

		if( $last_use_threshold
			&& (( $now - $selections->{$nick}) > ($last_use_threshold * 60)) ) {
			delete $selections->{ $nick }
		}
	}
	my $a_time = $selections->{ $a->{nick} } || 0 ;
	my $b_time = $selections->{ $b->{nick} } || 0 ;
	
	if( $a_time || $b_time ) {
		return $b_time <=> $a_time;
	} elsif( !$a_time && !$b_time ) {
		return $b->{lasttalk} <=> $a->{lasttalk};
	}

}

sub compare_nicks {
	# more package variables, value set in matching_nicks()
	our $my_nick;

	# our own nick is always last, then ordered by the people we spoke to most
	# recently and the people who were speaking most recently
	return 
		$a->{nick} eq $my_nick ? 1 :
		$b->{nick} eq $my_nick ? -1 :
		compare_times()
		|| Xchat::nickcmp( $a->{nick}, $b->{nick} );

#		$selections->{ $b->{nick} } <=> $selections->{ $a->{nick} }
#		||	$b->{lasttalk} <=> $a->{lasttalk}

}

sub matching_files {
	my $word = shift;

	my ($file, $input_dir) = fileparse( $word );

	my $dir = expand_tilde( $input_dir );

	if( opendir my $dir_handle, $dir ) {
		my @files;

		if( $file ) {
			@files = grep {
				#Xchat::print( $_ );
				/^\Q$file/ } readdir $dir_handle;
		} else {
			@files = readdir $dir_handle;
		}

		return map {
			File::Spec->catfile( $input_dir, $_ );
		} sort
		grep { !/^[.]{1,2}$/ } @files;
	} else {
		return ();
	}
}

# Remove completion related data for tabs that are closed
sub close_context {
	my $context = Xchat::get_context;
	delete $completions{$context};
	delete $last_visit{$context};
	return Xchat::EAT_NONE;
}

# track visit times
sub focus_tab {
	$last_visit{Xchat::get_context()} = time();
	return Xchat::EAT_NONE;
}

# keep track of the last time a message was addressed to someone
# a message is considered addressed to someone if their nick is used followed
# by the completion suffix
sub track_selected {
	my $input = $_[1][0];
	return Xchat::EAT_NONE unless defined $input;

	my $suffix = Xchat::get_prefs( "completion_suffix" );
	for( grep defined, $input =~ /^(.+)\Q$suffix/, $_[0][0] ) {
		if( in_channel( $_ ) ) {
			$selected{Xchat::get_context()}{$_} = time();
			last;
		}
	}

	return Xchat::EAT_NONE;
}

# if a user is in the current channel
# user_info() can also be used instead of the loop
sub in_channel {
	my $target = shift;
	for my $nick ( nicks() ) {
		if( $nick eq $target ) {
			return 1;
		}
	}

	return 0;
}

# list of nicks in the current channel
sub nicks {
	return map { $_->{nick} } Xchat::get_list( "users" );
}

# remove people from the selected list when they leave the channel
sub clean_selected {
	delete $selected{ Xchat::get_context() }{$_[0][0]};
	return Xchat::EAT_NONE;
}

# Longest common substring
# Used for partial completion when using non-cycling completion
sub lcs {
	my @nicks = @{+shift};
	return "" if @nicks == 0;
	return $nicks[0] if @nicks == 1;

	my $substring = shift @nicks;

	while(@nicks) {
		$substring = common_string( $substring, shift @nicks );
	}
	
	return $substring;
}

sub common_string {
	my ($nick1, $nick2) = @_;
	my $index = 0;

	$index++ while(
		($index < length $nick1) && ($index < length $nick2) &&
			lc(substr( $nick1, $index, 1 )) eq lc(substr( $nick2, $index, 1 ))
	);
	
	
	return substr( $nick1, 0, $index );
}

sub expand_tilde {
	my $file = shift;

	$file =~ s/^~/home_dir()/e;
	return $file;
}

sub home_dir {
	return $base_path if $base_path;

	if ( $^O eq "MSWin32" ) {
		return $ENV{USERPROFILE};
	} else {
		return ((getpwuid($>))[7] ||  $ENV{HOME} || $ENV{LOGDIR});
	}
}