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.231 by root, Sun Apr 27 20:26:28 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
… …
564sub parse_resource { 557sub parse_resource {
565 my ($term, $name, $isarg, $longopt, $flag, $value) = @_; 558 my ($term, $name, $isarg, $longopt, $flag, $value) = @_;
566 559
567 $name =~ y/-/./ if $isarg; 560 $name =~ y/-/./ if $isarg;
568 561
569 $term->scan_meta; 562 $term->scan_extensions;
570 563
571 my $r = $term->{meta}{resource}; 564 my $r = $term->{meta}{resource};
572 keys %$r; # reset iterator 565 keys %$r; # reset iterator
573 while (my ($pattern, $v) = each %$r) { 566 while (my ($pattern, $v) = each %$r) {
574 if ( 567 if (
… …
594} 587}
595 588
596sub usage { 589sub usage {
597 my ($term, $usage_type) = @_; 590 my ($term, $usage_type) = @_;
598 591
599 $term->scan_meta; 592 $term->scan_extensions;
600 593
601 my $r = $term->{meta}{resource}; 594 my $r = $term->{meta}{resource};
602 595
603 for my $pattern (sort keys %$r) { 596 for my $pattern (sort keys %$r) {
604 my ($ext, $type, $desc) = @{ $r->{$pattern} }; 597 my ($ext, $type, $desc) = @{ $r->{$pattern} };
… …
668 my $htype = shift; 661 my $htype = shift;
669 662
670 if ($htype == HOOK_INIT) { 663 if ($htype == HOOK_INIT) {
671 my @dirs = $TERM->perl_libdirs; 664 my @dirs = $TERM->perl_libdirs;
672 665
666 $TERM->scan_extensions;
667
673 my %ext_arg; 668 my %ext_arg;
674 669
675 { 670 {
676 my @init = @TERM_INIT; 671 my @init = @TERM_INIT;
677 @TERM_INIT = (); 672 @TERM_INIT = ();
… …
680 @TERM_EXT = (); 675 @TERM_EXT = ();
681 $TERM->register_package ($_) for @pkg; 676 $TERM->register_package ($_) for @pkg;
682 } 677 }
683 678
684 for ( 679 for (
685 @{ delete $TERM->{perl_ext_3} },
686 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2 680 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
687 ) { 681 ) {
688 if ($_ eq "default") { 682 if ($_ eq "default") {
689 $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
690 } elsif (/^-(.*)$/) { 700 } elsif (/^-(.*)$/) {
691 delete $ext_arg{$1}; 701 delete $ext_arg{$1};
702
692 } elsif (/^([^<]+)<(.*)>$/) { 703 } elsif (/^([^<]+)<(.*)>$/) {
693 push @{ $ext_arg{$1} }, $2; 704 push @{ $ext_arg{$1} }, $2;
705
694 } else { 706 } else {
695 $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]");
696 } 715 }
697 } 716 }
698 717
699 for my $ext (sort keys %ext_arg) { 718 for my $ext (sort keys %ext_arg) {
700 my @files = grep -f $_, map "$_/$ext", @dirs; 719 my @files = grep -f $_, map "$_/$ext", @dirs;
… …
714 733
715 if (my $cb = $TERM->{_hook}[$htype]) { 734 if (my $cb = $TERM->{_hook}[$htype]) {
716 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" 735 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
717 if $verbosity >= 10; 736 if $verbosity >= 10;
718 737
719 for my $pkg ( 738 if ($htype == HOOK_ACTION) {
720 # this hook is only sent to the extension with the name 739 # this hook is only sent to the extension with the name
721 # matching the first arg 740 # matching the first arg
722 $htype == HOOK_KEYBOARD_DISPATCH 741 my $pkg = shift;
723 ? exists $cb->{"urxvt::ext::$_[0]"} ? "urxvt::ext::" . shift : return undef 742 $pkg =~ y/-/_/;
724 : 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 };
725 ) { 749 }
750
751 for my $pkg (keys %$cb) {
726 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) }; 752 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) };
727 $retval ||= $retval_; 753 $retval ||= $retval_;
728 754
729 if ($@) { 755 if ($@) {
730 $TERM->ungrab; # better to lose the grab than the session 756 $TERM->ungrab; # better to lose the grab than the session
… …
1069 $ENV{URXVT_PERL_LIB}, 1095 $ENV{URXVT_PERL_LIB},
1070 "$ENV{HOME}/.urxvt/ext", 1096 "$ENV{HOME}/.urxvt/ext",
1071 "$LIBDIR/perl" 1097 "$LIBDIR/perl"
1072} 1098}
1073 1099
1074sub scan_meta { 1100# scan for available extensions and collect their metadata
1101sub scan_extensions {
1075 my ($self) = @_; 1102 my ($self) = @_;
1103
1104 return if exists $self->{meta};
1105
1076 my @libdirs = perl_libdirs $self; 1106 my @libdirs = perl_libdirs $self;
1077 1107
1078 return if $self->{meta_libdirs} eq join "\x00", @libdirs; 1108# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d#
1079 1109
1080 my %meta;
1081
1082 $self->{meta_libdirs} = join "\x00", @libdirs; 1110# $self->{meta_libdirs} = join "\x00", @libdirs;#d#
1083 $self->{meta} = \%meta; 1111 $self->{meta} = \my %meta;
1084 1112
1113 # first gather extensions
1085 for my $dir (reverse @libdirs) { 1114 for my $dir (reverse @libdirs) {
1086 opendir my $fh, $dir 1115 opendir my $fh, $dir
1087 or next; 1116 or next;
1088 for my $ext (readdir $fh) { 1117 for my $ext (readdir $fh) {
1089 $ext !~ /^\./ 1118 $ext !~ /^\./
1090 and open my $fh, "<", "$dir/$ext" 1119 and open my $fh, "<", "$dir/$ext"
1091 or next; 1120 or next;
1092 1121
1122 my %ext = (dir => $dir);
1123
1093 while (<$fh>) { 1124 while (<$fh>) {
1094 if (/^#:META:X_RESOURCE:(.*)/) { 1125 if (/^#:META:(?:X_)?RESOURCE:(.*)/) {
1095 my ($pattern, $type, $desc) = split /:/, $1; 1126 my ($pattern, $type, $desc) = split /:/, $1;
1096 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name 1127 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
1097 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) { 1128 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
1098 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";
1099 } else { 1130 } else {
1100 $meta{resource}{$pattern} = [$ext, $type, $desc]; 1131 $ext{resource}{$pattern} = [$ext, $type, $desc];
1101 } 1132 }
1133 } elsif (/^#:META:BINDING:(.*)/) {
1134 my ($keysym, $action) = split /:/, $1;
1135 $ext{binding}{$keysym} = [$ext, $action];
1102 } elsif (/^\s*(?:#|$)/) { 1136 } elsif (/^\s*(?:#|$)/) {
1103 # skip other comments and empty lines 1137 # skip other comments and empty lines
1104 } else { 1138 } else {
1105 last; # stop parsing on first non-empty non-comment line 1139 last; # stop parsing on first non-empty non-comment line
1106 } 1140 }
1107 } 1141 }
1142
1143 $meta{ext}{$ext} = \%ext;
1108 } 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} });
1109 } 1152 }
1110} 1153}
1111 1154
1112=item $term = new urxvt::term $envhashref, $rxvtname, [arg...] 1155=item $term = new urxvt::term $envhashref, $rxvtname, [arg...]
1113 1156
… …
1259 my $res = &x_resource; 1302 my $res = &x_resource;
1260 1303
1261 $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
1262} 1305}
1263 1306
1264=item $success = $term->parse_keysym ($key, $octets) 1307=item $success = $term->bind_action ($key, $octets)
1265 1308
1266Adds 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
1267C<keysym> resource in the urxvt(1) manpage. 1310C<keysym> resource in the urxvt(1) manpage.
1268
1269=item $term->register_command ($keysym, $modifiermask, $string)
1270
1271Adds a key binding. This is a lower level api compared to
1272C<parse_keysym>, as it expects a parsed key description, and can be
1273used only inside either the C<on_init> hook, to add a binding, or the
1274C<on_register_command> hook, to modify a parsed binding.
1275 1311
1276=item $rend = $term->rstyle ([$new_rstyle]) 1312=item $rend = $term->rstyle ([$new_rstyle])
1277 1313
1278Return and optionally change the current rendition. Text that is output by 1314Return and optionally change the current rendition. Text that is output by
1279the terminal application will use this style. 1315the terminal application will use this style.
… …
1459=item $term->tt_write ($octets) 1495=item $term->tt_write ($octets)
1460 1496
1461Write 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
1462pass characters instead of octets, you should convert your strings first 1498pass characters instead of octets, you should convert your strings first
1463to 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.
1464 1508
1465=item $term->tt_paste ($octets) 1509=item $term->tt_paste ($octets)
1466 1510
1467Write 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
1468CR 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