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.68 by root, Mon Jan 16 08:48:09 2006 UTC

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

Diff Legend

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