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.230 by root, Sat Apr 26 20:51:12 2014 UTC vs.
Revision 1.238 by root, Sun May 18 18:15:04 2014 UTC

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 going away in 292The event is simply the action string. This interface is going away in
293preference to the C<< ->register_keysym_action >> method. 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 a true value the binding
299is not registered. 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
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} };
670 my $htype = shift; 661 my $htype = shift;
671 662
672 if ($htype == HOOK_INIT) { 663 if ($htype == HOOK_INIT) {
673 my @dirs = $TERM->perl_libdirs; 664 my @dirs = $TERM->perl_libdirs;
674 665
666 $TERM->scan_extensions;
667
675 my %ext_arg; 668 my %ext_arg;
676 669
677 { 670 {
678 my @init = @TERM_INIT; 671 my @init = @TERM_INIT;
679 @TERM_INIT = (); 672 @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 map $_->[0], values %{ $TERM->{meta}{binding} },
688 @{ delete $TERM->{perl_ext_3} };
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 $ext =~ y/-/_/;
696
697 $ext_arg{$ext} = [];
698 }
699
692 } elsif (/^-(.*)$/) { 700 } elsif (/^-(.*)$/) {
693 delete $ext_arg{$1}; 701 delete $ext_arg{$1};
702
694 } elsif (/^([^<]+)<(.*)>$/) { 703 } elsif (/^([^<]+)<(.*)>$/) {
695 push @{ $ext_arg{$1} }, $2; 704 push @{ $ext_arg{$1} }, $2;
705
696 } else { 706 } else {
697 $ext_arg{$_} ||= []; 707 $ext_arg{$_} ||= [];
708 }
709 }
710
711 # now register default key bindings
712 for my $ext (sort keys %ext_arg) {
713 while (my ($k, $v) = each %{ $TERM->{meta}{ext}{$ext}{binding} }) {
714 $TERM->bind_action ($k, "$v->[0]:$v->[1]");
698 } 715 }
699 } 716 }
700 717
701 for my $ext (sort keys %ext_arg) { 718 for my $ext (sort keys %ext_arg) {
702 my @files = grep -f $_, map "$_/$ext", @dirs; 719 my @files = grep -f $_, map "$_/$ext", @dirs;
716 733
717 if (my $cb = $TERM->{_hook}[$htype]) { 734 if (my $cb = $TERM->{_hook}[$htype]) {
718 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" 735 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
719 if $verbosity >= 10; 736 if $verbosity >= 10;
720 737
721 for my $pkg ( 738 if ($htype == HOOK_ACTION) {
722 # this hook is only sent to the extension with the name 739 # this hook is only sent to the extension with the name
723 # matching the first arg 740 # matching the first arg
724 $htype == HOOK_KEYBOARD_DISPATCH 741 my $pkg = shift;
725 ? exists $cb->{"urxvt::ext::$_[0]"} ? "urxvt::ext::" . shift : return undef 742 $pkg =~ y/-/_/;
726 : keys %$cb 743 $pkg = "urxvt::ext::$pkg";
744
745 $cb = $cb->{$pkg}
746 or return undef; #TODO: maybe warn user?
747
748 $cb = { $pkg => $cb };
727 ) { 749 }
750
751 for my $pkg (keys %$cb) {
728 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) }; 752 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) };
729 $retval ||= $retval_; 753 $retval ||= $retval_;
730 754
731 if ($@) { 755 if ($@) {
732 $TERM->ungrab; # better to lose the grab than the session 756 $TERM->ungrab; # better to lose the grab than the session
1071 $ENV{URXVT_PERL_LIB}, 1095 $ENV{URXVT_PERL_LIB},
1072 "$ENV{HOME}/.urxvt/ext", 1096 "$ENV{HOME}/.urxvt/ext",
1073 "$LIBDIR/perl" 1097 "$LIBDIR/perl"
1074} 1098}
1075 1099
1076sub scan_meta { 1100# scan for available extensions and collect their metadata
1101sub scan_extensions {
1077 my ($self) = @_; 1102 my ($self) = @_;
1103
1104 return if exists $self->{meta};
1105
1078 my @libdirs = perl_libdirs $self; 1106 my @libdirs = perl_libdirs $self;
1079 1107
1080 return if $self->{meta_libdirs} eq join "\x00", @libdirs; 1108# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d#
1081 1109
1082 my %meta;
1083
1084 $self->{meta_libdirs} = join "\x00", @libdirs; 1110# $self->{meta_libdirs} = join "\x00", @libdirs;#d#
1085 $self->{meta} = \%meta; 1111 $self->{meta} = \my %meta;
1086 1112
1113 # first gather extensions
1087 for my $dir (reverse @libdirs) { 1114 for my $dir (reverse @libdirs) {
1088 opendir my $fh, $dir 1115 opendir my $fh, $dir
1089 or next; 1116 or next;
1090 for my $ext (readdir $fh) { 1117 for my $ext (readdir $fh) {
1091 $ext !~ /^\./ 1118 $ext !~ /^\./
1092 and open my $fh, "<", "$dir/$ext" 1119 and open my $fh, "<", "$dir/$ext"
1093 or next; 1120 or next;
1094 1121
1122 my %ext = (dir => $dir);
1123
1095 while (<$fh>) { 1124 while (<$fh>) {
1096 if (/^#:META:X_RESOURCE:(.*)/) { 1125 if (/^#:META:(?:X_)?RESOURCE:(.*)/) {
1097 my ($pattern, $type, $desc) = split /:/, $1; 1126 my ($pattern, $type, $desc) = split /:/, $1;
1098 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name 1127 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
1099 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) { 1128 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
1100 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n"; 1129 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n";
1101 } else { 1130 } else {
1102 $meta{resource}{$pattern} = [$ext, $type, $desc]; 1131 $ext{resource}{$pattern} = [$ext, $type, $desc];
1103 } 1132 }
1133 } elsif (/^#:META:BINDING:(.*)/) {
1134 my ($keysym, $action) = split /:/, $1;
1135 $ext{binding}{$keysym} = [$ext, $action];
1104 } elsif (/^\s*(?:#|$)/) { 1136 } elsif (/^\s*(?:#|$)/) {
1105 # skip other comments and empty lines 1137 # skip other comments and empty lines
1106 } else { 1138 } else {
1107 last; # stop parsing on first non-empty non-comment line 1139 last; # stop parsing on first non-empty non-comment line
1108 } 1140 }
1109 } 1141 }
1142
1143 $meta{ext}{$ext} = \%ext;
1110 } 1144 }
1145 }
1146
1147 # and now merge resources and bindings
1148 while (my ($k, $v) = each %{ $meta{ext} }) {
1149 #TODO: should check for extensions overriding each other
1150 %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} });
1151 %{ $meta{binding} } = (%{ $meta{binding} }, %{ $v->{binding} });
1111 } 1152 }
1112} 1153}
1113 1154
1114=item $term = new urxvt::term $envhashref, $rxvtname, [arg...] 1155=item $term = new urxvt::term $envhashref, $rxvtname, [arg...]
1115 1156
1261 my $res = &x_resource; 1302 my $res = &x_resource;
1262 1303
1263 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0 1304 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0
1264} 1305}
1265 1306
1266=item $success = $term->parse_keysym ($key, $octets) 1307=item $success = $term->bind_action ($key, $octets)
1267 1308
1268Adds a key binding exactly as specified via a resource. See the 1309Adds a key binding exactly as specified via a C<keysym> resource. See the
1269C<keysym> resource in the urxvt(1) manpage. 1310C<keysym> resource in the urxvt(1) manpage.
1270
1271=item $term->register_command ($keysym, $modifiermask, $string)
1272
1273Adds a key binding. This is a lower level api compared to
1274C<parse_keysym>, as it expects a parsed key description, and can be
1275used only inside either the C<on_init> hook, to add a binding, or the
1276C<on_register_command> hook, to modify a parsed binding.
1277 1311
1278=item $rend = $term->rstyle ([$new_rstyle]) 1312=item $rend = $term->rstyle ([$new_rstyle])
1279 1313
1280Return and optionally change the current rendition. Text that is output by 1314Return and optionally change the current rendition. Text that is output by
1281the terminal application will use this style. 1315the terminal application will use this style.
1461=item $term->tt_write ($octets) 1495=item $term->tt_write ($octets)
1462 1496
1463Write the octets given in C<$octets> to the tty (i.e. as program input). To 1497Write the octets given in C<$octets> to the tty (i.e. as program input). To
1464pass characters instead of octets, you should convert your strings first 1498pass characters instead of octets, you should convert your strings first
1465to the locale-specific encoding using C<< $term->locale_encode >>. 1499to the locale-specific encoding using C<< $term->locale_encode >>.
1500
1501=item $term->tt_write_user_input ($octets)
1502
1503Like C<tt_write>, but should be used when writing strings in response to
1504the user pressing a key, to invokes the additional actions requested by
1505the user for that case (C<tt_write> doesn't do that).
1506
1507The typical use case would be inside C<on_action> hooks.
1466 1508
1467=item $term->tt_paste ($octets) 1509=item $term->tt_paste ($octets)
1468 1510
1469Write the octets given in C<$octets> to the tty as a paste, converting NL to 1511Write the octets given in C<$octets> to the tty as a paste, converting NL to
1470CR and bracketing the data with control sequences if bracketed paste mode 1512CR and bracketing the data with control sequences if bracketed paste mode

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines