my $slave = $pty->slave;
while (<$slave>) { print $slave "got <$_>\n" }
-=item B<-perl> I<string>
+=item B<-pe> I<string>
-Used by perl extension. See resource B<perl>.
+Colon-separated list of perl extension scripts to use in this terminal instance. See resource B<perl-ext>.
=back
URxvt.keysym.M-C-3: command:\033[8;25;80t
URxvt.keysym.M-C-4: command:\033[8;48;110t
-=item B<perl>: I<string>
+=item B<perl-ext>: I<string>
-Used by perl extension and is free for any use, as it is not interpreted
-by rxvt-unicode itself; option B<perl>.
+Colon-separated list of perl extension scripts to use in this terminal
+instance. Each extension is looked up in the library directories, loaded
+if necessary, and bound to the current terminal instance; option B<-pe>.
=item B<perl-eval>: I<string>
-Perl code to be evaluated when all extensions have been loaded. See the
+Perl code to be evaluated when all extensions have been registered. See the
rxvtperl(3) manpage.
=item B<perl-lib>: I<path>
-Additional directory that holds extension scripts that are loaded and
-enabled for this terminal instance, in addition to scripts stored in
-F<@@RXVT_LIBDIR@@/urxvt/perl-ext/>, which are global to all terminal
-instances.
+Colon-separated list of additional directories that hold extension
+scripts. When looking for extensions specified by the C<perl> resource,
+@@RXVT_NAME@@ will first look in these directories and then in
+F<@@RXVT_LIBDIR@@/urxvt/perl-ext/>.
See the rxvtperl(3) manpage.
=head1 DESCRIPTION
-On startup, @@RXVT_NAME@@ will scan F<@@RXVT_LIBDIR@@/urxvt/perl-ext/>
-for files and will load them. Everytime a terminal object gets created,
-the directory specified by the C<perl-lib> resource will be additionally
-scanned.
+Everytime a terminal object gets created, scripts specified via the
+C<perl> resource are associated with it.
Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where
-scripts will be shared for all terminals.
-
-Hooks in scripts specified by C<perl-lib> will only be called for the
-terminals created with that specific option value.
+scripts will be shared (But not enabled) for all terminals.
=head2 General API Considerations
};
}
+my @hook_count;
my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
sub verbose {
my ($level, $msg) = @_;
- warn "$msg\n" if $level < $verbosity;
-}
-
-my %hook_global;
-my @hook_count;
-
-# called by the rxvt core
-sub invoke {
- local $term = shift;
- my $htype = shift;
-
- verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
- if $verbosity >= 10;
-
- for my $cb ($hook_global{_hook}[$htype], $term->{_hook}[$htype]) {
- $cb or next;
-
- while (my ($k, $v) = each %$cb) {
- return 1 if $v->($term, @_);
- }
- }
-
- 0
+ warn "$msg\n" if $level <= $verbosity;
}
# find on_xxx subs in the package and register them
my ($path) = @_;
$script_pkg{$path} ||= do {
- my $pkg = $script_pkg++;
+ my $pkg = "urxvt::" . ($script_pkg++);
+
verbose 3, "loading script '$path' into package '$pkg'";
open my $fh, "<:raw", $path
or die "$path: $!";
- eval "package $pkg; use strict; use utf8;\n"
- . "#line 1 \"$path\"\n"
- . do { local $/; <$fh> }
- or die "$path: $@";
+ my $source = "package $pkg; use strict; use utf8;\n"
+ . "#line 1 \"$path\"\n{\n"
+ . (do { local $/; <$fh> })
+ . "\n};\n1";
+
+ eval $source or die "$path: $@";
$pkg
}
}
-sub load_scripts($) {
- my ($dir) = @_;
-
- verbose 3, "loading scripts from '$dir'";
-
- register_package script_package $_
- for grep -f $_,
- <$dir/*>;
-}
+# called by the rxvt core
+sub invoke {
+ local $term = shift;
+ my $htype = shift;
-sub on_init {
- my ($term) = @_;
+ if ($htype == 0) { # INIT
+ my @dirs = ((split /:/, $term->resource ("perl_lib")), $LIBDIR);
- my $libdir = $term->resource ("perl_lib");
+ for my $ext (split /:/, $term->resource ("perl_ext")) {
+ my @files = grep -f $_, map "$_/$ext", @dirs;
- load_scripts $libdir
- if defined $libdir;
-}
+ if (@files) {
+ register_package script_package $files[0];
+ } else {
+ warn "perl extension '$ext' not found in perl library search path\n";
+ }
+ }
-sub on_destroy {
- my ($term) = @_;
+ } elsif ($htype == 1) { # DESTROY
+ if (my $hook = $term->{_hook}) {
+ for my $htype (0..$#$hook) {
+ $hook_count[$htype] -= scalar keys %{ $hook->[$htype] || {} }
+ or set_should_invoke $htype, 0;
+ }
+ }
+ }
- my $hook = $term->{_hook}
+ my $cb = $term->{_hook}[$htype]
or return;
- for my $htype (0..$#$hook) {
- $hook_count[$htype] -= scalar keys %{ $hook->[$htype] || {} }
- or set_should_invoke $htype, 0;
- }
-}
+ verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
+ if $verbosity >= 10;
-{
- local $term = \%hook_global;
+ while (my ($k, $v) = each %$cb) {
+ return 1 if $v->($term, @_);
+ }
- register_package __PACKAGE__;
- load_scripts "$LIBDIR/perl-ext";
+ 0
}
=back
borderLess color cursorBlink cursorUnderline cutchars delete_key
display_name embed ext_bwidth fade font geometry hold iconName
imFont imLocale inputMethod insecure int_bwidth intensityStyles
- italicFont jumpScroll lineSpace loginShell mapAlert menu meta8
- modifier mouseWheelScrollPage name pastableTabs path perl perl_eval
+ italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 modifier
+ mouseWheelScrollPage name pastableTabs path perl_eval perl_ext
perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd
reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating
scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput
BOOL (Rs_secondaryScroll, "secondaryScroll", "ssr", Opt_secondaryScroll, "enable secondary screen scroll"),
#endif
#if ENABLE_PERL
- STRG (Rs_perl_lib, "perl-lib", 0, "string", "directory where to look for additional extension scripts"),
- STRG (Rs_perl_eval, "perl-eval", 0, "string", "string to be evaluated after all extensions have been loaded"),
- STRG (Rs_perl, "perl", "perl", "string", "unused by urxvt proper, free for extensions to use"),
+ STRG (Rs_perl_lib, "perl-lib", 0, "string", "colon-separated directories with extension scripts"),
+ STRG (Rs_perl_eval, "perl-eval", 0, "string", "code to be evaluated after all extensions have been loaded"),
+ STRG (Rs_perl_ext, "perl-ext", "pe", "string", "colon-sepaated list of perl extensions to enable"),
#endif
#if 0 && TODO
#if !defined(NO_RESOURCES) && defined(USE_XGETDEFAULT)
projects / dana / urxvt.git / commitdiff