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.43 by root, Sat Jan 7 04:19:43 2006 UTC vs.
Revision 1.44 by root, Sat Jan 7 19:29:17 2006 UTC

… …
17 17
18 @@RXVT_NAME@@ --perl-lib $HOME -pe grab_test 18 @@RXVT_NAME@@ --perl-lib $HOME -pe grab_test
19 19
20=head1 DESCRIPTION 20=head1 DESCRIPTION
21 21
22Everytime a terminal object gets created, scripts specified via the 22Everytime a terminal object gets created, extension scripts specified via
23C<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' 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
… …
120 120
121The following subroutines can be declared in extension files, and will be 121The following subroutines can be declared in extension files, and will be
122called whenever the relevant event happens. 122called whenever the relevant event happens.
123 123
124The first argument passed to them is an object private to each terminal 124The first argument passed to them is an object private to each terminal
125and extension package. You can call all C<urxvt::term> methods on it, but 125and extension package. You can call all C<urxvt::term> methods on it, but
126its not a real C<urxvt::term> object. Instead, the real C<urxvt::term> 126its not a real C<urxvt::term> object. Instead, the real C<urxvt::term>
127object that is shared between all packages is stored in the C<term> 127object that is shared between all packages is stored in the C<term>
128member. 128member. It is, however, blessed intot he package of the extension script,
129so for all practical purposes you can treat an extension script as a class.
129 130
130All of them must return a boolean value. If it is true, then the event 131All of them must return a boolean value. If it is true, then the event
131counts as being I<consumed>, and the invocation of other hooks is skipped, 132counts as being I<consumed>, and the invocation of other hooks is skipped,
132and the relevant action might not be carried out by the C++ code. 133and the relevant action might not be carried out by the C++ code.
133 134
… …
428 $hook_count[$htype]++ 429 $hook_count[$htype]++
429 or set_should_invoke $htype, 1; 430 or set_should_invoke $htype, 1;
430 } 431 }
431} 432}
432 433
433my $script_pkg = "script0000"; 434my $extension_pkg = "extension0000";
434my %script_pkg; 435my %extension_pkg;
435 436
436# load a single script into its own package, once only 437# load a single script into its own package, once only
437sub script_package($) { 438sub extension_package($) {
438 my ($path) = @_; 439 my ($path) = @_;
439 440
440 $script_pkg{$path} ||= do { 441 $extension_pkg{$path} ||= do {
441 my $pkg = "urxvt::" . ($script_pkg++); 442 my $pkg = "urxvt::" . ($extension_pkg++);
442 443
443 verbose 3, "loading script '$path' into package '$pkg'"; 444 verbose 3, "loading extension '$path' into package '$pkg'";
444 445
445 open my $fh, "<:raw", $path 446 open my $fh, "<:raw", $path
446 or die "$path: $!"; 447 or die "$path: $!";
447 448
448 my $source = "package $pkg; use strict; use utf8;\n" 449 my $source = "package $pkg; use strict; use utf8;\n"
450 . "use base urxvt::term::proxy::;\n"
449 . "#line 1 \"$path\"\n{\n" 451 . "#line 1 \"$path\"\n{\n"
450 . (do { local $/; <$fh> }) 452 . (do { local $/; <$fh> })
451 . "\n};\n1"; 453 . "\n};\n1";
452 454
453 eval $source or die "$path: $@"; 455 eval $source or die "$path: $@";
… …
468 470
469 for my $ext (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) { 471 for my $ext (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {
470 my @files = grep -f $_, map "$_/$ext", @dirs; 472 my @files = grep -f $_, map "$_/$ext", @dirs;
471 473
472 if (@files) { 474 if (@files) {
473 register_package script_package $files[0]; 475 register_package extension_package $files[0];
474 } else { 476 } else {
475 warn "perl extension '$ext' not found in perl library search path\n"; 477 warn "perl extension '$ext' not found in perl library search path\n";
476 } 478 }
477 } 479 }
478 } 480 }
… …
484 if $verbosity >= 10; 486 if $verbosity >= 10;
485 487
486 keys %$cb; 488 keys %$cb;
487 489
488 while (my ($pkg, $cb) = each %$cb) { 490 while (my ($pkg, $cb) = each %$cb) {
491 eval {
489 $retval = $cb->( 492 $retval = $cb->(
490 $TERM->{_pkg}{$pkg} ||= do { 493 $TERM->{_pkg}{$pkg} ||= do {
491 my $proxy = bless { }, urxvt::term::proxy::; 494 my $proxy = bless { }, $pkg;
492 Scalar::Util::weaken ($proxy->{term} = $TERM); 495 Scalar::Util::weaken ($proxy->{term} = $TERM);
493 $proxy 496 $proxy
494 }, 497 },
495 @_, 498 @_,
496 ) and last; 499 ) and last;
500 };
501 warn $@ if $@;#d#
497 } 502 }
498 } 503 }
499 504
500 if ($htype == 1) { # DESTROY 505 if ($htype == 1) { # DESTROY
501 # remove hooks if unused 506 # remove hooks if unused

Diff Legend

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