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.133 by root, Tue Dec 7 17:51:27 2010 UTC vs.
Revision 1.134 by root, Thu Dec 16 23:03:50 2010 UTC

… …
329{ 329{
330 if (!perl) 330 if (!perl)
331 { 331 {
332 rxvt_push_locale (""); // perl init destroys current locale 332 rxvt_push_locale (""); // perl init destroys current locale
333 333
334 {
334 perl_environ = rxvt_environ; 335 perl_environ = rxvt_environ;
335 swap (perl_environ, environ); 336 localise_env set_environ (perl_environ);
336 337
337 char *args[] = { 338 char *args[] = {
338 "", 339 "",
339 "-e" 340 "-e"
340 "BEGIN {" 341 "BEGIN {"
341 " urxvt->bootstrap;" 342 " urxvt->bootstrap;"
342 " unshift @INC, '" LIBDIR "';" 343 " unshift @INC, '" LIBDIR "';"
343 "}" 344 "}"
344 "" 345 ""
345 "use urxvt;" 346 "use urxvt;"
346 }; 347 };
347 int argc = sizeof (args) / sizeof (args[0]); 348 int argc = sizeof (args) / sizeof (args[0]);
348 char **argv = args; 349 char **argv = args;
349 350
350 PERL_SYS_INIT3 (&argc, &argv, &environ); 351 PERL_SYS_INIT3 (&argc, &argv, &environ);
351 perl = perl_alloc (); 352 perl = perl_alloc ();
352 perl_construct (perl); 353 perl_construct (perl);
353 354
354 if (perl_parse (perl, xs_init, argc, argv, (char **)NULL) 355 if (perl_parse (perl, xs_init, argc, argv, (char **)NULL)
355 || perl_run (perl)) 356 || perl_run (perl))
356 { 357 {
357 rxvt_warn ("unable to initialize perl-interpreter, continuing without.\n"); 358 rxvt_warn ("unable to initialize perl-interpreter, continuing without.\n");
358 359
359 perl_destruct (perl); 360 perl_destruct (perl);
360 perl_free (perl); 361 perl_free (perl);
361 perl = 0; 362 perl = 0;
362 } 363 }
363 364 }
364 swap (perl_environ, environ);
365 365
366 rxvt_pop_locale (); 366 rxvt_pop_locale ();
367 } 367 }
368 368
369 if (perl) 369 if (perl)
… …
389rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...) 389rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...)
390{ 390{
391 if (!perl || !term->perl.self) 391 if (!perl || !term->perl.self)
392 return false; 392 return false;
393 393
394 localise_env set_environ (perl_environ);
395
394 // pre-handling of some events 396 // pre-handling of some events
395 if (htype == HOOK_REFRESH_END) 397 if (htype == HOOK_REFRESH_END)
396 { 398 {
397 AV *av = (AV *)SvRV (*hv_fetch ((HV *)SvRV ((SV *)term->perl.self), "_overlay", 8, 0)); 399 AV *av = (AV *)SvRV (*hv_fetch ((HV *)SvRV ((SV *)term->perl.self), "_overlay", 8, 0));
398 400
399 for (int i = 0; i <= AvFILL (av); i++) 401 for (int i = 0; i <= AvFILL (av); i++)
400 ((overlay *)SvIV (*av_fetch (av, i, 0)))->swap (); 402 ((overlay *)SvIV (*av_fetch (av, i, 0)))->swap ();
401 } 403 }
402 404
403 swap (perl_environ, environ);
404
405 bool event_consumed; 405 bool event_consumed;
406 406
407 if (htype == HOOK_INIT || htype == HOOK_DESTROY // must be called always 407 if (htype == HOOK_INIT || htype == HOOK_DESTROY // must be called always
408 || term->perl.should_invoke [htype]) 408 || term->perl.should_invoke [htype])
409 try
410 { 409 {
411 dSP; 410 dSP;
412 va_list ap; 411 va_list ap;
413 412
414 va_start (ap, htype); 413 va_start (ap, htype);
415 414
416 ENTER; 415 ENTER;
417 SAVETMPS; 416 SAVETMPS;
418 417
419 PUSHMARK (SP); 418 PUSHMARK (SP);
420 419
421 XPUSHs (sv_2mortal (newSVterm (term))); 420 XPUSHs (sv_2mortal (newSVterm (term)));
422 XPUSHs (sv_2mortal (newSViv (htype))); 421 XPUSHs (sv_2mortal (newSViv (htype)));
423 422
424 for (;;) { 423 for (;;) {
425 data_type dt = (data_type)va_arg (ap, int); 424 data_type dt = (data_type)va_arg (ap, int);
426 425
427 switch (dt) 426 switch (dt)
428 { 427 {
429 case DT_INT: 428 case DT_INT:
430 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int)))); 429 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int))));
431 break; 430 break;
432 431
433 case DT_LONG: 432 case DT_LONG:
434 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long)))); 433 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long))));
435 break; 434 break;
436 435
437 case DT_STR: 436 case DT_STR:
438 XPUSHs (sv_2mortal (newSVpv (va_arg (ap, char *), 0))); 437 XPUSHs (sv_2mortal (newSVpv (va_arg (ap, char *), 0)));
439 break; 438 break;
440 439
441 case DT_STR_LEN: 440 case DT_STR_LEN:
442 { 441 {
443 char *str = va_arg (ap, char *); 442 char *str = va_arg (ap, char *);
444 int len = va_arg (ap, int); 443 int len = va_arg (ap, int);
445 444
446 XPUSHs (sv_2mortal (newSVpvn (str, len))); 445 XPUSHs (sv_2mortal (newSVpvn (str, len)));
447 } 446 }
448 break; 447 break;
449 448
450 case DT_WCS_LEN: 449 case DT_WCS_LEN:
451 { 450 {
452 wchar_t *wstr = va_arg (ap, wchar_t *); 451 wchar_t *wstr = va_arg (ap, wchar_t *);
453 int wlen = va_arg (ap, int); 452 int wlen = va_arg (ap, int);
454 453
455 XPUSHs (sv_2mortal (wcs2sv (wstr, wlen))); 454 XPUSHs (sv_2mortal (wcs2sv (wstr, wlen)));
456 } 455 }
457 break; 456 break;
458 457
459 case DT_LCS_LEN: 458 case DT_LCS_LEN:
460 { 459 {
461 long *lstr = va_arg (ap, long *); 460 long *lstr = va_arg (ap, long *);
462 int llen = va_arg (ap, int); 461 int llen = va_arg (ap, int);
463 462
464 XPUSHs (sv_2mortal (newSVpvn ((char *)lstr, llen * sizeof (long)))); 463 XPUSHs (sv_2mortal (newSVpvn ((char *)lstr, llen * sizeof (long))));
465 } 464 }
466 break; 465 break;
467 466
468 case DT_XEVENT: 467 case DT_XEVENT:
469 { 468 {
470 XEvent *xe = va_arg (ap, XEvent *); 469 XEvent *xe = va_arg (ap, XEvent *);
471 HV *hv = newHV (); 470 HV *hv = newHV ();
472 471
473# define set(name, sv) hv_store (hv, # name, sizeof (# name) - 1, sv, 0) 472# define set(name, sv) hv_store (hv, # name, sizeof (# name) - 1, sv, 0)
474# define setiv(name, val) hv_store (hv, # name, sizeof (# name) - 1, newSViv (val), 0) 473# define setiv(name, val) hv_store (hv, # name, sizeof (# name) - 1, newSViv (val), 0)
475# define setuv(name, val) hv_store (hv, # name, sizeof (# name) - 1, newSVuv (val), 0) 474# define setuv(name, val) hv_store (hv, # name, sizeof (# name) - 1, newSVuv (val), 0)
476# undef set 475# undef set
477 476
478 setiv (type, xe->type); 477 setiv (type, xe->type);
479 setiv (send_event, xe->xany.send_event); 478 setiv (send_event, xe->xany.send_event);
480 setiv (serial, xe->xany.serial); 479 setiv (serial, xe->xany.serial);
481 480
482 switch (xe->type) 481 switch (xe->type)
483 { 482 {
484 case KeyPress: 483 case KeyPress:
485 case KeyRelease: 484 case KeyRelease:
486 case ButtonPress: 485 case ButtonPress:
487 case ButtonRelease: 486 case ButtonRelease:
488 case MotionNotify: 487 case MotionNotify:
489 setuv (window, xe->xmotion.window); 488 setuv (window, xe->xmotion.window);
490 setuv (root, xe->xmotion.root); 489 setuv (root, xe->xmotion.root);
491 setuv (subwindow, xe->xmotion.subwindow); 490 setuv (subwindow, xe->xmotion.subwindow);
492 setuv (time, xe->xmotion.time); 491 setuv (time, xe->xmotion.time);
493 setiv (x, xe->xmotion.x); 492 setiv (x, xe->xmotion.x);
494 setiv (y, xe->xmotion.y); 493 setiv (y, xe->xmotion.y);
495 setiv (row, xe->xmotion.y / term->fheight + term->view_start); 494 setiv (row, xe->xmotion.y / term->fheight + term->view_start);
496 setiv (col, xe->xmotion.x / term->fwidth); 495 setiv (col, xe->xmotion.x / term->fwidth);
497 setiv (x_root, xe->xmotion.x_root); 496 setiv (x_root, xe->xmotion.x_root);
498 setiv (y_root, xe->xmotion.y_root); 497 setiv (y_root, xe->xmotion.y_root);
499 setuv (state, xe->xmotion.state); 498 setuv (state, xe->xmotion.state);
500 499
501 switch (xe->type) 500 switch (xe->type)
502 { 501 {
503 case KeyPress: 502 case KeyPress:
504 case KeyRelease: 503 case KeyRelease:
505 setuv (keycode, xe->xkey.keycode); 504 setuv (keycode, xe->xkey.keycode);
506 break; 505 break;
507 506
508 case ButtonPress: 507 case ButtonPress:
509 case ButtonRelease: 508 case ButtonRelease:
510 setuv (button, xe->xbutton.button); 509 setuv (button, xe->xbutton.button);
511 break; 510 break;
512 511
513 case MotionNotify: 512 case MotionNotify:
514 setiv (is_hint, xe->xmotion.is_hint); 513 setiv (is_hint, xe->xmotion.is_hint);
515 break; 514 break;
516 } 515 }
517 516
518 break; 517 break;
519 518
520 case MapNotify: 519 case MapNotify:
521 case UnmapNotify: 520 case UnmapNotify:
522 case ConfigureNotify: 521 case ConfigureNotify:
523 setuv (event, xe->xconfigure.event); 522 setuv (event, xe->xconfigure.event);
524 setuv (window, xe->xconfigure.window); 523 setuv (window, xe->xconfigure.window);
525 524
526 switch (xe->type) 525 switch (xe->type)
527 { 526 {
528 case ConfigureNotify: 527 case ConfigureNotify:
529 setiv (x, xe->xconfigure.x); 528 setiv (x, xe->xconfigure.x);
530 setiv (y, xe->xconfigure.y); 529 setiv (y, xe->xconfigure.y);
531 setiv (width, xe->xconfigure.width); 530 setiv (width, xe->xconfigure.width);
532 setiv (height, xe->xconfigure.height); 531 setiv (height, xe->xconfigure.height);
533 setuv (above, xe->xconfigure.above); 532 setuv (above, xe->xconfigure.above);
534 break; 533 break;
535 } 534 }
536 535
537 break; 536 break;
538 537
539 case PropertyNotify: 538 case PropertyNotify:
540 setuv (window, xe->xproperty.window); 539 setuv (window, xe->xproperty.window);
541 setuv (atom, xe->xproperty.atom); 540 setuv (atom, xe->xproperty.atom);
542 setuv (time, xe->xproperty.time); 541 setuv (time, xe->xproperty.time);
543 setiv (state, xe->xproperty.state); 542 setiv (state, xe->xproperty.state);
544 break; 543 break;
545 544
546 case ClientMessage: 545 case ClientMessage:
547 setuv (window, xe->xclient.window); 546 setuv (window, xe->xclient.window);
548 setuv (message_type, xe->xclient.message_type); 547 setuv (message_type, xe->xclient.message_type);
549 setuv (format, xe->xclient.format); 548 setuv (format, xe->xclient.format);
550 setuv (l0, xe->xclient.data.l[0]); 549 setuv (l0, xe->xclient.data.l[0]);
551 setuv (l1, xe->xclient.data.l[1]); 550 setuv (l1, xe->xclient.data.l[1]);
552 setuv (l2, xe->xclient.data.l[2]); 551 setuv (l2, xe->xclient.data.l[2]);
553 setuv (l3, xe->xclient.data.l[3]); 552 setuv (l3, xe->xclient.data.l[3]);
554 setuv (l4, xe->xclient.data.l[4]); 553 setuv (l4, xe->xclient.data.l[4]);
555 break; 554 break;
556 } 555 }
557 556
558 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv))); 557 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
559 } 558 }
560 break; 559 break;
561 560
562 case DT_END: 561 case DT_END:
563 goto call; 562 goto call;
564 563
565 default: 564 default:
566 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt); 565 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt);
567 } 566 }
567 }
568
569 call:
570 va_end (ap);
571
572 PUTBACK;
573 int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL);
574 SPAGAIN;
575
576 if (count)
577 {
578 SV *status = POPs;
579 count = SvTRUE (status);
568 } 580 }
569 581
570 call:
571 va_end (ap);
572
573 PUTBACK; 582 PUTBACK;
574 int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL);
575 SPAGAIN;
576
577 if (count)
578 {
579 SV *status = POPs;
580 count = SvTRUE (status);
581 }
582
583 PUTBACK;
584 FREETMPS; 583 FREETMPS;
585 LEAVE; 584 LEAVE;
586 585
587 if (SvTRUE (ERRSV)) 586 if (SvTRUE (ERRSV))
588 { 587 {
589 rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV)); 588 rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV));
590 ungrab (term); // better lose the grab than the session 589 ungrab (term); // better lose the grab than the session
591 } 590 }
592 591
593 event_consumed = !!count; 592 event_consumed = !!count;
594 } 593 }
595 catch (...)
596 {
597 swap (perl_environ, environ);
598 throw;
599 }
600 else 594 else
601 event_consumed = false; 595 event_consumed = false;
602 596
603 // post-handling of some events 597 // post-handling of some events
604 if (htype == HOOK_REFRESH_BEGIN) 598 if (htype == HOOK_REFRESH_BEGIN)
… …
614 SvREFCNT_dec ((SV *)term->perl.self); 608 SvREFCNT_dec ((SV *)term->perl.self);
615 609
616 // don't allow further calls 610 // don't allow further calls
617 term->perl.self = 0; 611 term->perl.self = 0;
618 } 612 }
619
620 swap (perl_environ, environ);
621 613
622 return event_consumed; 614 return event_consumed;
623} 615}
624 616
625///////////////////////////////////////////////////////////////////////////// 617/////////////////////////////////////////////////////////////////////////////

Diff Legend

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