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.54 by root, Wed Jan 11 00:59:58 2006 UTC vs.
Revision 1.58 by root, Thu Jan 12 01:38:37 2006 UTC

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

Diff Legend

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