From: root Date: Sat, 7 Jan 2006 19:29:17 +0000 (+0000) Subject: *** empty log message *** X-Git-Url: http://git.openbox.org/?a=commitdiff_plain;h=794961621318332ad7e85a51403eda4418a068b8;p=dana%2Furxvt.git *** empty log message *** --- diff --git a/src/init.C b/src/init.C index 3fd5f4ac..79146580 100644 --- 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 c0152f41..6348feae 100644 --- 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 ba52c127..bf69305d 100644 --- 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 85a45274..96f08fcf 100644 --- 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 8624a51e..c2a7a42c 100644 --- 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 resource are loaded and associated with it. +Everytime a terminal object gets created, extension scripts specified via +the C 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 methods on it, but +and extension package. You can call all C methods on it, but its not a real C object. Instead, the real C object that is shared between all packages is stored in the C -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, 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# } }