ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/urxvt.pm
(Generate patch)

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.225 by root, Fri Aug 10 19:06:06 2012 UTC vs.
Revision 1.236 by root, Sat May 17 17:12:29 2014 UTC

1=encoding utf8 1=encoding utf8
2 2
3=head1 NAME 3=head1 NAME
4 4
5@@RXVT_NAME@@perl - rxvt-unicode's embedded perl interpreter 5urxvtperl - rxvt-unicode's embedded perl interpreter
6 6
7=head1 SYNOPSIS 7=head1 SYNOPSIS
8 8
9 # create a file grab_test in $HOME: 9 # create a file grab_test in $HOME:
10 10
11 sub on_sel_grab { 11 sub on_sel_grab {
12 warn "you selected ", $_[0]->selection; 12 warn "you selected ", $_[0]->selection;
13 () 13 ()
14 } 14 }
15 15
16 # start a @@RXVT_NAME@@ using it: 16 # start a urxvt using it:
17 17
18 @@RXVT_NAME@@ --perl-lib $HOME -pe grab_test 18 urxvt --perl-lib $HOME -pe grab_test
19 19
20=head1 DESCRIPTION 20=head1 DESCRIPTION
21 21
22Every time a terminal object gets created, extension scripts specified via 22Every time a terminal object gets created, extension scripts specified via
23the C<perl> resource are loaded and associated with it. 23the C<perl> resource are loaded and associated with it.
24 24
25Scripts are compiled in a 'use strict "vars"' and 'use utf8' environment, and 25Scripts are compiled in a 'use strict "vars"' and 'use utf8' environment, and
26thus must be encoded as UTF-8. 26thus must be encoded as UTF-8.
27 27
28Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where 28Each script will only ever be loaded once, even in urxvtd, where
29scripts will be shared (but not enabled) for all terminals. 29scripts will be shared (but not enabled) for all terminals.
30 30
31You can disable the embedded perl interpreter by setting both "perl-ext" 31You can disable the embedded perl interpreter by setting both "perl-ext"
32and "perl-ext-common" resources to the empty string. 32and "perl-ext-common" resources to the empty string.
33 33
34=head1 PREPACKAGED EXTENSIONS 34=head1 PREPACKAGED EXTENSIONS
35 35
36A number of extensions are delivered with this release. You can find them 36A number of extensions are delivered with this release. You can find them
37in F<@@RXVT_LIBDIR@@/urxvt/perl/>, and the documentation can be viewed 37in F<< <libdir>/urxvt/perl/ >>, and the documentation can be viewed using
38using F<< man urxvt-<EXTENSIONNAME> >>. 38F<< man urxvt-<EXTENSIONNAME> >>.
39 39
40You can activate them like this: 40You can activate them like this:
41 41
42 @@RXVT_NAME@@ -pe <extensionname> 42 urxvt -pe <extensionname>
43 43
44Or by adding them to the resource for extensions loaded by default: 44Or by adding them to the resource for extensions loaded by default:
45 45
46 URxvt.perl-ext-common: default,selection-autotransform 46 URxvt.perl-ext-common: default,selection-autotransform
47 47
281 281
282=item on_refresh_end $term 282=item on_refresh_end $term
283 283
284Called just after the screen gets redrawn. See C<on_refresh_begin>. 284Called just after the screen gets redrawn. See C<on_refresh_begin>.
285 285
286=item on_user_command $term, $string 286=item on_user_command $term, $string *DEPRECATED*
287 287
288Called whenever a user-configured event is being activated (e.g. via 288Called whenever a user-configured event is being activated (e.g. via
289a C<perl:string> action bound to a key, see description of the B<keysym> 289a C<perl:string> action bound to a key, see description of the B<keysym>
290resource in the @@RXVT_NAME@@(1) manpage). 290resource in the urxvt(1) manpage).
291 291
292The event is simply the action string. This interface is assumed to change 292The event is simply the action string. This interface is going away in
293slightly in the future. 293preference to the C<on_action> hook.
294
295=item on_register_command $term, $keysym, $modifiermask, $string
296
297Called after parsing a keysym resource but before registering the
298associated binding. If this hook returns TRUE the binding is not
299registered. It can be used to modify a binding by calling
300C<register_command>.
301 294
302=item on_resize_all_windows $term, $new_width, $new_height 295=item on_resize_all_windows $term, $new_width, $new_height
303 296
304Called just after the new window size has been calculated, but before 297Called just after the new window size has been calculated, but before
305windows are actually being resized or hints are being set. If this hook 298windows are actually being resized or hints are being set. If this hook
306returns TRUE, setting of the window hints is being skipped. 299returns a true value, setting of the window hints is being skipped.
307 300
308=item on_x_event $term, $event 301=item on_x_event $term, $event
309 302
310Called on every X event received on the vt window (and possibly other 303Called on every X event received on the vt window (and possibly other
311windows). Should only be used as a last resort. Most event structure 304windows). Should only be used as a last resort. Most event structure
350manpage), with the additional members C<row> and C<col>, which are the 343manpage), with the additional members C<row> and C<col>, which are the
351(real, not screen-based) row and column under the mouse cursor. 344(real, not screen-based) row and column under the mouse cursor.
352 345
353C<on_key_press> additionally receives the string rxvt-unicode would 346C<on_key_press> additionally receives the string rxvt-unicode would
354output, if any, in locale-specific encoding. 347output, if any, in locale-specific encoding.
355
356subwindow.
357 348
358=item on_client_message $term, $event 349=item on_client_message $term, $event
359 350
360=item on_wm_protocols $term, $event 351=item on_wm_protocols $term, $event
361 352
566sub parse_resource { 557sub parse_resource {
567 my ($term, $name, $isarg, $longopt, $flag, $value) = @_; 558 my ($term, $name, $isarg, $longopt, $flag, $value) = @_;
568 559
569 $name =~ y/-/./ if $isarg; 560 $name =~ y/-/./ if $isarg;
570 561
571 $term->scan_meta; 562 $term->scan_extensions;
572 563
573 my $r = $term->{meta}{resource}; 564 my $r = $term->{meta}{resource};
574 keys %$r; # reste iterator 565 keys %$r; # reset iterator
575 while (my ($pattern, $v) = each %$r) { 566 while (my ($pattern, $v) = each %$r) {
576 if ( 567 if (
577 $pattern =~ /\.$/ 568 $pattern =~ /\.$/
578 ? $pattern eq substr $name, 0, length $pattern 569 ? $pattern eq substr $name, 0, length $pattern
579 : $pattern eq $name 570 : $pattern eq $name
596} 587}
597 588
598sub usage { 589sub usage {
599 my ($term, $usage_type) = @_; 590 my ($term, $usage_type) = @_;
600 591
601 $term->scan_meta; 592 $term->scan_extensions;
602 593
603 my $r = $term->{meta}{resource}; 594 my $r = $term->{meta}{resource};
604 595
605 for my $pattern (sort keys %$r) { 596 for my $pattern (sort keys %$r) {
606 my ($ext, $type, $desc) = @{ $r->{$pattern} }; 597 my ($ext, $type, $desc) = @{ $r->{$pattern} };
667# called by the rxvt core 658# called by the rxvt core
668sub invoke { 659sub invoke {
669 local $TERM = shift; 660 local $TERM = shift;
670 my $htype = shift; 661 my $htype = shift;
671 662
672 if ($htype == 0) { # INIT 663 if ($htype == HOOK_INIT) {
673 my @dirs = $TERM->perl_libdirs; 664 my @dirs = $TERM->perl_libdirs;
665
666 $TERM->scan_extensions;
674 667
675 my %ext_arg; 668 my %ext_arg;
676 669
677 { 670 {
678 my @init = @TERM_INIT; 671 my @init = @TERM_INIT;
686 for ( 679 for (
687 @{ delete $TERM->{perl_ext_3} }, 680 @{ delete $TERM->{perl_ext_3} },
688 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2 681 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
689 ) { 682 ) {
690 if ($_ eq "default") { 683 if ($_ eq "default") {
691 $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup searchable-scrollback readline); 684
685 $ext_arg{$_} ||= []
686 for
687 qw(selection option-popup selection-popup readline),
688 map $_->[0], values %{ $TERM->{meta}{binding} };
689
692 } elsif (/^-(.*)$/) { 690 } elsif (/^-(.*)$/) {
693 delete $ext_arg{$1}; 691 delete $ext_arg{$1};
692
694 } elsif (/^([^<]+)<(.*)>$/) { 693 } elsif (/^([^<]+)<(.*)>$/) {
695 push @{ $ext_arg{$1} }, $2; 694 push @{ $ext_arg{$1} }, $2;
695
696 } else { 696 } else {
697 $ext_arg{$_} ||= []; 697 $ext_arg{$_} ||= [];
698 } 698 }
699 }
700
701 # now register default key bindings
702 while (my ($k, $v) = each %{ $TERM->{meta}{binding} }) {
703 $TERM->bind_action ($k, "$v->[0]:$v->[1]");
699 } 704 }
700 705
701 for my $ext (sort keys %ext_arg) { 706 for my $ext (sort keys %ext_arg) {
702 my @files = grep -f $_, map "$_/$ext", @dirs; 707 my @files = grep -f $_, map "$_/$ext", @dirs;
703 708
716 721
717 if (my $cb = $TERM->{_hook}[$htype]) { 722 if (my $cb = $TERM->{_hook}[$htype]) {
718 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" 723 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
719 if $verbosity >= 10; 724 if $verbosity >= 10;
720 725
726 if ($htype == HOOK_ACTION) {
727 # this hook is only sent to the extension with the name
728 # matching the first arg
729 my $pkg = shift;
730 $pkg =~ y/-/_/;
731 $pkg = "urxvt::ext::$pkg";
732
733 $cb = $cb->{$pkg}
734 or return undef; #TODO: maybe warn user?
735
736 $cb = { $pkg => $cb };
737 }
738
721 for my $pkg (keys %$cb) { 739 for my $pkg (keys %$cb) {
722 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) }; 740 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) };
723 $retval ||= $retval_; 741 $retval ||= $retval_;
724 742
725 if ($@) { 743 if ($@) {
730 748
731 verbose 11, "$HOOKNAME[$htype] returning <$retval>" 749 verbose 11, "$HOOKNAME[$htype] returning <$retval>"
732 if $verbosity >= 11; 750 if $verbosity >= 11;
733 } 751 }
734 752
735 if ($htype == 1) { # DESTROY 753 if ($htype == HOOK_DESTROY) {
736 # clear package objects 754 # clear package objects
737 %$_ = () for values %{ $TERM->{_pkg} }; 755 %$_ = () for values %{ $TERM->{_pkg} };
738 756
739 # clear package 757 # clear package
740 %$TERM = (); 758 %$TERM = ();
827} 845}
828 846
829=item $self->enable ($hook_name => $cb[, $hook_name => $cb..]) 847=item $self->enable ($hook_name => $cb[, $hook_name => $cb..])
830 848
831Dynamically enable the given hooks (named without the C<on_> prefix) for 849Dynamically enable the given hooks (named without the C<on_> prefix) for
832this extension, replacing any previous hook. This is useful when you want 850this extension, replacing any hook previously installed via C<enable> in
833to overwrite time-critical hooks only temporarily. 851this extension.
852
853This is useful when you want to overwrite time-critical hooks only
854temporarily.
834 855
835To install additional callbacks for the same hook, you can use the C<on> 856To install additional callbacks for the same hook, you can use the C<on>
836method of the C<urxvt::term> class. 857method of the C<urxvt::term> class.
837 858
838=item $self->disable ($hook_name[, $hook_name..]) 859=item $self->disable ($hook_name[, $hook_name..])
1062 $ENV{URXVT_PERL_LIB}, 1083 $ENV{URXVT_PERL_LIB},
1063 "$ENV{HOME}/.urxvt/ext", 1084 "$ENV{HOME}/.urxvt/ext",
1064 "$LIBDIR/perl" 1085 "$LIBDIR/perl"
1065} 1086}
1066 1087
1067sub scan_meta { 1088# scan for available extensions and collect their metadata
1089sub scan_extensions {
1068 my ($self) = @_; 1090 my ($self) = @_;
1091
1092 return if exists $self->{meta};
1093
1069 my @libdirs = perl_libdirs $self; 1094 my @libdirs = perl_libdirs $self;
1070 1095
1071 return if $self->{meta_libdirs} eq join "\x00", @libdirs; 1096# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d#
1072 1097
1073 my %meta;
1074
1075 $self->{meta_libdirs} = join "\x00", @libdirs; 1098# $self->{meta_libdirs} = join "\x00", @libdirs;#d#
1076 $self->{meta} = \%meta; 1099 $self->{meta} = \my %meta;
1077 1100
1101 # first gather extensions
1078 for my $dir (reverse @libdirs) { 1102 for my $dir (reverse @libdirs) {
1079 opendir my $fh, $dir 1103 opendir my $fh, $dir
1080 or next; 1104 or next;
1081 for my $ext (readdir $fh) { 1105 for my $ext (readdir $fh) {
1082 $ext !~ /^\./ 1106 $ext !~ /^\./
1083 and open my $fh, "<", "$dir/$ext" 1107 and open my $fh, "<", "$dir/$ext"
1084 or next; 1108 or next;
1085 1109
1110 my %ext = (dir => $dir);
1111
1086 while (<$fh>) { 1112 while (<$fh>) {
1087 if (/^#:META:X_RESOURCE:(.*)/) { 1113 if (/^#:META:(?:X_)?RESOURCE:(.*)/) {
1088 my ($pattern, $type, $desc) = split /:/, $1; 1114 my ($pattern, $type, $desc) = split /:/, $1;
1089 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name 1115 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
1090 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) { 1116 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
1091 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n"; 1117 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n";
1092 } else { 1118 } else {
1093 $meta{resource}{$pattern} = [$ext, $type, $desc]; 1119 $ext{resource}{$pattern} = [$ext, $type, $desc];
1094 } 1120 }
1121 } elsif (/^#:META:BINDING:(.*)/) {
1122 my ($keysym, $action) = split /:/, $1;
1123 $ext{binding}{$keysym} = [$ext, $action];
1095 } elsif (/^\s*(?:#|$)/) { 1124 } elsif (/^\s*(?:#|$)/) {
1096 # skip other comments and empty lines 1125 # skip other comments and empty lines
1097 } else { 1126 } else {
1098 last; # stop parsing on first non-empty non-comment line 1127 last; # stop parsing on first non-empty non-comment line
1099 } 1128 }
1100 } 1129 }
1130
1131 $meta{ext}{$ext} = \%ext;
1101 } 1132 }
1133 }
1134
1135 # and now merge resources and bindings
1136 while (my ($k, $v) = each %{ $meta{ext} }) {
1137 #TODO: should check for extensions overriding each other
1138 %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} });
1139 %{ $meta{binding} } = (%{ $meta{binding} }, %{ $v->{binding} });
1102 } 1140 }
1103} 1141}
1104 1142
1105=item $term = new urxvt::term $envhashref, $rxvtname, [arg...] 1143=item $term = new urxvt::term $envhashref, $rxvtname, [arg...]
1106 1144
1126} 1164}
1127 1165
1128=item $term->destroy 1166=item $term->destroy
1129 1167
1130Destroy the terminal object (close the window, free resources 1168Destroy the terminal object (close the window, free resources
1131etc.). Please note that @@RXVT_NAME@@ will not exit as long as any event 1169etc.). Please note that urxvt will not exit as long as any event
1132watchers (timers, io watchers) are still active. 1170watchers (timers, io watchers) are still active.
1133 1171
1134=item $term->exec_async ($cmd[, @args]) 1172=item $term->exec_async ($cmd[, @args])
1135 1173
1136Works like the combination of the C<fork>/C<exec> builtins, which executes 1174Works like the combination of the C<fork>/C<exec> builtins, which executes
1252 my $res = &x_resource; 1290 my $res = &x_resource;
1253 1291
1254 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0 1292 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0
1255} 1293}
1256 1294
1257=item $success = $term->parse_keysym ($key, $octets) 1295=item $success = $term->bind_action ($key, $octets)
1258 1296
1259Adds a key binding exactly as specified via a resource. See the 1297Adds a key binding exactly as specified via a C<keysym> resource. See the
1260C<keysym> resource in the @@RXVT_NAME@@(1) manpage. 1298C<keysym> resource in the urxvt(1) manpage.
1261
1262=item $term->register_command ($keysym, $modifiermask, $string)
1263
1264Adds a key binding. This is a lower level api compared to
1265C<parse_keysym>, as it expects a parsed key description, and can be
1266used only inside either the C<on_init> hook, to add a binding, or the
1267C<on_register_command> hook, to modify a parsed binding.
1268 1299
1269=item $rend = $term->rstyle ([$new_rstyle]) 1300=item $rend = $term->rstyle ([$new_rstyle])
1270 1301
1271Return and optionally change the current rendition. Text that is output by 1302Return and optionally change the current rendition. Text that is output by
1272the terminal application will use this style. 1303the terminal application will use this style.
1452=item $term->tt_write ($octets) 1483=item $term->tt_write ($octets)
1453 1484
1454Write the octets given in C<$octets> to the tty (i.e. as program input). To 1485Write the octets given in C<$octets> to the tty (i.e. as program input). To
1455pass characters instead of octets, you should convert your strings first 1486pass characters instead of octets, you should convert your strings first
1456to the locale-specific encoding using C<< $term->locale_encode >>. 1487to the locale-specific encoding using C<< $term->locale_encode >>.
1488
1489=item $term->tt_write_user_input ($octets)
1490
1491Like C<tt_write>, but should be used when writing strings in response to
1492the user pressing a key, to invokes the additional actions requested by
1493the user for that case (C<tt_write> doesn't do that).
1494
1495The typical use case would be inside C<on_action> hooks.
1457 1496
1458=item $term->tt_paste ($octets) 1497=item $term->tt_paste ($octets)
1459 1498
1460Write the octets given in C<$octets> to the tty as a paste, converting NL to 1499Write the octets given in C<$octets> to the tty as a paste, converting NL to
1461CR and bracketing the data with control sequences if bracketed paste mode 1500CR and bracketing the data with control sequences if bracketed paste mode
1695} 1734}
1696 1735
1697sub urxvt::line::t { 1736sub urxvt::line::t {
1698 my ($self) = @_; 1737 my ($self) = @_;
1699 1738
1700 if (@_ > 1) 1739 if (@_ > 1) {
1701 {
1702 $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) 1740 $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol})
1703 for $self->{beg} .. $self->{end}; 1741 for $self->{beg} .. $self->{end};
1704 } 1742 }
1705 1743
1706 defined wantarray && 1744 defined wantarray &&
1707 substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}), 1745 substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}),
1708 0, $self->{len} 1746 0, $self->{len}
1709} 1747}
1710 1748
1711sub urxvt::line::r { 1749sub urxvt::line::r {
1712 my ($self) = @_; 1750 my ($self) = @_;
1713 1751
1714 if (@_ > 1) 1752 if (@_ > 1) {
1715 {
1716 $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) 1753 $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol})
1717 for $self->{beg} .. $self->{end}; 1754 for $self->{beg} .. $self->{end};
1718 } 1755 }
1719 1756
1720 if (defined wantarray) { 1757 if (defined wantarray) {
1721 my $rend = [ 1758 my $rend = [
1722 map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end} 1759 map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end}
1723 ]; 1760 ];

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines