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.228 by sf-exg, Tue Oct 29 14:12:58 2013 UTC vs.
Revision 1.240 by sf-exg, Fri Oct 10 14:32:32 2014 UTC

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 urxvt(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; # reset iterator 565 keys %$r; # reset iterator
575 while (my ($pattern, $v) = each %$r) { 566 while (my ($pattern, $v) = each %$r) {
576 if ( 567 if (
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 !~ /^\./ 1117 $ext !~ /^\./
1083 and open my $fh, "<", "$dir/$ext" 1118 and open my $fh, "<", "$dir/$ext"
1084 or next; 1119 or next;
1085 1120
1121 my %ext = (dir => $dir);
1122
1086 while (<$fh>) { 1123 while (<$fh>) {
1087 if (/^#:META:X_RESOURCE:(.*)/) { 1124 if (/^#:META:(?:X_)?RESOURCE:(.*)/) {
1088 my ($pattern, $type, $desc) = split /:/, $1; 1125 my ($pattern, $type, $desc) = split /:/, $1;
1089 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name 1126 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
1090 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) { 1127 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
1091 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";
1092 } else { 1129 } else {
1093 $meta{resource}{$pattern} = [$ext, $type, $desc]; 1130 $ext{resource}{$pattern} = [$ext, $type, $desc];
1094 } 1131 }
1132 } elsif (/^#:META:BINDING:(.*)/) {
1133 my ($keysym, $action) = split /:/, $1;
1134 $ext{binding}{$keysym} = [$ext, $action];
1095 } elsif (/^\s*(?:#|$)/) { 1135 } elsif (/^\s*(?:#|$)/) {
1096 # skip other comments and empty lines 1136 # skip other comments and empty lines
1097 } else { 1137 } else {
1098 last; # stop parsing on first non-empty non-comment line 1138 last; # stop parsing on first non-empty non-comment line
1099 } 1139 }
1100 } 1140 }
1141
1142 $meta{ext}{$ext} = \%ext;
1101 } 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} });
1102 } 1151 }
1103} 1152}
1104 1153
1105=item $term = new urxvt::term $envhashref, $rxvtname, [arg...] 1154=item $term = new urxvt::term $envhashref, $rxvtname, [arg...]
1106 1155
1252 my $res = &x_resource; 1301 my $res = &x_resource;
1253 1302
1254 $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
1255} 1304}
1256 1305
1257=item $success = $term->parse_keysym ($key, $octets) 1306=item $success = $term->bind_action ($key, $octets)
1258 1307
1259Adds 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
1260C<keysym> resource in the urxvt(1) manpage. 1309C<keysym> resource in the urxvt(1) manpage.
1261
1262=item $term->register_command ($keysym, $modifiermask, $string)
1263
1264Adds a key binding. This is a lower level api compared to
1265C<parse_keysym>, as it expects a parsed key description, and can be
1266used only inside either the C<on_init> hook, to add a binding, or the
1267C<on_register_command> hook, to modify a parsed binding.
1268 1310
1269=item $rend = $term->rstyle ([$new_rstyle]) 1311=item $rend = $term->rstyle ([$new_rstyle])
1270 1312
1271Return and optionally change the current rendition. Text that is output by 1313Return and optionally change the current rendition. Text that is output by
1272the terminal application will use this style. 1314the terminal application will use this style.
1452=item $term->tt_write ($octets) 1494=item $term->tt_write ($octets)
1453 1495
1454Write 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
1455pass characters instead of octets, you should convert your strings first 1497pass characters instead of octets, you should convert your strings first
1456to 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.
1457 1507
1458=item $term->tt_paste ($octets) 1508=item $term->tt_paste ($octets)
1459 1509
1460Write 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
1461CR and bracketing the data with control sequences if bracketed paste mode 1511CR and bracketing the data with control sequences if bracketed paste mode

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines