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.57 by root, Sun Jan 8 08:43:11 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]) {
… …
541 } 557 }
542 558
543 $retval 559 $retval
544} 560}
545 561
562# urxvt::term::proxy
563
546sub urxvt::term::proxy::AUTOLOAD { 564sub urxvt::term::proxy::AUTOLOAD {
547 $urxvt::term::proxy::AUTOLOAD =~ /:([^:]+)$/ 565 $urxvt::term::proxy::AUTOLOAD =~ /:([^:]+)$/
548 or die "FATAL: \$AUTOLOAD '$urxvt::term::proxy::AUTOLOAD' unparsable"; 566 or die "FATAL: \$AUTOLOAD '$urxvt::term::proxy::AUTOLOAD' unparsable";
549 567
550 eval qq{ 568 eval qq{
… …
556 } or die "FATAL: unable to compile method forwarder: $@"; 574 } or die "FATAL: unable to compile method forwarder: $@";
557 575
558 goto &$urxvt::term::proxy::AUTOLOAD; 576 goto &$urxvt::term::proxy::AUTOLOAD;
559} 577}
560 578
579# urxvt::destroy_hook
580
561sub urxvt::destroy_hook::DESTROY { 581sub urxvt::destroy_hook::DESTROY {
562 ${$_[0]}->(); 582 ${$_[0]}->();
563} 583}
564 584
565sub urxvt::destroy_hook(&) { 585sub urxvt::destroy_hook(&) {
566 bless \shift, urxvt::destroy_hook:: 586 bless \shift, urxvt::destroy_hook::
567} 587}
588
589package urxvt::anyevent;
590
591=head2 The C<urxvt::anyevent> Class
592
593The sole purpose of this class is to deliver an interface to the
594C<AnyEvent> module - any module using it will work inside urxvt without
595further work. The only exception is that you cannot wait on condition
596variables, but non-blocking condvar use is ok. What this means is that you
597cannot use blocking APIs, but the non-blocking variant should work.
598
599=cut
600
601our $VERSION = 1;
602
603$INC{"urxvt/anyevent.pm"} = 1; # mark us as there
604push @AnyEvent::REGISTRY, [urxvt => urxvt::anyevent::];
605
606sub timer {
607 my ($class, %arg) = @_;
608
609 my $cb = $arg{cb};
610
611 urxvt::timer
612 ->new
613 ->start (urxvt::NOW + $arg{after})
614 ->cb (sub {
615 $_[0]->stop; # need to cancel manually
616 $cb->();
617 })
618}
619
620sub io {
621 my ($class, %arg) = @_;
622
623 my $cb = $arg{cb};
624
625 bless [$arg{fh}, urxvt::iow
626 ->new
627 ->fd (fileno $arg{fh})
628 ->events (($arg{poll} =~ /r/ ? 1 : 0)
629 | ($arg{poll} =~ /w/ ? 2 : 0))
630 ->start
631 ->cb (sub {
632 $cb->(($_[1] & 1 ? 'r' : '')
633 . ($_[1] & 2 ? 'w' : ''));
634 })],
635 urxvt::anyevent::
636}
637
638sub DESTROY {
639 $_[0][1]->stop;
640}
641
642sub condvar {
643 bless \my $flag, urxvt::anyevent::condvar::
644}
645
646sub urxvt::anyevent::condvar::broadcast {
647 ${$_[0]}++;
648}
649
650sub urxvt::anyevent::condvar::wait {
651 unless (${$_[0]}) {
652 require Carp;
653 Carp::croak ("AnyEvent->condvar blocking wait unsupported in urxvt, use a non-blocking API");
654 }
655}
656
657package urxvt::term;
568 658
569=head2 The C<urxvt::term> Class 659=head2 The C<urxvt::term> Class
570 660
571=over 4 661=over 4
572 662
… …
624 shade term_name title transparent transparent_all tripleclickwords 714 shade term_name title transparent transparent_all tripleclickwords
625 utmpInhibit visualBell 715 utmpInhibit visualBell
626 716
627=cut 717=cut
628 718
629sub urxvt::term::resource($$;$) { 719sub resource($$;$) {
630 my ($self, $name) = (shift, shift); 720 my ($self, $name) = (shift, shift);
631 unshift @_, $self, $name, ($name =~ s/\s*\+\s*(\d+)$// ? $1 : 0); 721 unshift @_, $self, $name, ($name =~ s/\s*\+\s*(\d+)$// ? $1 : 0);
632 &urxvt::term::_resource 722 &urxvt::term::_resource
633} 723}
634 724
… …
721C<$event> I<must> be the event causing the menu to pop up (a button event, 811C<$event> I<must> be the event causing the menu to pop up (a button event,
722currently). 812currently).
723 813
724=cut 814=cut
725 815
726sub urxvt::term::popup { 816sub popup {
727 my ($self, $event) = @_; 817 my ($self, $event) = @_;
728 818
729 $self->grab ($event->{time}, 1) 819 $self->grab ($event->{time}, 1)
730 or return; 820 or return;
731 821
… …
921 1011
922=back 1012=back
923 1013
924=cut 1014=cut
925 1015
926sub urxvt::term::line { 1016sub line {
927 my ($self, $row) = @_; 1017 my ($self, $row) = @_;
928 1018
929 my $maxrow = $self->nrow - 1; 1019 my $maxrow = $self->nrow - 1;
930 1020
931 my ($beg, $end) = ($row, $row); 1021 my ($beg, $end) = ($row, $row);
… …
1009Converts rxvt-unicodes text reprsentation into a perl string. See 1099Converts rxvt-unicodes text reprsentation into a perl string. See
1010C<< $term->ROW_t >> for details. 1100C<< $term->ROW_t >> for details.
1011 1101
1012=back 1102=back
1013 1103
1104=cut
1105
1106package urxvt::popup;
1107
1014=head2 The C<urxvt::popup> Class 1108=head2 The C<urxvt::popup> Class
1015 1109
1016=over 4 1110=over 4
1017 1111
1018=cut 1112=cut
1019
1020package urxvt::popup;
1021 1113
1022sub add_item { 1114sub add_item {
1023 my ($self, $item) = @_; 1115 my ($self, $item) = @_;
1024 1116
1117 $item->{rend}{normal} = "\x1b[0;30;47m" unless exists $item->{rend}{normal};
1118 $item->{rend}{hover} = "\x1b[0;30;46m" unless exists $item->{rend}{hover};
1119 $item->{rend}{active} = "\x1b[m" unless exists $item->{rend}{active};
1120
1121 $item->{render} ||= sub { $_[0]{text} };
1122
1025 push @{ $self->{item} }, $item; 1123 push @{ $self->{item} }, $item;
1124}
1125
1126sub add_separator {
1127 my ($self, $sep) = @_;
1128
1129 $sep ||= "═";
1130
1131 $self->add_item ({
1132 rend => { normal => "\x1b[0;30;47m", hover => "\x1b[0;30;47m", active => "\x1b[0;30;47m" },
1133 text => "",
1134 render => sub { $sep x $urxvt::TERM->ncol },
1135 activate => sub { },
1136 });
1137}
1138
1139sub add_title {
1140 my ($self, $title) = @_;
1141
1142 $self->add_item ({
1143 rend => { normal => "\x1b[38;5;11;44m", hover => "\x1b[38;5;11;44m", active => "\x1b[38;5;11;44m" },
1144 text => $title,
1145 activate => sub { },
1146 });
1026} 1147}
1027 1148
1028sub add_button { 1149sub add_button {
1029 my ($self, $text, $cb) = @_; 1150 my ($self, $text, $cb) = @_;
1030 1151
1031 $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb, 1152 $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb});
1032 render => sub { $_[0]{text} },
1033 });
1034} 1153}
1035 1154
1036sub add_toggle { 1155sub add_toggle {
1037 my ($self, $text, $cb, $value) = @_; 1156 my ($self, $text, $cb, $value) = @_;
1038 1157
1039 my $item; $item = { 1158 my $item; $item = {
1040 type => "button", 1159 type => "button",
1041 text => " $text", 1160 text => " $text",
1042 value => $value, 1161 value => $value,
1043 render => sub { ($item->{value} ? "✔" : " ") . $text }, 1162 render => sub { ($item->{value} ? "* " : " ") . $text },
1044 activate => sub { $cb->($item->{value} = !$item->{value}); }, 1163 activate => sub { $cb->($item->{value} = !$item->{value}); },
1045 }; 1164 };
1046 1165
1047 $self->add_item ($item); 1166 $self->add_item ($item);
1048} 1167}

Diff Legend

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