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.212 by root, Wed Jun 6 15:06:41 2012 UTC vs.
Revision 1.216 by root, Sun Jun 10 13:32:55 2012 UTC

… …
20=head1 DESCRIPTION 20=head1 DESCRIPTION
21 21
22Every time a terminal object gets created, extension scripts specified via 22Every time a terminal object gets created, extension scripts specified via
23the C<perl> resource are loaded and associated with it. 23the C<perl> resource are loaded and associated with it.
24 24
25Scripts are compiled in a 'use strict' and 'use utf8' environment, and 25Scripts are compiled in a 'use strict "vars"' and 'use utf8' environment, and
26thus must be encoded as UTF-8. 26thus must be encoded as UTF-8.
27 27
28Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where 28Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where
29scripts will be shared (but not enabled) for all terminals. 29scripts will be shared (but not enabled) for all terminals.
30 30
… …
755=cut 755=cut
756 756
757package urxvt; 757package urxvt;
758 758
759use utf8; 759use utf8;
760use strict; 760use strict 'vars';
761use Carp (); 761use Carp ();
762use Scalar::Util (); 762use Scalar::Util ();
763use List::Util (); 763use List::Util ();
764 764
765our $VERSION = 1; 765our $VERSION = 1;
… …
946no warnings 'utf8'; 946no warnings 'utf8';
947 947
948sub parse_resource { 948sub parse_resource {
949 my ($term, $name, $isarg, $longopt, $flag, $value) = @_; 949 my ($term, $name, $isarg, $longopt, $flag, $value) = @_;
950 950
951 $name =~ y/-/./ if $isarg;
952
951 $term->scan_meta; 953 $term->scan_meta;
952 954
953 my $r = $term->{meta}{resource}; 955 my $r = $term->{meta}{resource};
956 keys %$r; # reste iterator
954 while (my ($pattern, $v) = each %$r) { 957 while (my ($pattern, $v) = each %$r) {
955 $name =~ y/-/./ if $isarg;
956
957 if ( 958 if (
958 $pattern =~ /\.$/ 959 $pattern =~ /\.$/
959 ? $pattern eq substr $name, 0, length $pattern 960 ? $pattern eq substr $name, 0, length $pattern
960 : $pattern eq $name 961 : $pattern eq $name
961 ) { 962 ) {
962 $name = "$urxvt::RESCLASS.$name"; 963 $name = "$urxvt::RESCLASS.$name";
963 964
964 push @TERM_EXT, $v->[0]; 965 push @{ $term->{perl_ext_3} }, $v->[0];
965 966
966 if ($v->[1] eq "boolean") { 967 if ($v->[1] eq "boolean") {
967 $term->put_option_db ($name, $flag ? "true" : "false"); 968 $term->put_option_db ($name, $flag ? "true" : "false");
968 return 1; 969 return 1;
969 } else { 970 } else {
… …
996 urxvt::log sprintf " -%-30s %s\n", "/+$pattern", $desc; 997 urxvt::log sprintf " -%-30s %s\n", "/+$pattern", $desc;
997 } else { 998 } else {
998 urxvt::log sprintf " -%-30s %s\n", "$pattern $type", $desc; 999 urxvt::log sprintf " -%-30s %s\n", "$pattern $type", $desc;
999 } 1000 }
1000 } else { 1001 } else {
1002 $pattern =~ s/\.$/.*/g;
1001 urxvt::log sprintf " %-31s %s\n", "$pattern:", $type; 1003 urxvt::log sprintf " %-31s %s\n", "$pattern:", $type;
1002 } 1004 }
1003 } 1005 }
1004} 1006}
1005 1007
… …
1026 1028
1027 open my $fh, "<:raw", $path 1029 open my $fh, "<:raw", $path
1028 or die "$path: $!"; 1030 or die "$path: $!";
1029 1031
1030 my $source = 1032 my $source =
1031 "package $pkg; use strict; use utf8; no warnings 'utf8';\n" 1033 "package $pkg; use strict 'vars'; use utf8; no warnings 'utf8';\n"
1032 . "#line 1 \"$path\"\n{\n" 1034 . "#line 1 \"$path\"\n{\n"
1033 . (do { local $/; <$fh> }) 1035 . (do { local $/; <$fh> })
1034 . "\n};\n1"; 1036 . "\n};\n1";
1035 1037
1036 eval $source 1038 eval $source
… …
1059 my @pkg = @TERM_EXT; 1061 my @pkg = @TERM_EXT;
1060 @TERM_EXT = (); 1062 @TERM_EXT = ();
1061 $TERM->register_package ($_) for @pkg; 1063 $TERM->register_package ($_) for @pkg;
1062 } 1064 }
1063 1065
1066 for (
1067 @{ delete $TERM->{perl_ext_3} },
1064 for (grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) { 1068 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
1069 ) {
1065 if ($_ eq "default") { 1070 if ($_ eq "default") {
1066 $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup searchable-scrollback readline); 1071 $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup searchable-scrollback readline);
1067 } elsif (/^-(.*)$/) { 1072 } elsif (/^-(.*)$/) {
1068 delete $ext_arg{$1}; 1073 delete $ext_arg{$1};
1069 } elsif (/^([^<]+)<(.*)>$/) { 1074 } elsif (/^([^<]+)<(.*)>$/) {
… …
1359 or next; 1364 or next;
1360 1365
1361 while (<$fh>) { 1366 while (<$fh>) {
1362 if (/^#:META:X_RESOURCE:(.*)/) { 1367 if (/^#:META:X_RESOURCE:(.*)/) {
1363 my ($pattern, $type, $desc) = split /:/, $1; 1368 my ($pattern, $type, $desc) = split /:/, $1;
1364 $pattern =~ s/^%(?:\.|$)/$ext./g; # % in pattern == extension name 1369 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
1365 if ($pattern =~ /[^a-zA-Z\.]/) { 1370 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
1366 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n"; 1371 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n";
1367 } else { 1372 } else {
1368 $meta{resource}{$pattern} = [$ext, $type, $desc]; 1373 $meta{resource}{$pattern} = [$ext, $type, $desc];
1369 } 1374 }
1370 } elsif (/^\s*(?:#|$)/) { 1375 } elsif (/^\s*(?:#|$)/) {

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines