… | |
… | |
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 | |
22 | Everytime a terminal object gets created, scripts specified via the |
22 | Everytime a terminal object gets created, extension scripts specified via |
23 | C<perl> resource are loaded and associated with it. |
23 | the C<perl> resource are loaded and associated with it. |
24 | |
24 | |
25 | Scripts are compiled in a 'use strict' and 'use utf8' environment, and |
25 | Scripts are compiled in a 'use strict' and 'use utf8' environment, and |
26 | thus must be encoded as UTF-8. |
26 | thus must be encoded as UTF-8. |
27 | |
27 | |
28 | Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where |
28 | Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where |
… | |
… | |
120 | |
120 | |
121 | The following subroutines can be declared in extension files, and will be |
121 | The following subroutines can be declared in extension files, and will be |
122 | called whenever the relevant event happens. |
122 | called whenever the relevant event happens. |
123 | |
123 | |
124 | The first argument passed to them is an object private to each terminal |
124 | The first argument passed to them is an object private to each terminal |
125 | and extension package. You can call all C<urxvt::term> methods on it, but |
125 | and extension package. You can call all C<urxvt::term> methods on it, but |
126 | its not a real C<urxvt::term> object. Instead, the real C<urxvt::term> |
126 | its not a real C<urxvt::term> object. Instead, the real C<urxvt::term> |
127 | object that is shared between all packages is stored in the C<term> |
127 | object that is shared between all packages is stored in the C<term> |
128 | member. |
128 | member. It is, however, blessed intot he package of the extension script, |
|
|
129 | so for all practical purposes you can treat an extension script as a class. |
129 | |
130 | |
130 | All of them must return a boolean value. If it is true, then the event |
131 | All of them must return a boolean value. If it is true, then the event |
131 | counts as being I<consumed>, and the invocation of other hooks is skipped, |
132 | counts as being I<consumed>, and the invocation of other hooks is skipped, |
132 | and the relevant action might not be carried out by the C++ code. |
133 | and 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 | |
433 | my $script_pkg = "script0000"; |
434 | my $extension_pkg = "extension0000"; |
434 | my %script_pkg; |
435 | my %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 |
437 | sub script_package($) { |
438 | sub 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 |