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.233 by sf-exg, Fri May 2 20:34:24 2014 UTC vs.
Revision 1.243 by sf-exg, Sat Oct 11 22:02:50 2014 UTC

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
48Extensions that add command line parameters or resources on their own are 48Extensions may add resources on their own. Similarly to builtin
49loaded automatically when used. 49resources, these resources can also be specified on the command line
50as long options (with '.' replaced by '-'), in which case the
51corresponding extension is loaded automatically.
50 52
51=head1 API DOCUMENTATION 53=head1 API DOCUMENTATION
52 54
53=head2 General API Considerations 55=head2 General API Considerations
54 56
288Called whenever a user-configured event is being activated (e.g. via 290Called 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> 291a C<perl:string> action bound to a key, see description of the B<keysym>
290resource in the urxvt(1) manpage). 292resource in the urxvt(1) manpage).
291 293
292The event is simply the action string. This interface is going away in 294The event is simply the action string. This interface is going away in
293preference to the C<< ->register_keysym_action >> method. 295preference to the C<on_action> hook.
294 296
295=item on_resize_all_windows $term, $new_width, $new_height 297=item on_resize_all_windows $term, $new_width, $new_height
296 298
297Called just after the new window size has been calculated, but before 299Called just after the new window size has been calculated, but before
298windows are actually being resized or hints are being set. If this hook 300windows are actually being resized or hints are being set. If this hook
555no warnings 'utf8'; 557no warnings 'utf8';
556 558
557sub parse_resource { 559sub parse_resource {
558 my ($term, $name, $isarg, $longopt, $flag, $value) = @_; 560 my ($term, $name, $isarg, $longopt, $flag, $value) = @_;
559 561
560 $name =~ y/-/./ if $isarg;
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 ($k, $v) = each %$r) {
567 if ( 567 my $pattern = $k;
568 $pattern =~ y/./-/ if $isarg;
569 my $prefix = $name;
570 my $suffix;
568 $pattern =~ /\.$/ 571 if ($pattern =~ /\-$/) {
569 ? $pattern eq substr $name, 0, length $pattern 572 $prefix = substr $name, 0, length $pattern;
570 : $pattern eq $name 573 $suffix = substr $name, length $pattern;
571 ) { 574 }
575 if ($pattern eq $prefix) {
572 $name = "$urxvt::RESCLASS.$name"; 576 $name = "$urxvt::RESCLASS.$k$suffix";
573 577
574 push @{ $term->{perl_ext_3} }, $v->[0]; 578 push @{ $term->{perl_ext_3} }, $v->[0];
575 579
576 if ($v->[1] eq "boolean") { 580 if ($v->[1] eq "boolean") {
577 $term->put_option_db ($name, $flag ? "true" : "false"); 581 $term->put_option_db ($name, $flag ? "true" : "false");
587} 591}
588 592
589sub usage { 593sub usage {
590 my ($term, $usage_type) = @_; 594 my ($term, $usage_type) = @_;
591 595
592 $term->scan_meta; 596 $term->scan_extensions;
593 597
594 my $r = $term->{meta}{resource}; 598 my $r = $term->{meta}{resource};
595 599
596 for my $pattern (sort keys %$r) { 600 for my $pattern (sort keys %$r) {
597 my ($ext, $type, $desc) = @{ $r->{$pattern} }; 601 my ($ext, $type, $desc) = @{ $r->{$pattern} };
661 my $htype = shift; 665 my $htype = shift;
662 666
663 if ($htype == HOOK_INIT) { 667 if ($htype == HOOK_INIT) {
664 my @dirs = $TERM->perl_libdirs; 668 my @dirs = $TERM->perl_libdirs;
665 669
670 $TERM->scan_extensions;
671
666 my %ext_arg; 672 my %ext_arg;
667 673
668 { 674 {
669 my @init = @TERM_INIT; 675 my @init = @TERM_INIT;
670 @TERM_INIT = (); 676 @TERM_INIT = ();
673 @TERM_EXT = (); 679 @TERM_EXT = ();
674 $TERM->register_package ($_) for @pkg; 680 $TERM->register_package ($_) for @pkg;
675 } 681 }
676 682
677 for ( 683 for (
684 (grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2),
678 @{ delete $TERM->{perl_ext_3} }, 685 @{ delete $TERM->{perl_ext_3} }
679 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
680 ) { 686 ) {
681 if ($_ eq "default") { 687 if ($_ eq "default") {
682 $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup searchable-scrollback readline); 688
689 $ext_arg{$_} = []
690 for
691 qw(selection option-popup selection-popup readline),
692 map $_->[0], values %{ $TERM->{meta}{binding} };
693
694 for ($TERM->_keysym_resources) {
695 next if /^(?:string|command|builtin|builtin-string|perl)/;
696 next unless /^([A-Za-z0-9_\-]+):/;
697
698 my $ext = $1;
699
700 $ext_arg{$ext} = [];
701 }
702
683 } elsif (/^-(.*)$/) { 703 } elsif (/^-(.*)$/) {
684 delete $ext_arg{$1}; 704 delete $ext_arg{$1};
705
685 } elsif (/^([^<]+)<(.*)>$/) { 706 } elsif (/^([^<]+)<(.*)>$/) {
686 push @{ $ext_arg{$1} }, $2; 707 push @{ $ext_arg{$1} }, $2;
708
687 } else { 709 } else {
688 $ext_arg{$_} ||= []; 710 $ext_arg{$_} ||= [];
711 }
712 }
713
714 # now register default key bindings
715 for my $ext (sort keys %ext_arg) {
716 while (my ($k, $v) = each %{ $TERM->{meta}{ext}{$ext}{binding} }) {
717 $TERM->bind_action ($k, "$v->[0]:$v->[1]");
689 } 718 }
690 } 719 }
691 720
692 for my $ext (sort keys %ext_arg) { 721 for my $ext (sort keys %ext_arg) {
693 my @files = grep -f $_, map "$_/$ext", @dirs; 722 my @files = grep -f $_, map "$_/$ext", @dirs;
707 736
708 if (my $cb = $TERM->{_hook}[$htype]) { 737 if (my $cb = $TERM->{_hook}[$htype]) {
709 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" 738 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
710 if $verbosity >= 10; 739 if $verbosity >= 10;
711 740
712 for my $pkg ( 741 if ($htype == HOOK_ACTION) {
713 # this hook is only sent to the extension with the name 742 # this hook is only sent to the extension with the name
714 # matching the first arg 743 # matching the first arg
715 $htype == HOOK_KEYBOARD_DISPATCH 744 my $pkg = shift;
716 ? exists $cb->{"urxvt::ext::$_[0]"} ? "urxvt::ext::" . shift : return undef 745 $pkg =~ y/-/_/;
717 : keys %$cb 746 $pkg = "urxvt::ext::$pkg";
747
748 $cb = $cb->{$pkg}
749 or return undef; #TODO: maybe warn user?
750
751 $cb = { $pkg => $cb };
718 ) { 752 }
753
754 for my $pkg (keys %$cb) {
719 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) }; 755 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) };
720 $retval ||= $retval_; 756 $retval ||= $retval_;
721 757
722 if ($@) { 758 if ($@) {
723 $TERM->ungrab; # better to lose the grab than the session 759 $TERM->ungrab; # better to lose the grab than the session
1062 $ENV{URXVT_PERL_LIB}, 1098 $ENV{URXVT_PERL_LIB},
1063 "$ENV{HOME}/.urxvt/ext", 1099 "$ENV{HOME}/.urxvt/ext",
1064 "$LIBDIR/perl" 1100 "$LIBDIR/perl"
1065} 1101}
1066 1102
1067sub scan_meta { 1103# scan for available extensions and collect their metadata
1104sub scan_extensions {
1068 my ($self) = @_; 1105 my ($self) = @_;
1106
1107 return if exists $self->{meta};
1108
1069 my @libdirs = perl_libdirs $self; 1109 my @libdirs = perl_libdirs $self;
1070 1110
1071 return if $self->{meta_libdirs} eq join "\x00", @libdirs; 1111# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d#
1072 1112
1073 my %meta;
1074
1075 $self->{meta_libdirs} = join "\x00", @libdirs; 1113# $self->{meta_libdirs} = join "\x00", @libdirs;#d#
1076 $self->{meta} = \%meta; 1114 $self->{meta} = \my %meta;
1077 1115
1116 # first gather extensions
1078 for my $dir (reverse @libdirs) { 1117 for my $dir (reverse @libdirs) {
1079 opendir my $fh, $dir 1118 opendir my $fh, $dir
1080 or next; 1119 or next;
1081 for my $ext (readdir $fh) { 1120 for my $ext (readdir $fh) {
1082 $ext !~ /^\./ 1121 $ext !~ /^\./
1083 and open my $fh, "<", "$dir/$ext" 1122 and open my $fh, "<", "$dir/$ext"
1084 or next; 1123 or next;
1085 1124
1125 my %ext = (dir => $dir);
1126
1086 while (<$fh>) { 1127 while (<$fh>) {
1087 if (/^#:META:X_RESOURCE:(.*)/) { 1128 if (/^#:META:(?:X_)?RESOURCE:(.*)/) {
1088 my ($pattern, $type, $desc) = split /:/, $1; 1129 my ($pattern, $type, $desc) = split /:/, $1;
1089 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name 1130 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
1090 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) { 1131 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
1091 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n"; 1132 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n";
1092 } else { 1133 } else {
1093 $meta{resource}{$pattern} = [$ext, $type, $desc]; 1134 $ext{resource}{$pattern} = [$ext, $type, $desc];
1094 } 1135 }
1136 } elsif (/^#:META:BINDING:(.*)/) {
1137 my ($keysym, $action) = split /:/, $1;
1138 $ext{binding}{$keysym} = [$ext, $action];
1095 } elsif (/^\s*(?:#|$)/) { 1139 } elsif (/^\s*(?:#|$)/) {
1096 # skip other comments and empty lines 1140 # skip other comments and empty lines
1097 } else { 1141 } else {
1098 last; # stop parsing on first non-empty non-comment line 1142 last; # stop parsing on first non-empty non-comment line
1099 } 1143 }
1100 } 1144 }
1145
1146 $meta{ext}{$ext} = \%ext;
1101 } 1147 }
1148 }
1149
1150 # and now merge resources and bindings
1151 while (my ($k, $v) = each %{ $meta{ext} }) {
1152 #TODO: should check for extensions overriding each other
1153 %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} });
1154 %{ $meta{binding} } = (%{ $meta{binding} }, %{ $v->{binding} });
1102 } 1155 }
1103} 1156}
1104 1157
1105=item $term = new urxvt::term $envhashref, $rxvtname, [arg...] 1158=item $term = new urxvt::term $envhashref, $rxvtname, [arg...]
1106 1159
1222Returns the X-Resource for the given pattern, excluding the program or 1275Returns the X-Resource for the given pattern, excluding the program or
1223class name, i.e. C<< $term->x_resource ("boldFont") >> should return the 1276class name, i.e. C<< $term->x_resource ("boldFont") >> should return the
1224same value as used by this instance of rxvt-unicode. Returns C<undef> if no 1277same value as used by this instance of rxvt-unicode. Returns C<undef> if no
1225resource with that pattern exists. 1278resource with that pattern exists.
1226 1279
1227Extensions that define extra resource or command line arguments also need 1280Extensions that define extra resources also need to call this method
1228to call this method to access their values. 1281to access their values.
1229 1282
1230If the method is called on an extension object (basically, from an 1283If the method is called on an extension object (basically, from an
1231extension), then the special prefix C<%.> will be replaced by the name of 1284extension), then the special prefix C<%.> will be replaced by the name of
1232the extension and a dot, and the lone string C<%> will be replaced by the 1285the extension and a dot, and the lone string C<%> will be replaced by the
1233extension name itself. This makes it possible to code extensions so you 1286extension name itself. This makes it possible to code extensions so you
1254 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0 1307 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0
1255} 1308}
1256 1309
1257=item $success = $term->bind_action ($key, $octets) 1310=item $success = $term->bind_action ($key, $octets)
1258 1311
1259Adds a key binding exactly as specified via a resource. See the 1312Adds a key binding exactly as specified via a C<keysym> resource. See the
1260C<keysym> resource in the urxvt(1) manpage. 1313C<keysym> resource in the urxvt(1) manpage.
1261 1314
1262=item $rend = $term->rstyle ([$new_rstyle]) 1315=item $rend = $term->rstyle ([$new_rstyle])
1263 1316
1264Return and optionally change the current rendition. Text that is output by 1317Return and optionally change the current rendition. Text that is output by
1445=item $term->tt_write ($octets) 1498=item $term->tt_write ($octets)
1446 1499
1447Write the octets given in C<$octets> to the tty (i.e. as program input). To 1500Write 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 1501pass characters instead of octets, you should convert your strings first
1449to the locale-specific encoding using C<< $term->locale_encode >>. 1502to the locale-specific encoding using C<< $term->locale_encode >>.
1503
1504=item $term->tt_write_user_input ($octets)
1505
1506Like C<tt_write>, but should be used when writing strings in response to
1507the user pressing a key, to invoke the additional actions requested by
1508the user for that case (C<tt_write> doesn't do that).
1509
1510The typical use case would be inside C<on_action> hooks.
1450 1511
1451=item $term->tt_paste ($octets) 1512=item $term->tt_paste ($octets)
1452 1513
1453Write the octets given in C<$octets> to the tty as a paste, converting NL to 1514Write 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 1515CR and bracketing the data with control sequences if bracketed paste mode

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines