--- rxvt-unicode/src/urxvt.pm	2006/01/02 18:20:23	1.6
+++ rxvt-unicode/src/urxvt.pm	2006/01/02 20:47:52	1.10
@@ -4,36 +4,35 @@
 
 =head1 SYNOPSIS
 
-* Put your scripts into F<@@RXVT_LIBDIR@@/urxvt/perl-ext/>, they will be loaded automatically.
-
-* Scripts are evaluated in a 'use strict' and 'use utf8' environment, and
-thus must be encoded as UTF-8.
+   # create a file grab_test in $HOME:
 
    sub on_sel_grab {
       warn "you selected ", $_[0]->selection;
       ()
    }
 
-   1
+   # start a @@RXVT_NAME@@ using it:
+
+   @@RXVT_NAME@@ --perl-lib $HOME -pe grab_test
 
 =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 loaded and associated with it.
 
-Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where
-scripts will be shared for all terminals.
+Scripts are compiled in a 'use strict' and 'use utf8' environment, and
+thus must be encoded as UTF-8.
 
-Hooks in scripts specified by C<perl-lib> will only be called for the
-terminals created with that specific option value.
+Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where
+scripts will be shared (But not enabled) for all terminals.
 
 =head2 General API Considerations
 
 All objects (such as terminals, time watchers etc.) are typical
 reference-to-hash objects. The hash can be used to store anything you
-like. The only reserved member is C<_ptr>, which must not be changed.
+like. All members starting with an underscore (such as C<_ptr> or
+C<_hook>) are reserved for internal uses and must not be accessed or
+modified).
 
 When objects are destroyed on the C++ side, the perl object hashes are
 emptied, so its best to store related objects such as time watchers and
@@ -174,30 +173,12 @@
    };
 }
 
-my $verbosity = $ENV{URXVT_PERL_VERBOSITY} || 10;
+my @hook_count;
+my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
 
 sub verbose {
    my ($level, $msg) = @_;
-   warn "$msg\n"; #d#
-}
-
-my @invoke_cb;
-
-# called by the rxvt core
-sub invoke {
-   local $term = shift;
-   my $htype = shift;
-
-   my $cb = $invoke_cb[$htype];
-
-   verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
-      if $verbosity >= 10;
-
-   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
@@ -205,14 +186,15 @@
 sub register_package($) {
    my ($pkg) = @_;
 
-   for my $hook (0.. $#HOOKNAME) {
-      my $name = $HOOKNAME[$hook];
+   for my $htype (0.. $#HOOKNAME) {
+      my $name = $HOOKNAME[$htype];
 
       my $ref = $pkg->can ("on_" . lc $name)
          or next;
 
-      $invoke_cb[$hook]{$ref*1} = $ref;
-      set_should_invoke $hook, 1;
+      $term->{_hook}[$htype]{$ref*1} = $ref;
+      $hook_count[$htype]++
+         or set_should_invoke $htype, 1;
    }
 }
 
@@ -220,48 +202,67 @@
 my %script_pkg;
 
 # load a single script into its own package, once only
-sub load_script($) {
+sub script_package($) {
    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";
 
-      register_package $pkg;
+      eval $source or die "$path: $@";
 
       $pkg
-   };
+   }
 }
 
-sub load_scripts($) {
-   my ($dir) = @_;
+# called by the rxvt core
+sub invoke {
+   local $term = shift;
+   my $htype = shift;
 
-   verbose 3, "loading scripts from '$dir'";
+   if ($htype == 0) { # INIT
+      my @dirs = ((split /:/, $term->resource ("perl_lib")), "$LIBDIR/perl");
 
-   load_script $_
-      for grep -f $_,
-         <$dir/perl-ext/*>;
-}
+      for my $ext (split /:/, $term->resource ("perl_ext")) {
+         my @files = grep -f $_, map "$_/$ext", @dirs;
 
-sub on_init {
-   my ($term) = @_;
+         if (@files) {
+            register_package script_package $files[0];
+         } else {
+            warn "perl extension '$ext' not found in perl library search path\n";
+         }
+      }
+
+   } 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 $libdir = $term->resource ("perl_lib");
+   my $cb = $term->{_hook}[$htype]
+      or return;
 
-   load_scripts $libdir
-      if defined $libdir;
-}
+   verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
+      if $verbosity >= 10;
+
+   while (my ($k, $v) = each %$cb) {
+      return 1 if $v->($term, @_);
+   }
 
-register_package __PACKAGE__;
-load_scripts $LIBDIR;
+   0
+}
 
 =back
 
@@ -294,8 +295,8 @@
   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