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

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.223 by root, Sat Jul 14 08:00:18 2012 UTC vs.
Revision 1.235 by sf-exg, Sat May 17 15:33:24 2014 UTC

 =encoding utf8
 =head1 NAME
-@@RXVT_NAME@@perl - rxvt-unicode's embedded perl interpreter
+urxvtperl - rxvt-unicode's embedded perl interpreter
 =head1 SYNOPSIS
    # create a file grab_test in $HOME:
    sub on_sel_grab {
       warn "you selected ", $_[0]->selection;
       ()
    }
-   # 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
 Every time a terminal object gets created, extension scripts specified via
 the C<perl> resource are loaded and associated with it.
 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"
 and "perl-ext-common" resources to the empty string.
 =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
+in F<< <libdir>/urxvt/perl/ >>, and the documentation can be viewed using
-using F<< man urxvt-<EXTENSIONNAME> >>.
+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
 =item on_refresh_end $term
 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).
+resource in the urxvt(1) manpage).
-The event is simply the action string. This interface is assumed to change
+The event is simply the action string. This interface is going away in
-slightly in the future.
+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 TRUE 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 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
 Called on every X event received on the vt window (and possibly other
 windows). Should only be used as a last resort. Most event structure
 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; # reste iterator
+   keys %$r; # reset iterator
    while (my ($pattern, $v) = each %$r) {
       if (
          $pattern =~ /\.$/
          ? $pattern eq substr $name, 0, length $pattern
          : $pattern eq $name
 }
 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 = ();
 }
 =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
+this extension, replacing any hook previously installed via C<enable> in
-to overwrite time-critical hooks only temporarily.
+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..])
    my $disable = shift;
    my $term = delete $disable->{""};
    while (my ($htype, $id) = each %$disable) {
-      warn "disable hook $htype,$id\n";#d#
       delete $term->{_hook}[$htype]{$id};
       $term->set_should_invoke ($htype, -1);
    }
 }
       $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 ne "."
+         $ext !~ /^\./
-            and $ext ne ".."
             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...]
 }
 =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 $term->exec_async ($cmd[, @args])
 Works like the combination of the C<fork>/C<exec> builtins, which executes
    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 @@RXVT_NAME@@(1) manpage.
+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
 }
 sub urxvt::line::t {
    my ($self) = @_;
-   if (@_ > 1)
+   if (@_ > 1) {
-     {
-       $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol})
+      $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol})
-          for $self->{beg} .. $self->{end};
+         for $self->{beg} .. $self->{end};
-     }
+   }
    defined wantarray &&
       substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}),
              0, $self->{len}
 }
 sub urxvt::line::r {
    my ($self) = @_;
-   if (@_ > 1)
+   if (@_ > 1) {
-     {
-       $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol})
+      $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol})
-          for $self->{beg} .. $self->{end};
+         for $self->{beg} .. $self->{end};
-     }
+   }
    if (defined wantarray) {
       my $rend = [
          map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end}
       ];

Diff Legend

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

Comparing rxvt-unicode/src/urxvt.pm (file contents): Revision 1.223 by root, Sat Jul 14 08:00:18 2012 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.223 by root, Sat Jul 14 08:00:18 2012 UTC vs.
Revision 1.235 by sf-exg, Sat May 17 15:33:24 2014 UTC