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.49 by root, Sun Jan 8 00:07:18 2006 UTC vs.
Revision 1.58 by root, Sun Jan 8 22:58:13 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-Button3 that lets you toggle (some) options at
64runtime.
60 65
61=item digital-clock 66=item digital-clock
62 67
63Displays a digital clock using the built-in overlay. 68Displays a digital clock using the built-in overlay.
64 69
… …
337 342
338=item urxvt::ShiftMask, LockMask, ControlMask, Mod1Mask, Mod2Mask, 343=item urxvt::ShiftMask, LockMask, ControlMask, Mod1Mask, Mod2Mask,
339Mod3Mask, Mod4Mask, Mod5Mask, Button1Mask, Button2Mask, Button3Mask, 344Mod3Mask, Mod4Mask, Mod5Mask, Button1Mask, Button2Mask, Button3Mask,
340Button4Mask, Button5Mask, AnyModifier 345Button4Mask, Button5Mask, AnyModifier
341 346
342Various constants for use in X events. 347Various constants for use in X calls and event processing.
343 348
344=back 349=back
345 350
346=head2 RENDITION 351=head2 RENDITION
347 352
… …
402use utf8; 407use utf8;
403use strict; 408use strict;
404use Scalar::Util (); 409use Scalar::Util ();
405use List::Util (); 410use List::Util ();
406 411
412our $VERSION = 1;
407our $TERM; 413our $TERM;
408our @HOOKNAME; 414our @HOOKNAME;
409our %OPTION; 415our %OPTION;
410our $LIBDIR; 416our $LIBDIR;
411 417
… …
465 . "use base urxvt::term::proxy::;\n" 471 . "use base urxvt::term::proxy::;\n"
466 . "#line 1 \"$path\"\n{\n" 472 . "#line 1 \"$path\"\n{\n"
467 . (do { local $/; <$fh> }) 473 . (do { local $/; <$fh> })
468 . "\n};\n1"; 474 . "\n};\n1";
469 475
476 $source =~ /(.*)/s and $source = $1; # untaint
477
470 eval $source or die "$path: $@"; 478 eval $source or die "$path: $@";
471 479
472 $pkg 480 $pkg
473 } 481 }
474} 482}
… …
481 my $htype = shift; 489 my $htype = shift;
482 490
483 if ($htype == 0) { # INIT 491 if ($htype == 0) { # INIT
484 my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl"); 492 my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl");
485 493
494 my %want_ext;
495
486 my @ext = (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2); 496 for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {
487
488 while (@ext) {
489 my $ext = shift @ext;
490 if ($ext eq "default") { 497 if ($_ eq "default") {
491 unshift @ext, qw(selection); 498 $want_ext{$_}++ for qw(selection option-popup);
499 } elsif (/^-(.*)$/) {
500 delete $want_ext{$1};
492 } else { 501 } else {
493 my @files = grep -f $_, map "$_/$ext", @dirs; 502 $want_ext{$_}++;
494
495 if (@files) {
496 register_package extension_package $files[0];
497 } else {
498 warn "perl extension '$ext' not found in perl library search path\n";
499 }
500 } 503 }
501 } 504 }
505
506 for my $ext (keys %want_ext) {
507 my @files = grep -f $_, map "$_/$ext", @dirs;
508
509 if (@files) {
510 register_package extension_package $files[0];
511 } else {
512 warn "perl extension '$ext' not found in perl library search path\n";
513 }
514 }
515
516 eval "#line 1 \"--perl-eval resource/argument\"\n" . $TERM->resource ("perl_eval");
517 warn $@ if $@;
502 } 518 }
503 519
504 $retval = undef; 520 $retval = undef;
505 521
506 if (my $cb = $TERM->{_hook}[$htype]) { 522 if (my $cb = $TERM->{_hook}[$htype]) {
… …
518 $proxy 534 $proxy
519 }, 535 },
520 @_, 536 @_,
521 ) and last; 537 ) and last;
522 }; 538 };
523 warn $@ if $@;#d# 539 if ($@) {
540 $TERM->ungrab; # better to lose the grab than the session
541 warn $@;
542 }
524 } 543 }
525 } 544 }
526 545
527 if ($htype == 1) { # DESTROY 546 if ($htype == 1) { # DESTROY
528 # remove hooks if unused 547 # remove hooks if unused
… …
541 } 560 }
542 561
543 $retval 562 $retval
544} 563}
545 564
565# urxvt::term::proxy
566
546sub urxvt::term::proxy::AUTOLOAD { 567sub urxvt::term::proxy::AUTOLOAD {
547 $urxvt::term::proxy::AUTOLOAD =~ /:([^:]+)$/ 568 $urxvt::term::proxy::AUTOLOAD =~ /:([^:]+)$/
548 or die "FATAL: \$AUTOLOAD '$urxvt::term::proxy::AUTOLOAD' unparsable"; 569 or die "FATAL: \$AUTOLOAD '$urxvt::term::proxy::AUTOLOAD' unparsable";
549 570
550 eval qq{ 571 eval qq{
… …
556 } or die "FATAL: unable to compile method forwarder: $@"; 577 } or die "FATAL: unable to compile method forwarder: $@";
557 578
558 goto &$urxvt::term::proxy::AUTOLOAD; 579 goto &$urxvt::term::proxy::AUTOLOAD;
559} 580}
560 581
582sub urxvt::term::proxy::DESTROY {
583 # nop
584}
585
586# urxvt::destroy_hook
587
561sub urxvt::destroy_hook::DESTROY { 588sub urxvt::destroy_hook::DESTROY {
562 ${$_[0]}->(); 589 ${$_[0]}->();
563} 590}
564 591
565sub urxvt::destroy_hook(&) { 592sub urxvt::destroy_hook(&) {
566 bless \shift, urxvt::destroy_hook:: 593 bless \shift, urxvt::destroy_hook::
567} 594}
595
596package urxvt::anyevent;
597
598=head2 The C<urxvt::anyevent> Class
599
600The sole purpose of this class is to deliver an interface to the
601C<AnyEvent> module - any module using it will work inside urxvt without
602further work. The only exception is that you cannot wait on condition
603variables, but non-blocking condvar use is ok. What this means is that you
604cannot use blocking APIs, but the non-blocking variant should work.
605
606=cut
607
608our $VERSION = 1;
609
610$INC{"urxvt/anyevent.pm"} = 1; # mark us as there
611push @AnyEvent::REGISTRY, [urxvt => urxvt::anyevent::];
612
613sub timer {
614 my ($class, %arg) = @_;
615
616 my $cb = $arg{cb};
617
618 urxvt::timer
619 ->new
620 ->start (urxvt::NOW + $arg{after})
621 ->cb (sub {
622 $_[0]->stop; # need to cancel manually
623 $cb->();
624 })
625}
626
627sub io {
628 my ($class, %arg) = @_;
629
630 my $cb = $arg{cb};
631
632 bless [$arg{fh}, urxvt::iow
633 ->new
634 ->fd (fileno $arg{fh})
635 ->events (($arg{poll} =~ /r/ ? 1 : 0)
636 | ($arg{poll} =~ /w/ ? 2 : 0))
637 ->start
638 ->cb (sub {
639 $cb->(($_[1] & 1 ? 'r' : '')
640 . ($_[1] & 2 ? 'w' : ''));
641 })],
642 urxvt::anyevent::
643}
644
645sub DESTROY {
646 $_[0][1]->stop;
647}
648
649sub condvar {
650 bless \my $flag, urxvt::anyevent::condvar::
651}
652
653sub urxvt::anyevent::condvar::broadcast {
654 ${$_[0]}++;
655}
656
657sub urxvt::anyevent::condvar::wait {
658 unless (${$_[0]}) {
659 require Carp;
660 Carp::croak ("AnyEvent->condvar blocking wait unsupported in urxvt, use a non-blocking API");
661 }
662}
663
664package urxvt::term;
568 665
569=head2 The C<urxvt::term> Class 666=head2 The C<urxvt::term> Class
570 667
571=over 4 668=over 4
572 669
… …
624 shade term_name title transparent transparent_all tripleclickwords 721 shade term_name title transparent transparent_all tripleclickwords
625 utmpInhibit visualBell 722 utmpInhibit visualBell
626 723
627=cut 724=cut
628 725
629sub urxvt::term::resource($$;$) { 726sub resource($$;$) {
630 my ($self, $name) = (shift, shift); 727 my ($self, $name) = (shift, shift);
631 unshift @_, $self, $name, ($name =~ s/\s*\+\s*(\d+)$// ? $1 : 0); 728 unshift @_, $self, $name, ($name =~ s/\s*\+\s*(\d+)$// ? $1 : 0);
632 &urxvt::term::_resource 729 &urxvt::term::_resource
633} 730}
634 731
… …
721C<$event> I<must> be the event causing the menu to pop up (a button event, 818C<$event> I<must> be the event causing the menu to pop up (a button event,
722currently). 819currently).
723 820
724=cut 821=cut
725 822
726sub urxvt::term::popup { 823sub popup {
727 my ($self, $event) = @_; 824 my ($self, $event) = @_;
728 825
729 $self->grab ($event->{time}, 1) 826 $self->grab ($event->{time}, 1)
730 or return; 827 or return;
731 828
… …
921 1018
922=back 1019=back
923 1020
924=cut 1021=cut
925 1022
926sub urxvt::term::line { 1023sub line {
927 my ($self, $row) = @_; 1024 my ($self, $row) = @_;
928 1025
929 my $maxrow = $self->nrow - 1; 1026 my $maxrow = $self->nrow - 1;
930 1027
931 my ($beg, $end) = ($row, $row); 1028 my ($beg, $end) = ($row, $row);
… …
1009Converts rxvt-unicodes text reprsentation into a perl string. See 1106Converts rxvt-unicodes text reprsentation into a perl string. See
1010C<< $term->ROW_t >> for details. 1107C<< $term->ROW_t >> for details.
1011 1108
1012=back 1109=back
1013 1110
1111=cut
1112
1113package urxvt::popup;
1114
1014=head2 The C<urxvt::popup> Class 1115=head2 The C<urxvt::popup> Class
1015 1116
1016=over 4 1117=over 4
1017 1118
1018=cut 1119=cut
1019
1020package urxvt::popup;
1021 1120
1022sub add_item { 1121sub add_item {
1023 my ($self, $item) = @_; 1122 my ($self, $item) = @_;
1024 1123
1124 $item->{rend}{normal} = "\x1b[0;30;47m" unless exists $item->{rend}{normal};
1125 $item->{rend}{hover} = "\x1b[0;30;46m" unless exists $item->{rend}{hover};
1126 $item->{rend}{active} = "\x1b[m" unless exists $item->{rend}{active};
1127
1128 $item->{render} ||= sub { $_[0]{text} };
1129
1025 push @{ $self->{item} }, $item; 1130 push @{ $self->{item} }, $item;
1131}
1132
1133sub add_separator {
1134 my ($self, $sep) = @_;
1135
1136 $sep ||= "═";
1137
1138 $self->add_item ({
1139 rend => { normal => "\x1b[0;30;47m", hover => "\x1b[0;30;47m", active => "\x1b[0;30;47m" },
1140 text => "",
1141 render => sub { $sep x $urxvt::TERM->ncol },
1142 activate => sub { },
1143 });
1144}
1145
1146sub add_title {
1147 my ($self, $title) = @_;
1148
1149 $self->add_item ({
1150 rend => { normal => "\x1b[38;5;11;44m", hover => "\x1b[38;5;11;44m", active => "\x1b[38;5;11;44m" },
1151 text => $title,
1152 activate => sub { },
1153 });
1026} 1154}
1027 1155
1028sub add_button { 1156sub add_button {
1029 my ($self, $text, $cb) = @_; 1157 my ($self, $text, $cb) = @_;
1030 1158
1031 $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb, 1159 $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb});
1032 render => sub { $_[0]{text} },
1033 });
1034} 1160}
1035 1161
1036sub add_toggle { 1162sub add_toggle {
1037 my ($self, $text, $cb, $value) = @_; 1163 my ($self, $text, $cb, $value) = @_;
1038 1164
1039 my $item; $item = { 1165 my $item; $item = {
1040 type => "button", 1166 type => "button",
1041 text => " $text", 1167 text => " $text",
1042 value => $value, 1168 value => $value,
1043 render => sub { ($item->{value} ? "✔" : " ") . $text }, 1169 render => sub { ($_[0]{value} ? "* " : " ") . $text },
1044 activate => sub { $cb->($item->{value} = !$item->{value}); }, 1170 activate => sub { $cb->($_[0]{value} = !$_[0]{value}); },
1045 }; 1171 };
1046 1172
1047 $self->add_item ($item); 1173 $self->add_item ($item);
1048} 1174}
1049 1175
… …
1059} 1185}
1060 1186
1061sub DESTROY { 1187sub DESTROY {
1062 my ($self) = @_; 1188 my ($self) = @_;
1063 1189
1190 delete $self->{term}{_destroy}{$self};
1064 $self->{term}->ungrab; 1191 $self->{term}->ungrab;
1065} 1192}
1066 1193
1067=head2 The C<urxvt::timer> Class 1194=head2 The C<urxvt::timer> Class
1068 1195
… …
1172This variable controls the verbosity level of the perl extension. Higher 1299This variable controls the verbosity level of the perl extension. Higher
1173numbers indicate more verbose output. 1300numbers indicate more verbose output.
1174 1301
1175=over 4 1302=over 4
1176 1303
1177=item =0 - only fatal messages 1304=item == 0 - fatal messages
1178 1305
1179=item =3 - script loading and management 1306=item >= 3 - script loading and management
1180 1307
1181=item =10 - all events received 1308=item >=10 - all events received
1182 1309
1183=back 1310=back
1184 1311
1185=head1 AUTHOR 1312=head1 AUTHOR
1186 1313

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines