--- rxvt-unicode/src/urxvt.pm 2012/07/14 08:00:34 1.224 +++ rxvt-unicode/src/urxvt.pm 2014/12/22 09:10:12 1.245 @@ -2,7 +2,7 @@ =head1 NAME -@@RXVT_NAME@@perl - rxvt-unicode's embedded perl interpreter +urxvtperl - rxvt-unicode's embedded perl interpreter =head1 SYNOPSIS @@ -13,9 +13,9 @@ () } - # 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 @@ -25,7 +25,7 @@ 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" @@ -34,19 +34,26 @@ =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 -using F<< man urxvt- >>. +in F<< /urxvt/perl/ >>, and the documentation can be viewed using +F<< man urxvt- >>. You can activate them like this: - @@RXVT_NAME@@ -pe + urxvt -pe 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 -loaded automatically when used. +Extensions may add additional resources and C, i.e., methods +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 define META +comments for its resources. =head1 API DOCUMENTATION @@ -108,6 +115,29 @@ Additional methods only supported for extension objects are described in the C section below. +=head2 META comments + +rxvt-unicode recognizes special comments in extensions that define +different types of metadata: + +=over 4 + +=item #:META:RESOURCE:name:type:desc + +The RESOURCE comment defines a resource used by the extension, where +C is the resource name, C is the resource type, C +or C, and C is the resource description. + +=item #:META:BINDING:sym:action + +The BINDING comment defines a default binding for an action provided +by the extension, where C is the key combination that triggers +the action, whose format is defined in the description of the +B resource in the urxvt(1) manpage, and C is the name +of the action method. + +=back + =head2 Hooks The following subroutines can be declared in extension files, and will be @@ -283,27 +313,28 @@ Called just after the screen gets redrawn. See C. -=item on_user_command $term, $string +=item on_action $term, $string -Called whenever a user-configured event is being activated (e.g. via -a C action bound to a key, see description of the B -resource in the @@RXVT_NAME@@(1) manpage). +Called whenever an action is invoked for the corresponding extension +(e.g. via a C builtin action bound to a key, see +description of the B 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. -The event is simply the action string. This interface is assumed to change -slightly in the future. +=item on_user_command $term, $string *DEPRECATED* -=item on_register_command $term, $keysym, $modifiermask, $string +Called whenever a user-configured event is being activated (e.g. via +a C action bound to a key, see description of the B +resource in the urxvt(1) manpage). -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. +The event is simply the action string. This interface is going away in +preference to the C 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 -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 @@ -353,8 +384,6 @@ C 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 @@ -566,19 +595,21 @@ 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 - while (my ($pattern, $v) = each %$r) { - if ( - $pattern =~ /\.$/ - ? $pattern eq substr $name, 0, length $pattern - : $pattern eq $name - ) { - $name = "$urxvt::RESCLASS.$name"; + keys %$r; # reset iterator + while (my ($k, $v) = each %$r) { + my $pattern = $k; + $pattern =~ y/./-/ if $isarg; + my $prefix = $name; + my $suffix; + if ($pattern =~ /\-$/) { + $prefix = substr $name, 0, length $pattern; + $suffix = substr $name, length $pattern; + } + if ($pattern eq $prefix) { + $name = "$urxvt::RESCLASS.$k$suffix"; push @{ $term->{perl_ext_3} }, $v->[0]; @@ -598,7 +629,7 @@ sub usage { my ($term, $usage_type) = @_; - $term->scan_meta; + $term->scan_extensions; my $r = $term->{meta}{resource}; @@ -669,9 +700,11 @@ 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; { @@ -684,20 +717,43 @@ } for ( - @{ delete $TERM->{perl_ext_3} }, - grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2 + (grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2), + @{ delete $TERM->{perl_ext_3} } ) { if ($_ eq "default") { - $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup searchable-scrollback readline); + + $ext_arg{$_} = [] + for + qw(selection option-popup selection-popup readline), + map $_->[0], values %{ $TERM->{meta}{binding} }; + + 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{$_} ||= []; } } + # now register default key bindings + for my $ext (sort keys %ext_arg) { + while (my ($k, $v) = each %{ $TERM->{meta}{ext}{$ext}{binding} }) { + $TERM->bind_action ($k, "$v->[0]:$v->[1]"); + } + } + for my $ext (sort keys %ext_arg) { my @files = grep -f $_, map "$_/$ext", @dirs; @@ -718,6 +774,19 @@ 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_; @@ -732,7 +801,7 @@ if $verbosity >= 11; } - if ($htype == 1) { # DESTROY + if ($htype == HOOK_DESTROY) { # clear package objects %$_ = () for values %{ $TERM->{_pkg} }; @@ -829,8 +898,11 @@ =item $self->enable ($hook_name => $cb[, $hook_name => $cb..]) Dynamically enable the given hooks (named without the C prefix) for -this extension, replacing any previous hook. This is useful when you want -to overwrite time-critical hooks only temporarily. +this extension, replacing any hook previously installed via C in +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 method of the C class. @@ -1064,43 +1136,59 @@ "$LIBDIR/perl" } -sub scan_meta { +# scan for available extensions and collect their metadata +sub scan_extensions { my ($self) = @_; - my @libdirs = perl_libdirs $self; - return if $self->{meta_libdirs} eq join "\x00", @libdirs; + return if exists $self->{meta}; - my %meta; + my @libdirs = perl_libdirs $self; + +# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d# - $self->{meta_libdirs} = join "\x00", @libdirs; - $self->{meta} = \%meta; +# $self->{meta_libdirs} = join "\x00", @libdirs;#d# + $self->{meta} = \my %meta; + # first gather extensions for my $dir (reverse @libdirs) { opendir my $fh, $dir or next; for my $ext (readdir $fh) { - $ext ne "." - and $ext ne ".." + $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} = [$ext, $action]; } elsif (/^\s*(?:#|$)/) { # skip other comments and empty lines } else { last; # stop parsing on first non-empty non-comment line } } + + $meta{ext}{$ext} = \%ext; } } + + # and now merge resources and bindings + while (my ($k, $v) = each %{ $meta{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...] @@ -1129,7 +1217,7 @@ =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]) @@ -1225,15 +1313,15 @@ same value as used by this instance of rxvt-unicode. Returns C if no resource with that pattern exists. -Extensions that define extra resource or command line arguments also need -to call this method to access their values. +Extensions that define extra resources also need to call this method +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 -without having to change the actual code. +can rename them and get a new set of resources without having to change +the actual code. This method should only be called during the C hook, as there is only one resource database per display, and later invocations might return @@ -1255,17 +1343,10 @@ $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 -C resource in the @@RXVT_NAME@@(1) manpage. - -=item $term->register_command ($keysym, $modifiermask, $string) - -Adds a key binding. This is a lower level api compared to -C, as it expects a parsed key description, and can be -used only inside either the C hook, to add a binding, or the -C hook, to modify a parsed binding. +Adds a key binding exactly as specified via a C resource. See the +C resource in the urxvt(1) manpage. =item $rend = $term->rstyle ([$new_rstyle]) @@ -1433,8 +1514,9 @@ 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 -string is a normal text string, not in locale-dependent encoding. +codes - see C for that), but is free to use line feeds, +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 @@ -1452,9 +1534,18 @@ =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 >>. +Write the octets given in C<$octets> to the tty (i.e. as user input +to the program, see C for the opposite direction). 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, 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 doesn't do that). + +The typical use case would be inside C hooks. =item $term->tt_paste ($octets) @@ -1698,11 +1789,10 @@ sub urxvt::line::t { my ($self) = @_; - if (@_ > 1) - { - $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) - for $self->{beg} .. $self->{end}; - } + if (@_ > 1) { + $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) + for $self->{beg} .. $self->{end}; + } defined wantarray && substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}), @@ -1712,11 +1802,10 @@ sub urxvt::line::r { my ($self) = @_; - if (@_ > 1) - { - $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) - for $self->{beg} .. $self->{end}; - } + if (@_ > 1) { + $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) + for $self->{beg} .. $self->{end}; + } if (defined wantarray) { my $rend = [