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.235 by sf-exg, Sat May 17 15:33: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
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_extensions; 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");
675 @TERM_EXT = (); 679 @TERM_EXT = ();
676 $TERM->register_package ($_) for @pkg; 680 $TERM->register_package ($_) for @pkg;
677 } 681 }
678 682
679 for ( 683 for (
684 (grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2),
680 @{ delete $TERM->{perl_ext_3} }, 685 @{ delete $TERM->{perl_ext_3} }
681 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
682 ) { 686 ) {
683 if ($_ eq "default") { 687 if ($_ eq "default") {
684 $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
685 } elsif (/^-(.*)$/) { 703 } elsif (/^-(.*)$/) {
686 delete $ext_arg{$1}; 704 delete $ext_arg{$1};
705
687 } elsif (/^([^<]+)<(.*)>$/) { 706 } elsif (/^([^<]+)<(.*)>$/) {
688 push @{ $ext_arg{$1} }, $2; 707 push @{ $ext_arg{$1} }, $2;
708
689 } else { 709 } else {
690 $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]");
691 } 718 }
692 } 719 }
693 720
694 for my $ext (sort keys %ext_arg) { 721 for my $ext (sort keys %ext_arg) {
695 my @files = grep -f $_, map "$_/$ext", @dirs; 722 my @files = grep -f $_, map "$_/$ext", @dirs;
1079 1106
1080 return if exists $self->{meta}; 1107 return if exists $self->{meta};
1081 1108
1082 my @libdirs = perl_libdirs $self; 1109 my @libdirs = perl_libdirs $self;
1083 1110
1084 return if $self->{meta_libdirs} eq join "\x00", @libdirs; 1111# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d#
1085 1112
1086 my %meta;
1087
1088 $self->{meta_libdirs} = join "\x00", @libdirs; 1113# $self->{meta_libdirs} = join "\x00", @libdirs;#d#
1089 $self->{meta} = \%meta; 1114 $self->{meta} = \my %meta;
1090
1091 my %ext;
1092 1115
1093 # first gather extensions 1116 # first gather extensions
1094 for my $dir (reverse @libdirs) { 1117 for my $dir (reverse @libdirs) {
1095 opendir my $fh, $dir 1118 opendir my $fh, $dir
1096 or next; 1119 or next;
1110 } else { 1133 } else {
1111 $ext{resource}{$pattern} = [$ext, $type, $desc]; 1134 $ext{resource}{$pattern} = [$ext, $type, $desc];
1112 } 1135 }
1113 } elsif (/^#:META:BINDING:(.*)/) { 1136 } elsif (/^#:META:BINDING:(.*)/) {
1114 my ($keysym, $action) = split /:/, $1; 1137 my ($keysym, $action) = split /:/, $1;
1115 $ext{binding}{$keysym} = $action; 1138 $ext{binding}{$keysym} = [$ext, $action];
1116 } elsif (/^\s*(?:#|$)/) { 1139 } elsif (/^\s*(?:#|$)/) {
1117 # skip other comments and empty lines 1140 # skip other comments and empty lines
1118 } else { 1141 } else {
1119 last; # stop parsing on first non-empty non-comment line 1142 last; # stop parsing on first non-empty non-comment line
1120 } 1143 }
1121 } 1144 }
1122 1145
1123 $meta{$ext} = \%ext; 1146 $meta{ext}{$ext} = \%ext;
1124 } 1147 }
1125 } 1148 }
1126 1149
1127 # and now merge resources and bindings 1150 # and now merge resources and bindings
1128 while (my ($k, $v) = each %ext) { 1151 while (my ($k, $v) = each %{ $meta{ext} }) {
1129 #TODO: should check for extensions overriding each other 1152 #TODO: should check for extensions overriding each other
1130 %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} }); 1153 %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} });
1131 %{ $meta{binding} } = (%{ $meta{binding} }, %{ $v->{binding} }); 1154 %{ $meta{binding} } = (%{ $meta{binding} }, %{ $v->{binding} });
1132 } 1155 }
1133} 1156}
1252Returns the X-Resource for the given pattern, excluding the program or 1275Returns the X-Resource for the given pattern, excluding the program or
1253class name, i.e. C<< $term->x_resource ("boldFont") >> should return the 1276class name, i.e. C<< $term->x_resource ("boldFont") >> should return the
1254same 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
1255resource with that pattern exists. 1278resource with that pattern exists.
1256 1279
1257Extensions that define extra resource or command line arguments also need 1280Extensions that define extra resources also need to call this method
1258to call this method to access their values. 1281to access their values.
1259 1282
1260If the method is called on an extension object (basically, from an 1283If the method is called on an extension object (basically, from an
1261extension), 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
1262the 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
1263extension name itself. This makes it possible to code extensions so you 1286extension name itself. This makes it possible to code extensions so you
1479to the locale-specific encoding using C<< $term->locale_encode >>. 1502to the locale-specific encoding using C<< $term->locale_encode >>.
1480 1503
1481=item $term->tt_write_user_input ($octets) 1504=item $term->tt_write_user_input ($octets)
1482 1505
1483Like C<tt_write>, but should be used when writing strings in response to 1506Like C<tt_write>, but should be used when writing strings in response to
1484the user pressing a key, to invokes the additional actions requested by 1507the user pressing a key, to invoke the additional actions requested by
1485the user for that case (C<tt_write> doesn't do that). 1508the user for that case (C<tt_write> doesn't do that).
1486 1509
1487The typical use case would be inside C<on_action> hooks. 1510The typical use case would be inside C<on_action> hooks.
1488 1511
1489=item $term->tt_paste ($octets) 1512=item $term->tt_paste ($octets)

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines