--- rxvt-unicode/src/urxvt.pm 2014/04/27 20:26:28 1.231 +++ rxvt-unicode/src/urxvt.pm 2014/10/10 14:38:02 1.241 @@ -290,14 +290,7 @@ resource in the urxvt(1) manpage). The event is simply the action string. This interface is going away in -preference to the C<< ->register_keysym_action >> method. - -=item on_register_command $term, $keysym, $modifiermask, $string - -Called after parsing a keysym resource but before registering the -associated binding. If this hook returns a true value the binding -is not registered. It can be used to modify a binding by calling -C. +preference to the C hook. =item on_resize_all_windows $term, $new_width, $new_height @@ -564,19 +557,21 @@ sub parse_resource { my ($term, $name, $isarg, $longopt, $flag, $value) = @_; - $name =~ y/-/./ if $isarg; - - $term->scan_meta; + $term->scan_extensions; my $r = $term->{meta}{resource}; keys %$r; # reset iterator - while (my ($pattern, $v) = each %$r) { - if ( - $pattern =~ /\.$/ - ? $pattern eq substr $name, 0, length $pattern - : $pattern eq $name - ) { - $name = "$urxvt::RESCLASS.$name"; + while (my ($k, $v) = each %$r) { + my $pattern = $k; + $pattern =~ y/./-/ if $isarg; + my $prefix = $name; + my $suffix; + if ($pattern =~ /\-$/) { + $prefix = substr $name, 0, length $pattern; + $suffix = substr $name, length $pattern; + } + if ($pattern eq $prefix) { + $name = "$urxvt::RESCLASS.$k$suffix"; push @{ $term->{perl_ext_3} }, $v->[0]; @@ -596,7 +591,7 @@ sub usage { my ($term, $usage_type) = @_; - $term->scan_meta; + $term->scan_extensions; my $r = $term->{meta}{resource}; @@ -670,6 +665,8 @@ if ($htype == HOOK_INIT) { my @dirs = $TERM->perl_libdirs; + $TERM->scan_extensions; + my %ext_arg; { @@ -682,20 +679,43 @@ } for ( - @{ delete $TERM->{perl_ext_3} }, 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), + @{ delete $TERM->{perl_ext_3} }, + map $_->[0], values %{ $TERM->{meta}{binding} }; + + for ($TERM->_keysym_resources) { + next if /^(?:string|command|builtin|builtin-string|perl)/; + next unless /^([A-Za-z0-9_\-]+):/; + + my $ext = $1; + + $ext_arg{$ext} = []; + } + } elsif (/^-(.*)$/) { delete $ext_arg{$1}; + } elsif (/^([^<]+)<(.*)>$/) { push @{ $ext_arg{$1} }, $2; + } else { $ext_arg{$_} ||= []; } } + # now register default key bindings + for my $ext (sort keys %ext_arg) { + while (my ($k, $v) = each %{ $TERM->{meta}{ext}{$ext}{binding} }) { + $TERM->bind_action ($k, "$v->[0]:$v->[1]"); + } + } + for my $ext (sort keys %ext_arg) { my @files = grep -f $_, map "$_/$ext", @dirs; @@ -716,13 +736,20 @@ verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" if $verbosity >= 10; - for my $pkg ( + if ($htype == HOOK_ACTION) { # this hook is only sent to the extension with the name # matching the first arg - $htype == HOOK_KEYBOARD_DISPATCH - ? exists $cb->{"urxvt::ext::$_[0]"} ? "urxvt::ext::" . shift : return undef - : keys %$cb - ) { + 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_; @@ -1071,17 +1098,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; @@ -1090,23 +1120,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...] @@ -1261,18 +1305,11 @@ $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 +Adds a key binding exactly as specified via a C resource. See the C resource in the urxvt(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. - =item $rend = $term->rstyle ([$new_rstyle]) Return and optionally change the current rendition. Text that is output by @@ -1462,6 +1499,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 invoke 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