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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines