mark-and-yank

   1 #! perl
   2 # ------------------------------------------------------------------------
   3 # Author: Bart Trojanowski <bart@jukie.net>
   4 #
   5 # This script intends to provide functionality similar to screen's
   6 # copy-mode, but instead copy to the X clipboard.  In order to copy to
   7 # the clipboard we need either the Clipboard.pm from CPAN or the xclip
   8 # command line utility.
   9 #
  10 # More details here: http://www.jukie.net/~bart/blog/tag/urxvt
  11 #
  12 # This script is based on the mark-urls script from the rxvt-unicode
  13 # distribution.
  14 #
  15 # ------------------------------------------------------------------------
  16 # configuration
  17 #
  18 # Put this in your .Xdefaults
  19 #
  20 # URxvt.keysym.M-y: perl:mark-and-yank:activate_mark_mode
  21 # URxvt.keysym.M-u: perl:mark-and-yank:activate_mark_url_mode
  22 # URxvt.perl-lib: /home/jukie/bart/.urxvt/
  23 # URxvt.perl-ext: mark-and-yank
  24 # URxvt.urlLauncher: firefox
  25 #
  26 # you might have to edit the perl-lib line.
  27 #
  28 # ------------------------------------------------------------------------
  29
  30 use List::Util qw(first max maxstr min minstr reduce shuffle sum);
  31
  32
  33 # same url as used in "selection"
  34 my $url_matcher =
  35    qr{(
  36       (?:https?://|ftp://|news://|mailto:|file://)[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~#]+
  37       [ab-zA-Z0-9\-\@;\/?:&=%\$_+!*\x27()~]   # exclude some trailing characters (heuristic)
  38    )}x;
  39
  40 sub canonicalise_coordinates {
  41     if ($_[0] > $_[2] || ($_[0] == $_[2] && $_[1] > $_[3])) {
  42         (@_[2,3],@_[0,1])
  43     } else {
  44         (@_);
  45     }
  46 }
  47
  48 sub clamp { min( max( $_[0], $_[1] ), $_[2] ) }
  49
  50 sub on_start {
  51     my ($term) = @_;
  52
  53     $term->{have_Clipboard} = eval { require Clipboard; };
  54     if ($term->{have_Clipboard}) {
  55         import Clipboard;
  56     }
  57
  58     $term->{browser} = $term->x_resource ("urlLauncher") || "x-www-browser";
  59
  60     ()
  61 }
  62
  63 sub open_url {
  64     my ($term, $url) = @_;
  65
  66     $term->exec_async (split(/[[:blank:]]/, $term->{browser}), $url);
  67 }
  68
  69 sub on_line_update {
  70     my ($term, $row) = @_;
  71
  72     return unless ($term->x_resource ("underlineURLs") eq "true");
  73
  74     # fetch the line that has changed
  75     my $line = $term->line ($row);
  76     my $text = $line->t;
  77
  78     # find all urls (if any)
  79     while ($text =~ /$url_matcher/g) {
  80         my $rend = $line->r;
  81
  82         # mark all characters as underlined. we _must_ not toggle underline,
  83         # as we might get called on an already-marked url.
  84         $_ |= urxvt::RS_Uline
  85         for @{$rend}[ $-[1] .. $+[1] - 1];
  86
  87         $line->r ($rend);
  88     }
  89
  90     ()
  91 }
  92
  93 sub on_button_release {
  94     my ($term, $event) = @_;
  95
  96     my $mask = $term->ModLevel3Mask | $term->ModMetaMask
  97     | urxvt::ShiftMask | urxvt::ControlMask;
  98
  99     if ($event->{button} == 2 && ($event->{state} & $mask) == 0) {
 100         my $row = $event->{row};
 101         my $col = $event->{col};
 102
 103         my $line = $term->line ($row);
 104         my $text = $line->t;
 105
 106         while ($text =~ /$url_matcher/g) {
 107             if ($-[1] <= $col && $+[1] >= $col) {
 108                 open_url($term, $1);
 109                 return 1;
 110             }
 111         }
 112     }
 113
 114     ()
 115 }
 116
 117 # ------------------------------------------------------------------------
 118
 119 my %key2mod = (
 120     65505 => urxvt::ShiftMask,
 121     65507 => urxvt::ControlMask,
 122     65513 => urxvt::Mod1Mask,   # Alt
 123     65514 => urxvt::Mod1Mask,   # Alt
 124     65515 => urxvt::Mod4Mask,   # Super
 125     65516 => urxvt::Mod4Mask,   # Super
 126 );
 127 my $mod = 0;
 128
 129 #my %mod = ( 'control' => 0, 'shift' => 0 );
 130
 131 my $mark_mode_active = 0;
 132 my @backup_cursor = ();
 133 my @visual_start = ();
 134 my $visual_mode = 0;        # 'v', 'V', or '^v'
 135 my @cursor = ();
 136 my $url_selected = -1;
 137 my @url_db = ();
 138 my $first_mark_set = 0;
 139 my $msg_timeout = 2;
 140
 141 # ------------------------------------------------------------------------
 142
 143 sub do_scan_for_urls {
 144     my ($term) = @_;
 145
 146     @url_db = ();
 147
 148     my $row_start = $term->top_row;
 149     my $row_end = $term->nrow;
 150
 151     for (my $row=$row_start; $row<=$row_end; $row++) {
 152
 153         # fetch the line that has changed
 154         my $line = $term->line ($row);
 155         my $text = $line->t;
 156
 157         # find all urls (if any)
 158         while ($text =~ /$url_matcher/g) {
 159             my $url = $1;
 160
 161             my %h = ( 'row'      => $row,
 162                       'col_from' => $-[1],
 163                       'col_to'   => $+[1] - 1,
 164                       'url'      => $url);
 165             push @url_db, \%h;
 166         }
 167     }
 168
 169     # 0 for none, positive count otherwise
 170     return $#url_db + 1;
 171 }
 172
 173 sub status_message {
 174    my ($self, $text, $timeout) = @_;
 175    $timeout = $msg_timeout unless defined $timeout;
 176    $self->{msg} = {
 177       ov => $self->overlay (0, -1, length($text)+1, 1, urxvt::OVERLAY_RSTYLE, 1),
 178       to => urxvt::timer
 179         ->new
 180         ->start (urxvt::NOW + $timeout)
 181         ->cb (sub {
 182                 delete $self->{msg};
 183               }),
 184    };
 185    $self->{msg}{ov}->set(0,0,$text);
 186 }
 187
 188 sub on_user_command {
 189     my ($term, $cmd) = @_;
 190
 191     if ($cmd eq "mark-and-yank:activate_mark_mode") {
 192         activate_mark_mode($term);
 193
 194     } elsif ($cmd eq "mark-and-yank:activate_mark_url_mode") {
 195         activate_mark_url_mode($term);
 196     }
 197
 198     status_message ($term, "urxvt copy mode started");
 199
 200     ()
 201 }
 202
 203 # ------------------------------------------------------------------------
 204
 205 sub on_key_press {
 206     my ($term, $event, $keysym, $octets) = @_;
 207
 208     foreach my $key (keys %key2mod) {
 209         if ($keysym == $key) {
 210             $mod |= $key2mod{$key};
 211             return ();
 212         }
 213     }
 214
 215     # ignore all input when we are active
 216     $mark_mode_active && return 1;
 217
 218     ()
 219 }
 220
 221 sub on_key_release {
 222     my ($term, $event, $keysym) = @_;
 223
 224     foreach my $key (keys %key2mod) {
 225         if ($keysym == $key) {
 226             $mod &= ~$key2mod{$key};
 227             return ();
 228         }
 229     }
 230
 231     return () unless ($mark_mode_active);
 232
 233     my $ch = chr($keysym);
 234
 235     if ($mod & urxvt::ShiftMask && $ch =~ m/[[:alpha:]]/) {
 236         $ch = uc $ch;
 237         $mod &= ~urxvt::ShiftMask;
 238     }
 239
 240     if (!$mod && $keysym == 65307) {                     # <esc>
 241         deactivate_mark_mode ($term);
 242         visual_mode_disable ($term, @cursor);
 243
 244     } elsif (($mod & urxvt::ControlMask) && $ch eq 'c') {# ^c - abort
 245         deactivate_mark_mode ($term);
 246         visual_mode_disable ($term, @cursor);
 247
 248     } elsif (!$mod && $keysym == 65293) {                # <enter>
 249         if ($first_mark_set) {
 250             do_copy($term, @visual_start, @cursor);
 251
 252             deactivate_mark_mode ($term);
 253             visual_mode_disable ($term, @cursor);
 254         } else {
 255             my %url = get_active_url($term);
 256
 257             if (not %url) {
 258                 $first_mark_set = 1;
 259
 260                 visual_mode_enable ($term, 'v', @cursor);
 261             } else {
 262                 my $urltext = $url{url};
 263
 264                 $urltext =~ s/\(["|><&()]\)/\\$1/;
 265                 open_url($term, $urltext);
 266
 267                 deactivate_mark_mode ($term);
 268                 visual_mode_disable ($term, @cursor);
 269             }
 270         }
 271
 272     } elsif (!$mod && $keysym == 32) {                   # <space>
 273         if ($first_mark_set) {
 274             do_copy($term, @visual_start, @cursor);
 275
 276             deactivate_mark_mode ($term);
 277             visual_mode_disable ($term, @cursor);
 278         } else {
 279
 280             $first_mark_set = 1;
 281
 282             visual_mode_enable ($term, 'v', @cursor);
 283         }
 284
 285     } elsif (!$mod && $ch eq 'o') {                      # o - go to other end of region
 286         if ($first_mark_set) {
 287             my @dest = @visual_start;
 288             @visual_start = @cursor;
 289             @cursor = @dest;
 290
 291             $term->screen_cur (@dest);
 292             $term->want_refresh;
 293         }
 294
 295     } elsif (($mod & urxvt::ControlMask) && $ch eq 'w') {# w - copy the word under the cursor
 296         my ($y1, $x1, $y2, $x2) = (@cursor, @cursor);
 297
 298         --$x1 while substr($term->ROW_t($y1), $x1 - 1, 1) =~ m/\w/;
 299         ++$x2 while substr($term->ROW_t($y2), $x2 + 1, 1) =~ m/\w/;
 300
 301         do_copy($term, $y1, $x1, $y2, $x2);
 302
 303         deactivate_mark_mode ($term);
 304         visual_mode_disable ($term, @cursor);
 305
 306     } elsif ($ch eq 'Y') {                               # Y - yank from cursor to EOL
 307         do_copy($term, @cursor, $cursor[0], $term->ROW_l($cursor[0]) - $cursor[0]);
 308
 309         deactivate_mark_mode ($term);
 310         visual_mode_disable ($term, @cursor);
 311
 312     } elsif (!$mod && $ch eq 'y') {                      # y - yank selected
 313         my %url = get_active_url ($term);
 314
 315         do_copy($term, $url{row}, $url{col_from}, $url{row}, $url{col_to}) if %url;
 316
 317         deactivate_mark_mode ($term);
 318         visual_mode_disable ($term, @cursor);
 319
 320     } elsif (($mod & urxvt::ControlMask) && (($ch eq 'n') || ($ch eq 'p'))) {
 321                                                 # ^n and ^p to cycle list
 322         my $dir = ($ch eq 'n') ? 1 : -1;
 323         move_url_highlight ($term, $dir);
 324         visual_mode_disable ($term, @cursor);
 325
 326     } elsif (($mod & urxvt::ControlMask) && (($ch eq 'f') || ($ch eq 'b'))) {
 327                                                 # ^f and ^b to scroll
 328         my $ofs = ($ch eq 'f') ? 1 : -1;
 329         visual_mode_update ($term, \@cursor, [$cursor[0] + $ofs*($term->nrow - 1), $cursor[1]]);
 330
 331     } elsif (!$mod && $ch eq 'h') {                       # left
 332         if ($cursor[1] > 0) {
 333             visual_mode_update ($term, \@cursor, [$cursor[0], $cursor[1] - 1]);
 334         }
 335
 336     } elsif (!$mod && $ch eq 'j') {                  # down
 337         if ($cursor[0] < $term->nrow) {
 338             visual_mode_update ($term, \@cursor, [$cursor[0] + 1, $cursor[1]]);
 339         }
 340
 341     } elsif (!$mod && $ch eq 'k') {                  # up
 342         if ($cursor[0] > $term->top_row) {
 343             visual_mode_update ($term, \@cursor, [$cursor[0] - 1, $cursor[1]]);
 344         }
 345
 346     } elsif (!$mod && $ch eq 'l') {                  # right
 347         if ($cursor[1] < ($term->ncol - 1)) {
 348             visual_mode_update ($term, \@cursor, [$cursor[0], $cursor[1] + 1]);
 349         }
 350
 351     } elsif ($ch eq 'H') {
 352         visual_mode_update ($term, \@cursor, [0, $cursor[1]]);
 353
 354     } elsif ($ch eq 'M') {
 355         visual_mode_update ($term, \@cursor, [$term->nrow / 2, $cursor[1]]);
 356
 357     } elsif ($ch eq 'L') {
 358         visual_mode_update ($term, \@cursor, [$term->nrow, $cursor[1]]);
 359
 360     } elsif ($ch eq '^') {
 361         $term->ROW_t($cursor[0]) =~ m/^\s*/;
 362         visual_mode_update ($term, \@cursor, [$cursor[0], $+[0]]);
 363
 364     } elsif ($ch eq '0') {
 365         visual_mode_update ($term, \@cursor, [$cursor[0], 0]);
 366
 367     } elsif ($ch eq '$') {
 368         visual_mode_update ($term, \@cursor, [$cursor[0], $term->ROW_l($cursor[0]) - 1]);
 369
 370     } elsif ($ch eq 'g') {
 371         visual_mode_update ($term, \@cursor, [$term->top_row, 0]);
 372
 373     } elsif ($ch eq 'G') {
 374         visual_mode_update ($term, \@cursor, [$term->nrow - 1, $term->ROW_l($term->nrow - 1) - 1]);
 375
 376     } elsif ($ch eq 'w') {
 377         my @dest = @cursor;
 378         my $line = $term->ROW_t($dest[0]);
 379         ++$dest[1] while substr($line, $dest[1], 1) =~ m/\w/;
 380         until (substr($line, $dest[1], 1) =~ m/\w/) {
 381             ++$dest[1];
 382             next if $dest[1] <= $term->ROW_l($dest[0]);
 383             ++$dest[0];
 384             return 1 if $dest[0] >= $term->nrow;
 385             $dest[1] = 0;
 386             $line = $term->ROW_t($dest[0]);
 387         }
 388
 389         visual_mode_update ($term, \@cursor, \@dest);
 390
 391     } elsif ($ch eq 'e') {
 392         my @dest = @cursor;
 393         my $line = $term->ROW_t($dest[0]);
 394         ++$dest[1];
 395         ++$dest[1] while substr($line, $dest[1], 1) =~ m/\W/;
 396         until (substr($line, $dest[1], 1) =~ m/\w/) {
 397             ++$dest[1];
 398             next if $dest[1] <= $term->ROW_l($dest[0]);
 399             ++$dest[0];
 400             return 1 if $dest[0] >= $term->nrow;
 401             $dest[1] = 0;
 402             $line = $term->ROW_t($dest[0]);
 403         }
 404         ++$dest[1] while substr($line, $dest[1] + 1, 1) =~ m/\w/;
 405
 406         visual_mode_update ($term, \@cursor, \@dest);
 407
 408     } elsif ($ch eq 'b') {
 409         my @dest = @cursor;
 410         my $line = $term->ROW_t($dest[0]);
 411         # unless at the beginning of a word, jump to the beginning
 412         --$dest[1] while ($dest[1] >= 1 && substr($line, $dest[1] - 1, 1) =~ m/\w/);
 413         if ($dest[1] == $cursor[1]) { # at beginning of a word
 414             # skip non-word characters
 415             until ($dest[1] >= 1 && substr($line, $dest[1] - 1, 1) =~ m/\w/) {
 416                 --$dest[1];
 417                 next if $dest[1] > 0;
 418                 --$dest[0];
 419                 return 1 if $dest[0] < 0;
 420                 $dest[1] = $term->ROW_l($dest[0]);
 421                 $line = $term->ROW_t($dest[0]);
 422             }
 423             --$dest[1] while $dest[1] >= 1 && substr($line, $dest[1] - 1, 1) =~ m/\w/;
 424         }
 425
 426         visual_mode_update ($term, \@cursor, \@dest);
 427
 428     } elsif ($ch eq 'W') {
 429         my @dest = @cursor;
 430         my $line = $term->ROW_t($dest[0]);
 431         ++$dest[1] while substr($line, $dest[1], 1) =~ m/\S/;
 432         until (substr($line, $dest[1], 1) =~ m/\S/) {
 433             ++$dest[1];
 434             next if $dest[1] <= $term->ROW_l($dest[0]);
 435             ++$dest[0];
 436             return 1 if $dest[0] >= $term->nrow;
 437             $dest[1] = 0;
 438             $line = $term->ROW_t($dest[0]);
 439         }
 440
 441         visual_mode_update ($term, \@cursor, \@dest);
 442
 443     } elsif ($ch eq 'E') {
 444         my @dest = @cursor;
 445         my $line = $term->ROW_t($dest[0]);
 446         ++$dest[1];
 447         ++$dest[1] while substr($line, $dest[1], 1) =~ m/\s/;
 448         until (substr($line, $dest[1], 1) =~ m/\S/) {
 449             ++$dest[1];
 450             next if $dest[1] <= $term->ROW_l($dest[0]);
 451             ++$dest[0];
 452             return 1 if $dest[0] >= $term->nrow;
 453             $dest[1] = 0;
 454             $line = $term->ROW_t($dest[0]);
 455         }
 456         ++$dest[1] while substr($line, $dest[1] + 1, 1) =~ m/\S/;
 457
 458         visual_mode_update ($term, \@cursor, \@dest);
 459
 460     } elsif ($ch eq 'B') {
 461         my @dest = @cursor;
 462         my $line = $term->ROW_t($dest[0]);
 463         --$dest[1] while ($dest[1] >= 1 && substr($line, $dest[1] - 1, 1) =~ m/\S/);
 464         until ($dest[1] >= 1 && substr($line, $dest[1] - 1, 1) =~ m/\S/) {
 465             --$dest[1];
 466             next if $dest[1] > 0;
 467             --$dest[0];
 468             return 1 if $dest[0] < 0;
 469             $dest[1] = $term->ROW_l($dest[0]);
 470             $line = $term->ROW_t($dest[0]);
 471         }
 472         --$dest[1] while $dest[1] >= 1 && substr($line, $dest[1] - 1, 1) =~ m/\S/;
 473
 474         visual_mode_update ($term, \@cursor, \@dest);
 475     }
 476
 477     return 1;
 478 }
 479
 480 # ------------------------------------------------------------------------
 481
 482 sub get_active_url {
 483     my ($term) = @_;
 484     my $max = $#url_db + 1;
 485
 486     return if $url_selected < 0 || $url_selected >= $max;
 487     return if not defined $url_db[$url_selected];
 488
 489     return %{$url_db[$url_selected]};
 490 }
 491
 492 sub do_copy {
 493     my $term = shift;
 494
 495     my ($y1, $x1, $y2, $x2) = canonicalise_coordinates(@_);
 496
 497     $term->selection_beg($y1, $x1);
 498     $term->selection_end($y2, 1 + $x2);
 499     $term->selection_make(urxvt::CurrentTime);
 500
 501     my $text = $term->selection();
 502
 503     if ($term->{have_Clipboard}) {
 504         Clipboard->copy($text);
 505     } else {
 506         my $pid = open(XCLIP, "|xclip -i");
 507         print XCLIP $text;
 508         close(XCLIP)
 509     }
 510
 511     status_message ($term, "copied ".length($text)." characters into clipboard");
 512 }
 513
 514 # ------------------------------------------------------------------------
 515
 516 sub move_url_highlight {
 517     my ($term, $dir) = @_;
 518     my $max = $#url_db + 1;
 519
 520     do_highlight ($term, 0);
 521
 522     $url_selected = ($max + $url_selected + $dir) % $max;
 523
 524     do_highlight ($term, 1);
 525
 526     $term->want_refresh;
 527 }
 528
 529 sub do_highlight {
 530     my ($term, $enable) = @_;
 531     my $max = $#url_db + 1;
 532
 533     return if $url_selected < 0 || $url_selected >= $max;
 534     return if not defined $url_db[$url_selected];
 535
 536     my $o = $url_db[$url_selected];
 537     my %h = %$o;
 538
 539     my $row = $h{row};
 540     my $line = $term->line ($row);
 541     my $text = $line->t;
 542     my $rend = $line->r;
 543
 544     if ($enable) {
 545         $_ |= urxvt::RS_RVid
 546         for @{$rend}[ $h{col_from} .. $h{col_to}];
 547
 548         # make it visible
 549         $term->view_start ( $row < 0 ? $row : 0 );
 550
 551     } else {
 552         $_ &= ~urxvt::RS_RVid
 553         for @{$rend}[ $h{col_from} .. $h{col_to}];
 554     }
 555
 556     $line->r ($rend);
 557 }
 558
 559 # ------------------------------------------------------------------------
 560
 561 sub visual_mode_enable {
 562     my ($term, $mode, @cur) = @_;
 563
 564     $visual_mode = $mode;
 565     @visual_start = @cur;
 566 }
 567
 568 sub visual_mode_disable {
 569     my ($term, @cursor) = @_;
 570
 571     if ($visual_mode) {
 572         $term->scr_xor_span(canonicalise_coordinates(@visual_start, @cursor));
 573
 574         $visual_mode = 0;
 575
 576         $term->want_refresh;
 577     }
 578 }
 579
 580 sub visual_mode_update {
 581     my ($term, $oldref, $newref) = @_;
 582     my @old = @$oldref;
 583     my @new = @$newref;
 584
 585     @cursor = @new;
 586
 587     $cursor[0] = clamp $term->top_row, $cursor[0], $term->nrow - 1;
 588
 589     if ($visual_mode eq 'v') {
 590         $term->scr_xor_span(canonicalise_coordinates(@old, @new));
 591     }
 592
 593     $term->screen_cur (@cursor);
 594
 595     $term->view_start (clamp $cursor[0] - $term->nrow + 1,
 596                              $term->view_start,
 597                              min 0, $cursor[0]);
 598
 599     $term->want_refresh;
 600 }
 601
 602 # ------------------------------------------------------------------------
 603
 604 sub activate_mark_mode {
 605     my ($term) = @_;
 606
 607     print "title:     " . ($term->resource("title")) . "\n";
 608     print "name:      " . ($term->resource("name")) . "\n";
 609     print "term_name: " . ($term->resource("term_name")) . "\n";
 610     print "color:     " . ($term->resource("color")) . "\n";
 611
 612     my ($row, $col) = $term->screen_cur;
 613     print "cursor:    $row / $col \n";
 614
 615     $mark_mode_active = 1;
 616     @backup_cursor = @cursor = $term->screen_cur;
 617 }
 618
 619 sub activate_mark_url_mode {
 620     my ($term) = @_;
 621
 622     if ($mark_mode_active) {
 623
 624         move_url_highlight ($term, -1);
 625
 626     } elsif ( do_scan_for_urls ($term) ) {
 627
 628         $term->{save_view_start} = $term->view_start;
 629
 630         move_url_highlight ($term, 0);
 631
 632         if ($url_selected > -1) {
 633             $mark_mode_active = 1;
 634             @backup_cursor = @cursor = $term->screen_cur;
 635         }
 636     }
 637 }
 638
 639 sub deactivate_mark_mode {
 640     my ($term) = @_;
 641
 642     do_highlight ($term, 0);
 643
 644     $mark_mode_active = 0;
 645     $term->screen_cur (@backup_cursor);
 646     $first_mark_set = 0;
 647     $url_selected = -1;
 648
 649     $term->view_start ($term->{save_view_start});
 650     $term->want_refresh;
 651 }
 652
 653 # vim: set et ts=4 sw=4: