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.232 by sf-exg, Fri May 2 20:33:56 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 294
295=item on_resize_all_windows $term, $new_width, $new_height 295=item on_resize_all_windows $term, $new_width, $new_height
296 296
297Called just after the new window size has been calculated, but before 297Called just after the new window size has been calculated, but before
298windows 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
… …
557sub parse_resource { 557sub parse_resource {
558 my ($term, $name, $isarg, $longopt, $flag, $value) = @_; 558 my ($term, $name, $isarg, $longopt, $flag, $value) = @_;
559 559
560 $name =~ y/-/./ if $isarg; 560 $name =~ y/-/./ if $isarg;
561 561
562 $term->scan_meta; 562 $term->scan_extensions;
563 563
564 my $r = $term->{meta}{resource}; 564 my $r = $term->{meta}{resource};
565 keys %$r; # reset iterator 565 keys %$r; # reset iterator
566 while (my ($pattern, $v) = each %$r) { 566 while (my ($pattern, $v) = each %$r) {
567 if ( 567 if (
… …
587} 587}
588 588
589sub usage { 589sub usage {
590 my ($term, $usage_type) = @_; 590 my ($term, $usage_type) = @_;
591 591
592 $term->scan_meta; 592 $term->scan_extensions;
593 593
594 my $r = $term->{meta}{resource}; 594 my $r = $term->{meta}{resource};
595 595
596 for my $pattern (sort keys %$r) { 596 for my $pattern (sort keys %$r) {
597 my ($ext, $type, $desc) = @{ $r->{$pattern} }; 597 my ($ext, $type, $desc) = @{ $r->{$pattern} };
… …
661 my $htype = shift; 661 my $htype = shift;
662 662
663 if ($htype == HOOK_INIT) { 663 if ($htype == HOOK_INIT) {
664 my @dirs = $TERM->perl_libdirs; 664 my @dirs = $TERM->perl_libdirs;
665 665
666 $TERM->scan_extensions;
667
666 my %ext_arg; 668 my %ext_arg;
667 669
668 { 670 {
669 my @init = @TERM_INIT; 671 my @init = @TERM_INIT;
670 @TERM_INIT = (); 672 @TERM_INIT = ();
… …
673 @TERM_EXT = (); 675 @TERM_EXT = ();
674 $TERM->register_package ($_) for @pkg; 676 $TERM->register_package ($_) for @pkg;
675 } 677 }
676 678
677 for ( 679 for (
678 @{ delete $TERM->{perl_ext_3} },
679 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2 680 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
680 ) { 681 ) {
681 if ($_ eq "default") { 682 if ($_ eq "default") {
682 $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
683 } elsif (/^-(.*)$/) { 700 } elsif (/^-(.*)$/) {
684 delete $ext_arg{$1}; 701 delete $ext_arg{$1};
702
685 } elsif (/^([^<]+)<(.*)>$/) { 703 } elsif (/^([^<]+)<(.*)>$/) {
686 push @{ $ext_arg{$1} }, $2; 704 push @{ $ext_arg{$1} }, $2;
705
687 } else { 706 } else {
688 $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]");
689 } 715 }
690 } 716 }
691 717
692 for my $ext (sort keys %ext_arg) { 718 for my $ext (sort keys %ext_arg) {
693 my @files = grep -f $_, map "$_/$ext", @dirs; 719 my @files = grep -f $_, map "$_/$ext", @dirs;
… …
707 733
708 if (my $cb = $TERM->{_hook}[$htype]) { 734 if (my $cb = $TERM->{_hook}[$htype]) {
709 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" 735 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
710 if $verbosity >= 10; 736 if $verbosity >= 10;
711 737
712 for my $pkg ( 738 if ($htype == HOOK_ACTION) {
713 # this hook is only sent to the extension with the name 739 # this hook is only sent to the extension with the name
714 # matching the first arg 740 # matching the first arg
715 $htype == HOOK_KEYBOARD_DISPATCH 741 my $pkg = shift;
716 ? exists $cb->{"urxvt::ext::$_[0]"} ? "urxvt::ext::" . shift : return undef 742 $pkg =~ y/-/_/;
717 : 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 };
718 ) { 749 }
750
751 for my $pkg (keys %$cb) {
719 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) }; 752 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) };
720 $retval ||= $retval_; 753 $retval ||= $retval_;
721 754
722 if ($@) { 755 if ($@) {
723 $TERM->ungrab; # better to lose the grab than the session 756 $TERM->ungrab; # better to lose the grab than the session
… …
1062 $ENV{URXVT_PERL_LIB}, 1095 $ENV{URXVT_PERL_LIB},
1063 "$ENV{HOME}/.urxvt/ext", 1096 "$ENV{HOME}/.urxvt/ext",
1064 "$LIBDIR/perl" 1097 "$LIBDIR/perl"
1065} 1098}
1066 1099
1067sub scan_meta { 1100# scan for available extensions and collect their metadata
1101sub scan_extensions {
1068 my ($self) = @_; 1102 my ($self) = @_;
1103
1104 return if exists $self->{meta};
1105
1069 my @libdirs = perl_libdirs $self; 1106 my @libdirs = perl_libdirs $self;
1070 1107
1071 return if $self->{meta_libdirs} eq join "\x00", @libdirs; 1108# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d#
1072 1109
1073 my %meta;
1074
1075 $self->{meta_libdirs} = join "\x00", @libdirs; 1110# $self->{meta_libdirs} = join "\x00", @libdirs;#d#
1076 $self->{meta} = \%meta; 1111 $self->{meta} = \my %meta;
1077 1112
1113 # first gather extensions
1078 for my $dir (reverse @libdirs) { 1114 for my $dir (reverse @libdirs) {
1079 opendir my $fh, $dir 1115 opendir my $fh, $dir
1080 or next; 1116 or next;
1081 for my $ext (readdir $fh) { 1117 for my $ext (readdir $fh) {
1082 $ext !~ /^\./ 1118 $ext !~ /^\./
1083 and open my $fh, "<", "$dir/$ext" 1119 and open my $fh, "<", "$dir/$ext"
1084 or next; 1120 or next;
1085 1121
1122 my %ext = (dir => $dir);
1123
1086 while (<$fh>) { 1124 while (<$fh>) {
1087 if (/^#:META:X_RESOURCE:(.*)/) { 1125 if (/^#:META:(?:X_)?RESOURCE:(.*)/) {
1088 my ($pattern, $type, $desc) = split /:/, $1; 1126 my ($pattern, $type, $desc) = split /:/, $1;
1089 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name 1127 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
1090 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) { 1128 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
1091 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";
1092 } else { 1130 } else {
1093 $meta{resource}{$pattern} = [$ext, $type, $desc]; 1131 $ext{resource}{$pattern} = [$ext, $type, $desc];
1094 } 1132 }
1133 } elsif (/^#:META:BINDING:(.*)/) {
1134 my ($keysym, $action) = split /:/, $1;
1135 $ext{binding}{$keysym} = [$ext, $action];
1095 } elsif (/^\s*(?:#|$)/) { 1136 } elsif (/^\s*(?:#|$)/) {
1096 # skip other comments and empty lines 1137 # skip other comments and empty lines
1097 } else { 1138 } else {
1098 last; # stop parsing on first non-empty non-comment line 1139 last; # stop parsing on first non-empty non-comment line
1099 } 1140 }
1100 } 1141 }
1142
1143 $meta{ext}{$ext} = \%ext;
1101 } 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} });
1102 } 1152 }
1103} 1153}
1104 1154
1105=item $term = new urxvt::term $envhashref, $rxvtname, [arg...] 1155=item $term = new urxvt::term $envhashref, $rxvtname, [arg...]
1106 1156
… …
1252 my $res = &x_resource; 1302 my $res = &x_resource;
1253 1303
1254 $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
1255} 1305}
1256 1306
1257=item $success = $term->parse_keysym ($key, $octets) 1307=item $success = $term->bind_action ($key, $octets)
1258 1308
1259Adds 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
1260C<keysym> resource in the urxvt(1) manpage. 1310C<keysym> resource in the urxvt(1) manpage.
1261 1311
1262=item $rend = $term->rstyle ([$new_rstyle]) 1312=item $rend = $term->rstyle ([$new_rstyle])
1263 1313
1264Return and optionally change the current rendition. Text that is output by 1314Return and optionally change the current rendition. Text that is output by
… …
1445=item $term->tt_write ($octets) 1495=item $term->tt_write ($octets)
1446 1496
1447Write 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
1448pass characters instead of octets, you should convert your strings first 1498pass characters instead of octets, you should convert your strings first
1449to 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.
1450 1508
1451=item $term->tt_paste ($octets) 1509=item $term->tt_paste ($octets)
1452 1510
1453Write 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
1454CR 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