-- Leo's gemini proxy
-- Connecting to git.thebackupbox.net:1965...
-- Connected
-- Sending request
-- Meta line: 20 text/gemini
repo: rxvt-unicode-sixel action: commit revision: path_from: revision_from: 8359f53da4de7498e5141b00c184c03202774a7a: path_to: revision_to:
commit 8359f53da4de7498e5141b00c184c03202774a7a
Author: Marc Lehmann <schmorp@schmorp.de>
Date: Sat Jan 7 19:29:17 2006 +0000
*** empty log message ***
diff --git a/src/init.C b/src/init.C
--- 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
--- 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
--- 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
--- 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
--- 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#
}
}
-----END OF PAGE-----
-- Response ended
-- Page fetched on Sun Jun 2 13:24:50 2024