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.219 by sf-exg, Sun Jun 10 18:23:18 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
123=item $self->disable ($hook_name[, $hook_name..])
124
125Dynamically disable the given hooks.
126
127=back
128 110
129=head2 Hooks 111=head2 Hooks
130 112
131The following subroutines can be declared in extension files, and will be 113The following subroutines can be declared in extension files, and will be
132called whenever the relevant event happens. 114called whenever the relevant event happens.
… …
299 281
300=item on_refresh_end $term 282=item on_refresh_end $term
301 283
302Called just after the screen gets redrawn. See C<on_refresh_begin>. 284Called just after the screen gets redrawn. See C<on_refresh_begin>.
303 285
304=item on_user_command $term, $string 286=item on_user_command $term, $string *DEPRECATED*
305 287
306Called whenever a user-configured event is being activated (e.g. via 288Called whenever a user-configured event is being activated (e.g. via
307a 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>
308resource in the @@RXVT_NAME@@(1) manpage). 290resource in the urxvt(1) manpage).
309 291
310The 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
311slightly in the future. 293preference to the C<< ->register_keysym_action >> method.
312 294
313=item on_register_command $term, $keysym, $modifiermask, $string 295=item on_register_command $term, $keysym, $modifiermask, $string
314 296
315Called after parsing a keysym resource but before registering the 297Called after parsing a keysym resource but before registering the
316associated binding. If this hook returns TRUE the binding is not 298associated binding. If this hook returns a true value the binding
317registered. It can be used to modify a binding by calling 299is not registered. It can be used to modify a binding by calling
318C<register_command>. 300C<register_command>.
319 301
320=item on_resize_all_windows $term, $new_width, $new_height 302=item on_resize_all_windows $term, $new_width, $new_height
321 303
322Called just after the new window size has been calculated, but before 304Called just after the new window size has been calculated, but before
323windows 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
324returns TRUE, setting of the window hints is being skipped. 306returns a true value, setting of the window hints is being skipped.
325 307
326=item on_x_event $term, $event 308=item on_x_event $term, $event
327 309
328Called 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
329windows). Should only be used as a last resort. Most event structure 311windows). Should only be used as a last resort. Most event structure
… …
368manpage), 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
369(real, not screen-based) row and column under the mouse cursor. 351(real, not screen-based) row and column under the mouse cursor.
370 352
371C<on_key_press> additionally receives the string rxvt-unicode would 353C<on_key_press> additionally receives the string rxvt-unicode would
372output, if any, in locale-specific encoding. 354output, if any, in locale-specific encoding.
373
374subwindow.
375 355
376=item on_client_message $term, $event 356=item on_client_message $term, $event
377 357
378=item on_wm_protocols $term, $event 358=item on_wm_protocols $term, $event
379 359
… …
587 $name =~ y/-/./ if $isarg; 567 $name =~ y/-/./ if $isarg;
588 568
589 $term->scan_meta; 569 $term->scan_meta;
590 570
591 my $r = $term->{meta}{resource}; 571 my $r = $term->{meta}{resource};
592 keys %$r; # reste iterator 572 keys %$r; # reset iterator
593 while (my ($pattern, $v) = each %$r) { 573 while (my ($pattern, $v) = each %$r) {
594 if ( 574 if (
595 $pattern =~ /\.$/ 575 $pattern =~ /\.$/
596 ? $pattern eq substr $name, 0, length $pattern 576 ? $pattern eq substr $name, 0, length $pattern
597 : $pattern eq $name 577 : $pattern eq $name
… …
685# called by the rxvt core 665# called by the rxvt core
686sub invoke { 666sub invoke {
687 local $TERM = shift; 667 local $TERM = shift;
688 my $htype = shift; 668 my $htype = shift;
689 669
690 if ($htype == 0) { # INIT 670 if ($htype == HOOK_INIT) {
691 my @dirs = $TERM->perl_libdirs; 671 my @dirs = $TERM->perl_libdirs;
692 672
693 my %ext_arg; 673 my %ext_arg;
694 674
695 { 675 {
… …
734 714
735 if (my $cb = $TERM->{_hook}[$htype]) { 715 if (my $cb = $TERM->{_hook}[$htype]) {
736 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" 716 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
737 if $verbosity >= 10; 717 if $verbosity >= 10;
738 718
739 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 ) {
740 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg}, @_) }; 726 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) };
741 $retval ||= $retval_; 727 $retval ||= $retval_;
742 728
743 if ($@) { 729 if ($@) {
744 $TERM->ungrab; # better to lose the grab than the session 730 $TERM->ungrab; # better to lose the grab than the session
745 warn $@; 731 warn $@;
… …
748 734
749 verbose 11, "$HOOKNAME[$htype] returning <$retval>" 735 verbose 11, "$HOOKNAME[$htype] returning <$retval>"
750 if $verbosity >= 11; 736 if $verbosity >= 11;
751 } 737 }
752 738
753 if ($htype == 1) { # DESTROY 739 if ($htype == HOOK_DESTROY) {
754 # clear package objects 740 # clear package objects
755 %$_ = () for values %{ $TERM->{_pkg} }; 741 %$_ = () for values %{ $TERM->{_pkg} };
756 742
757 # clear package 743 # clear package
758 %$TERM = (); 744 %$TERM = ();
… …
790 ($mask, @color{qw(fg bg)}, \@failed) 776 ($mask, @color{qw(fg bg)}, \@failed)
791} 777}
792 778
793package urxvt::term::extension; 779package urxvt::term::extension;
794 780
795sub enable { 781=head2 The C<urxvt::term::extension> class
796 my ($self, %hook) = @_;
797 my $pkg = $self->{_pkg};
798 782
799 while (my ($name, $cb) = each %hook) { 783Each extension attached to a terminal object is represented by
800 my $htype = $HOOKTYPE{uc $name}; 784a C<urxvt::term::extension> object.
801 defined $htype
802 or Carp::croak "unsupported hook type '$name'";
803 785
804 $self->set_should_invoke ($htype, +1) 786You can use these objects, which are passed to all callbacks to store any
805 unless exists $self->{term}{_hook}[$htype]{$pkg}; 787state related to the terminal and extension instance.
806 788
807 $self->{term}{_hook}[$htype]{$pkg} = $cb; 789The methods (And data members) documented below can be called on extension
808 } 790objects, in addition to call methods documented for the <urxvt::term>
809} 791class.
810 792
811sub disable { 793=over 4
812 my ($self, @hook) = @_;
813 my $pkg = $self->{_pkg};
814 794
815 for my $name (@hook) { 795=item $urxvt_term = $self->{term}
816 my $htype = $HOOKTYPE{uc $name};
817 defined $htype
818 or Carp::croak "unsupported hook type '$name'";
819 796
820 $self->set_should_invoke ($htype, -1) 797Returns the C<urxvt::term> object associated with this instance of the
821 if delete $self->{term}{_hook}[$htype]{$pkg}; 798extension. This member I<must not> be changed in any way.
822 } 799
823} 800=cut
824 801
825our $AUTOLOAD; 802our $AUTOLOAD;
826 803
827sub AUTOLOAD { 804sub AUTOLOAD {
828 $AUTOLOAD =~ /:([^:]+)$/ 805 $AUTOLOAD =~ /:([^:]+)$/
… …
841 818
842sub DESTROY { 819sub DESTROY {
843 # nop 820 # nop
844} 821}
845 822
846# urxvt::destroy_hook 823# urxvt::destroy_hook (basically a cheap Guard:: implementation)
847 824
848sub urxvt::destroy_hook::DESTROY { 825sub urxvt::destroy_hook::DESTROY {
849 ${$_[0]}->(); 826 ${$_[0]}->();
850} 827}
851 828
852sub urxvt::destroy_hook(&) { 829sub urxvt::destroy_hook(&) {
853 bless \shift, urxvt::destroy_hook:: 830 bless \shift, urxvt::destroy_hook::
854} 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
855 930
856sub x_resource { 931sub x_resource {
857 my ($self, $name) = @_; 932 my ($self, $name) = @_;
858 $name =~ s/^%(\.|$)/$_[0]{_name}$1/; 933 $name =~ s/^%(\.|$)/$_[0]{_name}$1/;
859 $self->{term}->x_resource ($name) 934 $self->{term}->x_resource ($name)
… …
862sub x_resource_boolean { 937sub x_resource_boolean {
863 my ($self, $name) = @_; 938 my ($self, $name) = @_;
864 $name =~ s/^%(\.|$)/$_[0]{_name}$1/; 939 $name =~ s/^%(\.|$)/$_[0]{_name}$1/;
865 $self->{term}->x_resource_boolean ($name) 940 $self->{term}->x_resource_boolean ($name)
866} 941}
942
943=back
944
945=cut
867 946
868package urxvt::anyevent; 947package urxvt::anyevent;
869 948
870=head2 The C<urxvt::anyevent> Class 949=head2 The C<urxvt::anyevent> Class
871 950
… …
1005 1084
1006 for my $dir (reverse @libdirs) { 1085 for my $dir (reverse @libdirs) {
1007 opendir my $fh, $dir 1086 opendir my $fh, $dir
1008 or next; 1087 or next;
1009 for my $ext (readdir $fh) { 1088 for my $ext (readdir $fh) {
1010 $ext ne "." 1089 $ext !~ /^\./
1011 and $ext ne ".."
1012 and open my $fh, "<", "$dir/$ext" 1090 and open my $fh, "<", "$dir/$ext"
1013 or next; 1091 or next;
1014 1092
1015 while (<$fh>) { 1093 while (<$fh>) {
1016 if (/^#:META:X_RESOURCE:(.*)/) { 1094 if (/^#:META:X_RESOURCE:(.*)/) {
… …
1055} 1133}
1056 1134
1057=item $term->destroy 1135=item $term->destroy
1058 1136
1059Destroy the terminal object (close the window, free resources 1137Destroy the terminal object (close the window, free resources
1060etc.). 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
1061watchers (timers, io watchers) are still active. 1139watchers (timers, io watchers) are still active.
1062 1140
1063=item $term->exec_async ($cmd[, @args]) 1141=item $term->exec_async ($cmd[, @args])
1064 1142
1065Works 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
… …
1184} 1262}
1185 1263
1186=item $success = $term->parse_keysym ($key, $octets) 1264=item $success = $term->parse_keysym ($key, $octets)
1187 1265
1188Adds a key binding exactly as specified via a resource. See the 1266Adds a key binding exactly as specified via a resource. See the
1189C<keysym> resource in the @@RXVT_NAME@@(1) manpage. 1267C<keysym> resource in the urxvt(1) manpage.
1190 1268
1191=item $term->register_command ($keysym, $modifiermask, $string) 1269=item $term->register_command ($keysym, $modifiermask, $string)
1192 1270
1193Adds a key binding. This is a lower level api compared to 1271Adds a key binding. This is a lower level api compared to
1194C<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
… …
1624} 1702}
1625 1703
1626sub urxvt::line::t { 1704sub urxvt::line::t {
1627 my ($self) = @_; 1705 my ($self) = @_;
1628 1706
1629 if (@_ > 1) 1707 if (@_ > 1) {
1630 {
1631 $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})
1632 for $self->{beg} .. $self->{end}; 1709 for $self->{beg} .. $self->{end};
1633 } 1710 }
1634 1711
1635 defined wantarray && 1712 defined wantarray &&
1636 substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}), 1713 substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}),
1637 0, $self->{len} 1714 0, $self->{len}
1638} 1715}
1639 1716
1640sub urxvt::line::r { 1717sub urxvt::line::r {
1641 my ($self) = @_; 1718 my ($self) = @_;
1642 1719
1643 if (@_ > 1) 1720 if (@_ > 1) {
1644 {
1645 $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})
1646 for $self->{beg} .. $self->{end}; 1722 for $self->{beg} .. $self->{end};
1647 } 1723 }
1648 1724
1649 if (defined wantarray) { 1725 if (defined wantarray) {
1650 my $rend = [ 1726 my $rend = [
1651 map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end} 1727 map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end}
1652 ]; 1728 ];

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines