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

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.229 by root, Sat Apr 26 18:53:51 2014 UTC vs.
Revision 1.234 by root, Sat May 17 15:25:04 2014 UTC

 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<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
 returns a true value, setting of the window hints is being skipped.
 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} };
 # called by the rxvt core
 sub invoke {
    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;
       {
          my @init = @TERM_INIT;
    if (my $cb = $TERM->{_hook}[$htype]) {
       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_;
          if ($@) {
       verbose 11, "$HOOKNAME[$htype] returning <$retval>"
          if $verbosity >= 11;
    }
-   if ($htype == 1) { # DESTROY
+   if ($htype == HOOK_DESTROY) {
       # clear package objects
       %$_ = () for values %{ $TERM->{_pkg} };
       # clear package
       %$TERM = ();
       $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.229 by root, Sat Apr 26 18:53:51 2014 UTC vs. Revision 1.234 by root, Sat May 17 15:25:04 2014 UTC

Diff Legend

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.229 by root, Sat Apr 26 18:53:51 2014 UTC vs.
Revision 1.234 by root, Sat May 17 15:25:04 2014 UTC