[ViewVC] Diff of: cvs/rxvt-unicode/src/urxvt.pm

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.230 by root, Sat Apr 26 20:51:12 2014 UTC vs.
Revision 1.235 by sf-exg, Sat May 17 15:33:24 2014 UTC

 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 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_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<register_command>.
 =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
 manpage), with the additional members C<row> and C<col>, which are the
 (real, not screen-based) row and column under the mouse cursor.
 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
 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 (
 }
 sub usage {
    my ($term, $usage_type) = @_;
-   $term->scan_meta;
+   $term->scan_extensions;
    my $r = $term->{meta}{resource};
    for my $pattern (sort keys %$r) {
       my ($ext, $type, $desc) = @{ $r->{$pattern} };
    local $TERM = shift;
    my $htype = shift;
    if ($htype == HOOK_INIT) {
       my @dirs = $TERM->perl_libdirs;
+      $TERM->scan_extensions;
       my %ext_arg;
       {
          my @init = @TERM_INIT;
    if (my $cb = $TERM->{_hook}[$htype]) {
       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
+         my $pkg = shift;
-         ? exists $cb->{"urxvt::ext::$_[0]"} ? "urxvt::ext::" . shift : return undef
+         $pkg =~ y/-/_/;
-         : keys %$cb
+         $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_;
          if ($@) {
             $TERM->ungrab; # better to lose the grab than the session
       $ENV{URXVT_PERL_LIB},
       "$ENV{HOME}/.urxvt/ext",
       "$LIBDIR/perl"
 }
-sub scan_meta {
+# scan for available extensions and collect their metadata
+sub scan_extensions {
    my ($self) = @_;
+   return if exists $self->{meta};
    my @libdirs = perl_libdirs $self;
    return if $self->{meta_libdirs} eq join "\x00", @libdirs;
    my %meta;
    $self->{meta_libdirs} = join "\x00", @libdirs;
    $self->{meta}         = \%meta;
+   my %ext;
+   # first gather extensions
    for my $dir (reverse @libdirs) {
       opendir my $fh, $dir
          or next;
       for my $ext (readdir $fh) {
          $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} = $action;
             } elsif (/^\s*(?:#|$)/) {
                # skip other comments and empty lines
             } else {
                last; # stop parsing on first non-empty non-comment line
             }
          }
+         $meta{$ext} = \%ext;
       }
+   }
+   # and now merge resources and bindings
+   while (my ($k, $v) = each %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...]
    my $res = &x_resource;
    $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<keysym> resource. See the
 C<keysym> 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<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.
 =item $rend = $term->rstyle ([$new_rstyle])
 Return and optionally change the current rendition. Text that is output by
 the terminal application will use this style.
 =item $term->tt_write ($octets)
 Write the octets given in C<$octets> to the tty (i.e. as program input). To
 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 invokes 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
 CR and bracketing the data with control sequences if bracketed paste mode

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing rxvt-unicode/src/urxvt.pm (file contents): Revision 1.230 by root, Sat Apr 26 20:51:12 2014 UTC vs. Revision 1.235 by sf-exg, Sat May 17 15:33:24 2014 UTC

Diff Legend

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.230 by root, Sat Apr 26 20:51:12 2014 UTC vs.
Revision 1.235 by sf-exg, Sat May 17 15:33:24 2014 UTC