--- rxvt-unicode/src/urxvt.pm 2006/01/08 08:43:11 1.57 +++ rxvt-unicode/src/urxvt.pm 2006/01/09 20:00:31 1.68 @@ -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). @@ -425,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; @@ -435,23 +447,6 @@ warn "$msg\n" if $level <= $verbosity; } -# find on_xxx subs in the package and register them -# as hooks -sub register_package($) { - my ($pkg) = @_; - - for my $htype (0.. $#HOOKNAME) { - my $name = $HOOKNAME[$htype]; - - my $ref = $pkg->can ("on_" . lc $name) - or next; - - $TERM->{_hook}[$htype]{$pkg} = $ref; - $hook_count[$htype]++ - or set_should_invoke $htype, 1; - } -} - my $extension_pkg = "extension0000"; my %extension_pkg; @@ -467,14 +462,12 @@ 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> }) . "\n};\n1"; - $source =~ /(.*)/s and $source = $1; # untaint - eval $source or die "$path: $@"; $pkg @@ -491,23 +484,25 @@ if ($htype == 0) { # INIT my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl"); - my %want_ext; + my %ext_arg; for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) { if ($_ eq "default") { - $want_ext{$_}++ for qw(selection option-popup); + $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup); } elsif (/^-(.*)$/) { - delete $want_ext{$1}; + delete $ext_arg{$1}; + } elsif (/^([^<]+)<(.*)>$/) { + push @{ $ext_arg{$1} }, $2; } else { - $want_ext{$_}++; + $ext_arg{$_} ||= []; } } - for my $ext (keys %want_ext) { + while (my ($ext, $argv) = each %ext_arg) { my @files = grep -f $_, map "$_/$ext", @dirs; if (@files) { - register_package extension_package $files[0]; + $TERM->register_package (extension_package $files[0], $argv); } else { warn "perl extension '$ext' not found in perl library search path\n"; } @@ -526,17 +521,13 @@ keys %$cb; while (my ($pkg, $cb) = each %$cb) { - eval { - $retval = $cb->( - $TERM->{_pkg}{$pkg} ||= do { - my $proxy = bless { }, $pkg; - Scalar::Util::weaken ($proxy->{term} = $TERM); - $proxy - }, - @_, - ) and last; - }; - warn $@ if $@;#d# + $retval = eval { $cb->($TERM->{_pkg}{$pkg}, @_) } + and last; + + if ($@) { + $TERM->ungrab; # better to lose the grab than the session + warn $@; + } } } @@ -576,6 +567,10 @@ goto &$urxvt::term::proxy::AUTOLOAD; } +sub urxvt::term::proxy::DESTROY { + # nop +} + # urxvt::destroy_hook sub urxvt::destroy_hook::DESTROY { @@ -660,6 +655,30 @@ =over 4 +=cut + +# find on_xxx subs in the package and register them +# as hooks +sub register_package { + my ($self, $pkg, $argv) = @_; + + my $proxy = bless { argv => $argv }, $pkg; + Scalar::Util::weaken ($proxy->{term} = $TERM); + + $self->{_pkg}{$pkg} = $proxy; + + for my $htype (0.. $#HOOKNAME) { + my $name = $HOOKNAME[$htype]; + + my $ref = $pkg->can ("on_" . lc $name) + or next; + + $self->{_hook}[$htype]{$pkg} = $ref; + $hook_count[$htype]++ + or urxvt::set_should_invoke $htype, 1; + } +} + =item $term->destroy Destroy the terminal object (close the window, free resources etc.). @@ -902,6 +921,14 @@ Return various integers describing terminal characteristics. +=item $lc_ctype = $term->locale + +Returns the LC_CTYPE category string used by this rxvt-unicode. + +=item $x_display = $term->display_id + +Return the DISPLAY used by rxvt-unicode. + =item $modifiermask = $term->ModLevel3Mask =item $modifiermask = $term->ModMetaMask @@ -1087,7 +1114,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, @@ -1099,6 +1125,34 @@ 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 @@ -1126,12 +1180,12 @@ sub add_separator { my ($self, $sep) = @_; - $sep ||= "═"; + $sep ||= "="; $self->add_item ({ rend => { normal => "\x1b[0;30;47m", hover => "\x1b[0;30;47m", active => "\x1b[0;30;47m" }, text => "", - render => sub { $sep x $urxvt::TERM->ncol }, + render => sub { $sep x $self->{term}->ncol }, activate => sub { }, }); } @@ -1149,7 +1203,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 { @@ -1159,8 +1213,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); @@ -1171,8 +1225,11 @@ local $urxvt::popup::self = $self; + local $ENV{LC_ALL} = $self->{term}->locale; + 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"; } @@ -1180,6 +1237,7 @@ sub DESTROY { my ($self) = @_; + delete $self->{term}{_destroy}{$self}; $self->{term}->ungrab; } @@ -1293,11 +1351,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