--- rxvt-unicode/src/urxvt.pm	2012/06/21 06:08:05	1.221
+++ rxvt-unicode/src/urxvt.pm	2014/10/11 22:02:50	1.243
@@ -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,19 +34,21 @@
 =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-<EXTENSIONNAME> >>.
+in F<< <libdir>/urxvt/perl/ >>, and the documentation can be viewed using
+F<< man urxvt-<EXTENSIONNAME> >>.
 
 You can activate them like this:
 
-  @@RXVT_NAME@@ -pe <extensionname>
+  urxvt -pe <extensionname>
 
 Or by adding them to the resource for extensions loaded by default:
 
   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
 
@@ -105,37 +107,8 @@
 Although it isn't a C<urxvt::term> object, you can call all methods of the
 C<urxvt::term> class on this object.
 
-It has the following methods and data members:
-
-=over 4
-
-=item $urxvt_term = $self->{term}
-
-Returns the C<urxvt::term> object associated with this instance of the
-extension. This member I<must not> be changed in any way.
-
-=item $self->enable ($hook_name => $cb[, $hook_name => $cb..])
-
-Dynamically enable the given hooks (named without the C<on_> prefix) for
-this extension, replacing any previous hook. 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<on>
-method of the C<urxvt::term> class.
-
-=item $self->disable ($hook_name[, $hook_name..])
-
-Dynamically disable the given hooks.
-
-=item $self->x_resource ($pattern)
-
-=item $self->x_resource_boolean ($pattern)
-
-These methods support an additional C<%> prefix when called on an
-extension object - see the description of these methods in the
-C<urxvt::term> class for details.
-
-=back
+Additional methods only supported for extension objects are described in
+the C<urxvt::extension> section below.
 
 =head2 Hooks
 
@@ -312,27 +285,20 @@
 
 Called just after the screen gets redrawn. See C<on_refresh_begin>.
 
-=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<perl:string> action bound to a key, see description of the B<keysym>
-resource in the @@RXVT_NAME@@(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
+resource in the urxvt(1) manpage).
 
-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<register_command>.
+The event is simply the action string. This interface is going away in
+preference to the C<on_action> 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
 
@@ -382,8 +348,6 @@
 C<on_key_press> 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
