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

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.233 by sf-exg, Fri May 2 20:34:24 2014 UTC vs.
Revision 1.234 by root, Sat May 17 15:25:04 2014 UTC

 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...]
    $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0
 }
 =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])
 Return and optionally change the current rendition. Text that is output by
 =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.233 by sf-exg, Fri May 2 20:34:24 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.233 by sf-exg, Fri May 2 20:34:24 2014 UTC vs.
Revision 1.234 by root, Sat May 17 15:25:04 2014 UTC