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.56 by root, Thu Jan 12 00:35:39 2006 UTC vs.
Revision 1.57 by root, Thu Jan 12 01:30:53 2006 UTC

411void 411void
412rxvt_perl_interp::init () 412rxvt_perl_interp::init ()
413{ 413{
414 if (!perl) 414 if (!perl)
415 { 415 {
416 temp_environ temp_environ(rxvt_environ); 416 perl_environ = rxvt_environ;
417 swap (perl_environ, environ);
417 418
418 char *argv[] = { 419 char *argv[] = {
419 "", 420 "",
420 "-T", 421 "-T",
421 "-edo '" LIBDIR "/urxvt.pm' or ($@ and die $@) or exit 1", 422 "-edo '" LIBDIR "/urxvt.pm' or ($@ and die $@) or exit 1",
431 432
432 perl_destruct (perl); 433 perl_destruct (perl);
433 perl_free (perl); 434 perl_free (perl);
434 perl = 0; 435 perl = 0;
435 } 436 }
437
438 swap (perl_environ, environ);
436 } 439 }
437} 440}
438 441
439static void 442static void
440ungrab (rxvt_term *THIS) 443ungrab (rxvt_term *THIS)
482 485
483 if (!should_invoke [htype]) 486 if (!should_invoke [htype])
484 return false; 487 return false;
485 } 488 }
486 489
487 temp_environ temp_environ(rxvt_environ); 490 swap (perl_environ, environ);
488 491
492 try
493 {
489 dSP; 494 dSP;
490 va_list ap; 495 va_list ap;
491 496
492 va_start (ap, htype); 497 va_start (ap, htype);
493 498
494 ENTER; 499 ENTER;
495 SAVETMPS; 500 SAVETMPS;
496 501
497 PUSHMARK (SP); 502 PUSHMARK (SP);
498 503
499 XPUSHs (sv_2mortal (newSVterm (term))); 504 XPUSHs (sv_2mortal (newSVterm (term)));
500 XPUSHs (sv_2mortal (newSViv (htype))); 505 XPUSHs (sv_2mortal (newSViv (htype)));
501 506
502 for (;;) { 507 for (;;) {
503 data_type dt = (data_type)va_arg (ap, int); 508 data_type dt = (data_type)va_arg (ap, int);
504 509
505 switch (dt) 510 switch (dt)
506 { 511 {
507 case DT_INT: 512 case DT_INT:
508 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int)))); 513 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int))));
509 break; 514 break;
510 515
511 case DT_LONG: 516 case DT_LONG:
512 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long)))); 517 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long))));
513 break; 518 break;
514 519
515 case DT_STR: 520 case DT_STR:
516 XPUSHs (taint (sv_2mortal (newSVpv (va_arg (ap, char *), 0)))); 521 XPUSHs (taint (sv_2mortal (newSVpv (va_arg (ap, char *), 0))));
517 break; 522 break;
518 523
519 case DT_STR_LEN: 524 case DT_STR_LEN:
520 { 525 {
521 char *str = va_arg (ap, char *); 526 char *str = va_arg (ap, char *);
522 int len = va_arg (ap, int); 527 int len = va_arg (ap, int);
523 528
524 XPUSHs (taint (sv_2mortal (newSVpvn (str, len)))); 529 XPUSHs (taint (sv_2mortal (newSVpvn (str, len))));
525 } 530 }
526 break; 531 break;
527 532
528 case DT_WCS_LEN: 533 case DT_WCS_LEN:
529 { 534 {
530 wchar_t *wstr = va_arg (ap, wchar_t *); 535 wchar_t *wstr = va_arg (ap, wchar_t *);
531 int wlen = va_arg (ap, int); 536 int wlen = va_arg (ap, int);
532 537
533 XPUSHs (taint (sv_2mortal (wcs2sv (wstr, wlen)))); 538 XPUSHs (taint (sv_2mortal (wcs2sv (wstr, wlen))));
534 } 539 }
535 break; 540 break;
536 541
537 case DT_XEVENT: 542 case DT_XEVENT:
538 { 543 {
539 XEvent *xe = va_arg (ap, XEvent *); 544 XEvent *xe = va_arg (ap, XEvent *);
540 HV *hv = newHV (); 545 HV *hv = newHV ();
541 546
542# define set(name, sv) hv_store (hv, # name, sizeof (# name) - 1, sv, 0) 547# define set(name, sv) hv_store (hv, # name, sizeof (# name) - 1, sv, 0)
543# define setiv(name, val) hv_store (hv, # name, sizeof (# name) - 1, newSViv (val), 0) 548# define setiv(name, val) hv_store (hv, # name, sizeof (# name) - 1, newSViv (val), 0)
544# undef set 549# undef set
545 550
546 setiv (type, xe->type); 551 setiv (type, xe->type);
547 setiv (send_event, xe->xany.send_event); 552 setiv (send_event, xe->xany.send_event);
548 setiv (serial, xe->xany.serial); 553 setiv (serial, xe->xany.serial);
549 554
550 switch (xe->type) 555 switch (xe->type)
556 {
557 case KeyPress:
558 case KeyRelease:
559 case ButtonPress:
560 case ButtonRelease:
561 case MotionNotify:
562 setiv (time, xe->xmotion.time);
563 setiv (x, xe->xmotion.x);
564 setiv (y, xe->xmotion.y);
565 setiv (row, xe->xmotion.y / term->fheight);
566 setiv (col, xe->xmotion.x / term->fwidth);
567 setiv (x_root, xe->xmotion.x_root);
568 setiv (y_root, xe->xmotion.y_root);
569 setiv (state, xe->xmotion.state);
570 break;
571 }
572
573 switch (xe->type)
574 {
575 case KeyPress:
576 case KeyRelease:
577 setiv (keycode, xe->xkey.keycode);
578 break;
579
580 case ButtonPress:
581 case ButtonRelease:
582 setiv (button, xe->xbutton.button);
583 break;
584
585 case MotionNotify:
586 setiv (is_hint, xe->xmotion.is_hint);
587 break;
588 }
589
590 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
591 }
592 break;
593
594 case DT_END:
551 { 595 {
552 case KeyPress: 596 va_end (ap);
553 case KeyRelease: 597
554 case ButtonPress: 598 PUTBACK;
555 case ButtonRelease: 599 int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL);
556 case MotionNotify: 600 SPAGAIN;
557 setiv (time, xe->xmotion.time); 601
558 setiv (x, xe->xmotion.x); 602 if (count)
559 setiv (y, xe->xmotion.y);
560 setiv (row, xe->xmotion.y / term->fheight);
561 setiv (col, xe->xmotion.x / term->fwidth);
562 setiv (x_root, xe->xmotion.x_root);
563 setiv (y_root, xe->xmotion.y_root);
564 setiv (state, xe->xmotion.state);
565 break; 603 {
604 SV *status = POPs;
605 count = SvTRUE (status);
606 }
607
608 PUTBACK;
609 FREETMPS;
610 LEAVE;
611
612 if (SvTRUE (ERRSV))
613 {
614 rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV));
615 ungrab (term); // better lose the grab than the session
616 }
617
618 if (htype == HOOK_DESTROY)
619 {
620 clearSVptr ((SV *)term->perl.self);
621 SvREFCNT_dec ((SV *)term->perl.self);
622 }
623
624 swap (perl_environ, environ);
625 return count;
566 } 626 }
567 627
568 switch (xe->type)
569 {
570 case KeyPress:
571 case KeyRelease:
572 setiv (keycode, xe->xkey.keycode);
573 break;
574
575 case ButtonPress:
576 case ButtonRelease:
577 setiv (button, xe->xbutton.button);
578 break;
579
580 case MotionNotify:
581 setiv (is_hint, xe->xmotion.is_hint);
582 break;
583 }
584
585 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
586 }
587 break;
588
589 case DT_END:
590 {
591 va_end (ap);
592
593 PUTBACK;
594 int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL);
595 SPAGAIN;
596
597 if (count)
598 {
599 SV *status = POPs;
600 count = SvTRUE (status);
601 }
602
603 PUTBACK;
604 FREETMPS;
605 LEAVE;
606
607 if (SvTRUE (ERRSV))
608 {
609 rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV));
610 ungrab (term); // better lose the grab than the session
611 }
612
613 if (htype == HOOK_DESTROY)
614 {
615 clearSVptr ((SV *)term->perl.self);
616 SvREFCNT_dec ((SV *)term->perl.self);
617 }
618
619 return count;
620 }
621
622 default: 628 default:
623 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt); 629 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt);
630 }
624 } 631 }
625 } 632 }
633 catch (...)
634 {
635 swap (perl_environ, environ);
636 throw;
637 }
626} 638}
627 639
628///////////////////////////////////////////////////////////////////////////// 640/////////////////////////////////////////////////////////////////////////////
629 641
630MODULE = urxvt PACKAGE = urxvt 642MODULE = urxvt PACKAGE = urxvt

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines