ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/urxvt.pm
(Generate patch)

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.47 by root, Sat Jan 7 21:22:02 2006 UTC vs.
Revision 1.59 by root, Mon Jan 9 00:34:36 2006 UTC

37 37
38 @@RXVT_NAME@@ -pe <extensionname> 38 @@RXVT_NAME@@ -pe <extensionname>
39 39
40=over 4 40=over 4
41 41
42=item selection 42=item selection (enabled by default)
43 43
44Intelligent selection. This extension tries to be more intelligent when 44Intelligent selection. This extension tries to be more intelligent when
45the user extends selections (double-click). Right now, it tries to select 45the user extends selections (double-click). Right now, it tries to select
46urls and complete shell-quoted arguments, which is very convenient, too, 46urls and complete shell-quoted arguments, which is very convenient, too,
47if your F<ls> supports C<--quoting-style=shell>. 47if your F<ls> supports C<--quoting-style=shell>.
55Rot-13 the selection when activated. Used via keyboard trigger: 55Rot-13 the selection when activated. Used via keyboard trigger:
56 56
57 URxvt.keysym.C-M-r: perl:selection:rot13 57 URxvt.keysym.C-M-r: perl:selection:rot13
58 58
59=back 59=back
60
61=item option-popup (enabled by default)
62
63Binds a popup menu to Ctrl-Button2 that lets you toggle (some) options at
64runtime.
65
66=item selection-popup (enabled by default)
67
68Binds a popup menu to Ctrl-Button3 that lets you convert the selection
69text into various other formats/action.
60 70
61=item digital-clock 71=item digital-clock
62 72
63Displays a digital clock using the built-in overlay. 73Displays a digital clock using the built-in overlay.
64 74
337 347
338=item urxvt::ShiftMask, LockMask, ControlMask, Mod1Mask, Mod2Mask, 348=item urxvt::ShiftMask, LockMask, ControlMask, Mod1Mask, Mod2Mask,
339Mod3Mask, Mod4Mask, Mod5Mask, Button1Mask, Button2Mask, Button3Mask, 349Mod3Mask, Mod4Mask, Mod5Mask, Button1Mask, Button2Mask, Button3Mask,
340Button4Mask, Button5Mask, AnyModifier 350Button4Mask, Button5Mask, AnyModifier
341 351
342Various constants for use in X events. 352Various constants for use in X calls and event processing.
343 353
344=back 354=back
345 355
346=head2 RENDITION 356=head2 RENDITION
347 357
397 407
398=cut 408=cut
399 409
400package urxvt; 410package urxvt;
401 411
412use utf8;
402use strict; 413use strict;
403use Scalar::Util (); 414use Scalar::Util ();
415use List::Util ();
404 416
417our $VERSION = 1;
405our $TERM; 418our $TERM;
406our @HOOKNAME; 419our @HOOKNAME;
420our %OPTION;
407our $LIBDIR; 421our $LIBDIR;
408 422
409BEGIN { 423BEGIN {
410 urxvt->bootstrap; 424 urxvt->bootstrap;
411 425
414 my $msg = join "", @_; 428 my $msg = join "", @_;
415 $msg .= "\n" 429 $msg .= "\n"
416 unless $msg =~ /\n$/; 430 unless $msg =~ /\n$/;
417 urxvt::warn ($msg); 431 urxvt::warn ($msg);
418 }; 432 };
433
434 $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin:/opt/bin:/opt/sbin";
435 delete $ENV{CDPATH};
419} 436}
420 437
421my @hook_count; 438my @hook_count;
422my $verbosity = $ENV{URXVT_PERL_VERBOSITY}; 439my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
423 440
456 verbose 3, "loading extension '$path' into package '$pkg'"; 473 verbose 3, "loading extension '$path' into package '$pkg'";
457 474
458 open my $fh, "<:raw", $path 475 open my $fh, "<:raw", $path
459 or die "$path: $!"; 476 or die "$path: $!";
460 477
461 my $source = "package $pkg; use strict; use utf8;\n" 478 my $source = untaint "package $pkg; use strict; use utf8;\n"
462 . "use base urxvt::term::proxy::;\n" 479 . "use base urxvt::term::proxy::;\n"
463 . "#line 1 \"$path\"\n{\n" 480 . "#line 1 \"$path\"\n{\n"
464 . (do { local $/; <$fh> }) 481 . (do { local $/; <$fh> })
465 . "\n};\n1"; 482 . "\n};\n1";
466 483
477 local $TERM = shift; 494 local $TERM = shift;
478 my $htype = shift; 495 my $htype = shift;
479 496
480 if ($htype == 0) { # INIT 497 if ($htype == 0) { # INIT
481 my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl"); 498 my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl");
499
500 my %want_ext;
482 501
483 for my $ext (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) { 502 for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {
503 if ($_ eq "default") {
504 $want_ext{$_}++ for qw(selection option-popup selection-popup);
505 } elsif (/^-(.*)$/) {
506 delete $want_ext{$1};
507 } else {
508 $want_ext{$_}++;
509 }
510 }
511
512 for my $ext (keys %want_ext) {
484 my @files = grep -f $_, map "$_/$ext", @dirs; 513 my @files = grep -f $_, map "$_/$ext", @dirs;
485 514
486 if (@files) { 515 if (@files) {
487 register_package extension_package $files[0]; 516 register_package extension_package $files[0];
488 } else { 517 } else {
489 warn "perl extension '$ext' not found in perl library search path\n"; 518 warn "perl extension '$ext' not found in perl library search path\n";
490 } 519 }
491 } 520 }
521
522 eval "#line 1 \"--perl-eval resource/argument\"\n" . $TERM->resource ("perl_eval");
523 warn $@ if $@;
492 } 524 }
493 525
494 $retval = undef; 526 $retval = undef;
495 527
496 if (my $cb = $TERM->{_hook}[$htype]) { 528 if (my $cb = $TERM->{_hook}[$htype]) {
508 $proxy 540 $proxy
509 }, 541 },
510 @_, 542 @_,
511 ) and last; 543 ) and last;
512 }; 544 };
513 warn $@ if $@;#d# 545 if ($@) {
546 $TERM->ungrab; # better to lose the grab than the session
547 warn $@;
548 }
514 } 549 }
515 } 550 }
516 551
517 if ($htype == 1) { # DESTROY 552 if ($htype == 1) { # DESTROY
518 # remove hooks if unused 553 # remove hooks if unused
531 } 566 }
532 567
533 $retval 568 $retval
534} 569}
535 570
571# urxvt::term::proxy
572
536sub urxvt::term::proxy::AUTOLOAD { 573sub urxvt::term::proxy::AUTOLOAD {
537 $urxvt::term::proxy::AUTOLOAD =~ /:([^:]+)$/ 574 $urxvt::term::proxy::AUTOLOAD =~ /:([^:]+)$/
538 or die "FATAL: \$AUTOLOAD '$urxvt::term::proxy::AUTOLOAD' unparsable"; 575 or die "FATAL: \$AUTOLOAD '$urxvt::term::proxy::AUTOLOAD' unparsable";
539 576
540 eval qq{ 577 eval qq{
546 } or die "FATAL: unable to compile method forwarder: $@"; 583 } or die "FATAL: unable to compile method forwarder: $@";
547 584
548 goto &$urxvt::term::proxy::AUTOLOAD; 585 goto &$urxvt::term::proxy::AUTOLOAD;
549} 586}
550 587
588sub urxvt::term::proxy::DESTROY {
589 # nop
590}
591
592# urxvt::destroy_hook
593
551sub urxvt::destroy_hook::DESTROY { 594sub urxvt::destroy_hook::DESTROY {
552 ${$_[0]}->(); 595 ${$_[0]}->();
553} 596}
554 597
555sub urxvt::destroy_hook(&) { 598sub urxvt::destroy_hook(&) {
556 bless \shift, urxvt::destroy_hook:: 599 bless \shift, urxvt::destroy_hook::
557} 600}
558 601
602package urxvt::anyevent;
603
604=head2 The C<urxvt::anyevent> Class
605
606The sole purpose of this class is to deliver an interface to the
607C<AnyEvent> module - any module using it will work inside urxvt without
608further work. The only exception is that you cannot wait on condition
609variables, but non-blocking condvar use is ok. What this means is that you
610cannot use blocking APIs, but the non-blocking variant should work.
611
612=cut
613
614our $VERSION = 1;
615
616$INC{"urxvt/anyevent.pm"} = 1; # mark us as there
617push @AnyEvent::REGISTRY, [urxvt => urxvt::anyevent::];
618
619sub timer {
620 my ($class, %arg) = @_;
621
622 my $cb = $arg{cb};
623
624 urxvt::timer
625 ->new
626 ->start (urxvt::NOW + $arg{after})
627 ->cb (sub {
628 $_[0]->stop; # need to cancel manually
629 $cb->();
630 })
631}
632
633sub io {
634 my ($class, %arg) = @_;
635
636 my $cb = $arg{cb};
637
638 bless [$arg{fh}, urxvt::iow
639 ->new
640 ->fd (fileno $arg{fh})
641 ->events (($arg{poll} =~ /r/ ? 1 : 0)
642 | ($arg{poll} =~ /w/ ? 2 : 0))
643 ->start
644 ->cb (sub {
645 $cb->(($_[1] & 1 ? 'r' : '')
646 . ($_[1] & 2 ? 'w' : ''));
647 })],
648 urxvt::anyevent::
649}
650
651sub DESTROY {
652 $_[0][1]->stop;
653}
654
655sub condvar {
656 bless \my $flag, urxvt::anyevent::condvar::
657}
658
659sub urxvt::anyevent::condvar::broadcast {
660 ${$_[0]}++;
661}
662
663sub urxvt::anyevent::condvar::wait {
664 unless (${$_[0]}) {
665 require Carp;
666 Carp::croak ("AnyEvent->condvar blocking wait unsupported in urxvt, use a non-blocking API");
667 }
668}
669
670package urxvt::term;
671
559=head2 The C<urxvt::term> Class 672=head2 The C<urxvt::term> Class
560 673
561=over 4 674=over 4
562 675
563=item $term->destroy 676=item $term->destroy
564 677
565Destroy the terminal object (close the window, free resources etc.). 678Destroy the terminal object (close the window, free resources etc.).
679
680=item $isset = $term->option ($optval[, $set])
681
682Returns true if the option specified by C<$optval> is enabled, and
683optionally change it. All option values are stored by name in the hash
684C<%urxvt::OPTION>. Options not enabled in this binary are not in the hash.
685
686Here is a a likely non-exhaustive list of option names, please see the
687source file F</src/optinc.h> to see the actual list:
688
689 borderLess console cursorBlink cursorUnderline hold iconic insecure
690 intensityStyles jumpScroll loginShell mapAlert meta8 mouseWheelScrollPage
691 pastableTabs pointerBlank reverseVideo scrollBar scrollBar_floating
692 scrollBar_right scrollTtyKeypress scrollTtyOutput scrollWithBuffer
693 secondaryScreen secondaryScroll skipBuiltinGlyphs transparent
694 tripleclickwords utmpInhibit visualBell
566 695
567=item $value = $term->resource ($name[, $newval]) 696=item $value = $term->resource ($name[, $newval])
568 697
569Returns the current resource value associated with a given name and 698Returns the current resource value associated with a given name and
570optionally sets a new value. Setting values is most useful in the C<init> 699optionally sets a new value. Setting values is most useful in the C<init>
580 709
581Please note that resource strings will currently only be freed when the 710Please note that resource strings will currently only be freed when the
582terminal is destroyed, so changing options frequently will eat memory. 711terminal is destroyed, so changing options frequently will eat memory.
583 712
584Here is a a likely non-exhaustive list of resource names, not all of which 713Here is a a likely non-exhaustive list of resource names, not all of which
585are supported in every build, please see the source to see the actual 714are supported in every build, please see the source file F</src/rsinc.h>
586list: 715to see the actual list:
587 716
588 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont 717 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont
589 borderLess color cursorBlink cursorUnderline cutchars delete_key 718 borderLess color cursorBlink cursorUnderline cutchars delete_key
590 display_name embed ext_bwidth fade font geometry hold iconName 719 display_name embed ext_bwidth fade font geometry hold iconName
591 imFont imLocale inputMethod insecure int_bwidth intensityStyles 720 imFont imLocale inputMethod insecure int_bwidth intensityStyles
598 shade term_name title transparent transparent_all tripleclickwords 727 shade term_name title transparent transparent_all tripleclickwords
599 utmpInhibit visualBell 728 utmpInhibit visualBell
600 729
601=cut 730=cut
602 731
603sub urxvt::term::resource($$;$) { 732sub resource($$;$) {
604 my ($self, $name) = (shift, shift); 733 my ($self, $name) = (shift, shift);
605 unshift @_, $self, $name, ($name =~ s/\s*\+\s*(\d+)$// ? $1 : 0); 734 unshift @_, $self, $name, ($name =~ s/\s*\+\s*(\d+)$// ? $1 : 0);
606 &urxvt::term::_resource 735 &urxvt::term::_resource
607} 736}
608 737
695C<$event> I<must> be the event causing the menu to pop up (a button event, 824C<$event> I<must> be the event causing the menu to pop up (a button event,
696currently). 825currently).
697 826
698=cut 827=cut
699 828
700sub urxvt::term::popup { 829sub popup {
701 my ($self, $event) = @_; 830 my ($self, $event) = @_;
702 831
703 $self->grab ($event->{time}, 1) 832 $self->grab ($event->{time}, 1)
704 or return; 833 or return;
705 834
895 1024
896=back 1025=back
897 1026
898=cut 1027=cut
899 1028
900sub urxvt::term::line { 1029sub line {
901 my ($self, $row) = @_; 1030 my ($self, $row) = @_;
902 1031
903 my $maxrow = $self->nrow - 1; 1032 my $maxrow = $self->nrow - 1;
904 1033
905 my ($beg, $end) = ($row, $row); 1034 my ($beg, $end) = ($row, $row);
983Converts rxvt-unicodes text reprsentation into a perl string. See 1112Converts rxvt-unicodes text reprsentation into a perl string. See
984C<< $term->ROW_t >> for details. 1113C<< $term->ROW_t >> for details.
985 1114
986=back 1115=back
987 1116
1117=cut
1118
1119package urxvt::popup;
1120
988=head2 The C<urxvt::popup> Class 1121=head2 The C<urxvt::popup> Class
989 1122
990=over 4 1123=over 4
991 1124
992=cut 1125=cut
993
994package urxvt::popup;
995 1126
996sub add_item { 1127sub add_item {
997 my ($self, $item) = @_; 1128 my ($self, $item) = @_;
998 1129
1130 $item->{rend}{normal} = "\x1b[0;30;47m" unless exists $item->{rend}{normal};
1131 $item->{rend}{hover} = "\x1b[0;30;46m" unless exists $item->{rend}{hover};
1132 $item->{rend}{active} = "\x1b[m" unless exists $item->{rend}{active};
1133
1134 $item->{render} ||= sub { $_[0]{text} };
1135
999 push @{ $self->{item} }, $item; 1136 push @{ $self->{item} }, $item;
1137}
1138
1139sub add_separator {
1140 my ($self, $sep) = @_;
1141
1142 $sep ||= "═";
1143
1144 $self->add_item ({
1145 rend => { normal => "\x1b[0;30;47m", hover => "\x1b[0;30;47m", active => "\x1b[0;30;47m" },
1146 text => "",
1147 render => sub { $sep x $urxvt::TERM->ncol },
1148 activate => sub { },
1149 });
1150}
1151
1152sub add_title {
1153 my ($self, $title) = @_;
1154
1155 $self->add_item ({
1156 rend => { normal => "\x1b[38;5;11;44m", hover => "\x1b[38;5;11;44m", active => "\x1b[38;5;11;44m" },
1157 text => $title,
1158 activate => sub { },
1159 });
1000} 1160}
1001 1161
1002sub add_button { 1162sub add_button {
1003 my ($self, $text, $cb) = @_; 1163 my ($self, $text, $cb) = @_;
1004 1164
1005 $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb }); 1165 $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb});
1166}
1167
1168sub add_toggle {
1169 my ($self, $text, $cb, $value) = @_;
1170
1171 my $item; $item = {
1172 type => "button",
1173 text => " $text",
1174 value => $value,
1175 render => sub { ($_[0]{value} ? "* " : " ") . $text },
1176 activate => sub { $cb->($_[0]{value} = !$_[0]{value}); },
1177 };
1178
1179 $self->add_item ($item);
1006} 1180}
1007 1181
1008sub show { 1182sub show {
1009 my ($self) = @_; 1183 my ($self) = @_;
1010 1184
1017} 1191}
1018 1192
1019sub DESTROY { 1193sub DESTROY {
1020 my ($self) = @_; 1194 my ($self) = @_;
1021 1195
1196 delete $self->{term}{_destroy}{$self};
1022 $self->{term}->ungrab; 1197 $self->{term}->ungrab;
1023} 1198}
1024 1199
1025=head2 The C<urxvt::timer> Class 1200=head2 The C<urxvt::timer> Class
1026 1201
1130This variable controls the verbosity level of the perl extension. Higher 1305This variable controls the verbosity level of the perl extension. Higher
1131numbers indicate more verbose output. 1306numbers indicate more verbose output.
1132 1307
1133=over 4 1308=over 4
1134 1309
1135=item =0 - only fatal messages 1310=item == 0 - fatal messages
1136 1311
1137=item =3 - script loading and management 1312=item >= 3 - script loading and management
1138 1313
1139=item =10 - all events received 1314=item >=10 - all events received
1140 1315
1141=back 1316=back
1142 1317
1143=head1 AUTHOR 1318=head1 AUTHOR
1144 1319

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines