--- rxvt-unicode/src/urxvt.pm 2012/08/10 19:06:06 1.225 +++ rxvt-unicode/src/urxvt.pm 2014/05/17 17:12:29 1.236 @@ -2,7 +2,7 @@ =head1 NAME -@@RXVT_NAME@@perl - rxvt-unicode's embedded perl interpreter +urxvtperl - rxvt-unicode's embedded perl interpreter =head1 SYNOPSIS @@ -13,9 +13,9 @@ () } - # start a @@RXVT_NAME@@ using it: + # start a urxvt using it: - @@RXVT_NAME@@ --perl-lib $HOME -pe grab_test + urxvt --perl-lib $HOME -pe grab_test =head1 DESCRIPTION @@ -25,7 +25,7 @@ Scripts are compiled in a 'use strict "vars"' and 'use utf8' environment, and thus must be encoded as UTF-8. -Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where +Each script will only ever be loaded once, even in urxvtd, where scripts will be shared (but not enabled) for all terminals. You can disable the embedded perl interpreter by setting both "perl-ext" @@ -34,12 +34,12 @@ =head1 PREPACKAGED EXTENSIONS A number of extensions are delivered with this release. You can find them -in F<@@RXVT_LIBDIR@@/urxvt/perl/>, and the documentation can be viewed -using F<< man urxvt- >>. +in F<< /urxvt/perl/ >>, and the documentation can be viewed using +F<< man urxvt- >>. You can activate them like this: - @@RXVT_NAME@@ -pe + urxvt -pe Or by adding them to the resource for extensions loaded by default: @@ -283,27 +283,20 @@ Called just after the screen gets redrawn. See C. -=item on_user_command $term, $string +=item on_user_command $term, $string *DEPRECATED* Called whenever a user-configured event is being activated (e.g. via a C action bound to a key, see description of the B -resource in the @@RXVT_NAME@@(1) manpage). +resource in the urxvt(1) manpage). -The event is simply the action string. This interface is assumed to change -slightly in the future. - -=item on_register_command $term, $keysym, $modifiermask, $string - -Called after parsing a keysym resource but before registering the -associated binding. If this hook returns TRUE the binding is not -registered. It can be used to modify a binding by calling -C. +The event is simply the action string. This interface is going away in +preference to the C hook. =item on_resize_all_windows $term, $new_width, $new_height Called just after the new window size has been calculated, but before windows are actually being resized or hints are being set. If this hook -returns TRUE, setting of the window hints is being skipped. +returns a true value, setting of the window hints is being skipped. =item on_x_event $term, $event @@ -353,8 +346,6 @@ C additionally receives the string rxvt-unicode would output, if any, in locale-specific encoding. -subwindow. - =item on_client_message $term, $event =item on_wm_protocols $term, $event @@ -568,10 +559,10 @@ $name =~ y/-/./ if $isarg; - $term->scan_meta; + $term->scan_extensions; my $r = $term->{meta}{resource}; - keys %$r; # reste iterator + keys %$r; # reset iterator while (my ($pattern, $v) = each %$r) { if ( $pattern =~ /\.$/ @@ -598,7 +589,7 @@ sub usage { my ($term, $usage_type) = @_; - $term->scan_meta; + $term->scan_extensions; my $r = $term->{meta}{resource}; @@ -669,9 +660,11 @@ local $TERM = shift; my $htype = shift; - if ($htype == 0) { # INIT + if ($htype == HOOK_INIT) { my @dirs = $TERM->perl_libdirs; + $TERM->scan_extensions; + my %ext_arg; { @@ -688,16 +681,28 @@ grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2 ) { if ($_ eq "default") { - $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup searchable-scrollback readline); + + $ext_arg{$_} ||= [] + for + qw(selection option-popup selection-popup readline), + map $_->[0], values %{ $TERM->{meta}{binding} }; + } elsif (/^-(.*)$/) { delete $ext_arg{$1}; + } elsif (/^([^<]+)<(.*)>$/) { push @{ $ext_arg{$1} }, $2; + } else { $ext_arg{$_} ||= []; } } + # now register default key bindings + while (my ($k, $v) = each %{ $TERM->{meta}{binding} }) { + $TERM->bind_action ($k, "$v->[0]:$v->[1]"); + } + for my $ext (sort keys %ext_arg) { my @files = grep -f $_, map "$_/$ext", @dirs; @@ -718,6 +723,19 @@ verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" if $verbosity >= 10; + if ($htype == HOOK_ACTION) { + # this hook is only sent to the extension with the name + # matching the first arg + my $pkg = shift; + $pkg =~ y/-/_/; + $pkg = "urxvt::ext::$pkg"; + + $cb = $cb->{$pkg} + or return undef; #TODO: maybe warn user? + + $cb = { $pkg => $cb }; + } + for my $pkg (keys %$cb) { my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) }; $retval ||= $retval_; @@ -732,7 +750,7 @@ if $verbosity >= 11; } - if ($htype == 1) { # DESTROY + if ($htype == HOOK_DESTROY) { # clear package objects %$_ = () for values %{ $TERM->{_pkg} }; @@ -829,8 +847,11 @@ =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. +this extension, replacing any hook previously installed via C in +this extension. + +This is useful when you want to overwrite time-critical hooks only +temporarily. To install additional callbacks for the same hook, you can use the C method of the C class. @@ -1064,17 +1085,20 @@ "$LIBDIR/perl" } -sub scan_meta { +# scan for available extensions and collect their metadata +sub scan_extensions { my ($self) = @_; - my @libdirs = perl_libdirs $self; - return if $self->{meta_libdirs} eq join "\x00", @libdirs; + return if exists $self->{meta}; + + my @libdirs = perl_libdirs $self; - my %meta; +# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d# - $self->{meta_libdirs} = join "\x00", @libdirs; - $self->{meta} = \%meta; +# $self->{meta_libdirs} = join "\x00", @libdirs;#d# + $self->{meta} = \my %meta; + # first gather extensions for my $dir (reverse @libdirs) { opendir my $fh, $dir or next; @@ -1083,23 +1107,37 @@ and open my $fh, "<", "$dir/$ext" or next; + my %ext = (dir => $dir); + while (<$fh>) { - if (/^#:META:X_RESOURCE:(.*)/) { + if (/^#:META:(?:X_)?RESOURCE:(.*)/) { my ($pattern, $type, $desc) = split /:/, $1; $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name if ($pattern =~ /[^a-zA-Z0-9\-\.]/) { warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n"; } else { - $meta{resource}{$pattern} = [$ext, $type, $desc]; + $ext{resource}{$pattern} = [$ext, $type, $desc]; } + } elsif (/^#:META:BINDING:(.*)/) { + my ($keysym, $action) = split /:/, $1; + $ext{binding}{$keysym} = [$ext, $action]; } elsif (/^\s*(?:#|$)/) { # skip other comments and empty lines } else { last; # stop parsing on first non-empty non-comment line } } + + $meta{ext}{$ext} = \%ext; } } + + # and now merge resources and bindings + while (my ($k, $v) = each %{ $meta{ext} }) { + #TODO: should check for extensions overriding each other + %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} }); + %{ $meta{binding} } = (%{ $meta{binding} }, %{ $v->{binding} }); + } } =item $term = new urxvt::term $envhashref, $rxvtname, [arg...] @@ -1128,7 +1166,7 @@ =item $term->destroy Destroy the terminal object (close the window, free resources -etc.). Please note that @@RXVT_NAME@@ will not exit as long as any event +etc.). Please note that urxvt will not exit as long as any event watchers (timers, io watchers) are still active. =item $term->exec_async ($cmd[, @args]) @@ -1254,17 +1292,10 @@ $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0 } -=item $success = $term->parse_keysym ($key, $octets) +=item $success = $term->bind_action ($key, $octets) -Adds a key binding exactly as specified via a resource. See the -C resource in the @@RXVT_NAME@@(1) manpage. - -=item $term->register_command ($keysym, $modifiermask, $string) - -Adds a key binding. This is a lower level api compared to -C, as it expects a parsed key description, and can be -used only inside either the C hook, to add a binding, or the -C hook, to modify a parsed binding. +Adds a key binding exactly as specified via a C resource. See the +C resource in the urxvt(1) manpage. =item $rend = $term->rstyle ([$new_rstyle]) @@ -1455,6 +1486,14 @@ pass characters instead of octets, you should convert your strings first to the locale-specific encoding using C<< $term->locale_encode >>. +=item $term->tt_write_user_input ($octets) + +Like C, but should be used when writing strings in response to +the user pressing a key, to invokes the additional actions requested by +the user for that case (C doesn't do that). + +The typical use case would be inside C hooks. + =item $term->tt_paste ($octets) Write the octets given in C<$octets> to the tty as a paste, converting NL to @@ -1697,11 +1736,10 @@ sub urxvt::line::t { my ($self) = @_; - if (@_ > 1) - { - $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) - for $self->{beg} .. $self->{end}; - } + if (@_ > 1) { + $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) + for $self->{beg} .. $self->{end}; + } defined wantarray && substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}), @@ -1711,11 +1749,10 @@ sub urxvt::line::r { my ($self) = @_; - if (@_ > 1) - { - $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) - for $self->{beg} .. $self->{end}; - } + if (@_ > 1) { + $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) + for $self->{beg} .. $self->{end}; + } if (defined wantarray) { my $rend = [