*** empty log message ***

diff --git a/src/init.C b/src/init.C
index 3fd5f4ac8782de8d3e287c192028f4ef8216e6fb..7914658019e7aff5b1a4e203c0371addba348201 100644 (file)
--- a/src/init.C
+++ b/src/init.C
@@ -1093,7 +1093,7 @@ rxvt_term::create_windows (int argc, const char *const *argv)
 
   if (OPTION (Opt_pointerBlank)
 #ifdef ENABLE_PERL
-      || self
+      || perl.self
 #endif
       )
     vt_emask |= PointerMotionMask;

diff --git a/src/rxvt.h b/src/rxvt.h
index c0152f41b4341e5e16efe4f4b0263d79e2e88284..6348feaeda89b8a91c717d7d368ba593db821be5 100644 (file)
--- a/src/rxvt.h
+++ b/src/rxvt.h
@@ -21,6 +21,8 @@
 #include "iom.h"
 #include "salloc.h"
 
+#include "rxvtperl.h"
+
 #if ENABLE_FRILLS
 # define ENABLE_XEMBED 1
 # define ENABLE_EWMH   1
@@ -966,11 +968,11 @@ extern class rxvt_composite_vec rxvt_composite;
 #endif
 
 struct rxvt_term : zero_initialized, rxvt_vars {
-  log_callback *log_hook;               // log error messages through this hook, if != 0
+  log_callback   *log_hook;               // log error messages through this hook, if != 0
   getfd_callback *getfd_hook;           // convert remote to local fd, if != 0
 
 #if ENABLE_PERL
-  void *self; // perl's $self
+  rxvt_perl_term  perl;
 #endif
 
   struct mbstate  mbstate;              // current input multibyte state

diff --git a/src/rxvtperl.h b/src/rxvtperl.h
index ba52c127bd4ddbb6d2066b4814d74b2fa964d0ae..bf69305d952a231e8800f005155b5a3dede23b05 100644 (file)
--- a/src/rxvtperl.h
+++ b/src/rxvtperl.h
@@ -28,6 +28,12 @@ enum hook_type {
   HOOK_NUM,
 };
 
+struct rxvt_perl_term
+{
+  void *self;
+  unsigned long grabtime;
+};
+
 struct rxvt_perl_interp
 {
   rxvt_perl_interp ();

diff --git a/src/rxvtperl.xs b/src/rxvtperl.xs
index 85a45274cbcb0ee6e72a179a654b7e0baaf42575..96f08fcf9762ffa9820715daec606a975fcebdbd 100644 (file)
--- a/src/rxvtperl.xs
+++ b/src/rxvtperl.xs
@@ -103,7 +103,7 @@ SvPTR (SV *sv, const char *klass)
   return (long)mg->mg_ptr;
 }
 
-#define newSVterm(term) SvREFCNT_inc ((SV *)term->self)
+#define newSVterm(term) SvREFCNT_inc ((SV *)term->perl.self)
 #define SvTERM(sv) (rxvt_term *)SvPTR (sv, "urxvt::term")
 
 /////////////////////////////////////////////////////////////////////////////
@@ -292,14 +292,14 @@ overlay::show ()
 {
   char key[33]; sprintf (key, "%32lx", (long)this);
 
-  HV *hv = (HV *)SvRV (*hv_fetch ((HV *)SvRV ((SV *)THIS->self), "_overlay", 8, 0));
+  HV *hv = (HV *)SvRV (*hv_fetch ((HV *)SvRV ((SV *)THIS->perl.self), "_overlay", 8, 0));
   hv_store (hv, key, 32, newSViv ((long)this), 0);
 }
 
 void
 overlay::hide ()
 {
-  SV **ovs = hv_fetch ((HV *)SvRV ((SV *)THIS->self), "_overlay", 8, 0);
+  SV **ovs = hv_fetch ((HV *)SvRV ((SV *)THIS->perl.self), "_overlay", 8, 0);
 
   if (ovs)
     {
@@ -417,10 +417,10 @@ rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...)
 
   if (htype == HOOK_INIT) // first hook ever called
     {
-      term->self = (void *)newSVptr ((void *)term, "urxvt::term");
-      hv_store ((HV *)SvRV ((SV *)term->self), "_overlay", 8, newRV_noinc ((SV *)newHV ()), 0);
+      term->perl.self = (void *)newSVptr ((void *)term, "urxvt::term");
+      hv_store ((HV *)SvRV ((SV *)term->perl.self), "_overlay", 8, newRV_noinc ((SV *)newHV ()), 0);
     }
-  else if (!term->self)
+  else if (!term->perl.self)
     return false; // perl not initialized for this instance
   else if (htype == HOOK_DESTROY)
     {
@@ -428,7 +428,7 @@ rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...)
     }
   else if (htype == HOOK_REFRESH_BEGIN || htype == HOOK_REFRESH_END)
     {
-      HV *hv = (HV *)SvRV (*hv_fetch ((HV *)SvRV ((SV *)term->self), "_overlay", 8, 0));
+      HV *hv = (HV *)SvRV (*hv_fetch ((HV *)SvRV ((SV *)term->perl.self), "_overlay", 8, 0));
 
       if (HvKEYS (hv))
         {
@@ -564,8 +564,8 @@ rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...)
 
             if (htype == HOOK_DESTROY)
               {
-                clearSVptr ((SV *)term->self);
-                SvREFCNT_dec ((SV *)term->self);
+                clearSVptr ((SV *)term->perl.self);
+                SvREFCNT_dec ((SV *)term->perl.self);
               }
 
             return count;
@@ -598,6 +598,7 @@ BOOT:
   export_const (RS_Blink);
   export_const (RS_RVid);
   export_const (RS_Uline);
+  export_const (CurrentTime);
 
   sv_setpv (get_sv ("urxvt::LIBDIR", 1), LIBDIR);
 }
@@ -627,7 +628,7 @@ new (...)
             croak ("exception caught while initializing new terminal instance");
           }
 
