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.209 by root, Tue Jun 5 22:38:17 2012 UTC vs.
Revision 1.215 by root, Thu Jun 7 16:30:58 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;
766our $TERM; 766our $TERM;
767our @TERM_INIT; 767our @TERM_INIT; # should go, prevents async I/O etc.
768our @TERM_EXT; 768our @TERM_EXT; # should go, prevents async I/O etc.
769our @HOOKNAME; 769our @HOOKNAME;
770our %HOOKTYPE = map +($HOOKNAME[$_] => $_), 0..$#HOOKNAME; 770our %HOOKTYPE = map +($HOOKNAME[$_] => $_), 0..$#HOOKNAME;
771our %OPTION; 771our %OPTION;
772 772
773our $LIBDIR; 773our $LIBDIR;
… …
943 }; 943 };
944} 944}
945 945
946no warnings 'utf8'; 946no warnings 'utf8';
947 947
948sub resource { 948sub parse_resource {
949 my ($term, $name, $isarg, $flag, $value) = @_; 949 my ($term, $name, $isarg, $longopt, $flag, $value) = @_;
950 950
951 $term->scan_meta; 951 $term->scan_meta;
952 952
953 warn "resourece<@_>\n";#d# 953 my $r = $term->{meta}{resource};
954 while (my ($pattern, $v) = each %$r) {
955 $name =~ y/-/./ if $isarg;
956
957 if (
958 $pattern =~ /\.$/
959 ? $pattern eq substr $name, 0, length $pattern
960 : $pattern eq $name
961 ) {
962 $name = "$urxvt::RESCLASS.$name";
963
964 push @{ $term->{perl_ext_3} }, $v->[0];
965
966 if ($v->[1] eq "boolean") {
967 $term->put_option_db ($name, $flag ? "true" : "false");
968 return 1;
969 } else {
970 $term->put_option_db ($name, $value);
971 return 1 + 2;
972 }
973 }
974 }
954 975
955 0 976 0
956} 977}
957 978
958sub usage { 979sub usage {
… …
960 981
961 $term->scan_meta; 982 $term->scan_meta;
962 983
963 my $r = $term->{meta}{resource}; 984 my $r = $term->{meta}{resource};
964 985
965 for my $regex (sort keys %$r) { 986 for my $pattern (sort keys %$r) {
966 my ($ext, $type, $desc) = @{ $r->{$regex} }; 987 my ($ext, $type, $desc) = @{ $r->{$pattern} };
967 988
968 $desc .= " (-pe $ext)"; 989 $desc .= " (-pe $ext)";
969 990
970 if ($usage_type == 1) { 991 if ($usage_type == 1) {
992 $pattern =~ y/./-/;
993 $pattern =~ s/-$/-.../g;
994
971 if ($type eq "boolean") { 995 if ($type eq "boolean") {
972 urxvt::log sprintf " -%-20.20s %s\n", "/+$regex", $desc; 996 urxvt::log sprintf " -%-30s %s\n", "/+$pattern", $desc;
973 } else { 997 } else {
974 urxvt::log sprintf " -%-20.20s %s\n", "$regex $type", $desc; 998 urxvt::log sprintf " -%-30s %s\n", "$pattern $type", $desc;
975 } 999 }
976 } else { 1000 } else {
1001 $pattern =~ s/\.$/.*/g;
977 urxvt::log sprintf " %-19.19s %s\n", "$regex:", $type; 1002 urxvt::log sprintf " %-31s %s\n", "$pattern:", $type;
978 } 1003 }
979 } 1004 }
980} 1005}
981 1006
982my $verbosity = $ENV{URXVT_PERL_VERBOSITY}; 1007my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
… …
1002 1027
1003 open my $fh, "<:raw", $path 1028 open my $fh, "<:raw", $path
1004 or die "$path: $!"; 1029 or die "$path: $!";
1005 1030
1006 my $source = 1031 my $source =
1007 "package $pkg; use strict; use utf8; no warnings 'utf8';\n" 1032 "package $pkg; use strict 'vars'; use utf8; no warnings 'utf8';\n"
1008 . "#line 1 \"$path\"\n{\n" 1033 . "#line 1 \"$path\"\n{\n"
1009 . (do { local $/; <$fh> }) 1034 . (do { local $/; <$fh> })
1010 . "\n};\n1"; 1035 . "\n};\n1";
1011 1036
1012 eval $source 1037 eval $source
… …
1035 my @pkg = @TERM_EXT; 1060 my @pkg = @TERM_EXT;
1036 @TERM_EXT = (); 1061 @TERM_EXT = ();
1037 $TERM->register_package ($_) for @pkg; 1062 $TERM->register_package ($_) for @pkg;
1038 } 1063 }
1039 1064
1065 for (
1066 @{ delete $TERM->{perl_ext_3} },
1040 for (grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) { 1067 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
1068 ) {
1041 if ($_ eq "default") { 1069 if ($_ eq "default") {
1042 $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup searchable-scrollback readline); 1070 $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup searchable-scrollback readline);
1043 } elsif (/^-(.*)$/) { 1071 } elsif (/^-(.*)$/) {
1044 delete $ext_arg{$1}; 1072 delete $ext_arg{$1};
1045 } elsif (/^([^<]+)<(.*)>$/) { 1073 } elsif (/^([^<]+)<(.*)>$/) {
… …
1333 and $ext ne ".." 1361 and $ext ne ".."
1334 and open my $fh, "<", "$dir/$ext" 1362 and open my $fh, "<", "$dir/$ext"
1335 or next; 1363 or next;
1336 1364
1337 while (<$fh>) { 1365 while (<$fh>) {
1338 if (/^#:META:RESOURCE:(.*)/) { 1366 if (/^#:META:X_RESOURCE:(.*)/) {
1339 my ($regex, $type, $desc) = split /:/, $1; 1367 my ($pattern, $type, $desc) = split /:/, $1;
1340 $regex =~ s/\$\$/$ext/g; # $$ in regex == extension name 1368 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
1369 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
1370 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n";
1371 } else {
1341 $meta{resource}{$regex} = [$ext, $type, $desc]; 1372 $meta{resource}{$pattern} = [$ext, $type, $desc];
1373 }
1342 } elsif (/^\s*(?:#|$)/) { 1374 } elsif (/^\s*(?:#|$)/) {
1343 # skip other comments and empty lines 1375 # skip other comments and empty lines
1344 } else { 1376 } else {
1345 last; # stop parsing on first non-empty non-comment line 1377 last; # stop parsing on first non-empty non-comment line
1346 } 1378 }
… …
1473 1505
1474This method should only be called during the C<on_start> hook, as there is 1506This method should only be called during the C<on_start> hook, as there is
1475only one resource database per display, and later invocations might return 1507only one resource database per display, and later invocations might return
1476the wrong resources. 1508the wrong resources.
1477 1509
1510=item $value = $term->x_resource_boolean ($pattern)
1511
1512Like C<x_resource>, above, but interprets the string value as a boolean
1513and returns C<1> for true values, C<0> for false values and C<undef> if
1514the resource or option isn't specified.
1515
1516You should always use this method to parse boolean resources.
1517
1518=cut
1519
1520sub x_resource_boolean {
1521 my $res = &x_resource;
1522
1523 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0
1524}
1525
1478=item $success = $term->parse_keysym ($key, $octets) 1526=item $success = $term->parse_keysym ($key, $octets)
1479 1527
1480Adds a key binding exactly as specified via a resource. See the 1528Adds a key binding exactly as specified via a resource. See the
1481C<keysym> resource in the @@RXVT_NAME@@(1) manpage. 1529C<keysym> resource in the @@RXVT_NAME@@(1) manpage.
1482 1530

Diff Legend

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