--- rxvt-unicode/src/rxvtperl.xs 2006/01/15 06:02:41 1.67 +++ rxvt-unicode/src/rxvtperl.xs 2006/01/16 08:48:09 1.68 @@ -409,10 +409,12 @@ } void -rxvt_perl_interp::init () +rxvt_perl_interp::init (rxvt_term *term) { if (!perl) { + rxvt_push_locale (""); // perl init destroys current locale + perl_environ = rxvt_environ; swap (perl_environ, environ); @@ -436,7 +438,13 @@ } swap (perl_environ, environ); + + rxvt_pop_locale (); } + + // runs outside of perls ENV + term->perl.self = (void *)newSVptr ((void *)term, "urxvt::term"); + hv_store ((HV *)SvRV ((SV *)term->perl.self), "_overlay", 8, newRV_noinc ((SV *)newHV ()), 0); } static void @@ -467,184 +475,174 @@ bool rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...) { - if (!perl) + if (!perl || !term->perl.self) return false; - if (htype == HOOK_INIT) // first hook ever called - { - 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->perl.self) - return false; // perl not initialized for this instance - else if (htype == HOOK_DESTROY) - { - // handled later - } - else - { - if (htype == HOOK_REFRESH_END) - swap_overlays (term); - - if (!term->perl.should_invoke [htype]) - { - if (htype == HOOK_REFRESH_BEGIN) - swap_overlays (term); - - return false; - } - } + // pre-handling of some events + if (htype == HOOK_REFRESH_END) + swap_overlays (term); swap (perl_environ, environ); - try - { - dSP; - va_list ap; + bool event_consumed; - va_start (ap, htype); + if (htype == HOOK_INIT || htype == HOOK_DESTROY // must be called always + || term->perl.should_invoke [htype]) + try + { + dSP; + va_list ap; + + va_start (ap, htype); + + ENTER; + SAVETMPS; + + PUSHMARK (SP); + + XPUSHs (sv_2mortal (newSVterm (term))); + XPUSHs (sv_2mortal (newSViv (htype))); + + for (;;) { + data_type dt = (data_type)va_arg (ap, int); + + switch (dt) + { + case DT_INT: + XPUSHs (sv_2mortal (newSViv (va_arg (ap, int)))); + break; + + case DT_LONG: + XPUSHs (sv_2mortal (newSViv (va_arg (ap, long)))); + break; + + case DT_STR: + XPUSHs (taint (sv_2mortal (newSVpv (va_arg (ap, char *), 0)))); + break; + + case DT_STR_LEN: + { + char *str = va_arg (ap, char *); + int len = va_arg (ap, int); + + XPUSHs (taint (sv_2mortal (newSVpvn (str, len)))); + } + break; + + case DT_WCS_LEN: + { + wchar_t *wstr = va_arg (ap, wchar_t *); + int wlen = va_arg (ap, int); + + XPUSHs (taint (sv_2mortal (wcs2sv (wstr, wlen)))); + } + break; + + case DT_XEVENT: + { + XEvent *xe = va_arg (ap, XEvent *); + HV *hv = newHV (); - ENTER; - SAVETMPS; +# define set(name, sv) hv_store (hv, # name, sizeof (# name) - 1, sv, 0) +# define setiv(name, val) hv_store (hv, # name, sizeof (# name) - 1, newSViv (val), 0) +# undef set - PUSHMARK (SP); + setiv (type, xe->type); + setiv (send_event, xe->xany.send_event); + setiv (serial, xe->xany.serial); + + switch (xe->type) + { + case KeyPress: + case KeyRelease: + case ButtonPress: + case ButtonRelease: + case MotionNotify: + setiv (time, xe->xmotion.time); + setiv (x, xe->xmotion.x); + setiv (y, xe->xmotion.y); + setiv (row, xe->xmotion.y / term->fheight); + setiv (col, xe->xmotion.x / term->fwidth); + setiv (x_root, xe->xmotion.x_root); + setiv (y_root, xe->xmotion.y_root); + setiv (state, xe->xmotion.state); + break; + } + + switch (xe->type) + { + case KeyPress: + case KeyRelease: + setiv (keycode, xe->xkey.keycode); + break; + + case ButtonPress: + case ButtonRelease: + setiv (button, xe->xbutton.button); + break; + + case MotionNotify: + setiv (is_hint, xe->xmotion.is_hint); + break; + } + + XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv))); + } + break; + + case DT_END: + goto call; + + default: + rxvt_fatal ("FATAL: unable to pass data type %d\n", dt); + } + } - XPUSHs (sv_2mortal (newSVterm (term))); - XPUSHs (sv_2mortal (newSViv (htype))); + call: + va_end (ap); - for (;;) { - data_type dt = (data_type)va_arg (ap, int); + PUTBACK; + int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL); + SPAGAIN; - switch (dt) + if (count) { - case DT_INT: - XPUSHs (sv_2mortal (newSViv (va_arg (ap, int)))); - break; - - case DT_LONG: - XPUSHs (sv_2mortal (newSViv (va_arg (ap, long)))); - break; - - case DT_STR: - XPUSHs (taint (sv_2mortal (newSVpv (va_arg (ap, char *), 0)))); - break; - - case DT_STR_LEN: - { - char *str = va_arg (ap, char *); - int len = va_arg (ap, int); - - XPUSHs (taint (sv_2mortal (newSVpvn (str, len)))); - } - break; - - case DT_WCS_LEN: - { - wchar_t *wstr = va_arg (ap, wchar_t *); - int wlen = va_arg (ap, int); - - XPUSHs (taint (sv_2mortal (wcs2sv (wstr, wlen)))); - } - break; - - case DT_XEVENT: - { - XEvent *xe = va_arg (ap, XEvent *); - HV *hv = newHV (); - -# define set(name, sv) hv_store (hv, # name, sizeof (# name) - 1, sv, 0) -# define setiv(name, val) hv_store (hv, # name, sizeof (# name) - 1, newSViv (val), 0) -# undef set + SV *status = POPs; + count = SvTRUE (status); + } - setiv (type, xe->type); - setiv (send_event, xe->xany.send_event); - setiv (serial, xe->xany.serial); - - switch (xe->type) - { - case KeyPress: - case KeyRelease: - case ButtonPress: - case ButtonRelease: - case MotionNotify: - setiv (time, xe->xmotion.time); - setiv (x, xe->xmotion.x); - setiv (y, xe->xmotion.y); - setiv (row, xe->xmotion.y / term->fheight); - setiv (col, xe->xmotion.x / term->fwidth); - setiv (x_root, xe->xmotion.x_root); - setiv (y_root, xe->xmotion.y_root); - setiv (state, xe->xmotion.state); - break; - } - - switch (xe->type) - { - case KeyPress: - case KeyRelease: - setiv (keycode, xe->xkey.keycode); - break; - - case ButtonPress: - case ButtonRelease: - setiv (button, xe->xbutton.button); - break; - - case MotionNotify: - setiv (is_hint, xe->xmotion.is_hint); - break; - } - - XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv))); - } - break; - - case DT_END: - { - va_end (ap); - - PUTBACK; - int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL); - SPAGAIN; - - if (count) - { - SV *status = POPs; - count = SvTRUE (status); - } - - PUTBACK; - FREETMPS; - LEAVE; - - if (SvTRUE (ERRSV)) - { - rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV)); - ungrab (term); // better lose the grab than the session - } - - if (htype == HOOK_REFRESH_BEGIN) - swap_overlays (term); - else if (htype == HOOK_DESTROY) - { - clearSVptr ((SV *)term->perl.self); - SvREFCNT_dec ((SV *)term->perl.self); - } - - swap (perl_environ, environ); - return count; - } + PUTBACK; + FREETMPS; + LEAVE; - default: - rxvt_fatal ("FATAL: unable to pass data type %d\n", dt); + if (SvTRUE (ERRSV)) + { + rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV)); + ungrab (term); // better lose the grab than the session } + + event_consumed = !!count; } - } - catch (...) + catch (...) + { + swap (perl_environ, environ); + throw; + } + else + event_consumed = false; + + // post-handling of some events + if (htype == HOOK_REFRESH_BEGIN) + swap_overlays (term); + else if (htype == HOOK_DESTROY) { - swap (perl_environ, environ); - throw; + clearSVptr ((SV *)term->perl.self); + SvREFCNT_dec ((SV *)term->perl.self); } + + swap (perl_environ, environ); + + return event_consumed; } /////////////////////////////////////////////////////////////////////////////