@@ -595,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; # reste iterator
-   while (my ($pattern, $v) = each %$r) {
-      if (
-         $pattern =~ /\.$/
-         ? $pattern eq substr $name, 0, length $pattern
-         : $pattern eq $name
-      ) {
-         $name = "$urxvt::RESCLASS.$name";
+   keys %$r; # reset iterator
+   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];
 
@@ -627,7 +593,7 @@
 sub usage {
    my ($term, $usage_type) = @_;
 
-   $term->scan_meta;
+   $term->scan_extensions;
 
    my $r = $term->{meta}{resource};
 
@@ -698,9 +664,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;
 
       {
@@ -713,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;
 
@@ -747,6 +738,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_;
@@ -761,7 +765,7 @@
          if $verbosity >= 11;
    }
 
-   if ($htype == 1) { # DESTROY
+   if ($htype == HOOK_DESTROY) {
       # clear package objects
       %$_ = () for values %{ $TERM->{_pkg} };
 
@@ -803,6 +807,76 @@
 
 package urxvt::term::extension;
 
+=head2 The C<urxvt::term::extension> class
+
+Each extension attached to a terminal object is represented by
+a C<urxvt::term::extension> object.
+
+You can use these objects, which are passed to all callbacks to store any
+state related to the terminal and extension instance.
+
+The methods (And data members) documented below can be called on extension
+objects, in addition to call methods documented for the <urxvt::term>
+class.
+
+=over 4
+
+=item $urxvt_term = $self->{term}
+
+Returns the C<urxvt::term> object associated with this instance of the
+extension. This member I<must not> be changed in any way.
+
+=cut
+
+our $AUTOLOAD;
+
+sub AUTOLOAD {
+   $AUTOLOAD =~ /:([^:]+)$/
+      or die "FATAL: \$AUTOLOAD '$AUTOLOAD' unparsable";
+
+   eval qq{
+      sub $AUTOLOAD {
+         my \$proxy = shift;
+         \$proxy->{term}->$1 (\@_)
+      }
+      1
+   } or die "FATAL: unable to compile method forwarder: $@";
+
+   goto &$AUTOLOAD;
+}
+
+sub DESTROY {
+   # nop
+}
+
+# urxvt::destroy_hook (basically a cheap Guard:: implementation)
+
+sub urxvt::destroy_hook::DESTROY {
+   ${$_[0]}->();
+}
+
+sub urxvt::destroy_hook(&) {
+   bless \shift, urxvt::destroy_hook::
+}
+
+=item $self->enable ($hook_name => $cb[, $hook_name => $cb..])
+
+Dynamically enable the given hooks (named without the C<on_> prefix) for
+this extension, replacing any hook previously installed via C<enable> 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<on>
+method of the C<urxvt::term> class.
+
+=item $self->disable ($hook_name[, $hook_name..])
+
+Dynamically disable the given hooks.
+
+=cut
+
 sub enable {
    my ($self, %hook) = @_;
    my $pkg = $self->{_pkg};
@@ -833,37 +907,56 @@
    }
 }
 
-our $AUTOLOAD;
+=item $guard = $self->on ($hook_name => $cb[, $hook_name => $cb..])
 
-sub AUTOLOAD {
-   $AUTOLOAD =~ /:([^:]+)$/
-      or die "FATAL: \$AUTOLOAD '$AUTOLOAD' unparsable";
+Similar to the C<enable> enable, but installs additional callbacks for
+the given hook(s) (that is, it doesn't replace existing callbacks), and
+returns a guard object. When the guard object is destroyed the callbacks
+are disabled again.
 
-   eval qq{
-      sub $AUTOLOAD {
-         my \$proxy = shift;
-         \$proxy->{term}->$1 (\@_)
-      }
-      1
-   } or die "FATAL: unable to compile method forwarder: $@";
+=cut
 
-   goto &$AUTOLOAD;
-}
+sub urxvt::extension::on_disable::DESTROY {
+   my $disable = shift;
 
-sub DESTROY {
-   # nop
+   my $term = delete $disable->{""};
+
+   while (my ($htype, $id) = each %$disable) {
+      delete $term->{_hook}[$htype]{$id};
+      $term->set_should_invoke ($htype, -1);
+   }
 }
 
-# urxvt::destroy_hook
+sub on {
+   my ($self, %hook) = @_;
 
-sub urxvt::destroy_hook::DESTROY {
-   ${$_[0]}->();
-}
+   my $term = $self->{term};
 
-sub urxvt::destroy_hook(&) {
-   bless \shift, urxvt::destroy_hook::
+   my %disable = ( "" => $term );
+
+   while (my ($name, $cb) = each %hook) {
+      my $htype = $HOOKTYPE{uc $name};
+      defined $htype
+         or Carp::croak "unsupported hook type '$name'";
+
+      $term->set_should_invoke ($htype, +1);
+      $term->{_hook}[$htype]{ $disable{$htype} = $cb+0 }
+         = sub { shift; $cb->($self, @_) }; # very ugly indeed
+   }
+
+   bless \%disable, "urxvt::extension::on_disable"
 }
 
+=item $self->x_resource ($pattern)
+
+=item $self->x_resource_boolean ($pattern)
+
+These methods support an additional C<%> prefix when called on an
+extension object - see the description of these methods in the
+C<urxvt::term> class for details.
+
+=cut
+
 sub x_resource {
    my ($self, $name) = @_;
    $name =~ s/^%(\.|$)/$_[0]{_name}$1/;
@@ -876,6 +969,10 @@
    $self->{term}->x_resource_boolean ($name)
 }
 
+=back
+
+=cut
+
 package urxvt::anyevent;
 
 =head2 The C<urxvt::anyevent> Class
@@ -1003,43 +1100,59 @@
       "$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;
       for my $ext (readdir $fh) {
-         $ext ne "."
-            and $ext ne ".."
+         $ext !~ /^\./
             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...]
@@ -1068,52 +1181,9 @@
 =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 $guard = $self->on ($hook_name => $cb[, $hook_name => $cb..])
-
-Similar to the extension method C<enable>, but installs additional
-callbacks for the given hook(s) (existing ones are not replaced), and
-returns a guard object. When the guard object is destroyed the callbacks
-are disabled again.
-
-Note that these callbacks receive the normal parameters, but the first
-argument (normally the extension) is currently undefined.
-
-=cut
-
-sub urxvt::term::on_disable::DESTROY {
-   my $disable = shift;
-
-   my $self = delete $disable->{""};
-
-   while (my ($htype, $id) = each %$disable) {
-      delete $self->{_hook}[$htype]{$id};
-      $self->set_should_invoke ($htype, -1);
-   }
-}
-
-sub on {
-   my ($self, %hook) = @_;
-
-   my %disable = ( "" => $self );
-
-   while (my ($name, $cb) = each %hook) {
-      my $htype = $HOOKTYPE{uc $name};
-      defined $htype
-         or Carp::croak "unsupported hook type '$name'";
-
-      my $id = $cb+0;
-
-      $self->set_should_invoke ($htype, +1);
-      $disable{$htype} = $id;
-      $self->{_hook}[$htype]{$id} = $cb;
-   }
-
-   bless \%disable, "urxvt::term::on_disable"
-}
-
 =item $term->exec_async ($cmd[, @args])
 
 Works like the combination of the C<fork>/C<exec> builtins, which executes
@@ -1207,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
@@ -1237,17 +1307,10 @@
    $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0
 }
 
-=item $success = $term->parse_keysym ($key, $octets)
-
-Adds a key binding exactly as specified via a resource. See the
-C<keysym> resource in the @@RXVT_NAME@@(1) manpage.
+=item $success = $term->bind_action ($key, $octets)
 
-=item $term->register_command ($keysym, $modifiermask, $string)
-
-Adds a key binding. This is a lower level api compared to
-C<parse_keysym>, as it expects a parsed key description, and can be
-used only inside either the C<on_init> hook, to add a binding, or the
-C<on_register_command> hook, to modify a parsed binding.
+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])
 
@@ -1438,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
@@ -1680,11 +1751,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}),
@@ -1694,11 +1764,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 = [