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.221 by sf-exg, Thu Jun 21 06:08:05 2012 UTC vs.
Revision 1.231 by root, Sun Apr 27 20:26:28 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
103internal use. 103internal use.
104 104
105Although it isn't a C<urxvt::term> object, you can call all methods of the 105Although it isn't a C<urxvt::term> object, you can call all methods of the
106C<urxvt::term> class on this object. 106C<urxvt::term> class on this object.
107 107
108It has the following methods and data members: 108Additional methods only supported for extension objects are described in
109 109the C<urxvt::extension> section below.
110=over 4
111
112=item $urxvt_term = $self->{term}
113
114Returns the C<urxvt::term> object associated with this instance of the
115extension. This member I<must not> be changed in any way.
116
117=item $self->enable ($hook_name => $cb[, $hook_name => $cb..])
118
119Dynamically enable the given hooks (named without the C<on_> prefix) for
120this extension, replacing any previous hook. This is useful when you want
121to overwrite time-critical hooks only temporarily.
122
123To install additional callbacks for the same hook, you can use the C<on>
124method of the C<urxvt::term> class.
125
126=item $self->disable ($hook_name[, $hook_name..])
127
128Dynamically disable the given hooks.
129
130=item $self->x_resource ($pattern)
131
132=item $self->x_resource_boolean ($pattern)
133
134These methods support an additional C<%> prefix when called on an
135extension object - see the description of these methods in the
136C<urxvt::term> class for details.
137
138=back
139 110
140=head2 Hooks 111=head2 Hooks
141 112
142The following subroutines can be declared in extension files, and will be 113The following subroutines can be declared in extension files, and will be
143called whenever the relevant event happens. 114called whenever the relevant event happens.
310 281
311=item on_refresh_end $term 282=item on_refresh_end $term
312 283
313Called just after the screen gets redrawn. See C<on_refresh_begin>. 284Called just after the screen gets redrawn. See C<on_refresh_begin>.
314 285
315=item on_user_command $term, $string 286=item on_user_command $term, $string *DEPRECATED*
316 287
317Called whenever a user-configured event is being activated (e.g. via 288Called whenever a user-configured event is being activated (e.g. via
318a 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>
319resource in the @@RXVT_NAME@@(1) manpage). 290resource in the urxvt(1) manpage).
320 291
321The 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
322slightly in the future. 293preference to the C<< ->register_keysym_action >> method.
323 294
324=item on_register_command $term, $keysym, $modifiermask, $string 295=item on_register_command $term, $keysym, $modifiermask, $string
325 296
326Called after parsing a keysym resource but before registering the 297Called after parsing a keysym resource but before registering the
327associated binding. If this hook returns TRUE the binding is not 298associated binding. If this hook returns a true value the binding
328registered. It can be used to modify a binding by calling 299is not registered. It can be used to modify a binding by calling
329C<register_command>. 300C<register_command>.
330 301
331=item on_resize_all_windows $term, $new_width, $new_height 302=item on_resize_all_windows $term, $new_width, $new_height
332 303
333Called just after the new window size has been calculated, but before 304Called just after the new window size has been calculated, but before
334windows are actually being resized or hints are being set. If this hook 305windows are actually being resized or hints are being set. If this hook
335returns TRUE, setting of the window hints is being skipped. 306returns a true value, setting of the window hints is being skipped.
336 307
337=item on_x_event $term, $event 308=item on_x_event $term, $event
338 309
339Called on every X event received on the vt window (and possibly other 310Called on every X event received on the vt window (and possibly other
340windows). Should only be used as a last resort. Most event structure 311windows). Should only be used as a last resort. Most event structure
379manpage), with the additional members C<row> and C<col>, which are the 350manpage), with the additional members C<row> and C<col>, which are the
380(real, not screen-based) row and column under the mouse cursor. 351(real, not screen-based) row and column under the mouse cursor.
381 352
382C<on_key_press> additionally receives the string rxvt-unicode would 353C<on_key_press> additionally receives the string rxvt-unicode would
383output, if any, in locale-specific encoding. 354output, if any, in locale-specific encoding.
384
385subwindow.
386 355
387=item on_client_message $term, $event 356=item on_client_message $term, $event
388 357
389=item on_wm_protocols $term, $event 358=item on_wm_protocols $term, $event
390 359
598 $name =~ y/-/./ if $isarg; 567 $name =~ y/-/./ if $isarg;
599 568
600 $term->scan_meta; 569 $term->scan_meta;
601 570
602 my $r = $term->{meta}{resource}; 571 my $r = $term->{meta}{resource};
603 keys %$r; # reste iterator 572 keys %$r; # reset iterator
604 while (my ($pattern, $v) = each %$r) { 573 while (my ($pattern, $v) = each %$r) {
605 if ( 574 if (
606 $pattern =~ /\.$/ 575 $pattern =~ /\.$/
607 ? $pattern eq substr $name, 0, length $pattern 576 ? $pattern eq substr $name, 0, length $pattern
608 : $pattern eq $name 577 : $pattern eq $name
696# called by the rxvt core 665# called by the rxvt core
697sub invoke { 666sub invoke {
698 local $TERM = shift; 667 local $TERM = shift;
699 my $htype = shift; 668 my $htype = shift;
700 669
701 if ($htype == 0) { # INIT 670 if ($htype == HOOK_INIT) {
702 my @dirs = $TERM->perl_libdirs; 671 my @dirs = $TERM->perl_libdirs;
703 672
704 my %ext_arg; 673 my %ext_arg;
705 674
706 { 675 {
745 714
746 if (my $cb = $TERM->{_hook}[$htype]) { 715 if (my $cb = $TERM->{_hook}[$htype]) {
747 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" 716 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
748 if $verbosity >= 10; 717 if $verbosity >= 10;
749 718
750 for my $pkg (keys %$cb) { 719 for my $pkg (
720 # this hook is only sent to the extension with the name
721 # matching the first arg
722 $htype == HOOK_KEYBOARD_DISPATCH
723 ? exists $cb->{"urxvt::ext::$_[0]"} ? "urxvt::ext::" . shift : return undef
724 : keys %$cb
725 ) {
751 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) }; 726 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) };
752 $retval ||= $retval_; 727 $retval ||= $retval_;
753 728
754 if ($@) { 729 if ($@) {
755 $TERM->ungrab; # better to lose the grab than the session 730 $TERM->ungrab; # better to lose the grab than the session
759 734
760 verbose 11, "$HOOKNAME[$htype] returning <$retval>" 735 verbose 11, "$HOOKNAME[$htype] returning <$retval>"
761 if $verbosity >= 11; 736 if $verbosity >= 11;
762 } 737 }
763 738
764 if ($htype == 1) { # DESTROY 739 if ($htype == HOOK_DESTROY) {
765 # clear package objects 740 # clear package objects
766 %$_ = () for values %{ $TERM->{_pkg} }; 741 %$_ = () for values %{ $TERM->{_pkg} };
767 742
768 # clear package 743 # clear package
769 %$TERM = (); 744 %$TERM = ();
801 ($mask, @color{qw(fg bg)}, \@failed) 776 ($mask, @color{qw(fg bg)}, \@failed)
802} 777}
803 778
804package urxvt::term::extension; 779package urxvt::term::extension;
805 780
806sub enable { 781=head2 The C<urxvt::term::extension> class
807 my ($self, %hook) = @_;
808 my $pkg = $self->{_pkg};
809 782
810 while (my ($name, $cb) = each %hook) { 783Each extension attached to a terminal object is represented by
811 my $htype = $HOOKTYPE{uc $name}; 784a C<urxvt::term::extension> object.
812 defined $htype
813 or Carp::croak "unsupported hook type '$name'";
814 785
815 $self->set_should_invoke ($htype, +1) 786You can use these objects, which are passed to all callbacks to store any
816 unless exists $self->{term}{_hook}[$htype]{$pkg}; 787state related to the terminal and extension instance.
817 788
818 $self->{term}{_hook}[$htype]{$pkg} = $cb; 789The methods (And data members) documented below can be called on extension
819 } 790objects, in addition to call methods documented for the <urxvt::term>
820} 791class.
821 792
822sub disable { 793=over 4
823 my ($self, @hook) = @_;
824 my $pkg = $self->{_pkg};
825 794
826 for my $name (@hook) { 795=item $urxvt_term = $self->{term}
827 my $htype = $HOOKTYPE{uc $name};
828 defined $htype
829 or Carp::croak "unsupported hook type '$name'";
830 796
831 $self->set_should_invoke ($htype, -1) 797Returns the C<urxvt::term> object associated with this instance of the
832 if delete $self->{term}{_hook}[$htype]{$pkg}; 798extension. This member I<must not> be changed in any way.
833 } 799
834} 800=cut
835 801
836our $AUTOLOAD; 802our $AUTOLOAD;
837 803
838sub AUTOLOAD { 804sub AUTOLOAD {
839 $AUTOLOAD =~ /:([^:]+)$/ 805 $AUTOLOAD =~ /:([^:]+)$/
852 818
853sub DESTROY { 819sub DESTROY {
854 # nop 820 # nop
855} 821}
856 822
857# urxvt::destroy_hook 823# urxvt::destroy_hook (basically a cheap Guard:: implementation)
858 824
859sub urxvt::destroy_hook::DESTROY { 825sub urxvt::destroy_hook::DESTROY {
860 ${$_[0]}->(); 826 ${$_[0]}->();
861} 827}
862 828
863sub urxvt::destroy_hook(&) { 829sub urxvt::destroy_hook(&) {
864 bless \shift, urxvt::destroy_hook:: 830 bless \shift, urxvt::destroy_hook::
865} 831}
832
833=item $self->enable ($hook_name => $cb[, $hook_name => $cb..])
834
835Dynamically enable the given hooks (named without the C<on_> prefix) for
836this extension, replacing any hook previously installed via C<enable> in
837this extension.
838
839This is useful when you want to overwrite time-critical hooks only
840temporarily.
841
842To install additional callbacks for the same hook, you can use the C<on>
843method of the C<urxvt::term> class.
844
845=item $self->disable ($hook_name[, $hook_name..])
846
847Dynamically disable the given hooks.
848
849=cut
850
851sub enable {
852 my ($self, %hook) = @_;
853 my $pkg = $self->{_pkg};
854
855 while (my ($name, $cb) = each %hook) {
856 my $htype = $HOOKTYPE{uc $name};
857 defined $htype
858 or Carp::croak "unsupported hook type '$name'";
859
860 $self->set_should_invoke ($htype, +1)
861 unless exists $self->{term}{_hook}[$htype]{$pkg};
862
863 $self->{term}{_hook}[$htype]{$pkg} = $cb;
864 }
865}
866
867sub disable {
868 my ($self, @hook) = @_;
869 my $pkg = $self->{_pkg};
870
871 for my $name (@hook) {
872 my $htype = $HOOKTYPE{uc $name};
873 defined $htype
874 or Carp::croak "unsupported hook type '$name'";
875
876 $self->set_should_invoke ($htype, -1)
877 if delete $self->{term}{_hook}[$htype]{$pkg};
878 }
879}
880
881=item $guard = $self->on ($hook_name => $cb[, $hook_name => $cb..])
882
883Similar to the C<enable> enable, but installs additional callbacks for
884the given hook(s) (that is, it doesn't replace existing callbacks), and
885returns a guard object. When the guard object is destroyed the callbacks
886are disabled again.
887
888=cut
889
890sub urxvt::extension::on_disable::DESTROY {
891 my $disable = shift;
892
893 my $term = delete $disable->{""};
894
895 while (my ($htype, $id) = each %$disable) {
896 delete $term->{_hook}[$htype]{$id};
897 $term->set_should_invoke ($htype, -1);
898 }
899}
900
901sub on {
902 my ($self, %hook) = @_;
903
904 my $term = $self->{term};
905
906 my %disable = ( "" => $term );
907
908 while (my ($name, $cb) = each %hook) {
909 my $htype = $HOOKTYPE{uc $name};
910 defined $htype
911 or Carp::croak "unsupported hook type '$name'";
912
913 $term->set_should_invoke ($htype, +1);
914 $term->{_hook}[$htype]{ $disable{$htype} = $cb+0 }
915 = sub { shift; $cb->($self, @_) }; # very ugly indeed
916 }
917
918 bless \%disable, "urxvt::extension::on_disable"
919}
920
921=item $self->x_resource ($pattern)
922
923=item $self->x_resource_boolean ($pattern)
924
925These methods support an additional C<%> prefix when called on an
926extension object - see the description of these methods in the
927C<urxvt::term> class for details.
928
929=cut
866 930
867sub x_resource { 931sub x_resource {
868 my ($self, $name) = @_; 932 my ($self, $name) = @_;
869 $name =~ s/^%(\.|$)/$_[0]{_name}$1/; 933 $name =~ s/^%(\.|$)/$_[0]{_name}$1/;
870 $self->{term}->x_resource ($name) 934 $self->{term}->x_resource ($name)
873sub x_resource_boolean { 937sub x_resource_boolean {
874 my ($self, $name) = @_; 938 my ($self, $name) = @_;
875 $name =~ s/^%(\.|$)/$_[0]{_name}$1/; 939 $name =~ s/^%(\.|$)/$_[0]{_name}$1/;
876 $self->{term}->x_resource_boolean ($name) 940 $self->{term}->x_resource_boolean ($name)
877} 941}
942
943=back
944
945=cut
878 946
879package urxvt::anyevent; 947package urxvt::anyevent;
880 948
881=head2 The C<urxvt::anyevent> Class 949=head2 The C<urxvt::anyevent> Class
882 950
1016 1084
1017 for my $dir (reverse @libdirs) { 1085 for my $dir (reverse @libdirs) {
1018 opendir my $fh, $dir 1086 opendir my $fh, $dir
1019 or next; 1087 or next;
1020 for my $ext (readdir $fh) { 1088 for my $ext (readdir $fh) {
1021 $ext ne "." 1089 $ext !~ /^\./
1022 and $ext ne ".."
1023 and open my $fh, "<", "$dir/$ext" 1090 and open my $fh, "<", "$dir/$ext"
1024 or next; 1091 or next;
1025 1092
1026 while (<$fh>) { 1093 while (<$fh>) {
1027 if (/^#:META:X_RESOURCE:(.*)/) { 1094 if (/^#:META:X_RESOURCE:(.*)/) {
1066} 1133}
1067 1134
1068=item $term->destroy 1135=item $term->destroy
1069 1136
1070Destroy the terminal object (close the window, free resources 1137Destroy the terminal object (close the window, free resources
1071etc.). Please note that @@RXVT_NAME@@ will not exit as long as any event 1138etc.). Please note that urxvt will not exit as long as any event
1072watchers (timers, io watchers) are still active. 1139watchers (timers, io watchers) are still active.
1073
1074=item $guard = $self->on ($hook_name => $cb[, $hook_name => $cb..])
1075
1076Similar to the extension method C<enable>, but installs additional
1077callbacks for the given hook(s) (existing ones are not replaced), and
1078returns a guard object. When the guard object is destroyed the callbacks
1079are disabled again.
1080
1081Note that these callbacks receive the normal parameters, but the first
1082argument (normally the extension) is currently undefined.
1083
1084=cut
1085
1086sub urxvt::term::on_disable::DESTROY {
1087 my $disable = shift;
1088
1089 my $self = delete $disable->{""};
1090
1091 while (my ($htype, $id) = each %$disable) {
1092 delete $self->{_hook}[$htype]{$id};
1093 $self->set_should_invoke ($htype, -1);
1094 }
1095}
1096
1097sub on {
1098 my ($self, %hook) = @_;
1099
1100 my %disable = ( "" => $self );
1101
1102 while (my ($name, $cb) = each %hook) {
1103 my $htype = $HOOKTYPE{uc $name};
1104 defined $htype
1105 or Carp::croak "unsupported hook type '$name'";
1106
1107 my $id = $cb+0;
1108
1109 $self->set_should_invoke ($htype, +1);
1110 $disable{$htype} = $id;
1111 $self->{_hook}[$htype]{$id} = $cb;
1112 }
1113
1114 bless \%disable, "urxvt::term::on_disable"
1115}
1116 1140
1117=item $term->exec_async ($cmd[, @args]) 1141=item $term->exec_async ($cmd[, @args])
1118 1142
1119Works like the combination of the C<fork>/C<exec> builtins, which executes 1143Works like the combination of the C<fork>/C<exec> builtins, which executes
1120("starts") programs in the background. This function takes care of setting 1144("starts") programs in the background. This function takes care of setting
1238} 1262}
1239 1263
1240=item $success = $term->parse_keysym ($key, $octets) 1264=item $success = $term->parse_keysym ($key, $octets)
1241 1265
1242Adds a key binding exactly as specified via a resource. See the 1266Adds a key binding exactly as specified via a resource. See the
1243C<keysym> resource in the @@RXVT_NAME@@(1) manpage. 1267C<keysym> resource in the urxvt(1) manpage.
1244 1268
1245=item $term->register_command ($keysym, $modifiermask, $string) 1269=item $term->register_command ($keysym, $modifiermask, $string)
1246 1270
1247Adds a key binding. This is a lower level api compared to 1271Adds a key binding. This is a lower level api compared to
1248C<parse_keysym>, as it expects a parsed key description, and can be 1272C<parse_keysym>, as it expects a parsed key description, and can be
1678} 1702}
1679 1703
1680sub urxvt::line::t { 1704sub urxvt::line::t {
1681 my ($self) = @_; 1705 my ($self) = @_;
1682 1706
1683 if (@_ > 1) 1707 if (@_ > 1) {
1684 {
1685 $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) 1708 $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol})
1686 for $self->{beg} .. $self->{end}; 1709 for $self->{beg} .. $self->{end};
1687 } 1710 }
1688 1711
1689 defined wantarray && 1712 defined wantarray &&
1690 substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}), 1713 substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}),
1691 0, $self->{len} 1714 0, $self->{len}
1692} 1715}
1693 1716
1694sub urxvt::line::r { 1717sub urxvt::line::r {
1695 my ($self) = @_; 1718 my ($self) = @_;
1696 1719
1697 if (@_ > 1) 1720 if (@_ > 1) {
1698 {
1699 $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) 1721 $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol})
1700 for $self->{beg} .. $self->{end}; 1722 for $self->{beg} .. $self->{end};
1701 } 1723 }
1702 1724
1703 if (defined wantarray) { 1725 if (defined wantarray) {
1704 my $rend = [ 1726 my $rend = [
1705 map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end} 1727 map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end}
1706 ]; 1728 ];

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines