citadel

My dotfiles, scripts and nix configs
git clone git://jb55.com/citadel
Log | Files | Refs | README | LICENSE

keyboard-select (15046B)


      1 #!/usr/bin/env perl
      2 # Author:   Bert Muennich
      3 # Website:  http://www.github.com/muennich/urxvt-perls
      4 # License:  GPLv2
      5 
      6 # Use keyboard shortcuts to select and copy text.
      7 
      8 # Usage: put the following lines in your .Xdefaults/.Xresources:
      9 #   URxvt.perl-ext-common: ...,keyboard-select
     10 #   URxvt.keysym.M-Escape: perl:keyboard-select:activate
     11 # The following line overwrites the default Meta-s binding and allows to
     12 # activate keyboard-select directly in backward search mode:
     13 #   URxvt.keysym.M-s: perl:keyboard-select:search
     14 
     15 # Use Meta-Escape to activate selection mode, then use the following keys:
     16 #   h/j/k/l:    Move cursor left/down/up/right (also with arrow keys)
     17 #   g/G/0/^/$/H/M/L/f/F/;/,/w/W/b/B/e/E: More vi-like cursor movement keys
     18 #   '/'/?:      Start forward/backward search
     19 #   n/N:        Repeat last search, N: in reverse direction
     20 #   Ctrl-f/b:   Scroll down/up one screen
     21 #   Ctrl-d/u:   Scroll down/up half a screen
     22 #   v/V/Ctrl-v: Toggle normal/linewise/blockwise selection
     23 #   y/Return:   Copy selection to primary buffer, Return: quit afterwards
     24 #   Y:          Copy selected lines to primary buffer or cursor line and quit
     25 #   q/Escape:   Quit keyboard selection mode
     26 
     27 use warnings;
     28 use strict;
     29 
     30 sub on_start{
     31 	my ($self) = @_;
     32 
     33 	$self->{patterns}{'w'} = qr/\w[^\w\s]|\W\w|\s\S/;
     34 	$self->{patterns}{'W'} = qr/\s\S/;
     35 	$self->{patterns}{'b'} = qr/.*(?:\w[^\w\s]|\W\w|\s\S)/;
     36 	$self->{patterns}{'B'} = qr/.*\s\S/;
     37 	$self->{patterns}{'e'} = qr/[^\w\s](?=\w)|\w(?=\W)|\S(?=\s|$)/;
     38 	$self->{patterns}{'E'} = qr/\S(?=\s|$)/;
     39 
     40 	()
     41 }
     42 
     43 
     44 sub on_action {
     45     my ($self, $action) = @_;
     46 
     47     on_user_command($self, "keyboard-select:" . $action);
     48 }
     49 
     50 
     51 sub on_user_command {
     52 	my ($self, $cmd) = @_;
     53 
     54 	if (not $self->{active}) {
     55 		if ($cmd eq 'keyboard-select:activate') {
     56 			activate($self);
     57 		} elsif ($cmd eq 'keyboard-select:search') {
     58 			activate($self, 1);
     59 		}
     60 	}
     61 
     62 	()
     63 }
     64 
     65 
     66 sub key_press {
     67 	my ($self, $event, $keysym, $char) = @_;
     68 	my $key = chr($keysym);
     69 
     70 	if (lc($key) eq 'c' && $event->{state} & urxvt::ControlMask) {
     71 		deactivate($self);
     72 	} elsif ($self->{search}) {
     73 		if ($keysym == 0xff1b) {
     74 			if ($self->{search_mode}) {
     75 				deactivate($self);
     76 			} else {
     77 				$self->{search} = '';
     78 				status_area($self);
     79 			}
     80 		} elsif ($keysym == 0xff08) {
     81 			$self->{search} = substr($self->{search}, 0, -1);
     82 			if (not $self->{search} and $self->{search_mode}) {
     83 				deactivate($self);
     84 			} else {
     85 				status_area($self);
     86 			}
     87 		} elsif ($keysym == 0xff0d ||
     88 				(lc($key) eq 'm' && $event->{state} & urxvt::ControlMask)) {
     89 			my $txt = substr($self->{search}, 1);
     90 			if ($txt) {
     91 				$self->{pattern} = ($txt =~ m/[[:upper:]]/) ? qr/\Q$txt\E/ :
     92 						qr/\Q$txt\E/i;
     93 			} elsif ($self->{pattern}) {
     94 				delete $self->{pattern};
     95 			}
     96 			$self->{search} = '';
     97 			$self->screen_cur($self->{srhcr}, $self->{srhcc});
     98 			if (not find_next($self)) {
     99 				if ($self->{search_mode}) {
    100 					deactivate($self);
    101 				} else {
    102 					status_area($self);
    103 				}
    104 			}
    105 		} elsif (length($char) > 0) {
    106 			$self->{search} .= $self->locale_decode($char);
    107 			my $txt = substr($self->{search}, 1);
    108 			if ($txt) {
    109 				$self->{pattern} = ($txt =~ m/[[:upper:]]/) ? qr/\Q$txt\E/ :
    110 				qr/\Q$txt\E/i;
    111 			} elsif ($self->{pattern}) {
    112 				delete $self->{pattern};
    113 			}
    114 			$self->screen_cur($self->{srhcr}, $self->{srhcc});
    115 			find_next($self);
    116 			status_area($self);
    117 		}
    118 	} elsif ($self->{move_to}) {
    119 		if ($keysym == 0xff1b) {
    120 			$self->{move_to} = 0;
    121 			status_area($self);
    122 		} elsif (length($char) > 0) {
    123 			$self->{move_to} = 0;
    124 			$self->{patterns}{'f-1'} = qr/^.*\Q$key\E/;
    125 			$self->{patterns}{'f+1'} = qr/^.+?\Q$key\E/;
    126 			move_to($self, ';');
    127 			status_area($self);
    128 		}
    129 	} elsif ($keysym == 0xff1b || lc($key) eq 'q') {
    130 		deactivate($self);
    131 	} elsif (lc($key) eq 'y' || $keysym == 0xff0d ||
    132 			(lc($key) eq 'm' && $event->{state} & urxvt::ControlMask)) {
    133 		my $quit = 0;
    134 		if ($key eq 'Y' && $self->{select} ne 'l') {
    135 			$quit = !$self->{select};
    136 			toggle_select($self, 'l');
    137 		}
    138 		if ($self->{select}) {
    139 			my ($br, $bc, $er, $ec) = calc_span($self);
    140 			$ec = $self->line($er)->l if $self->{select} eq 'l';
    141 			$self->selection_beg($br, $bc);
    142 			$self->selection_end($er, $ec);
    143 			$self->selection_make($event->{time}, $self->{select} eq 'b');
    144 			if (lc($key) eq 'y') {
    145 				$self->selection_beg(1, 0);
    146 				$self->selection_end(1, 0);
    147 				$self->{select} = '';
    148 				status_area($self);
    149 				$self->want_refresh();
    150 			} else {
    151 				$quit = 1;
    152 			}
    153 		}
    154 		if ($quit) {
    155 			deactivate($self); 
    156 		}
    157 	} elsif ($key eq 'V') {
    158 		toggle_select($self, 'l');
    159 	} elsif ($key eq 'v') {
    160 		if ($event->{state} & urxvt::ControlMask) {
    161 			toggle_select($self, 'b');
    162 		} else {
    163 			toggle_select($self, 'n');
    164 		}
    165 	} elsif ($key eq 'k' || $keysym == 0xff52) {
    166 		move_cursor($self, 'k');
    167 	} elsif ($key eq 'j' || $keysym == 0xff54) {
    168 		move_cursor($self, 'j');
    169 	} elsif ($key eq 'h' || $keysym == 0xff51) {
    170 		move_cursor($self, 'h');
    171 	} elsif ($key eq 'l' || $keysym == 0xff53) {
    172 		move_cursor($self, 'l');
    173 	} elsif ($keysym == 0xff57) {
    174 		move_cursor($self, '$');
    175 	} elsif ($keysym == 0xff50) {
    176 		move_cursor($self, '^');
    177 	} elsif ('gG0^$HML' =~ m/\Q$key\E/ ||
    178 			('fbdu' =~ m/\Q$key\E/ && $event->{state} & urxvt::ControlMask)) {
    179 		move_cursor($self, $key);
    180 	} elsif (lc($key) eq 'f') {
    181 		$self->{move_to} = 1;
    182 		$self->{move_dir} = $key eq 'F' ? -1 : 1;
    183 		status_area($self, $key);
    184 	} elsif (';,wWbBeE' =~ m/\Q$key\E/) {
    185 		move_to($self, $key);
    186 	} elsif ($key eq '/' || $key eq '?') {
    187 		$self->{search} = $key;
    188 		$self->{search_dir} = $key eq '?' ? -1 : 1;
    189 		($self->{srhcr}, $self->{srhcc}) = $self->screen_cur();
    190 		status_area($self);
    191 	} elsif (lc($key) eq 'n') {
    192 		find_next($self, $self->{search_dir} * ($key eq 'N' ? -1 : 1));
    193 	}
    194 
    195 	return 1;
    196 }
    197 
    198 
    199 sub move_cursor {
    200 	my ($self, $key) = @_;
    201 	my ($cr, $cc) = $self->screen_cur();
    202 	my $line = $self->line($cr);
    203 
    204 	if ($key eq 'k' && $line->beg > $self->top_row) {
    205 		$cr = $line->beg - 1;
    206 	} elsif ($key eq 'j' && $line->end < $self->nrow - 1) {
    207 		$cr = $line->end + 1;
    208 	} elsif ($key eq 'h' && $self->{offset} > 0) {
    209 		$self->{offset} = $line->offset_of($cr, $cc) - 1;
    210 		$self->{dollar} = 0;
    211 	} elsif ($key eq 'l' && $self->{offset} < $line->l - 1) {
    212 		++$self->{offset};
    213 	} elsif ($key eq 'f' || $key eq 'd') {
    214 		my $vs = $self->view_start() +
    215 				($key eq 'd' ? $self->nrow / 2 : $self->nrow - 1);
    216 		$vs = 0 if $vs > 0;
    217 		$cr += $vs - $self->view_start($vs);
    218 	} elsif ($key eq 'b' || $key eq 'u') {
    219 		my $vs = $self->view_start() -
    220 				($key eq 'u' ? $self->nrow / 2 : $self->nrow - 1);
    221 		$vs = $self->top_row if $vs < $self->top_row;
    222 		$cr += $vs - $self->view_start($vs);
    223 	} elsif ($key eq 'g') {
    224 		($cr, $self->{offset}) = ($self->top_row, 0);
    225 		$self->{dollar} = 0;
    226 	} elsif ($key eq 'G') {
    227 		($cr, $self->{offset}) = ($self->nrow - 1, 0);
    228 		$self->{dollar} = 0;
    229 	} elsif ($key eq '0') {
    230 		$self->{offset} = 0;
    231 		$self->{dollar} = 0;
    232 	} elsif ($key eq '^') {
    233 		my $ltxt = $self->special_decode($line->t);
    234 		while ($ltxt =~ s/^( *)\t/$1 . " " x (8 - length($1) % 8)/e) {}
    235 		$self->{offset} = $ltxt =~ m/^ +/ ? $+[0] : 0;
    236 		$self->{dollar} = 0;
    237 	} elsif ($key eq '$') {
    238 		my $co = $line->offset_of($cr, $cc);
    239 		$self->{dollar} = $co + 1;
    240 		$self->{offset} = $line->l - 1;
    241 	} elsif ($key eq 'H') {
    242 		$cr = $self->view_start();
    243 	} elsif ($key eq 'M') {
    244 		$cr = $self->view_start() + $self->nrow / 2;
    245 	} elsif ($key eq 'L') {
    246 		$cr = $self->view_start() + $self->nrow - 1;
    247 	}
    248 
    249 	$line = $self->line($cr);
    250 	$cc = $self->{dollar} || $self->{offset} >= $line->l ? $line->l - 1 :
    251 			$self->{offset};
    252 	$self->screen_cur($line->coord_of($cc));
    253 
    254 	status_area($self);
    255 	$self->want_refresh();
    256 	
    257 	()
    258 }
    259 
    260 
    261 sub move_to {
    262 	my ($self, $key) = @_;
    263 	my ($cr, $cc) = $self->screen_cur();
    264 	my $line = $self->line($cr);
    265 	my $offset = $self->{offset};
    266 	my ($dir, $pattern);
    267 	my ($wrap, $found) = (0, 0);
    268 
    269 	if ($key eq ';' || $key eq ',') {
    270 		$dir = $self->{move_dir} * ($key eq ',' ? -1 : 1);
    271 		$pattern = $self->{patterns}{sprintf('f%+d', $dir)};
    272 		return if not $pattern;
    273 	} else {
    274 		if (lc($key) eq 'b') {
    275 			$dir = -1;
    276 		} else {
    277 			$dir = 1;
    278 			++$offset if lc($key) eq 'e';
    279 		}
    280 		$pattern = $self->{patterns}{$key};
    281 		$wrap = 1;
    282 	}
    283 
    284 	if ($dir > 0) {
    285 		NEXTDOWN: my $text = substr($line->t, $offset);
    286 		if ($text =~ m/$pattern/) {
    287 			$offset += $+[0] - 1;
    288 			$found = 1;
    289 		} elsif ($wrap && $line->end + 1 < $self->nrow) {
    290 			$cr = $line->end + 1;
    291 			$line = $self->line($cr);
    292 			$offset = 0;
    293 			if (lc($key) eq 'e') {
    294 				goto NEXTDOWN;
    295 			} else {
    296 				$found = 1;
    297 			}
    298 		}
    299 	} elsif ($dir < 0) {
    300 		NEXTUP: my $text = substr($line->t, 0, $offset);
    301 		if ($text =~ m/$pattern/) {
    302 			$offset += $+[0] - length($text) - 1;
    303 			$found = 1;
    304 		} elsif ($wrap) {
    305 			if ($offset > 0) {
    306 				$offset = 0;
    307 				$found = 1;
    308 			} elsif ($line->beg > $self->top_row) {
    309 				$cr = $line->beg - 1;
    310 				$line = $self->line($cr);
    311 				$offset = $line->l;
    312 				goto NEXTUP;
    313 			}
    314 		}
    315 	}
    316 
    317 	if ($found) {
    318 		$self->{dollar} = 0;
    319 		$self->{offset} = $offset;
    320 		$self->screen_cur($line->coord_of($offset));
    321 		$self->want_refresh();
    322 	}
    323 
    324 	()
    325 }
    326 
    327 
    328 sub find_next {
    329 	my ($self, $dir) = @_;
    330 
    331 	return if not $self->{pattern};
    332 	$dir = $self->{search_dir} if not $dir;
    333 
    334 	my ($cr, $cc) = $self->screen_cur();
    335 	my $line = $self->line($cr);
    336 	my $offset = $line->offset_of($cr, $cc);
    337 	my $text;
    338 	my $found = 0;
    339 
    340 	++$offset if $dir > 0;
    341 
    342 	while (not $found) {
    343 		if ($dir > 0) {
    344 			$text = substr($line->t, $offset);
    345 			if ($text =~ m/$self->{pattern}/) {
    346 				$found = 1;
    347 				$offset += $-[0];
    348 			} else {
    349 				last if $line->end >= $self->nrow;
    350 				$line = $self->line($line->end + 1);
    351 				$offset = 0;
    352 			}
    353 		} else {
    354 			$text = substr($line->t, 0, $offset);
    355 			if ($text =~ m/$self->{pattern}/) {
    356 				$found = 1;
    357 				$offset = $-[0] while $text =~ m/$self->{pattern}/g;
    358 			} else {
    359 				last if $line->beg <= $self->top_row;
    360 				$line = $self->line($line->beg - 1);
    361 				$offset = $line->l;
    362 			}
    363 		}
    364 	}
    365 
    366 	if ($found) {
    367 		$self->{dollar} = 0;
    368 		$self->{offset} = $offset;
    369 		$self->screen_cur($line->coord_of($offset));
    370 		status_area($self);
    371 		$self->want_refresh();
    372 	}
    373 
    374 	return $found;
    375 }
    376 
    377 
    378 sub tt_write {
    379 	return 1;
    380 }
    381 
    382 
    383 sub refresh {
    384 	my ($self) = @_;
    385 	my ($cr, $cc) = $self->screen_cur();
    386 
    387 	# scroll the current cursor position into visible area
    388 	if ($cr < $self->view_start()) {
    389 		$self->view_start($cr);
    390 	} elsif ($cr >= $self->view_start() + $self->nrow) {
    391 		$self->view_start($cr - $self->nrow + 1);
    392 	}
    393 
    394 	if ($self->{select}) {
    395 		my ($hl, $reverse_cursor);
    396 		my ($br, $bc, $er, $ec) = calc_span($self);
    397 
    398 		if ($self->x_resource('highlightColor')) {
    399 			$hl = urxvt::RS_Sel;
    400 			$reverse_cursor = 0;
    401 		} else {
    402 			$hl = urxvt::RS_RVid;
    403 			$reverse_cursor = $self->{select} ne 'l';
    404 		}
    405 		if ($self->{select} eq 'b') {
    406 			my $co = $self->line($cr)->offset_of($cr, $cc);
    407 			my $dollar = $self->{dollar} && $co >= $self->{dollar} - 1;
    408 
    409 			my $r = $br;
    410 			while ($r <= $er) {
    411 				my $line = $self->line($r);
    412 				if ($bc < $line->l) {
    413 					$ec = $line->l if $dollar;
    414 					my ($br, $bc) = $line->coord_of($bc);
    415 					my ($er, $ec) = $line->coord_of($ec <= $line->l ? $ec : $line->l);
    416 					$self->scr_xor_span($br, $bc, $er, $ec, $hl);
    417 				} elsif ($r == $cr) {
    418 					$reverse_cursor = 0;
    419 				}
    420 				$r = $line->end + 1;
    421 			}
    422 		} else {
    423 			$self->scr_xor_span($br, $bc, $er, $ec, $hl);
    424 		}
    425 
    426 		if ($reverse_cursor) {
    427 			# make the cursor visible again
    428 			$self->scr_xor_span($cr, $cc, $cr, $cc + 1, $hl);
    429 		}
    430 	}
    431 
    432 	()
    433 }
    434 
    435 
    436 sub activate {
    437 	my ($self, $search) = @_;
    438 
    439 	$self->{active} = 1;
    440 
    441 	$self->{select} = '';
    442 	$self->{dollar} = 0;
    443 	$self->{move_to} = 0;
    444 
    445 	if ($search) {
    446 		$self->{search} = '?';
    447 		$self->{search_dir} = -1;
    448 		$self->{search_mode} = 1;
    449 	} else {
    450 		$self->{search} = '';
    451 		$self->{search_mode} = 0;
    452 	}
    453 
    454 	($self->{oldcr}, $self->{oldcc}) = $self->screen_cur();
    455 	($self->{srhcr}, $self->{srhcc}) = $self->screen_cur();
    456 	$self->{old_view_start} = $self->view_start();
    457 	$self->{old_pty_ev_events} = $self->pty_ev_events(urxvt::EV_NONE);
    458 
    459 	my $line = $self->line($self->{oldcr});
    460 	$self->{offset} = $line->offset_of($self->{oldcr}, $self->{oldcc});
    461 
    462 	$self->selection_beg(1, 0);
    463 	$self->selection_end(1, 0);
    464 
    465 	$self->enable(
    466 		key_press     => \&key_press,
    467 		refresh_begin => \&refresh,
    468 		refresh_end   => \&refresh,
    469 		tt_write      => \&tt_write,
    470 	);
    471 
    472 	if ($self->{offset} >= $line->l) {
    473 		$self->{offset} = $line->l > 0 ? $line->l - 1 : 0;
    474 		$self->screen_cur($line->coord_of($self->{offset}));
    475 		$self->want_refresh();
    476 	}
    477 
    478 	$self->{overlay_len} = 0;
    479 	status_area($self);
    480 
    481 	()
    482 }
    483 
    484 
    485 sub deactivate {
    486 	my ($self) = @_;
    487 
    488 	$self->selection_beg(1, 0);
    489 	$self->selection_end(1, 0);
    490 
    491 	delete $self->{overlay} if $self->{overlay};
    492 
    493 	$self->disable("key_press", "refresh_begin", "refresh_end", "tt_write");
    494 	$self->screen_cur($self->{oldcr}, $self->{oldcc});
    495 	$self->view_start($self->{old_view_start});
    496 	$self->pty_ev_events($self->{old_pty_ev_events});
    497 
    498 	$self->want_refresh();
    499 
    500 	$self->{active} = 0;
    501 
    502 	()
    503 }
    504 
    505 
    506 sub status_area {
    507 	my ($self, $extra) = @_;
    508 	my ($stat, $stat_len);
    509 
    510 	if ($self->{search}) {
    511 		$stat_len = $self->ncol;
    512 		$stat = $self->{search} . ' ' x ($stat_len - length($self->{search}));
    513 	} else {
    514 		if ($self->{select}) {
    515 			$stat = "-V" . ($self->{select} ne 'n' ? uc($self->{select}) : "") . "- ";
    516 		}
    517 
    518 		if ($self->top_row == 0) {
    519 			$stat .= "All";
    520 		} elsif ($self->view_start() == $self->top_row) {
    521 			$stat .= "Top";
    522 		} elsif ($self->view_start() == 0) {
    523 			$stat .= "Bot";
    524 		} else {
    525 			$stat .= sprintf("%2d%%",
    526 					($self->top_row - $self->view_start) * 100 / $self->top_row);
    527 		}
    528 		
    529 		$stat = "$extra $stat" if $extra;
    530 		$stat_len = length($stat);
    531 	}
    532 
    533 	if (!$self->{overlay} || $self->{overlay_len} != $stat_len) {
    534 		delete $self->{overlay} if $self->{overlay};
    535 		$self->{overlay} = $self->overlay(-1, -1, $stat_len, 1,
    536 				urxvt::OVERLAY_RSTYLE, 0);
    537 		$self->{overlay_len} = $stat_len;
    538 	}
    539 
    540 	$self->{overlay}->set(0, 0, $self->special_encode($stat));
    541 	$self->{overlay}->show();
    542 
    543 	()
    544 }
    545 
    546 
    547 sub toggle_select {
    548 	my ($self, $mode) = @_;
    549 
    550 	if ($self->{select} eq $mode) {
    551 		$self->{select} = '';
    552 	} else {
    553 		if (not $self->{select}) {
    554 			($self->{ar}, $self->{ac}) = $self->screen_cur();
    555 		}
    556 		$self->{select} = $mode;
    557 	}
    558 
    559 	status_area($self);
    560 	$self->want_refresh();
    561 
    562 	()
    563 }
    564 
    565 
    566 sub calc_span {
    567 	my ($self) = @_;
    568 	my ($cr, $cc) = $self->screen_cur();
    569 	my ($br, $bc, $er, $ec);
    570 	
    571 	if ($self->{select} eq 'b') {
    572 		$br = $self->line($cr)->beg;
    573 		$bc = $self->line($cr)->offset_of($cr, $cc);
    574 		$er = $self->line($self->{ar})->beg;
    575 		$ec = $self->line($self->{ar})->offset_of($self->{ar}, $self->{ac});
    576 		($br, $er) = ($er, $br) if $br > $er;
    577 		($bc, $ec) = ($ec, $bc) if $bc > $ec;
    578 	} else {
    579 		if ($cr < $self->{ar}) {
    580 			($br, $bc, $er, $ec) = ($cr, $cc, $self->{ar}, $self->{ac});
    581 		} elsif ($cr > $self->{ar}) {
    582 			($br, $bc, $er, $ec) = ($self->{ar}, $self->{ac}, $cr, $cc);
    583 		} else {
    584 			($br, $er) = ($cr, $cr);
    585 			($bc, $ec) = $cc < $self->{ac} ? ($cc, $self->{ac}) : ($self->{ac}, $cc);
    586 		}
    587 	}
    588 
    589 	if ($self->{select} eq 'l') {
    590 		($br, $er) = ($self->line($br)->beg, $self->line($er)->end);
    591 		($bc, $ec) = (0, $self->ncol);
    592 	} else {
    593 		++$ec;
    594 	}
    595 
    596 	return ($br, $bc, $er, $ec);
    597 }