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.224 by root, Sat Jul 14 08:00:34 2012 UTC vs.
Revision 1.238 by root, Sun May 18 18:15:04 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;
682 @TERM_EXT = (); 675 @TERM_EXT = ();
683 $TERM->register_package ($_) for @pkg; 676 $TERM->register_package ($_) for @pkg;
684 } 677 }
685 678
686 for ( 679 for (
687 @{ delete $TERM->{perl_ext_3} },
688 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2 680 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
689 ) { 681 ) {
690 if ($_ eq "default") { 682 if ($_ eq "default") {
691 $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup searchable-scrollback readline); 683
684 $ext_arg{$_} = []
685 for
686 qw(selection option-popup selection-popup readline),
687 map $_->[0], values %{ $TERM->{meta}{binding} },
688 @{ delete $TERM->{perl_ext_3} };
689
690 for ($TERM->_keysym_resources) {
691 next if /^(?:string|command|builtin|builtin-string|perl)/;
692 next unless /^([A-Za-z0-9_\-]+):/;
693
694 my $ext = $1;
695 $ext =~ y/-/_/;
696
697 $ext_arg{$ext} = [];
698 }
699
692 } elsif (/^-(.*)$/) { 700 } elsif (/^-(.*)$/) {
693 delete $ext_arg{$1}; 701 delete $ext_arg{$1};
702
694 } elsif (/^([^<]+)<(.*)>$/) { 703 } elsif (/^([^<]+)<(.*)>$/) {
695 push @{ $ext_arg{$1} }, $2; 704 push @{ $ext_arg{$1} }, $2;
705
696 } else { 706 } else {
697 $ext_arg{$_} ||= []; 707 $ext_arg{$_} ||= [];
708 }
709 }
710
711 # now register default key bindings
712 for my $ext (sort keys %ext_arg) {
713 while (my ($k, $v) = each %{ $TERM->{meta}{ext}{$ext}{binding} }) {
714 $TERM->bind_action ($k, "$v->[0]:$v->[1]");
698 } 715 }
699 } 716 }
700 717
701 for my $ext (sort keys %ext_arg) { 718 for my $ext (sort keys %ext_arg) {
702 my @files = grep -f $_, map "$_/$ext", @dirs; 719 my @files = grep -f $_, map "$_/$ext", @dirs;
716 733
717 if (my $cb = $TERM->{_hook}[$htype]) { 734 if (my $cb = $TERM->{_hook}[$htype]) {
718 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" 735 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
719 if $verbosity >= 10; 736 if $verbosity >= 10;
720 737
738 if ($htype == HOOK_ACTION) {
739 # this hook is only sent to the extension with the name
740 # matching the first arg
741 my $pkg = shift;
742 $pkg =~ y/-/_/;
743 $pkg = "urxvt::ext::$pkg";
744
745 $cb = $cb->{$pkg}
746 or return undef; #TODO: maybe warn user?
747
748 $cb = { $pkg => $cb };
749 }
750
721 for my $pkg (keys %$cb) { 751 for my $pkg (keys %$cb) {
722 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) }; 752 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) };
723 $retval ||= $retval_; 753 $retval ||= $retval_;
724 754
725 if ($@) { 755 if ($@) {
730 760
731 verbose 11, "$HOOKNAME[$htype] returning <$retval>" 761 verbose 11, "$HOOKNAME[$htype] returning <$retval>"
732 if $verbosity >= 11; 762 if $verbosity >= 11;
733 } 763 }
734 764
735 if ($htype == 1) { # DESTROY 765 if ($htype == HOOK_DESTROY) {
736 # clear package objects 766 # clear package objects
737 %$_ = () for values %{ $TERM->{_pkg} }; 767 %$_ = () for values %{ $TERM->{_pkg} };
738 768
739 # clear package 769 # clear package
740 %$TERM = (); 770 %$TERM = ();
827} 857}
828 858
829=item $self->enable ($hook_name => $cb[, $hook_name => $cb..]) 859=item $self->enable ($hook_name => $cb[, $hook_name => $cb..])
830 860
831Dynamically enable the given hooks (named without the C<on_> prefix) for 861Dynamically enable the given hooks (named without the C<on_> prefix) for
832this extension, replacing any previous hook. This is useful when you want 862this extension, replacing any hook previously installed via C<enable> in
833to overwrite time-critical hooks only temporarily. 863this extension.
864
865This is useful when you want to overwrite time-critical hooks only
866temporarily.
834 867
835To install additional callbacks for the same hook, you can use the C<on> 868To install additional callbacks for the same hook, you can use the C<on>
836method of the C<urxvt::term> class. 869method of the C<urxvt::term> class.
837 870
838=item $self->disable ($hook_name[, $hook_name..]) 871=item $self->disable ($hook_name[, $hook_name..])
1062 $ENV{URXVT_PERL_LIB}, 1095 $ENV{URXVT_PERL_LIB},
1063 "$ENV{HOME}/.urxvt/ext", 1096 "$ENV{HOME}/.urxvt/ext",
1064 "$LIBDIR/perl" 1097 "$LIBDIR/perl"
1065} 1098}
1066 1099
1067sub scan_meta { 1100# scan for available extensions and collect their metadata
1101sub scan_extensions {
1068 my ($self) = @_; 1102 my ($self) = @_;
1103
1104 return if exists $self->{meta};
1105
1069 my @libdirs = perl_libdirs $self; 1106 my @libdirs = perl_libdirs $self;
1070 1107
1071 return if $self->{meta_libdirs} eq join "\x00", @libdirs; 1108# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d#
1072 1109
1073 my %meta;
1074
1075 $self->{meta_libdirs} = join "\x00", @libdirs; 1110# $self->{meta_libdirs} = join "\x00", @libdirs;#d#
1076 $self->{meta} = \%meta; 1111 $self->{meta} = \my %meta;
1077 1112
1113 # first gather extensions
1078 for my $dir (reverse @libdirs) { 1114 for my $dir (reverse @libdirs) {
1079 opendir my $fh, $dir 1115 opendir my $fh, $dir
1080 or next; 1116 or next;
1081 for my $ext (readdir $fh) { 1117 for my $ext (readdir $fh) {
1082 $ext ne "." 1118 $ext !~ /^\./
1083 and $ext ne ".."
1084 and open my $fh, "<", "$dir/$ext" 1119 and open my $fh, "<", "$dir/$ext"
1085 or next; 1120 or next;
1086 1121
1122 my %ext = (dir => $dir);
1123
1087 while (<$fh>) { 1124 while (<$fh>) {
1088 if (/^#:META:X_RESOURCE:(.*)/) { 1125 if (/^#:META:(?:X_)?RESOURCE:(.*)/) {
1089 my ($pattern, $type, $desc) = split /:/, $1; 1126 my ($pattern, $type, $desc) = split /:/, $1;
1090 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name 1127 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
1091 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) { 1128 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
1092 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n"; 1129 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n";
1093 } else { 1130 } else {
1094 $meta{resource}{$pattern} = [$ext, $type, $desc]; 1131 $ext{resource}{$pattern} = [$ext, $type, $desc];
1095 } 1132 }
1133 } elsif (/^#:META:BINDING:(.*)/) {
1134 my ($keysym, $action) = split /:/, $1;
1135 $ext{binding}{$keysym} = [$ext, $action];
1096 } elsif (/^\s*(?:#|$)/) { 1136 } elsif (/^\s*(?:#|$)/) {
1097 # skip other comments and empty lines 1137 # skip other comments and empty lines
1098 } else { 1138 } else {
1099 last; # stop parsing on first non-empty non-comment line 1139 last; # stop parsing on first non-empty non-comment line
1100 } 1140 }
1101 } 1141 }
1142
1143 $meta{ext}{$ext} = \%ext;
1102 } 1144 }
1145 }
1146
1147 # and now merge resources and bindings
1148 while (my ($k, $v) = each %{ $meta{ext} }) {
1149 #TODO: should check for extensions overriding each other
1150 %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} });
1151 %{ $meta{binding} } = (%{ $meta{binding} }, %{ $v->{binding} });
1103 } 1152 }
1104} 1153}
1105 1154
1106=item $term = new urxvt::term $envhashref, $rxvtname, [arg...] 1155=item $term = new urxvt::term $envhashref, $rxvtname, [arg...]
1107 1156
1127} 1176}
1128 1177
1129=item $term->destroy 1178=item $term->destroy
1130 1179
1131Destroy the terminal object (close the window, free resources 1180Destroy the terminal object (close the window, free resources
1132etc.). Please note that @@RXVT_NAME@@ will not exit as long as any event 1181etc.). Please note that urxvt will not exit as long as any event
1133watchers (timers, io watchers) are still active. 1182watchers (timers, io watchers) are still active.
1134 1183
1135=item $term->exec_async ($cmd[, @args]) 1184=item $term->exec_async ($cmd[, @args])
1136 1185
1137Works like the combination of the C<fork>/C<exec> builtins, which executes 1186Works like the combination of the C<fork>/C<exec> builtins, which executes
1253 my $res = &x_resource; 1302 my $res = &x_resource;
1254 1303
1255 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0 1304 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0
1256} 1305}
1257 1306
1258=item $success = $term->parse_keysym ($key, $octets) 1307=item $success = $term->bind_action ($key, $octets)
1259 1308
1260Adds a key binding exactly as specified via a resource. See the 1309Adds a key binding exactly as specified via a C<keysym> resource. See the
1261C<keysym> resource in the @@RXVT_NAME@@(1) manpage. 1310C<keysym> resource in the urxvt(1) manpage.
1262
1263=item $term->register_command ($keysym, $modifiermask, $string)
1264
1265Adds a key binding. This is a lower level api compared to
1266C<parse_keysym>, as it expects a parsed key description, and can be
1267used only inside either the C<on_init> hook, to add a binding, or the
1268C<on_register_command> hook, to modify a parsed binding.
1269 1311
1270=item $rend = $term->rstyle ([$new_rstyle]) 1312=item $rend = $term->rstyle ([$new_rstyle])
1271 1313
1272Return and optionally change the current rendition. Text that is output by 1314Return and optionally change the current rendition. Text that is output by
1273the terminal application will use this style. 1315the terminal application will use this style.
1453=item $term->tt_write ($octets) 1495=item $term->tt_write ($octets)
1454 1496
1455Write the octets given in C<$octets> to the tty (i.e. as program input). To 1497Write the octets given in C<$octets> to the tty (i.e. as program input). To
1456pass characters instead of octets, you should convert your strings first 1498pass characters instead of octets, you should convert your strings first
1457to the locale-specific encoding using C<< $term->locale_encode >>. 1499to the locale-specific encoding using C<< $term->locale_encode >>.
1500
1501=item $term->tt_write_user_input ($octets)
1502
1503Like C<tt_write>, but should be used when writing strings in response to
1504the user pressing a key, to invokes the additional actions requested by
1505the user for that case (C<tt_write> doesn't do that).
1506
1507The typical use case would be inside C<on_action> hooks.
1458 1508
1459=item $term->tt_paste ($octets) 1509=item $term->tt_paste ($octets)
1460 1510
1461Write the octets given in C<$octets> to the tty as a paste, converting NL to 1511Write the octets given in C<$octets> to the tty as a paste, converting NL to
1462CR and bracketing the data with control sequences if bracketed paste mode 1512CR and bracketing the data with control sequences if bracketed paste mode
1696} 1746}
1697 1747
1698sub urxvt::line::t { 1748sub urxvt::line::t {
1699 my ($self) = @_; 1749 my ($self) = @_;
1700 1750
1701 if (@_ > 1) 1751 if (@_ > 1) {
1702 {
1703 $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) 1752 $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol})
1704 for $self->{beg} .. $self->{end}; 1753 for $self->{beg} .. $self->{end};
1705 } 1754 }
1706 1755
1707 defined wantarray && 1756 defined wantarray &&
1708 substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}), 1757 substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}),
1709 0, $self->{len} 1758 0, $self->{len}
1710} 1759}
1711 1760
1712sub urxvt::line::r { 1761sub urxvt::line::r {
1713 my ($self) = @_; 1762 my ($self) = @_;
1714 1763
1715 if (@_ > 1) 1764 if (@_ > 1) {
1716 {
1717 $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) 1765 $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol})
1718 for $self->{beg} .. $self->{end}; 1766 for $self->{beg} .. $self->{end};
1719 } 1767 }
1720 1768
1721 if (defined wantarray) { 1769 if (defined wantarray) {
1722 my $rend = [ 1770 my $rend = [
1723 map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end} 1771 map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end}
1724 ]; 1772 ];

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines