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.233 by sf-exg, Fri May 2 20:34:24 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
313=item on_register_command $term, $keysym, $modifiermask, $string
314
315Called after parsing a keysym resource but before registering the
316associated binding. If this hook returns TRUE the binding is not
317registered. It can be used to modify a binding by calling
318C<register_command>.
319 294
320=item on_resize_all_windows $term, $new_width, $new_height 295=item on_resize_all_windows $term, $new_width, $new_height
321 296
322Called just after the new window size has been calculated, but before 297Called just after the new window size has been calculated, but before
323windows 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
324returns TRUE, setting of the window hints is being skipped. 299returns a true value, setting of the window hints is being skipped.
325 300
326=item on_x_event $term, $event 301=item on_x_event $term, $event
327 302
328Called 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
329windows). Should only be used as a last resort. Most event structure 304windows). Should only be used as a last resort. Most event structure
368manpage), 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
369(real, not screen-based) row and column under the mouse cursor. 344(real, not screen-based) row and column under the mouse cursor.
370 345
371C<on_key_press> additionally receives the string rxvt-unicode would 346C<on_key_press> additionally receives the string rxvt-unicode would
372output, if any, in locale-specific encoding. 347output, if any, in locale-specific encoding.
373
374subwindow.
375 348
376=item on_client_message $term, $event 349=item on_client_message $term, $event
377 350
378=item on_wm_protocols $term, $event 351=item on_wm_protocols $term, $event
379 352
587 $name =~ y/-/./ if $isarg; 560 $name =~ y/-/./ if $isarg;
588 561
589 $term->scan_meta; 562 $term->scan_meta;
590 563
591 my $r = $term->{meta}{resource}; 564 my $r = $term->{meta}{resource};
592 keys %$r; # reste iterator 565 keys %$r; # reset iterator
593 while (my ($pattern, $v) = each %$r) { 566 while (my ($pattern, $v) = each %$r) {
594 if ( 567 if (
595 $pattern =~ /\.$/ 568 $pattern =~ /\.$/
596 ? $pattern eq substr $name, 0, length $pattern 569 ? $pattern eq substr $name, 0, length $pattern
597 : $pattern eq $name 570 : $pattern eq $name
685# called by the rxvt core 658# called by the rxvt core
686sub invoke { 659sub invoke {
687 local $TERM = shift; 660 local $TERM = shift;
688 my $htype = shift; 661 my $htype = shift;
689 662
690 if ($htype == 0) { # INIT 663 if ($htype == HOOK_INIT) {
691 my @dirs = $TERM->perl_libdirs; 664 my @dirs = $TERM->perl_libdirs;
692 665
693 my %ext_arg; 666 my %ext_arg;
694 667
695 { 668 {
734 707
735 if (my $cb = $TERM->{_hook}[$htype]) { 708 if (my $cb = $TERM->{_hook}[$htype]) {
736 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" 709 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
737 if $verbosity >= 10; 710 if $verbosity >= 10;
738 711
739 for my $pkg (keys %$cb) { 712 for my $pkg (
713 # this hook is only sent to the extension with the name
714 # matching the first arg
715 $htype == HOOK_KEYBOARD_DISPATCH
716 ? exists $cb->{"urxvt::ext::$_[0]"} ? "urxvt::ext::" . shift : return undef
717 : keys %$cb
718 ) {
740 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg}, @_) }; 719 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) };
741 $retval ||= $retval_; 720 $retval ||= $retval_;
742 721
743 if ($@) { 722 if ($@) {
744 $TERM->ungrab; # better to lose the grab than the session 723 $TERM->ungrab; # better to lose the grab than the session
745 warn $@; 724 warn $@;
748 727
749 verbose 11, "$HOOKNAME[$htype] returning <$retval>" 728 verbose 11, "$HOOKNAME[$htype] returning <$retval>"
750 if $verbosity >= 11; 729 if $verbosity >= 11;
751 } 730 }
752 731
753 if ($htype == 1) { # DESTROY 732 if ($htype == HOOK_DESTROY) {
754 # clear package objects 733 # clear package objects
755 %$_ = () for values %{ $TERM->{_pkg} }; 734 %$_ = () for values %{ $TERM->{_pkg} };
756 735
757 # clear package 736 # clear package
758 %$TERM = (); 737 %$TERM = ();
790 ($mask, @color{qw(fg bg)}, \@failed) 769 ($mask, @color{qw(fg bg)}, \@failed)
791} 770}
792 771
793package urxvt::term::extension; 772package urxvt::term::extension;
794 773
795sub enable { 774=head2 The C<urxvt::term::extension> class
796 my ($self, %hook) = @_;
797 my $pkg = $self->{_pkg};
798 775
799 while (my ($name, $cb) = each %hook) { 776Each extension attached to a terminal object is represented by
800 my $htype = $HOOKTYPE{uc $name}; 777a C<urxvt::term::extension> object.
801 defined $htype
802 or Carp::croak "unsupported hook type '$name'";
803 778
804 $self->set_should_invoke ($htype, +1) 779You can use these objects, which are passed to all callbacks to store any
805 unless exists $self->{term}{_hook}[$htype]{$pkg}; 780state related to the terminal and extension instance.
806 781
807 $self->{term}{_hook}[$htype]{$pkg} = $cb; 782The methods (And data members) documented below can be called on extension
808 } 783objects, in addition to call methods documented for the <urxvt::term>
809} 784class.
810 785
811sub disable { 786=over 4
812 my ($self, @hook) = @_;
813 my $pkg = $self->{_pkg};
814 787
815 for my $name (@hook) { 788=item $urxvt_term = $self->{term}
816 my $htype = $HOOKTYPE{uc $name};
817 defined $htype
818 or Carp::croak "unsupported hook type '$name'";
819 789
820 $self->set_should_invoke ($htype, -1) 790Returns the C<urxvt::term> object associated with this instance of the
821 if delete $self->{term}{_hook}[$htype]{$pkg}; 791extension. This member I<must not> be changed in any way.
822 } 792
823} 793=cut
824 794
825our $AUTOLOAD; 795our $AUTOLOAD;
826 796
827sub AUTOLOAD { 797sub AUTOLOAD {
828 $AUTOLOAD =~ /:([^:]+)$/ 798 $AUTOLOAD =~ /:([^:]+)$/
841 811
842sub DESTROY { 812sub DESTROY {
843 # nop 813 # nop
844} 814}
845 815
846# urxvt::destroy_hook 816# urxvt::destroy_hook (basically a cheap Guard:: implementation)
847 817
848sub urxvt::destroy_hook::DESTROY { 818sub urxvt::destroy_hook::DESTROY {
849 ${$_[0]}->(); 819 ${$_[0]}->();
850} 820}
851 821
852sub urxvt::destroy_hook(&) { 822sub urxvt::destroy_hook(&) {
853 bless \shift, urxvt::destroy_hook:: 823 bless \shift, urxvt::destroy_hook::
854} 824}
825
826=item $self->enable ($hook_name => $cb[, $hook_name => $cb..])
827
828Dynamically enable the given hooks (named without the C<on_> prefix) for
829this extension, replacing any hook previously installed via C<enable> in
830this extension.
831
832This is useful when you want to overwrite time-critical hooks only
833temporarily.
834
835To install additional callbacks for the same hook, you can use the C<on>
836method of the C<urxvt::term> class.
837
838=item $self->disable ($hook_name[, $hook_name..])
839
840Dynamically disable the given hooks.
841
842=cut
843
844sub enable {
845 my ($self, %hook) = @_;
846 my $pkg = $self->{_pkg};
847
848 while (my ($name, $cb) = each %hook) {
849 my $htype = $HOOKTYPE{uc $name};
850 defined $htype
851 or Carp::croak "unsupported hook type '$name'";
852
853 $self->set_should_invoke ($htype, +1)
854 unless exists $self->{term}{_hook}[$htype]{$pkg};
855
856 $self->{term}{_hook}[$htype]{$pkg} = $cb;
857 }
858}
859
860sub disable {
861 my ($self, @hook) = @_;
862 my $pkg = $self->{_pkg};
863
864 for my $name (@hook) {
865 my $htype = $HOOKTYPE{uc $name};
866 defined $htype
867 or Carp::croak "unsupported hook type '$name'";
868
869 $self->set_should_invoke ($htype, -1)
870 if delete $self->{term}{_hook}[$htype]{$pkg};
871 }
872}
873
874=item $guard = $self->on ($hook_name => $cb[, $hook_name => $cb..])
875
876Similar to the C<enable> enable, but installs additional callbacks for
877the given hook(s) (that is, it doesn't replace existing callbacks), and
878returns a guard object. When the guard object is destroyed the callbacks
879are disabled again.
880
881=cut
882
883sub urxvt::extension::on_disable::DESTROY {
884 my $disable = shift;
885
886 my $term = delete $disable->{""};
887
888 while (my ($htype, $id) = each %$disable) {
889 delete $term->{_hook}[$htype]{$id};
890 $term->set_should_invoke ($htype, -1);
891 }
892}
893
894sub on {
895 my ($self, %hook) = @_;
896
897 my $term = $self->{term};
898
899 my %disable = ( "" => $term );
900
901 while (my ($name, $cb) = each %hook) {
902 my $htype = $HOOKTYPE{uc $name};
903 defined $htype
904 or Carp::croak "unsupported hook type '$name'";
905
906 $term->set_should_invoke ($htype, +1);
907 $term->{_hook}[$htype]{ $disable{$htype} = $cb+0 }
908 = sub { shift; $cb->($self, @_) }; # very ugly indeed
909 }
910
911 bless \%disable, "urxvt::extension::on_disable"
912}
913
914=item $self->x_resource ($pattern)
915
916=item $self->x_resource_boolean ($pattern)
917
918These methods support an additional C<%> prefix when called on an
919extension object - see the description of these methods in the
920C<urxvt::term> class for details.
921
922=cut
855 923
856sub x_resource { 924sub x_resource {
857 my ($self, $name) = @_; 925 my ($self, $name) = @_;
858 $name =~ s/^%(\.|$)/$_[0]{_name}$1/; 926 $name =~ s/^%(\.|$)/$_[0]{_name}$1/;
859 $self->{term}->x_resource ($name) 927 $self->{term}->x_resource ($name)
862sub x_resource_boolean { 930sub x_resource_boolean {
863 my ($self, $name) = @_; 931 my ($self, $name) = @_;
864 $name =~ s/^%(\.|$)/$_[0]{_name}$1/; 932 $name =~ s/^%(\.|$)/$_[0]{_name}$1/;
865 $self->{term}->x_resource_boolean ($name) 933 $self->{term}->x_resource_boolean ($name)
866} 934}
935
936=back
937
938=cut
867 939
868package urxvt::anyevent; 940package urxvt::anyevent;
869 941
870=head2 The C<urxvt::anyevent> Class 942=head2 The C<urxvt::anyevent> Class
871 943
1005 1077
1006 for my $dir (reverse @libdirs) { 1078 for my $dir (reverse @libdirs) {
1007 opendir my $fh, $dir 1079 opendir my $fh, $dir
1008 or next; 1080 or next;
1009 for my $ext (readdir $fh) { 1081 for my $ext (readdir $fh) {
1010 $ext ne "." 1082 $ext !~ /^\./
1011 and $ext ne ".."
1012 and open my $fh, "<", "$dir/$ext" 1083 and open my $fh, "<", "$dir/$ext"
1013 or next; 1084 or next;
1014 1085
1015 while (<$fh>) { 1086 while (<$fh>) {
1016 if (/^#:META:X_RESOURCE:(.*)/) { 1087 if (/^#:META:X_RESOURCE:(.*)/) {
1055} 1126}
1056 1127
1057=item $term->destroy 1128=item $term->destroy
1058 1129
1059Destroy the terminal object (close the window, free resources 1130Destroy the terminal object (close the window, free resources
1060etc.). Please note that @@RXVT_NAME@@ will not exit as long as any event 1131etc.). Please note that urxvt will not exit as long as any event
1061watchers (timers, io watchers) are still active. 1132watchers (timers, io watchers) are still active.
1062 1133
1063=item $term->exec_async ($cmd[, @args]) 1134=item $term->exec_async ($cmd[, @args])
1064 1135
1065Works like the combination of the C<fork>/C<exec> builtins, which executes 1136Works like the combination of the C<fork>/C<exec> builtins, which executes
1181 my $res = &x_resource; 1252 my $res = &x_resource;
1182 1253
1183 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0 1254 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0
1184} 1255}
1185 1256
1186=item $success = $term->parse_keysym ($key, $octets) 1257=item $success = $term->bind_action ($key, $octets)
1187 1258
1188Adds a key binding exactly as specified via a resource. See the 1259Adds a key binding exactly as specified via a resource. See the
1189C<keysym> resource in the @@RXVT_NAME@@(1) manpage. 1260C<keysym> resource in the urxvt(1) manpage.
1190
1191=item $term->register_command ($keysym, $modifiermask, $string)
1192
1193Adds a key binding. This is a lower level api compared to
1194C<parse_keysym>, as it expects a parsed key description, and can be
1195used only inside either the C<on_init> hook, to add a binding, or the
1196C<on_register_command> hook, to modify a parsed binding.
1197 1261
1198=item $rend = $term->rstyle ([$new_rstyle]) 1262=item $rend = $term->rstyle ([$new_rstyle])
1199 1263
1200Return and optionally change the current rendition. Text that is output by 1264Return and optionally change the current rendition. Text that is output by
1201the terminal application will use this style. 1265the terminal application will use this style.
1624} 1688}
1625 1689
1626sub urxvt::line::t { 1690sub urxvt::line::t {
1627 my ($self) = @_; 1691 my ($self) = @_;
1628 1692
1629 if (@_ > 1) 1693 if (@_ > 1) {
1630 {
1631 $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) 1694 $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol})
1632 for $self->{beg} .. $self->{end}; 1695 for $self->{beg} .. $self->{end};
1633 } 1696 }
1634 1697
1635 defined wantarray && 1698 defined wantarray &&
1636 substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}), 1699 substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}),
1637 0, $self->{len} 1700 0, $self->{len}
1638} 1701}
1639 1702
1640sub urxvt::line::r { 1703sub urxvt::line::r {
1641 my ($self) = @_; 1704 my ($self) = @_;
1642 1705
1643 if (@_ > 1) 1706 if (@_ > 1) {
1644 {
1645 $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) 1707 $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol})
1646 for $self->{beg} .. $self->{end}; 1708 for $self->{beg} .. $self->{end};
1647 } 1709 }
1648 1710
1649 if (defined wantarray) { 1711 if (defined wantarray) {
1650 my $rend = [ 1712 my $rend = [
1651 map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end} 1713 map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end}
1652 ]; 1714 ];

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines