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.75 by root, Wed Jan 18 11:05:09 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 if (htype == HOOK_REFRESH_END)
475 swap_overlays (term);
476
477 swap (perl_environ, environ);
478
479 bool event_consumed;
480
481 if (htype == HOOK_INIT || htype == HOOK_DESTROY // must be called always
482 || term->perl.should_invoke [htype])
483 try
474 { 484 {
475 term->perl.self = (void *)newSVptr ((void *)term, "urxvt::term"); 485 dSP;
476 hv_store ((HV *)SvRV ((SV *)term->perl.self), "_overlay", 8, newRV_noinc ((SV *)newHV ()), 0); 486 va_list ap;
487
488 va_start (ap, htype);
489
490 ENTER;
491 SAVETMPS;
492
493 PUSHMARK (SP);
494
495 XPUSHs (sv_2mortal (newSVterm (term)));
496 XPUSHs (sv_2mortal (newSViv (htype)));
497
498 for (;;) {
499 data_type dt = (data_type)va_arg (ap, int);
500
501 switch (dt)
502 {
503 case DT_INT:
504 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int))));
505 break;
506
507 case DT_LONG:
508 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long))));
509 break;
510
511 case DT_STR:
512 XPUSHs (sv_2mortal (newSVpv (va_arg (ap, char *), 0)));
513 break;
514
515 case DT_STR_LEN:
516 {
517 char *str = va_arg (ap, char *);
518 int len = va_arg (ap, int);
519
520 XPUSHs (sv_2mortal (newSVpvn (str, len)));
521 }
522 break;
523
524 case DT_WCS_LEN:
525 {
526 wchar_t *wstr = va_arg (ap, wchar_t *);
527 int wlen = va_arg (ap, int);
528
529 XPUSHs (sv_2mortal (wcs2sv (wstr, wlen)));
530 }
531 break;
532
533 case DT_XEVENT:
534 {
535 XEvent *xe = va_arg (ap, XEvent *);
536 HV *hv = newHV ();
537
538# 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)
540# define setuv(name, val) hv_store (hv, # name, sizeof (# name) - 1, newSVuv (val), 0)
541# undef set
542
543 setiv (type, xe->type);
544 setiv (send_event, xe->xany.send_event);
545 setiv (serial, xe->xany.serial);
546
547 switch (xe->type)
548 {
549 case KeyPress:
550 case KeyRelease:
551 case ButtonPress:
552 case ButtonRelease:
553 case MotionNotify:
554 setuv (window, xe->xmotion.window);
555 setuv (root, xe->xmotion.root);
556 setuv (subwindow, xe->xmotion.subwindow);
557 setuv (time, xe->xmotion.time);
558 setiv (x, xe->xmotion.x);
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 setuv (state, xe->xmotion.state);
565
566 switch (xe->type)
567 {
568 case KeyPress:
569 case KeyRelease:
570 setuv (keycode, xe->xkey.keycode);
571 break;
572
573 case ButtonPress:
574 case ButtonRelease:
575 setuv (button, xe->xbutton.button);
576 break;
577
578 case MotionNotify:
579 setiv (is_hint, xe->xmotion.is_hint);
580 break;
581 }
582
583 break;
584
585 case MapNotify:
586 case UnmapNotify:
587 case ConfigureNotify:
588 setuv (event, xe->xconfigure.event);
589 setuv (window, xe->xconfigure.window);
590
591 switch (xe->type)
592 {
593 case ConfigureNotify:
594 setiv (x, xe->xconfigure.x);
595 setiv (y, xe->xconfigure.y);
596 setiv (width, xe->xconfigure.width);
597 setiv (height, xe->xconfigure.height);
598 setuv (above, xe->xconfigure.above);
599 break;
600 }
601
602 break;
603 }
604
605 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
606 }
607 break;
608
609 case DT_END:
610 goto call;
611
612 default:
613 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt);
614 }
615 }
616
617 call:
618 va_end (ap);
619
620 PUTBACK;
621 int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL);
622 SPAGAIN;
623
624 if (count)
625 {
626 SV *status = POPs;
627 count = SvTRUE (status);
628 }
629
630 PUTBACK;
631 FREETMPS;
632 LEAVE;
633
634 if (SvTRUE (ERRSV))
635 {
636 rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV));
637 ungrab (term); // better lose the grab than the session
638 }
639
640 event_consumed = !!count;
477 } 641 }
478 else if (!term->perl.self) 642 catch (...)
479 return false; // perl not initialized for this instance 643 {
644 swap (perl_environ, environ);
645 throw;
646 }
647 else
648 event_consumed = false;
649
650 // post-handling of some events
651 if (htype == HOOK_REFRESH_BEGIN)
652 swap_overlays (term);
480 else if (htype == HOOK_DESTROY) 653 else if (htype == HOOK_DESTROY)
481 { 654 {
482 // handled later 655 clearSVptr ((SV *)term->perl.self);
656 SvREFCNT_dec ((SV *)term->perl.self);
483 } 657 }
484 else
485 {
486 if (htype == HOOK_REFRESH_END)
487 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 658
498 swap (perl_environ, environ); 659 swap (perl_environ, environ);
499 660
500 try 661 return event_consumed;
501 {
502 dSP;
503 va_list ap;
504
505 va_start (ap, htype);
506
507 ENTER;
508 SAVETMPS;
509
510 PUSHMARK (SP);
511
512 XPUSHs (sv_2mortal (newSVterm (term)));
513 XPUSHs (sv_2mortal (newSViv (htype)));
514
515 for (;;) {
516 data_type dt = (data_type)va_arg (ap, int);
517
518 switch (dt)
519 {
520 case DT_INT:
521 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int))));
522 break;
523
524 case DT_LONG:
525 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long))));
526 break;
527
528 case DT_STR:
529 XPUSHs (taint (sv_2mortal (newSVpv (va_arg (ap, char *), 0))));
530 break;
531
532 case DT_STR_LEN:
533 {
534 char *str = va_arg (ap, char *);
535 int len = va_arg (ap, int);
536
537 XPUSHs (taint (sv_2mortal (newSVpvn (str, len))));
538 }
539 break;
540
541 case DT_WCS_LEN:
542 {
543 wchar_t *wstr = va_arg (ap, wchar_t *);
544 int wlen = va_arg (ap, int);
545
546 XPUSHs (taint (sv_2mortal (wcs2sv (wstr, wlen))));
547 }
548 break;
549
550 case DT_XEVENT:
551 {
552 XEvent *xe = va_arg (ap, XEvent *);
553 HV *hv = newHV ();
554
555# 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)
557# undef set
558
559 setiv (type, xe->type);
560 setiv (send_event, xe->xany.send_event);
561 setiv (serial, xe->xany.serial);
562
563 switch (xe->type)
564 {
565 case KeyPress:
566 case KeyRelease:
567 case ButtonPress:
568 case ButtonRelease:
569 case MotionNotify:
570 setiv (time, xe->xmotion.time);
571 setiv (x, xe->xmotion.x);
572 setiv (y, xe->xmotion.y);
573 setiv (row, xe->xmotion.y / term->fheight);
574 setiv (col, xe->xmotion.x / term->fwidth);
575 setiv (x_root, xe->xmotion.x_root);
576 setiv (y_root, xe->xmotion.y_root);
577 setiv (state, xe->xmotion.state);
578 break;
579 }
580
581 switch (xe->type)
582 {
583 case KeyPress:
584 case KeyRelease:
585 setiv (keycode, xe->xkey.keycode);
586 break;
587
588 case ButtonPress:
589 case ButtonRelease:
590 setiv (button, xe->xbutton.button);
591 break;
592
593 case MotionNotify:
594 setiv (is_hint, xe->xmotion.is_hint);
595 break;
596 }
597
598 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
599 }
600 break;
601
602 case DT_END:
603 {
604 va_end (ap);
605
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:
639 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt);
640 }
641 }
642 }
643 catch (...)
644 {
645 swap (perl_environ, environ);
646 throw;
647 }
648} 662}
649 663
650///////////////////////////////////////////////////////////////////////////// 664/////////////////////////////////////////////////////////////////////////////
651 665
652MODULE = urxvt PACKAGE = urxvt 666MODULE = urxvt PACKAGE = urxvt
… …
781void 795void
782fatal (const char *msg) 796fatal (const char *msg)
783 CODE: 797 CODE:
784 rxvt_fatal ("%s", msg); 798 rxvt_fatal ("%s", msg);
785 799
786SV *
787untaint (SV *sv)
788 CODE:
789 RETVAL = newSVsv (sv);
790 SvTAINTED_off (RETVAL);
791 OUTPUT:
792 RETVAL
793
794void 800void
795_exit (int status) 801_exit (int status)
796
797bool
798safe ()
799 CODE:
800 RETVAL = !rxvt_tainted ();
801 OUTPUT:
802 RETVAL
803 802
804NV 803NV
805NOW () 804NOW ()
806 CODE: 805 CODE:
807 RETVAL = NOW; 806 RETVAL = NOW;
… …
1073 char *mbstr = rxvt_wcstombs (wstr); 1072 char *mbstr = rxvt_wcstombs (wstr);
1074 rxvt_pop_locale (); 1073 rxvt_pop_locale ();
1075 1074
1076 free (wstr); 1075 free (wstr);
1077 1076
1078 RETVAL = taint_if (newSVpv (mbstr, 0), str); 1077 RETVAL = newSVpv (mbstr, 0);
1079 free (mbstr); 1078 free (mbstr);
1080} 1079}
1081 OUTPUT: 1080 OUTPUT:
1082 RETVAL 1081 RETVAL
1083 1082
… …
1090 1089
1091 rxvt_push_locale (THIS->locale); 1090 rxvt_push_locale (THIS->locale);
1092 wchar_t *wstr = rxvt_mbstowcs (data, len); 1091 wchar_t *wstr = rxvt_mbstowcs (data, len);
1093 rxvt_pop_locale (); 1092 rxvt_pop_locale ();
1094 1093
1095 RETVAL = taint_if (wcs2sv (wstr), octets); 1094 RETVAL = wcs2sv (wstr);
1096 free (wstr); 1095 free (wstr);
1097} 1096}
1098 OUTPUT: 1097 OUTPUT:
1099 RETVAL 1098 RETVAL
1100 1099
… …
1252 wchar_t *wstr = new wchar_t [THIS->ncol]; 1251 wchar_t *wstr = new wchar_t [THIS->ncol];
1253 1252
1254 for (int col = 0; col < THIS->ncol; col++) 1253 for (int col = 0; col < THIS->ncol; col++)
1255 wstr [col] = l.t [col]; 1254 wstr [col] = l.t [col];
1256 1255
1257 XPUSHs (taint (sv_2mortal (wcs2sv (wstr, THIS->ncol)))); 1256 XPUSHs (sv_2mortal (wcs2sv (wstr, THIS->ncol)));
1258 1257
1259 delete [] wstr; 1258 delete [] wstr;
1260 } 1259 }
1261 1260
1262 if (new_text) 1261 if (new_text)
… …
1383 else 1382 else
1384 *r++ = *s; 1383 *r++ = *s;
1385 1384
1386 rxvt_pop_locale (); 1385 rxvt_pop_locale ();
1387 1386
1388 RETVAL = taint_if (wcs2sv (rstr, r - rstr), string); 1387 RETVAL = wcs2sv (rstr, r - rstr);
1389 1388
1390 delete [] rstr; 1389 delete [] rstr;
1391} 1390}
1392 OUTPUT: 1391 OUTPUT:
1393 RETVAL 1392 RETVAL
… …
1419 else if (IS_COMPOSE (*s)) 1418 else if (IS_COMPOSE (*s))
1420 r += rxvt_composite.expand (*s, r); 1419 r += rxvt_composite.expand (*s, r);
1421 else 1420 else
1422 *r++ = *s; 1421 *r++ = *s;
1423 1422
1424 RETVAL = taint_if (wcs2sv (rstr, r - rstr), text); 1423 RETVAL = wcs2sv (rstr, r - rstr);
1425 1424
1426 delete [] rstr; 1425 delete [] rstr;
1427} 1426}
1428 OUTPUT: 1427 OUTPUT:
1429 RETVAL 1428 RETVAL
… …
1451 1450
1452 if (!IN_RANGE_EXC (index, 0, NUM_RESOURCES)) 1451 if (!IN_RANGE_EXC (index, 0, NUM_RESOURCES))
1453 croak ("requested out-of-bound resource %s+%d,", name, index - rs->value); 1452 croak ("requested out-of-bound resource %s+%d,", name, index - rs->value);
1454 1453
1455 if (GIMME_V != G_VOID) 1454 if (GIMME_V != G_VOID)
1456 XPUSHs (THIS->rs [index] ? sv_2mortal (taint (newSVpv (THIS->rs [index], 0))) : &PL_sv_undef); 1455 XPUSHs (THIS->rs [index] ? sv_2mortal (newSVpv (THIS->rs [index], 0)) : &PL_sv_undef);
1457 1456
1458 if (newval) 1457 if (newval)
1459 { 1458 {
1460 if (SvOK (newval)) 1459 if (SvOK (newval))
1461 { 1460 {
… …
1468 } 1467 }
1469} 1468}
1470 1469
1471const char * 1470const char *
1472rxvt_term::x_resource (const char *name) 1471rxvt_term::x_resource (const char *name)
1473 CLEANUP:
1474 SvTAINTED_on (ST (0));
1475 1472
1476bool 1473bool
1477rxvt_term::option (U32 optval, int set = -1) 1474rxvt_term::option (U32 optval, int set = -1)
1478 CODE: 1475 CODE:
1479{ 1476{
… …
1539 PUSHs (sv_2mortal (newSViv (rc.col))); 1536 PUSHs (sv_2mortal (newSViv (rc.col)));
1540 } 1537 }
1541 1538
1542 if (items == 3) 1539 if (items == 3)
1543 { 1540 {
1541 rc.row = SvIV (ST (1));
1542 rc.col = SvIV (ST (2));
1543
1544 if (ix == 2 && rc.col == 0)
1545 {
1546 rc.row--;
1547 rc.col = THIS->ncol;
1548 }
1549
1550 clamp_it (rc.col, 0, THIS->ncol);
1544 rc.row = clamp (SvIV (ST (1)), THIS->top_row, THIS->nrow - 1); 1551 clamp_it (rc.row, THIS->top_row, THIS->nrow - 1);
1545 rc.col = clamp (SvIV (ST (2)), 0, THIS->ncol - 1);
1546 1552
1547 if (ix) 1553 if (ix)
1548 THIS->want_refresh = 1; 1554 THIS->want_refresh = 1;
1549 } 1555 }
1550} 1556}
… …
1573rxvt_term::selection (SV *newtext = 0) 1579rxvt_term::selection (SV *newtext = 0)
1574 PPCODE: 1580 PPCODE:
1575{ 1581{
1576 if (GIMME_V != G_VOID) 1582 if (GIMME_V != G_VOID)
1577 XPUSHs (THIS->selection.text 1583 XPUSHs (THIS->selection.text
1578 ? taint (sv_2mortal (wcs2sv (THIS->selection.text, THIS->selection.len))) 1584 ? sv_2mortal (wcs2sv (THIS->selection.text, THIS->selection.len))
1579 : &PL_sv_undef); 1585 : &PL_sv_undef);
1580 1586
1581 if (newtext) 1587 if (newtext)
1582 { 1588 {
1583 free (THIS->selection.text); 1589 free (THIS->selection.text);
… …
1709 RETVAL = THIS; 1715 RETVAL = THIS;
1710 OUTPUT: 1716 OUTPUT:
1711 RETVAL 1717 RETVAL
1712 1718
1713timer * 1719timer *
1720timer::after (NV delay)
1721 CODE:
1722 THIS->start (NOW + delay);
1723 OUTPUT:
1724 RETVAL
1725
1726timer *
1714timer::stop () 1727timer::stop ()
1715 CODE: 1728 CODE:
1716 THIS->stop (); 1729 THIS->stop ();
1717 RETVAL = THIS; 1730 RETVAL = THIS;
1718 OUTPUT: 1731 OUTPUT:

Diff Legend

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