[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.249 by root, Fri Dec 26 21:26:37 2014 UTC

 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
+Extensions may add additional resources and C<actions>, i.e., methods
-loaded automatically when used.
+which can be bound to a key and invoked by the user. An extension can
+define the resources it support and also default bindings for one or
+more actions it provides using so called META comments, described
+below. Similarly to builtin resources, extension resources can also be
+specified on the command line as long options (with C<.> replaced by
+C<->), in which case the corresponding extension is loaded
+automatically. For this to work the extension B<must> define META
+comments for its resources.
 =head1 API DOCUMENTATION
 =head2 General API Considerations
 C<urxvt::term> class on this object.
 Additional methods only supported for extension objects are described in
 the C<urxvt::extension> section below.
+=head2 META comments
+Rxvt-unicode recognizes special meta comments in extensions that define
+different types of metadata.
+Currently, it recxognises only one such comment:
+=over 4
+=item #:META:RESOURCE:name:type:desc
+The RESOURCE comment defines a resource used by the extension, where
+C<name> is the resource name, C<type> is the resource type, C<boolean>
+or C<string>, and C<desc> is the resource description.
+=back
 =head2 Hooks
 The following subroutines can be declared in extension files, and will be
 called whenever the relevant event happens.
 =item on_refresh_end $term
 Called just after the screen gets redrawn. See C<on_refresh_begin>.
+=item on_action $term, $string
+Called whenever an action is invoked for the corresponding extension
+(e.g. via a C<extension:string> builtin action bound to a key, see
+description of the B<keysym> resource in the urxvt(1) manpage). The
+event is simply the action string. Note that an action event is always
+associated to a single extension.
 =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 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_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
 no warnings 'utf8';
 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) {
+   while (my ($k, $v) = each %$r) {
-      if (
+      my $pattern = $k;
+      $pattern =~ y/./-/ if $isarg;
+      my $prefix = $name;
+      my $suffix;
-         $pattern =~ /\.$/
+      if ($pattern =~ /\-$/) {
-         ? $pattern eq substr $name, 0, length $pattern
+         $prefix = substr $name, 0, length $pattern;
-         : $pattern eq $name
+         $suffix = substr $name, length $pattern;
-      ) {
+      }
+      if ($pattern eq $prefix) {
-         $name = "$urxvt::RESCLASS.$name";
+         $name = "$urxvt::RESCLASS.$k$suffix";
          push @{ $term->{perl_ext_3} }, $v->[0];
          if ($v->[1] eq "boolean") {
             $term->put_option_db ($name, $flag ? "true" : "false");
 }
 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} };
    my $htype = shift;
    if ($htype == HOOK_INIT) {
       my @dirs = $TERM->perl_libdirs;
+      $TERM->scan_extensions;
       my %ext_arg;
       {
          my @init = @TERM_INIT;
          @TERM_INIT = ();
          @TERM_EXT = ();
          $TERM->register_package ($_) for @pkg;
       }
       for (
+         (grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2),
-         @{ delete $TERM->{perl_ext_3} },
+         @{ delete $TERM->{perl_ext_3} }
-         grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
       ) {
          if ($_ eq "default") {
+            $ext_arg{$_} = []
-            $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup searchable-scrollback readline);
+               for qw(selection option-popup selection-popup readline searchable-scrollback);
+            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{$_} ||= [];
          }
       }
    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
    }
    bless \%disable, "urxvt::extension::on_disable"
 }
+=item $self->bind_action ($hotkey, $action)
 =item $self->x_resource ($pattern)
 =item $self->x_resource_boolean ($pattern)
-These methods support an additional C<%> prefix when called on an
+These methods support an additional C<%> prefix for C<$action> or
-extension object - see the description of these methods in the
+C<$pattern> when called on an extension object, compared to the
+C<urxvt::term> methods of the same name - see the description of these
-C<urxvt::term> class for details.
+methods in the C<urxvt::term> class for details.
 =cut