-        RETVAL = term && term->self ? newSVterm (term) : &PL_sv_undef;
+        RETVAL = term && term->perl.self ? newSVterm (term) : &PL_sv_undef;
 }
        OUTPUT:
         RETVAL
@@ -708,15 +709,55 @@ void
 rxvt_term::destroy ()
 
 void
-rxvt_term::grab (int eventtime)
+rxvt_term::grab_button (int button, U32 modifiers)
+       CODE:
+       XGrabButton (THIS->display->display, button, modifiers, THIS->vt, 1,
+                     ButtonPressMask | ButtonReleaseMask | EnterWindowMask | LeaveWindowMask | PointerMotionMask,
+                     GrabModeSync, GrabModeSync, None, None);
+
+bool
+rxvt_term::grab (U32 eventtime, int sync = 0)
        CODE:
 {
-return;
-        XGrabPointer (THIS->display->display, THIS->vt, 0,
-                      ButtonPressMask | ButtonReleaseMask | EnterWindowMask | LeaveWindowMask | PointerMotionMask,
-                      GrabModeAsync, GrabModeAsync, None, None, eventtime);
-        XGrabKeyboard (THIS->display->display, THIS->vt, 0, GrabModeAsync, GrabModeAsync, eventtime);
+        int mode = sync ? GrabModeSync : GrabModeAsync;
+
+        THIS->perl.grabtime = 0;
+
+        if (!XGrabPointer (THIS->display->display, THIS->vt, 0,
+                           ButtonPressMask | ButtonReleaseMask | EnterWindowMask | LeaveWindowMask | PointerMotionMask,
+                           mode, mode, None, None, eventtime))
+          if (!XGrabKeyboard (THIS->display->display, THIS->vt, 0, mode, mode, eventtime))
+            THIS->perl.grabtime = eventtime;
+          else
+            XUngrabPointer (THIS->display->display, eventtime);
+
+        RETVAL = !!THIS->perl.grabtime;
 }
+       OUTPUT:
+        RETVAL
+
+void
+rxvt_term::allow_events_async (U32 eventtime = THIS->perl.grabtime)
+       CODE:
+        XAllowEvents (THIS->display->display, AsyncBoth, eventtime);
+
+void
+rxvt_term::allow_events_sync (U32 eventtime = THIS->perl.grabtime)
+       CODE:
+        XAllowEvents (THIS->display->display, SyncBoth, eventtime);
+
+void
+rxvt_term::allow_events_replay (U32 eventtime = THIS->perl.grabtime)
+       CODE:
+        XAllowEvents (THIS->display->display, ReplayPointer, eventtime);
+        XAllowEvents (THIS->display->display, ReplayKeyboard, eventtime);
+
+void
+rxvt_term::ungrab (U32 eventtime = THIS->perl.grabtime)
+       CODE:
+        THIS->perl.grabtime = 0;
+        XUngrabKeyboard (THIS->display->display, eventtime);
+        XUngrabPointer (THIS->display->display, eventtime);
 
 int
 rxvt_term::strwidth (SV *str)
