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.72 by root, Wed Jan 18 08:33:34 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
… …
53#define ROW(n) THIS->row_buf [LINENO (n)] 53#define ROW(n) THIS->row_buf [LINENO (n)]
54 54
55#define ENABLE_PERL_FRILLS 1 55#define ENABLE_PERL_FRILLS 1
56 56
57///////////////////////////////////////////////////////////////////////////// 57/////////////////////////////////////////////////////////////////////////////
58
59static SV *
60taint (SV *sv)
61{
62 SvTAINT (sv);
63 return sv;
64}
65
66static SV *
67taint_if (SV *sv, SV *src)
68{
69 if (SvTAINTED (src))
70 SvTAINT (sv);
71
72 return sv;
73}
74 58
75static wchar_t * 59static wchar_t *
76sv2wcs (SV *sv) 60sv2wcs (SV *sv)
77{ 61{
78 STRLEN len; 62 STRLEN len;
… …
407 perl_free (perl); 391 perl_free (perl);
408 } 392 }
409} 393}
410 394
411void 395void
412rxvt_perl_interp::init () 396rxvt_perl_interp::init (rxvt_term *term)
413{ 397{
414 if (!perl) 398 if (!perl)
415 { 399 {
400 rxvt_push_locale (""); // perl init destroys current locale
401
416 perl_environ = rxvt_environ; 402 perl_environ = rxvt_environ;
417 swap (perl_environ, environ); 403 swap (perl_environ, environ);
418 404
419 char *argv[] = { 405 char *argv[] = {
420 "", 406 "",
421 "-T", 407 "-e"
422 "-edo '" LIBDIR "/urxvt.pm' or ($@ and die $@) or exit 1", 408 "BEGIN {"
409 " urxvt->bootstrap;"
410 " unshift @INC, '" LIBDIR "';"
411 "}"
412 ""
413 "use urxvt;"
423 }; 414 };
424 415
425 perl = perl_alloc (); 416 perl = perl_alloc ();
426 perl_construct (perl); 417 perl_construct (perl);
427 418
428 if (perl_parse (perl, xs_init, 3, argv, (char **)NULL) 419 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL)
429 || perl_run (perl)) 420 || perl_run (perl))
430 { 421 {
431 rxvt_warn ("unable to initialize perl-interpreter, continuing without.\n"); 422 rxvt_warn ("unable to initialize perl-interpreter, continuing without.\n");
432 423
433 perl_destruct (perl); 424 perl_destruct (perl);
434 perl_free (perl); 425 perl_free (perl);
435 perl = 0; 426 perl = 0;
436 } 427 }
437 428
438 swap (perl_environ, environ); 429 swap (perl_environ, environ);
430
431 rxvt_pop_locale ();
432 }
433
434 if (perl)
435 {
436 // runs outside of perls ENV
437 term->perl.self = (void *)newSVptr ((void *)term, "urxvt::term");
438 hv_store ((HV *)SvRV ((SV *)term->perl.self), "_overlay", 8, newRV_noinc ((SV *)newHV ()), 0);
439 } 439 }
440} 440}
441 441
442static void 442static void
443ungrab (rxvt_term *THIS) 443ungrab (rxvt_term *THIS)
… …
465} 465}
466 466
467bool 467bool
468rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...) 468rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...)
469{ 469{
470 if (!perl) 470 if (!perl || !term->perl.self)
471 return false; 471 return false;
472 472
473 if (htype == HOOK_INIT) // first hook ever called 473 // 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) 474 if (htype == HOOK_REFRESH_END)
487 swap_overlays (term); 475 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 476
498 swap (perl_environ, environ); 477 swap (perl_environ, environ);
499 478
479 bool event_consumed;
480
481 if (htype == HOOK_INIT || htype == HOOK_DESTROY // must be called always
482 || term->perl.should_invoke [htype])
500 try 483 try
501 { 484 {
502 dSP; 485 dSP;
503 va_list ap; 486 va_list ap;
504 487
505 va_start (ap, htype); 488 va_start (ap, htype);
506 489
507 ENTER; 490 ENTER;
508 SAVETMPS; 491 SAVETMPS;
509 492
510 PUSHMARK (SP); 493 PUSHMARK (SP);
511 494
512 XPUSHs (sv_2mortal (newSVterm (term))); 495 XPUSHs (sv_2mortal (newSVterm (term)));
513 XPUSHs (sv_2mortal (newSViv (htype))); 496 XPUSHs (sv_2mortal (newSViv (htype)));
514 497
515 for (;;) { 498 for (;;) {
516 data_type dt = (data_type)va_arg (ap, int); 499 data_type dt = (data_type)va_arg (ap, int);
517 500
518 switch (dt) 501 switch (dt)
519 { 502 {
520 case DT_INT: 503 case DT_INT:
521 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int)))); 504 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int))));
522 break; 505 break;
523 506
524 case DT_LONG: 507 case DT_LONG:
525 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long)))); 508 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long))));
526 break; 509 break;
527 510
528 case DT_STR: 511 case DT_STR:
529 XPUSHs (taint (sv_2mortal (newSVpv (va_arg (ap, char *), 0)))); 512 XPUSHs (sv_2mortal (newSVpv (va_arg (ap, char *), 0)));
530 break; 513 break;
531 514
532 case DT_STR_LEN: 515 case DT_STR_LEN:
533 { 516 {
534 char *str = va_arg (ap, char *); 517 char *str = va_arg (ap, char *);
535 int len = va_arg (ap, int); 518 int len = va_arg (ap, int);
536 519
537 XPUSHs (taint (sv_2mortal (newSVpvn (str, len)))); 520 XPUSHs (sv_2mortal (newSVpvn (str, len)));
538 } 521 }
539 break; 522 break;
540 523
541 case DT_WCS_LEN: 524 case DT_WCS_LEN:
542 { 525 {
543 wchar_t *wstr = va_arg (ap, wchar_t *); 526 wchar_t *wstr = va_arg (ap, wchar_t *);
544 int wlen = va_arg (ap, int); 527 int wlen = va_arg (ap, int);
545 528
546 XPUSHs (taint (sv_2mortal (wcs2sv (wstr, wlen)))); 529 XPUSHs (sv_2mortal (wcs2sv (wstr, wlen)));
547 } 530 }
548 break; 531 break;
549 532
550 case DT_XEVENT: 533 case DT_XEVENT:
551 { 534 {
552 XEvent *xe = va_arg (ap, XEvent *); 535 XEvent *xe = va_arg (ap, XEvent *);
553 HV *hv = newHV (); 536 HV *hv = newHV ();
554 537
555# define set(name, sv) hv_store (hv, # name, sizeof (# name) - 1, sv, 0) 538# 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) 539# define setiv(name, val) hv_store (hv, # name, sizeof (# name) - 1, newSViv (val), 0)
557# undef set 540# undef set
558 541
559 setiv (type, xe->type); 542 setiv (type, xe->type);
560 setiv (send_event, xe->xany.send_event); 543 setiv (send_event, xe->xany.send_event);
561 setiv (serial, xe->xany.serial); 544 setiv (serial, xe->xany.serial);
562 545
563 switch (xe->type) 546 switch (xe->type)
564 { 547 {
565 case KeyPress: 548 case KeyPress:
566 case KeyRelease: 549 case KeyRelease:
567 case ButtonPress: 550 case ButtonPress:
568 case ButtonRelease: 551 case ButtonRelease:
569 case MotionNotify: 552 case MotionNotify:
570 setiv (time, xe->xmotion.time); 553 setiv (time, xe->xmotion.time);
571 setiv (x, xe->xmotion.x); 554 setiv (x, xe->xmotion.x);
572 setiv (y, xe->xmotion.y); 555 setiv (y, xe->xmotion.y);
573 setiv (row, xe->xmotion.y / term->fheight); 556 setiv (row, xe->xmotion.y / term->fheight);
574 setiv (col, xe->xmotion.x / term->fwidth); 557 setiv (col, xe->xmotion.x / term->fwidth);
575 setiv (x_root, xe->xmotion.x_root); 558 setiv (x_root, xe->xmotion.x_root);
576 setiv (y_root, xe->xmotion.y_root); 559 setiv (y_root, xe->xmotion.y_root);
577 setiv (state, xe->xmotion.state); 560 setiv (state, xe->xmotion.state);
578 break; 561 break;
579 } 562 }
580 563
581 switch (xe->type) 564 switch (xe->type)
582 { 565 {
583 case KeyPress: 566 case KeyPress:
584 case KeyRelease: 567 case KeyRelease:
585 setiv (keycode, xe->xkey.keycode); 568 setiv (keycode, xe->xkey.keycode);
586 break; 569 break;
587 570
588 case ButtonPress: 571 case ButtonPress:
589 case ButtonRelease: 572 case ButtonRelease:
590 setiv (button, xe->xbutton.button); 573 setiv (button, xe->xbutton.button);
591 break; 574 break;
592 575
593 case MotionNotify: 576 case MotionNotify:
594 setiv (is_hint, xe->xmotion.is_hint); 577 setiv (is_hint, xe->xmotion.is_hint);
595 break; 578 break;
596 } 579 }
597 580
598 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv))); 581 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
599 } 582 }
600 break; 583 break;
601 584
602 case DT_END: 585 case DT_END:
603 { 586 goto call;
604 va_end (ap);
605 587
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: 588 default:
639 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt); 589 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt);
640 } 590 }
591 }
592
593 call:
594 va_end (ap);
595
596 PUTBACK;
597 int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL);
598 SPAGAIN;
599
600 if (count)
601 {
602 SV *status = POPs;
603 count = SvTRUE (status);
604 }
605
606 PUTBACK;
607 FREETMPS;
608 LEAVE;
609
610 if (SvTRUE (ERRSV))
611 {
612 rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV));
613 ungrab (term); // better lose the grab than the session
614 }
615
616 event_consumed = !!count;
641 } 617 }
618 catch (...)
619 {
620 swap (perl_environ, environ);
621 throw;
622 }
623 else
624 event_consumed = false;
625
626 // post-handling of some events
627 if (htype == HOOK_REFRESH_BEGIN)
628 swap_overlays (term);
629 else if (htype == HOOK_DESTROY)
630 {
631 clearSVptr ((SV *)term->perl.self);
632 SvREFCNT_dec ((SV *)term->perl.self);
642 } 633 }
643 catch (...) 634
644 {
645 swap (perl_environ, environ); 635 swap (perl_environ, environ);
646 throw; 636
647 } 637 return event_consumed;
648} 638}
649 639
650///////////////////////////////////////////////////////////////////////////// 640/////////////////////////////////////////////////////////////////////////////
651 641
652MODULE = urxvt PACKAGE = urxvt 642MODULE = urxvt PACKAGE = urxvt
… …
781void 771void
782fatal (const char *msg) 772fatal (const char *msg)
783 CODE: 773 CODE:
784 rxvt_fatal ("%s", msg); 774 rxvt_fatal ("%s", msg);
785 775
786SV *
787untaint (SV *sv)
788 CODE:
789 RETVAL = newSVsv (sv);
790 SvTAINTED_off (RETVAL);
791 OUTPUT:
792 RETVAL
793
794void 776void
795_exit (int status) 777_exit (int status)
796
797bool
798safe ()
799 CODE:
800 RETVAL = !rxvt_tainted ();
801 OUTPUT:
802 RETVAL
803 778
804NV 779NV
805NOW () 780NOW ()
806 CODE: 781 CODE:
807 RETVAL = NOW; 782 RETVAL = NOW;
… …
1073 char *mbstr = rxvt_wcstombs (wstr); 1048 char *mbstr = rxvt_wcstombs (wstr);
1074 rxvt_pop_locale (); 1049 rxvt_pop_locale ();
1075 1050
1076 free (wstr); 1051 free (wstr);
1077 1052
1078 RETVAL = taint_if (newSVpv (mbstr, 0), str); 1053 RETVAL = newSVpv (mbstr, 0);
1079 free (mbstr); 1054 free (mbstr);
1080} 1055}
1081 OUTPUT: 1056 OUTPUT:
1082 RETVAL 1057 RETVAL
1083 1058
… …
1090 1065
1091 rxvt_push_locale (THIS->locale); 1066 rxvt_push_locale (THIS->locale);
1092 wchar_t *wstr = rxvt_mbstowcs (data, len); 1067 wchar_t *wstr = rxvt_mbstowcs (data, len);
1093 rxvt_pop_locale (); 1068 rxvt_pop_locale ();
1094 1069
1095 RETVAL = taint_if (wcs2sv (wstr), octets); 1070 RETVAL = wcs2sv (wstr);
1096 free (wstr); 1071 free (wstr);
1097} 1072}
1098 OUTPUT: 1073 OUTPUT:
1099 RETVAL 1074 RETVAL
1100 1075
… …
1252 wchar_t *wstr = new wchar_t [THIS->ncol]; 1227 wchar_t *wstr = new wchar_t [THIS->ncol];
1253 1228
1254 for (int col = 0; col < THIS->ncol; col++) 1229 for (int col = 0; col < THIS->ncol; col++)
1255 wstr [col] = l.t [col]; 1230 wstr [col] = l.t [col];
1256 1231
1257 XPUSHs (taint (sv_2mortal (wcs2sv (wstr, THIS->ncol)))); 1232 XPUSHs (sv_2mortal (wcs2sv (wstr, THIS->ncol)));
1258 1233
1259 delete [] wstr; 1234 delete [] wstr;
1260 } 1235 }
1261 1236
1262 if (new_text) 1237 if (new_text)
… …
1383 else 1358 else
1384 *r++ = *s; 1359 *r++ = *s;
1385 1360
1386 rxvt_pop_locale (); 1361 rxvt_pop_locale ();
1387 1362
1388 RETVAL = taint_if (wcs2sv (rstr, r - rstr), string); 1363 RETVAL = wcs2sv (rstr, r - rstr);
1389 1364
1390 delete [] rstr; 1365 delete [] rstr;
1391} 1366}
1392 OUTPUT: 1367 OUTPUT:
1393 RETVAL 1368 RETVAL
… …
1419 else if (IS_COMPOSE (*s)) 1394 else if (IS_COMPOSE (*s))
1420 r += rxvt_composite.expand (*s, r); 1395 r += rxvt_composite.expand (*s, r);
1421 else 1396 else
1422 *r++ = *s; 1397 *r++ = *s;
1423 1398
1424 RETVAL = taint_if (wcs2sv (rstr, r - rstr), text); 1399 RETVAL = wcs2sv (rstr, r - rstr);
1425 1400
1426 delete [] rstr; 1401 delete [] rstr;
1427} 1402}
1428 OUTPUT: 1403 OUTPUT:
1429 RETVAL 1404 RETVAL
… …
1451 1426
1452 if (!IN_RANGE_EXC (index, 0, NUM_RESOURCES)) 1427 if (!IN_RANGE_EXC (index, 0, NUM_RESOURCES))
1453 croak ("requested out-of-bound resource %s+%d,", name, index - rs->value); 1428 croak ("requested out-of-bound resource %s+%d,", name, index - rs->value);
1454 1429
1455 if (GIMME_V != G_VOID) 1430 if (GIMME_V != G_VOID)
1456 XPUSHs (THIS->rs [index] ? sv_2mortal (taint (newSVpv (THIS->rs [index], 0))) : &PL_sv_undef); 1431 XPUSHs (THIS->rs [index] ? sv_2mortal (newSVpv (THIS->rs [index], 0)) : &PL_sv_undef);
1457 1432
1458 if (newval) 1433 if (newval)
1459 { 1434 {
1460 if (SvOK (newval)) 1435 if (SvOK (newval))
1461 { 1436 {
… …
1468 } 1443 }
1469} 1444}
1470 1445
1471const char * 1446const char *
1472rxvt_term::x_resource (const char *name) 1447rxvt_term::x_resource (const char *name)
1473 CLEANUP:
1474 SvTAINTED_on (ST (0));
1475 1448
1476bool 1449bool
1477rxvt_term::option (U32 optval, int set = -1) 1450rxvt_term::option (U32 optval, int set = -1)
1478 CODE: 1451 CODE:
1479{ 1452{
… …
1573rxvt_term::selection (SV *newtext = 0) 1546rxvt_term::selection (SV *newtext = 0)
1574 PPCODE: 1547 PPCODE:
1575{ 1548{
1576 if (GIMME_V != G_VOID) 1549 if (GIMME_V != G_VOID)
1577 XPUSHs (THIS->selection.text 1550 XPUSHs (THIS->selection.text
1578 ? taint (sv_2mortal (wcs2sv (THIS->selection.text, THIS->selection.len))) 1551 ? sv_2mortal (wcs2sv (THIS->selection.text, THIS->selection.len))
1579 : &PL_sv_undef); 1552 : &PL_sv_undef);
1580 1553
1581 if (newtext) 1554 if (newtext)
1582 { 1555 {
1583 free (THIS->selection.text); 1556 free (THIS->selection.text);

Diff Legend

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