--- rxvt-unicode/src/urxvt.pm	2014/05/02 20:34:24	1.233
+++ rxvt-unicode/src/urxvt.pm	2014/10/11 22:02:50	1.243
@@ -45,8 +45,10 @@
 
   URxvt.perl-ext-common: default,selection-autotransform
 
-Extensions that add command line parameters or resources on their own are
-loaded automatically when used.
+Extensions may add resources on their own. Similarly to builtin
+resources, these resources can also be specified on the command line
+as long options (with '.' replaced by '-'), in which case the
+corresponding extension is loaded automatically.
 
 =head1 API DOCUMENTATION
 
@@ -290,7 +292,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.
+preference to the C<on_action> hook.
 
 =item on_resize_all_windows $term, $new_width, $new_height
 
@@ -557,19 +559,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];
 
@@ -589,7 +593,7 @@
 sub usage {
    my ($term, $usage_type) = @_;
 
-   $term->scan_meta;
+   $term->scan_extensions;
 
    my $r = $term->{meta}{resource};
 
@@ -663,6 +667,8 @@
    if ($htype == HOOK_INIT) {
       my @dirs = $TERM->perl_libdirs;
 
+      $TERM->scan_extensions;
+
       my %ext_arg;
 
       {
@@ -675,20 +681,43 @@
       }
 
       for (
-         @{ delete $TERM->{perl_ext_3} },
-         grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
+         (grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2),
+         @{ delete $TERM->{perl_ext_3} }
       ) {
          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} };
+
+            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;
 
@@ -709,13 +738,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_;
 
@@ -1064,17 +1100,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 +1122,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...]
@@ -1224,8 +1277,8 @@
 same value as used by this instance of rxvt-unicode. Returns C<undef> if no
 resource with that pattern exists.
 
-Extensions that define extra resource or command line arguments also need
-to call this method to access their values.
+Extensions that define extra resources also need to call this method
+to access their values.
 
 If the method is called on an extension object (basically, from an
 extension), then the special prefix C<%.> will be replaced by the name of
@@ -1256,7 +1309,7 @@
 
 =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<keysym> resource. See the
 C<keysym> resource in the urxvt(1) manpage.
 
 =item $rend = $term->rstyle ([$new_rstyle])
@@ -1448,6 +1501,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<tt_write>, 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<tt_write> doesn't do that).
+
+The typical use case would be inside C<on_action> hooks.
+
 =item $term->tt_paste ($octets)
 
 Write the octets given in C<$octets> to the tty as a paste, converting NL to