--- rxvt-unicode/src/urxvt.pm 2006/01/08 22:58:13 1.58 +++ rxvt-unicode/src/urxvt.pm 2006/01/09 23:00:07 1.70 @@ -60,9 +60,22 @@ =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 searchable-scrollback (enabled by default) + +Adds regex search functionality to the scrollback buffer, triggered by a +hotkey (default: C). When in search mode, terminal input/output is +suspended, C starts an incremental regex search, C searches further, +C

jumps to the previous match. C leaves search mode at the +current position and C returns to the original position. + =item digital-clock Displays a digital clock using the built-in overlay. @@ -121,23 +134,52 @@ =back +=head2 Extension Objects + +Very perl extension is a perl class. A separate perl object is created +for each terminal and each extension and passed as the first parameter to +hooks. So extensions can use their C<$self> object without having to think +about other extensions, with the exception of methods and members that +begin with an underscore character C<_>: these are reserved for internal +use. + +Although it isn't a C object, you can call all methods of the +C class on this object. + +It has the following methods and data members: + +=over 4 + +=item $urxvt_term = $self->{term} + +Returns the C object associated with this instance of the +extension. This member I be changed in any way. + +=item $self->enable ($hook_name => $cb, [$hook_name => $cb..]) + +Dynamically enable the given hooks (named without the C prefix) for +this extension, replacing any previous hook. This is useful when you want +to overwrite time-critical hooks only temporarily. + +=item $self->disable ($hook_name[, $hook_name..]) + +Dynamically disable the given hooks. + +=back + =head2 Hooks The following subroutines can be declared in extension files, and will be called whenever the relevant event happens. -The first argument passed to them is an object private to each terminal -and extension package. You can call all C methods on it, but -its not a real C object. Instead, the real C -object that is shared between all packages is stored in the C -member. It is, however, blessed intot he package of the extension script, -so for all practical purposes you can treat an extension script as a class. - -All of them must return a boolean value. If it is true, then the event -counts as being I, and the invocation of other hooks is skipped, -and the relevant action might not be carried out by the C++ code. +The first argument passed to them is an extension oject as described in +the in the C section. -When in doubt, return a false value (preferably C<()>). +B of these hooks must return a boolean value. If it is true, then the +event counts as being I, and the invocation of other hooks is +skipped, and the relevant action might not be carried out by the C++ code. + +I<< When in doubt, return a false value (preferably C<()>). >> =over 4 @@ -202,10 +244,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 = @@ -268,9 +306,9 @@ Called wheneever the window loses keyboard focus, before rxvt-unicode does focus out processing. -=item on_key_press $term, $event, $octets +=item on_key_press $term, $event, $keysym, $octets -=item on_key_release $term, $event +=item on_key_release $term, $event, $keysym =item on_button_press $term, $event @@ -334,6 +372,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). @@ -406,12 +450,14 @@ use utf8; use strict; +use Carp (); use Scalar::Util (); use List::Util (); our $VERSION = 1; our $TERM; our @HOOKNAME; +our %HOOKTYPE = map +($HOOKNAME[$_] => $_), 0..$#HOOKNAME; our %OPTION; our $LIBDIR; @@ -425,6 +471,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 +486,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,15 +501,15 @@ open my $fh, "<:raw", $path or die "$path: $!"; - my $source = "package $pkg; use strict; use utf8;\n" - . "use base urxvt::term::proxy::;\n" - . "#line 1 \"$path\"\n{\n" - . (do { local $/; <$fh> }) - . "\n};\n1"; + 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: $@"; + eval $source + or die "$path: $@"; $pkg } @@ -491,23 +525,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 searchable-scrollback); } 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,16 +562,9 @@ 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; - }; + $retval = eval { $cb->($TERM->{_pkg}{$pkg}, @_) } + and last; + if ($@) { $TERM->ungrab; # better to lose the grab than the session warn $@; @@ -544,8 +573,7 @@ } if ($htype == 1) { # DESTROY - # remove hooks if unused - if (my $hook = $TERM->{_hook}) { + if (my $hook = delete $TERM->{_hook}) { for my $htype (0..$#$hook) { $hook_count[$htype] -= scalar keys %{ $hook->[$htype] || {} } or set_should_invoke $htype, 0; @@ -564,22 +592,60 @@ # urxvt::term::proxy -sub urxvt::term::proxy::AUTOLOAD { - $urxvt::term::proxy::AUTOLOAD =~ /:([^:]+)$/ - or die "FATAL: \$AUTOLOAD '$urxvt::term::proxy::AUTOLOAD' unparsable"; +package urxvt::term::proxy; + +sub enable { + my ($self, %hook) = @_; + my $pkg = $self->{_pkg}; + + while (my ($name, $cb) = each %hook) { + my $htype = $HOOKTYPE{uc $name}; + defined $htype + or Carp::croak "unsupported hook type '$name'"; + + unless (exists $self->{term}{_hook}[$htype]{$pkg}) { + $hook_count[$htype]++ + or urxvt::set_should_invoke $htype, 1; + } + + $self->{term}{_hook}[$htype]{$pkg} = $cb; + } +} + +sub disable { + my ($self, @hook) = @_; + my $pkg = $self->{_pkg}; + + for my $name (@hook) { + my $htype = $HOOKTYPE{uc $name}; + defined $htype + or Carp::croak "unsupported hook type '$name'"; + + if (delete $self->{term}{_hook}[$htype]{$pkg}) { + --$hook_count[$htype] + or urxvt::set_should_invoke $htype, 0; + } + } +} + +our $AUTOLOAD; + +sub AUTOLOAD { + $AUTOLOAD =~ /:([^:]+)$/ + or die "FATAL: \$AUTOLOAD '$AUTOLOAD' unparsable"; eval qq{ - sub $urxvt::term::proxy::AUTOLOAD { + sub $AUTOLOAD { my \$proxy = shift; \$proxy->{term}->$1 (\@_) } 1 } or die "FATAL: unable to compile method forwarder: $@"; - goto &$urxvt::term::proxy::AUTOLOAD; + goto &$AUTOLOAD; } -sub urxvt::term::proxy::DESTROY { +sub DESTROY { # nop } @@ -656,8 +722,7 @@ sub urxvt::anyevent::condvar::wait { unless (${$_[0]}) { - require Carp; - Carp::croak ("AnyEvent->condvar blocking wait unsupported in urxvt, use a non-blocking API"); + Carp::croak "AnyEvent->condvar blocking wait unsupported in urxvt, use a non-blocking API"; } } @@ -667,6 +732,28 @@ =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 { + _pkg => $pkg, + argv => $argv, + }, $pkg; + Scalar::Util::weaken ($proxy->{term} = $self); + + $self->{_pkg}{$pkg} = $proxy; + + for my $name (@HOOKNAME) { + if (my $ref = $pkg->can ("on_" . lc $name)) { + $proxy->enable ($name => $ref); + } + } +} + =item $term->destroy Destroy the terminal object (close the window, free resources etc.). @@ -729,6 +816,11 @@ &urxvt::term::_resource } +=item $success = $term->parse_keysym ($keysym_spec, $command_string) + +Adds a keymap translation exactly as specified via a resource. See the +C resource in the @@RXVT_NAME@@(1) manpage. + =item $rend = $term->rstyle ([$new_rstyle]) Return and optionally change the current rendition. Text that is output by @@ -757,25 +849,24 @@ Return the current selection text and optionally replace it by C<$newtext>. -#=item $term->overlay ($x, $y, $text) -# -#Create a simple multi-line overlay box. See the next method for details. -# -#=cut -# -#sub urxvt::term::scr_overlay { -# my ($self, $x, $y, $text) = @_; -# -# my @lines = split /\n/, $text; -# -# my $w = 0; -# for (map $self->strwidth ($_), @lines) { -# $w = $_ if $w < $_; -# } -# -# $self->scr_overlay_new ($x, $y, $w, scalar @lines); -# $self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines; -#} +=item $term->overlay_simple ($x, $y, $text) + +Create a simple multi-line overlay box. See the next method for details. + +=cut + +sub overlay_simple { + my ($self, $x, $y, $text) = @_; + + my @lines = split /\n/, $text; + + my $w = List::Util::max map $self->strwidth ($_), @lines; + + my $overlay = $self->overlay ($x, $y, $w, scalar @lines); + $overlay->set (0, $_, $lines[$_]) for 0.. $#lines; + + $overlay +} =item $term->overlay ($x, $y, $width, $height[, $rstyle[, $border]]) @@ -852,6 +943,23 @@ Convert the given locale-encoded octets into a perl string. +=item $term->scr_xor_span ($beg_row, $beg_col, $end_row, $end_col[, $rstyle]) + +XORs the rendition values in the given span with the provided value +(default: C). Useful in refresh hooks to provide effects similar +to the selection. + +=item $term->scr_xor_rect ($beg_row, $beg_col, $end_row, $end_col[, $rstyle1[, $rstyle2]]) + +Similar to C, but xors a rectangle instead. Trailing +whitespace will additionally be xored with the C<$rstyle2>, which defaults +to C, which removes reverse video again and underlines +it instead. + +=item $term->scr_bell + +Ring the bell! + =item $term->scr_add_lines ($string) Write the given text string to the screen, as if output by the application @@ -875,6 +983,13 @@ pass characters instead of octets, you should convert your strings first to the locale-specific encoding using C<< $term->locale_encode >>. +=item $old_events = $term->pty_ev_events ([$new_events]) + +Replaces the event mask of the pty watcher by the given event mask. Can +be used to suppress input and output handling to the pty/tty. See the +description of C<< urxvt::timer->events >>. Make sure to always restore +the previous value. + =item $windowid = $term->parent Return the window id of the toplevel window. @@ -909,6 +1024,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 @@ -1094,7 +1217,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, @@ -1106,6 +1228,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 @@ -1133,12 +1283,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 { }, }); } @@ -1156,7 +1306,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 { @@ -1178,8 +1328,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"; } @@ -1252,7 +1405,7 @@ $term->{iow} = urxvt::iow ->new ->fd (fileno $term->{socket}) - ->events (1) # wait for read data + ->events (urxvt::EVENT_READ) ->start ->cb (sub { my ($iow, $revents) = @_; @@ -1279,8 +1432,9 @@ =item $iow = $iow->events ($eventmask) -Set the event mask to watch. Bit #0 (value C<1>) enables watching for read -data, Bit #1 (value C<2>) enables watching for write data. +Set the event mask to watch. The only allowed values are +C and C, which might be ORed +together, or C. =item $iow = $iow->start