ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/rxvtperl.xs
(Generate patch)

Comparing rxvt-unicode/src/rxvtperl.xs (file contents):
Revision 1.67 by root, Sun Jan 15 06:02:41 2006 UTC vs.
Revision 1.70 by root, Tue Jan 17 09:34:21 2006 UTC

… …
39#include "rxvtutil.h" 39#include "rxvtutil.h"
40#include "rxvtperl.h" 40#include "rxvtperl.h"
41 41
42#include "perlxsi.c" 42#include "perlxsi.c"
43 43
44#if defined(HAVE_SCROLLBARS) || defined(MENUBAR) 44#ifdef HAVE_SCROLLBARS
45# define GRAB_CURSOR THIS->leftptr_cursor 45# define GRAB_CURSOR THIS->leftptr_cursor
46#else 46#else
47# define GRAB_CURSOR None 47# define GRAB_CURSOR None
48#endif 48#endif
49 49
… …
407 perl_free (perl); 407 perl_free (perl);
408 } 408 }
409} 409}
410 410
411void 411void
412rxvt_perl_interp::init () 412rxvt_perl_interp::init (rxvt_term *term)
413{ 413{
414 if (!perl) 414 if (!perl)
415 { 415 {
416 rxvt_push_locale (""); // perl init destroys current locale
417
416 perl_environ = rxvt_environ; 418 perl_environ = rxvt_environ;
417 swap (perl_environ, environ); 419 swap (perl_environ, environ);
418 420
419 char *argv[] = { 421 char *argv[] = {
420 "", 422 "",
… …
434 perl_free (perl); 436 perl_free (perl);
435 perl = 0; 437 perl = 0;
436 } 438 }
437 439
438 swap (perl_environ, environ); 440 swap (perl_environ, environ);
441
442 rxvt_pop_locale ();
443 }
444
445 if (perl)
446 {
447 // runs outside of perls ENV
448 term->perl.self = (void *)newSVptr ((void *)term, "urxvt::term");
449 hv_store ((HV *)SvRV ((SV *)term->perl.self), "_overlay", 8, newRV_noinc ((SV *)newHV ()), 0);
439 } 450 }
440} 451}
441 452
442static void 453static void
443ungrab (rxvt_term *THIS) 454ungrab (rxvt_term *THIS)
… …
465} 476}
466 477
467bool 478bool
468rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...) 479rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...)
469{ 480{
470 if (!perl) 481 if (!perl || !term->perl.self)
471 return false; 482 return false;
472 483
473 if (htype == HOOK_INIT) // first hook ever called 484 // pre-handling of some events
474 {
475 term->perl.self = (void *)newSVptr ((void *)term, "urxvt::term");
476 hv_store ((HV *)SvRV ((SV *)term->perl.self), "_overlay", 8, newRV_noinc ((SV *)newHV ()), 0);
477 }
478 else if (!term->perl.self)
479 return false; // perl not initialized for this instance
480 else if (htype == HOOK_DESTROY)
481 {
482 // handled later
483 }
484 else
485 {
486 if (htype == HOOK_REFRESH_END) 485 if (htype == HOOK_REFRESH_END)
487 swap_overlays (term); 486 swap_overlays (term);
488
489 if (!term->perl.should_invoke [htype])
490 {
491 if (htype == HOOK_REFRESH_BEGIN)
492 swap_overlays (term);
493
494 return false;
495 }
496 }
497 487
498 swap (perl_environ, environ); 488 swap (perl_environ, environ);
499 489
490 bool event_consumed;
491
492 if (htype == HOOK_INIT || htype == HOOK_DESTROY // must be called always
493 || term->perl.should_invoke [htype])
500 try 494 try
501 { 495 {
502 dSP; 496 dSP;
503 va_list ap; 497 va_list ap;
504 498
505 va_start (ap, htype); 499 va_start (ap, htype);
506 500
507 ENTER; 501 ENTER;
508 SAVETMPS; 502 SAVETMPS;
509 503
510 PUSHMARK (SP); 504 PUSHMARK (SP);
511 505
512 XPUSHs (sv_2mortal (newSVterm (term))); 506 XPUSHs (sv_2mortal (newSVterm (term)));
513 XPUSHs (sv_2mortal (newSViv (htype))); 507 XPUSHs (sv_2mortal (newSViv (htype)));
514 508
515 for (;;) { 509 for (;;) {
516 data_type dt = (data_type)va_arg (ap, int); 510 data_type dt = (data_type)va_arg (ap, int);
517 511
518 switch (dt) 512 switch (dt)
519 { 513 {
520 case DT_INT: 514 case DT_INT:
521 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int)))); 515 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int))));
522 break; 516 break;
523 517
524 case DT_LONG: 518 case DT_LONG:
525 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long)))); 519 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long))));
526 break; 520 break;
527 521
528 case DT_STR: 522 case DT_STR:
529 XPUSHs (taint (sv_2mortal (newSVpv (va_arg (ap, char *), 0)))); 523 XPUSHs (taint (sv_2mortal (newSVpv (va_arg (ap, char *), 0))));
530 break; 524 break;
531 525
532 case DT_STR_LEN: 526 case DT_STR_LEN:
533 { 527 {
534 char *str = va_arg (ap, char *); 528 char *str = va_arg (ap, char *);
535 int len = va_arg (ap, int); 529 int len = va_arg (ap, int);
536 530
537 XPUSHs (taint (sv_2mortal (newSVpvn (str, len)))); 531 XPUSHs (taint (sv_2mortal (newSVpvn (str, len))));
538 } 532 }
539 break; 533 break;
540 534
541 case DT_WCS_LEN: 535 case DT_WCS_LEN:
542 { 536 {
543 wchar_t *wstr = va_arg (ap, wchar_t *); 537 wchar_t *wstr = va_arg (ap, wchar_t *);
544 int wlen = va_arg (ap, int); 538 int wlen = va_arg (ap, int);
545 539
546 XPUSHs (taint (sv_2mortal (wcs2sv (wstr, wlen)))); 540 XPUSHs (taint (sv_2mortal (wcs2sv (wstr, wlen))));
547 } 541 }
548 break; 542 break;
549 543
550 case DT_XEVENT: 544 case DT_XEVENT:
551 { 545 {
552 XEvent *xe = va_arg (ap, XEvent *); 546 XEvent *xe = va_arg (ap, XEvent *);
553 HV *hv = newHV (); 547 HV *hv = newHV ();
554 548
555# define set(name, sv) hv_store (hv, # name, sizeof (# name) - 1, sv, 0) 549# define set(name, sv) hv_store (hv, # name, sizeof (# name) - 1, sv, 0)
556# define setiv(name, val) hv_store (hv, # name, sizeof (# name) - 1, newSViv (val), 0) 550# define setiv(name, val) hv_store (hv, # name, sizeof (# name) - 1, newSViv (val), 0)
557# undef set 551# undef set
558 552
559 setiv (type, xe->type); 553 setiv (type, xe->type);
560 setiv (send_event, xe->xany.send_event); 554 setiv (send_event, xe->xany.send_event);
561 setiv (serial, xe->xany.serial); 555 setiv (serial, xe->xany.serial);
562 556
563 switch (xe->type) 557 switch (xe->type)
564 { 558 {
565 case KeyPress: 559 case KeyPress:
566 case KeyRelease: 560 case KeyRelease:
567 case ButtonPress: 561 case ButtonPress:
568 case ButtonRelease: 562 case ButtonRelease:
569 case MotionNotify: 563 case MotionNotify:
570 setiv (time, xe->xmotion.time); 564 setiv (time, xe->xmotion.time);
571 setiv (x, xe->xmotion.x); 565 setiv (x, xe->xmotion.x);
572 setiv (y, xe->xmotion.y); 566 setiv (y, xe->xmotion.y);
573 setiv (row, xe->xmotion.y / term->fheight); 567 setiv (row, xe->xmotion.y / term->fheight);
574 setiv (col, xe->xmotion.x / term->fwidth); 568 setiv (col, xe->xmotion.x / term->fwidth);
575 setiv (x_root, xe->xmotion.x_root); 569 setiv (x_root, xe->xmotion.x_root);
576 setiv (y_root, xe->xmotion.y_root); 570 setiv (y_root, xe->xmotion.y_root);
577 setiv (state, xe->xmotion.state); 571 setiv (state, xe->xmotion.state);
578 break; 572 break;
579 } 573 }
580 574
581 switch (xe->type) 575 switch (xe->type)
582 { 576 {
583 case KeyPress: 577 case KeyPress:
584 case KeyRelease: 578 case KeyRelease:
585 setiv (keycode, xe->xkey.keycode); 579 setiv (keycode, xe->xkey.keycode);
586 break; 580 break;
587 581
588 case ButtonPress: 582 case ButtonPress:
589 case ButtonRelease: 583 case ButtonRelease:
590 setiv (button, xe->xbutton.button); 584 setiv (button, xe->xbutton.button);
591 break; 585 break;
592 586
593 case MotionNotify: 587 case MotionNotify:
594 setiv (is_hint, xe->xmotion.is_hint); 588 setiv (is_hint, xe->xmotion.is_hint);
595 break; 589 break;
596 } 590 }
597 591
598 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv))); 592 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
599 } 593 }
600 break; 594 break;
601 595
602 case DT_END: 596 case DT_END:
603 { 597 goto call;
604 va_end (ap);
605 598
606 PUTBACK;
607 int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL);
608 SPAGAIN;
609
610 if (count)
611 {
612 SV *status = POPs;
613 count = SvTRUE (status);
614 }
615
616 PUTBACK;
617 FREETMPS;
618 LEAVE;
619
620 if (SvTRUE (ERRSV))
621 {
622 rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV));
623 ungrab (term); // better lose the grab than the session
624 }
625
626 if (htype == HOOK_REFRESH_BEGIN)
627 swap_overlays (term);
628 else if (htype == HOOK_DESTROY)
629 {
630 clearSVptr ((SV *)term->perl.self);
631 SvREFCNT_dec ((SV *)term->perl.self);
632 }
633
634 swap (perl_environ, environ);
635 return count;
636 }
637
638 default: 599 default:
639 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt); 600 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt);
640 } 601 }
602 }
603
604 call:
605 va_end (ap);
606
607 PUTBACK;
608 int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL);
609 SPAGAIN;
610
611 if (count)
612 {
613 SV *status = POPs;
614 count = SvTRUE (status);
615 }
616
617 PUTBACK;
618 FREETMPS;
619 LEAVE;
620
621 if (SvTRUE (ERRSV))
622 {
623 rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV));
624 ungrab (term); // better lose the grab than the session
625 }
626
627 event_consumed = !!count;
641 } 628 }
629 catch (...)
630 {
631 swap (perl_environ, environ);
632 throw;
633 }
634 else
635 event_consumed = false;
636
637 // post-handling of some events
638 if (htype == HOOK_REFRESH_BEGIN)
639 swap_overlays (term);
640 else if (htype == HOOK_DESTROY)
641 {
642 clearSVptr ((SV *)term->perl.self);
643 SvREFCNT_dec ((SV *)term->perl.self);
642 } 644 }
643 catch (...) 645
644 {
645 swap (perl_environ, environ); 646 swap (perl_environ, environ);
646 throw; 647
647 } 648 return event_consumed;
648} 649}
649 650
650///////////////////////////////////////////////////////////////////////////// 651/////////////////////////////////////////////////////////////////////////////
651 652
652MODULE = urxvt PACKAGE = urxvt 653MODULE = urxvt PACKAGE = urxvt

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines