--- rxvt-unicode/src/urxvt.pm 2006/01/08 01:59:29 1.54 +++ rxvt-unicode/src/urxvt.pm 2006/01/09 06:29:47 1.64 @@ -60,9 +60,14 @@ =item option-popup (enabled by default) -Binds a popup menu to Ctrl-Button3 that lets you toggle (some) options at +Binds a popup menu to Ctrl-Button2 that lets you toggle (some) options at runtime. +=item selection-popup (enabled by default) + +Binds a popup menu to Ctrl-Button3 that lets you convert the selection +text into various other formats/action. + =item digital-clock Displays a digital clock using the built-in overlay. @@ -202,10 +207,6 @@ $nrow - 1) represent the lines to be scrolled out). C<$saved> is the total number of lines that will be in the scrollback buffer. -=item on_tty_activity $term *NYI* - -Called whenever the program(s) running in the urxvt window send output. - =item on_osc_seq $term, $string Called whenever the B command sequence (OSC = @@ -334,6 +335,12 @@ Using this function has the advantage that its output ends up in the correct place, e.g. on stderr of the connecting urxvtc client. +=item $is_safe = urxvt::safe + +Returns true when it is safe to do potentially unsafe things, such as +evaluating perl code specified by the user. This is true when urxvt was +started setuid or setgid. + =item $time = urxvt::NOW Returns the "current time" (as per the event loop). @@ -344,7 +351,7 @@ Mod3Mask, Mod4Mask, Mod5Mask, Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask, AnyModifier -Various constants for use in X events. +Various constants for use in X calls and event processing. =back @@ -409,6 +416,7 @@ use Scalar::Util (); use List::Util (); +our $VERSION = 1; our $TERM; our @HOOKNAME; our %OPTION; @@ -424,6 +432,11 @@ unless $msg =~ /\n$/; urxvt::warn ($msg); }; + + delete $ENV{IFS}; + delete $ENV{CDPATH}; + delete $ENV{BASH_ENV}; + $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin:/opt/bin:/opt/sbin"; } my @hook_count; @@ -466,7 +479,7 @@ open my $fh, "<:raw", $path or die "$path: $!"; - my $source = "package $pkg; use strict; use utf8;\n" + my $source = untaint "package $pkg; use strict; use utf8;\n" . "use base urxvt::term::proxy::;\n" . "#line 1 \"$path\"\n{\n" . (do { local $/; <$fh> }) @@ -492,7 +505,7 @@ for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) { if ($_ eq "default") { - $want_ext{$_}++ for qw(selection option-popup); + $want_ext{$_}++ for qw(selection option-popup selection-popup); } elsif (/^-(.*)$/) { delete $want_ext{$1}; } else { @@ -509,6 +522,9 @@ warn "perl extension '$ext' not found in perl library search path\n"; } } + + eval "#line 1 \"--perl-eval resource/argument\"\n" . $TERM->resource ("perl_eval"); + warn $@ if $@; } $retval = undef; @@ -530,7 +546,10 @@ @_, ) and last; }; - warn $@ if $@;#d# + if ($@) { + $TERM->ungrab; # better to lose the grab than the session + warn $@; + } } } @@ -553,6 +572,8 @@ $retval } +# urxvt::term::proxy + sub urxvt::term::proxy::AUTOLOAD { $urxvt::term::proxy::AUTOLOAD =~ /:([^:]+)$/ or die "FATAL: \$AUTOLOAD '$urxvt::term::proxy::AUTOLOAD' unparsable"; @@ -568,6 +589,12 @@ goto &$urxvt::term::proxy::AUTOLOAD; } +sub urxvt::term::proxy::DESTROY { + # nop +} + +# urxvt::destroy_hook + sub urxvt::destroy_hook::DESTROY { ${$_[0]}->(); } @@ -576,6 +603,76 @@ bless \shift, urxvt::destroy_hook:: } +package urxvt::anyevent; + +=head2 The C Class + +The sole purpose of this class is to deliver an interface to the +C module - any module using it will work inside urxvt without +further work. The only exception is that you cannot wait on condition +variables, but non-blocking condvar use is ok. What this means is that you +cannot use blocking APIs, but the non-blocking variant should work. + +=cut + +our $VERSION = 1; + +$INC{"urxvt/anyevent.pm"} = 1; # mark us as there +push @AnyEvent::REGISTRY, [urxvt => urxvt::anyevent::]; + +sub timer { + my ($class, %arg) = @_; + + my $cb = $arg{cb}; + + urxvt::timer + ->new + ->start (urxvt::NOW + $arg{after}) + ->cb (sub { + $_[0]->stop; # need to cancel manually + $cb->(); + }) +} + +sub io { + my ($class, %arg) = @_; + + my $cb = $arg{cb}; + + bless [$arg{fh}, urxvt::iow + ->new + ->fd (fileno $arg{fh}) + ->events (($arg{poll} =~ /r/ ? 1 : 0) + | ($arg{poll} =~ /w/ ? 2 : 0)) + ->start + ->cb (sub { + $cb->(($_[1] & 1 ? 'r' : '') + . ($_[1] & 2 ? 'w' : '')); + })], + urxvt::anyevent:: +} + +sub DESTROY { + $_[0][1]->stop; +} + +sub condvar { + bless \my $flag, urxvt::anyevent::condvar:: +} + +sub urxvt::anyevent::condvar::broadcast { + ${$_[0]}++; +} + +sub urxvt::anyevent::condvar::wait { + unless (${$_[0]}) { + require Carp; + Carp::croak ("AnyEvent->condvar blocking wait unsupported in urxvt, use a non-blocking API"); + } +} + +package urxvt::term; + =head2 The C Class =over 4 @@ -636,7 +733,7 @@ =cut -sub urxvt::term::resource($$;$) { +sub resource($$;$) { my ($self, $name) = (shift, shift); unshift @_, $self, $name, ($name =~ s/\s*\+\s*(\d+)$// ? $1 : 0); &urxvt::term::_resource @@ -733,7 +830,7 @@ =cut -sub urxvt::term::popup { +sub popup { my ($self, $event) = @_; $self->grab ($event->{time}, 1) @@ -933,7 +1030,7 @@ =cut -sub urxvt::term::line { +sub line { my ($self, $row) = @_; my $maxrow = $self->nrow - 1; @@ -1007,7 +1104,6 @@ ) } -=item ($row, $col) = $line->coord_of ($offset) =item $text = $term->special_encode $string Converts a perl string into the special encoding used by rxvt-unicode, @@ -1019,16 +1115,46 @@ Converts rxvt-unicodes text reprsentation into a perl string. See C<< $term->ROW_t >> for details. +=item $success = $term->grab_button ($button, $modifiermask) + +Registers a synchronous button grab. See the XGrabButton manpage. + +=item $success = $term->grab ($eventtime[, $sync]) + +Calls XGrabPointer and XGrabKeyboard in asynchronous (default) or +synchronous (C<$sync> is true). Also remembers the grab timestampe. + +=item $term->allow_events_async + +Calls XAllowEvents with AsyncBoth for the most recent grab. + +=item $term->allow_events_sync + +Calls XAllowEvents with SyncBoth for the most recent grab. + +=item $term->allow_events_replay + +Calls XAllowEvents with both ReplayPointer and ReplayKeyboard for the most +recent grab. + +=item $term->ungrab + +Calls XUngrab for the most recent grab. Is called automatically on +evaluation errors, as it is better to lose the grab in the error case as +the session. + =back +=cut + +package urxvt::popup; + =head2 The C Class =over 4 =cut -package urxvt::popup; - sub add_item { my ($self, $item) = @_; @@ -1067,7 +1193,7 @@ sub add_button { my ($self, $text, $cb) = @_; - $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb}); + $self->add_item ({ type => "button", text => $text, activate => $cb}); } sub add_toggle { @@ -1077,8 +1203,8 @@ type => "button", text => " $text", value => $value, - render => sub { ($item->{value} ? "* " : " ") . $text }, - activate => sub { $cb->($item->{value} = !$item->{value}); }, + render => sub { ($_[0]{value} ? "* " : " ") . $text }, + activate => sub { $cb->($_[0]{value} = !$_[0]{value}); }, }; $self->add_item ($item); @@ -1091,6 +1217,7 @@ urxvt->new ("--perl-lib" => "", "--perl-ext-common" => "", "-pty-fd" => -1, "-sl" => 0, "-b" => 0, "--transient-for" => $self->{term}->parent, + "-display" => $self->{term}->display_id, "-pe" => "urxvt-popup") or die "unable to create popup window\n"; } @@ -1098,6 +1225,7 @@ sub DESTROY { my ($self) = @_; + delete $self->{term}{_destroy}{$self}; $self->{term}->ungrab; } @@ -1211,11 +1339,11 @@ =over 4 -=item =0 - only fatal messages +=item == 0 - fatal messages -=item =3 - script loading and management +=item >= 3 - script loading and management -=item =10 - all events received +=item >=10 - all events received =back