@@ -1111,7 +1152,7 @@ rxvt_term::cur (...)
 }
 
 int
-rxvt_term::selection_grab (int eventtime = CurrentTime)
+rxvt_term::selection_grab (U32 eventtime)
 
 void
 rxvt_term::selection (SV *newtext = 0)

diff --git a/src/urxvt.pm b/src/urxvt.pm
index 8624a51e8bbbc7771aa8e59874fbe3c99e345546..c2a7a42ce393dfcbb8c8513adaeea332e2404b28 100644 (file)
--- a/src/urxvt.pm
+++ b/src/urxvt.pm
@@ -19,8 +19,8 @@
 
 =head1 DESCRIPTION
 
-Everytime a terminal object gets created, scripts specified via the
-C<perl> resource are loaded and associated with it.
+Everytime a terminal object gets created, extension scripts specified via
+the C<perl> resource are loaded and associated with it.
 
 Scripts are compiled in a 'use strict' and 'use utf8' environment, and
 thus must be encoded as UTF-8.
@@ -122,10 +122,11 @@ The following subroutines can be declared in extension files, and will be
 called whenever the relevant event happens.
 
 The first argument passed to them is an object private to each terminal
-and extension package.  You can call all C<urxvt::term> methods on it, but
+and extension package. You can call all C<urxvt::term> methods on it, but
 its not a real C<urxvt::term> object. Instead, the real C<urxvt::term>
 object that is shared between all packages is stored in the C<term>
-member.
+member. It is, however, blessed intot he package of the extension script,
+so for all practical purposes you can treat an extension script as a class.
 
 All of them must return a boolean value. If it is true, then the event
 counts as being I<consumed>, and the invocation of other hooks is skipped,
@@ -430,22 +431,23 @@ sub register_package($) {
    }
 }
 
-my $script_pkg = "script0000";
-my %script_pkg;
+my $extension_pkg = "extension0000";
+my %extension_pkg;
 
 # load a single script into its own package, once only
-sub script_package($) {
+sub extension_package($) {
    my ($path) = @_;
 
-   $script_pkg{$path} ||= do {
-      my $pkg = "urxvt::" . ($script_pkg++);
+   $extension_pkg{$path} ||= do {
+      my $pkg = "urxvt::" . ($extension_pkg++);
 
-      verbose 3, "loading script '$path' into package '$pkg'";
+      verbose 3, "loading extension '$path' into package '$pkg'";
 
       open my $fh, "<:raw", $path
          or die "$path: $!";
 
       my $source = "package $pkg; use strict; use utf8;\n"
+                   . "use base urxvt::term::proxy::;\n"
                    . "#line 1 \"$path\"\n{\n"
                    . (do { local $/; <$fh> })
                    . "\n};\n1";
@@ -470,7 +472,7 @@ sub invoke {
          my @files = grep -f $_, map "$_/$ext", @dirs;
 
          if (@files) {
-            register_package script_package $files[0];
+            register_package extension_package $files[0];
          } else {
             warn "perl extension '$ext' not found in perl library search path\n";
          }
@@ -486,14 +488,17 @@ sub invoke {
       keys %$cb;
 
       while (my ($pkg, $cb) = each %$cb) {
-         $retval = $cb->(
-            $TERM->{_pkg}{$pkg} ||= do {
-               my $proxy = bless { }, urxvt::term::proxy::;
-               Scalar::Util::weaken ($proxy->{term} = $TERM);
-               $proxy
-            },
-            @_,
-         ) and last;
+         eval {
+            $retval = $cb->(
+               $TERM->{_pkg}{$pkg} ||= do {
+                  my $proxy = bless { }, $pkg;
+                  Scalar::Util::weaken ($proxy->{term} = $TERM);
+                  $proxy
+               },
+               @_,
+            ) and last;
+         };
+         warn $@ if $@;#d#
       }
    }