[ViewVC] Diff of: cvs/rxvt-unicode/src/rxvtperl.xs

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

Diff Legend

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

Comparing rxvt-unicode/src/rxvtperl.xs (file contents): Revision 1.67 by root, Sun Jan 15 06:02:41 2006 UTC vs. Revision 1.71 by root, Tue Jan 17 16:22:41 2006 UTC

Diff Legend

Comparing rxvt-unicode/src/rxvtperl.xs (file contents):
Revision 1.67 by root, Sun Jan 15 06:02:41 2006 UTC vs.
Revision 1.71 by root, Tue Jan 17 16:22:41 2006 UTC