+sub bind_action {
+   my ($self, $hotkey, $action) = @_;
+   $action =~ s/^%:/$_[0]{_name}:/;
+   $self->{term}->bind_action ($hotkey, $action)
+}
 sub x_resource {
    my ($self, $name) = @_;
    $name =~ s/^%(\.|$)/$_[0]{_name}$1/;
    $self->{term}->x_resource ($name)
       $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;
+   my @urxvtdirs = perl_libdirs $self;
+   my @cpandirs = grep -d, map "$_/URxvt/Ext", @INC;
-   return if $self->{meta_libdirs} eq join "\x00", @libdirs;
-   my %meta;
-   $self->{meta_libdirs} = join "\x00", @libdirs;
-   $self->{meta}         = \%meta;
+   $self->{meta} = \my %meta;
-   for my $dir (reverse @libdirs) {
+   # first gather extensions
+   my $gather = sub {
+      my ($dir, $core) = @_;
       opendir my $fh, $dir
-         or next;
+         or return;
       for my $ext (readdir $fh) {
          $ext !~ /^\./
-            and open my $fh, "<", "$dir/$ext"
             or next;
+         open my $fh, "<", "$dir/$ext"
+            or next;
+         -f $fh
+            or next;
+         $ext =~ s/\.uext$// or $core
+            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 (/^\s*(?:#|$)/) {
                # skip other comments and empty lines
             } else {
                last; # stop parsing on first non-empty non-comment line
             }
          }
+         $meta{ext}{$ext} = \%ext;
       }
+   };
+   $gather->($_, 0) for @cpandirs;
+   $gather->($_, 1) for @urxvtdirs;
+   # and now merge resources
+   while (my ($k, $v) = each %{ $meta{ext} }) {
+      #TODO: should check for extensions overriding each other
+      %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} });
    }
 }
 =item $term = new urxvt::term $envhashref, $rxvtname, [arg...]
 Returns the X-Resource for the given pattern, excluding the program or
 class name, i.e.  C<< $term->x_resource ("boldFont") >> should return the
 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
+Extensions that define extra resources also need to call this method
-to call this method to access their values.
+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
 the extension and a dot, and the lone string C<%> will be replaced by the
 extension name itself. This makes it possible to code extensions so you
-can rename them and get a new set of commandline switches and resources
+can rename them and get a new set of resources without having to change
-without having to change the actual code.
+the actual code.
 This method should only be called during the C<on_start> hook, as there is
 only one resource database per display, and later invocations might return
 the wrong resources.
    my $res = &x_resource;
    $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0
 }
-=item $success = $term->bind_action ($key, $octets)
+=item $success = $term->bind_action ($key, $action)
-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.
+To add default bindings for an extension, the extension should call C<<
+->bind_action >> on it's C<init> hook for every such binding. Doing it
+in the C<init> hook allows users the override or remove the the binding
+again.
+Example: the C<searchable-scrollback> by default binds itself
+on C<Meta-s>, using C<< $self->bind_action >>, which calls C<<
+$term->bind_action >>.
+   sub init {
+      my ($self) = @_;
+      $self->bind_action ("M-s" => "%:start");
+   }
 =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->scr_add_lines ($string)
 Write the given text string to the screen, as if output by the application
 running inside the terminal. It may not contain command sequences (escape
-codes), but is free to use line feeds, carriage returns and tabs. The
+codes - see C<cmd_parse> for that), but is free to use line feeds,
-string is a normal text string, not in locale-dependent encoding.
+carriage returns and tabs. The string is a normal text string, not in
+locale-dependent encoding.
 Normally its not a good idea to use this function, as programs might be
 confused by changes in cursor position or scrolling. Its useful inside a
 C<on_add_lines> hook, though.
 locale-specific encoding of the terminal and can contain command sequences
 (escape codes) that will be interpreted.
 =item $term->tt_write ($octets)
-Write the octets given in C<$octets> to the tty (i.e. as program input). To
+Write the octets given in C<$octets> to the tty (i.e. as user input
+to the program, see C<cmd_parse> for the opposite direction). To pass
-pass characters instead of octets, you should convert your strings first
+characters instead of octets, you should convert your strings first to the
-to the locale-specific encoding using C<< $term->locale_encode >>.
+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
 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.249 by root, Fri Dec 26 21:26:37 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.249 by root, Fri Dec 26 21:26:37 2014 UTC