1 /*----------------------------------------------------------------------*
3 *----------------------------------------------------------------------*
5 * All portions of code are copyright by their respective author/s.
6 * Copyright (c) 2005-2005 Marc Lehmann <pcg@goof.com>
8 * This program is free software; you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation; either version 2 of the License, or
11 * (at your option) any later version.
13 * This program is distributed in the hope that it will be useful,
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 * GNU General Public License for more details.
18 * You should have received a copy of the GNU General Public License
19 * along with this program; if not, write to the Free Software
20 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 *----------------------------------------------------------------------*/
23 #define line_t perl_line_t
29 #include "../config.h"
40 /////////////////////////////////////////////////////////////////////////////
46 char *str = SvPVutf8 (sv, len);
47 return rxvt_utf8towcs (str, len);
51 new_ref (HV *hv, const char *klass)
53 return sv_bless (newRV ((SV *)hv), gv_stashpv (klass, 1));
58 newSVptr (void *ptr, const char *klass)
61 hv_store (hv, "_ptr", 4, newSViv ((long)ptr), 0);
62 return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
66 SvPTR (SV *sv, const char *klass)
68 if (!sv_derived_from (sv, klass))
69 croak ("object of type %s expected", klass);
71 IV iv = SvIV (*hv_fetch ((HV *)SvRV (sv), "_ptr", 4, 1));
74 croak ("perl code used %s object, but C++ object is already destroyed, caught", klass);
79 #define newSVterm(term) SvREFCNT_inc ((SV *)term->self)
80 #define SvTERM(sv) (rxvt_term *)SvPTR (sv, "urxvt::term")
82 /////////////////////////////////////////////////////////////////////////////
104 void invoke (const char *type, SV *self, int arg = -1);
108 perl_watcher::invoke (const char *type, SV *self, int arg)
117 XPUSHs (sv_2mortal (self));
120 XPUSHs (sv_2mortal (newSViv (arg)));
123 call_sv (cbsv, G_VOID | G_EVAL | G_DISCARD);
131 rxvt_warn ("%s callback evaluation error: %s", type, SvPV_nolen (ERRSV));
134 #define newSVtimer(timer) new_ref (timer->self, "urxvt::timer")
135 #define SvTIMER(sv) (timer *)SvPTR (sv, "urxvt::timer")
137 struct timer : time_watcher, perl_watcher
140 : time_watcher (this, &timer::execute)
144 void execute (time_watcher &w)
146 invoke ("urxvt::timer", newSVtimer (this));
150 #define newSViow(iow) new_ref (iow->self, "urxvt::iow")
151 #define SvIOW(sv) (iow *)SvPTR (sv, "urxvt::iow")
153 struct iow : io_watcher, perl_watcher
156 : io_watcher (this, &iow::execute)
160 void execute (io_watcher &w, short revents)
162 invoke ("urxvt::iow", newSViow (this), revents);
166 /////////////////////////////////////////////////////////////////////////////
168 struct rxvt_perl_interp rxvt_perl;
170 static PerlInterpreter *perl;
172 rxvt_perl_interp::rxvt_perl_interp ()
176 rxvt_perl_interp::~rxvt_perl_interp ()
180 perl_destruct (perl);
186 rxvt_perl_interp::init ()
192 "-edo '" LIBDIR "/urxvt.pm' or ($@ and die $@) or exit 1",
195 perl = perl_alloc ();
196 perl_construct (perl);
198 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL)
201 rxvt_warn ("unable to initialize perl-interpreter, continuing without.\n");
203 perl_destruct (perl);
211 rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...)
213 // INIT and DESTROY must be requested by the runtime
215 if (!perl || !should_invoke [htype])
218 if (htype == HOOK_INIT) // first hook ever called
219 term->self = (void *)newSVptr ((void *)term, "urxvt::term");
224 va_start (ap, htype);
231 XPUSHs (sv_2mortal (newSVterm (term)));
232 XPUSHs (sv_2mortal (newSViv (htype)));
235 data_type dt = (data_type)va_arg (ap, int);
240 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int))));
244 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long))));
252 int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL);
258 count = SvTRUE (status);
266 rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV));
268 if (htype == HOOK_DESTROY)
271 hv_clear ((HV *)SvRV ((SV *)term->self));
272 SvREFCNT_dec ((SV *)term->self);
279 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt);
284 /////////////////////////////////////////////////////////////////////////////
286 MODULE = urxvt PACKAGE = urxvt
292 # define set_hookname(sym) av_store (hookname, PP_CONCAT(HOOK_, sym), newSVpv (PP_STRINGIFY(sym), 0))
293 AV *hookname = get_av ("urxvt::HOOKNAME", 1);
296 set_hookname (RESET);
297 set_hookname (START);
298 set_hookname (DESTROY);
299 set_hookname (SEL_BEGIN);
300 set_hookname (SEL_EXTEND);
301 set_hookname (SEL_MAKE);
302 set_hookname (SEL_GRAB);
303 set_hookname (FOCUS_IN);
304 set_hookname (FOCUS_OUT);
305 set_hookname (VIEW_CHANGE);
306 set_hookname (SCROLL_BACK);
307 set_hookname (TTY_ACTIVITY);
308 set_hookname (REFRESH_BEGIN);
309 set_hookname (REFRESH_END);
311 sv_setpv (get_sv ("urxvt::LIBDIR", 1), LIBDIR);
315 set_should_invoke (int htype, int value)
317 rxvt_perl.should_invoke [htype] = value;
320 warn (const char *msg)
322 rxvt_warn ("%s", msg);
325 fatal (const char *msg)
327 rxvt_fatal ("%s", msg);
336 MODULE = urxvt PACKAGE = urxvt::term
339 rxvt_term::strwidth (SV *str)
342 wchar_t *wstr = sv2wcs (str);
344 rxvt_push_locale (THIS->locale);
345 RETVAL = wcswidth (wstr, wcslen (wstr));
354 rxvt_term::locale_encode (SV *str)
357 wchar_t *wstr = sv2wcs (str);
359 rxvt_push_locale (THIS->locale);
360 char *mbstr = rxvt_wcstombs (wstr);
365 RETVAL = newSVpv (mbstr, 0);
372 rxvt_term::locale_decode (SV *octets)
376 char *data = SvPVbyte (octets, len);
378 rxvt_push_locale (THIS->locale);
379 wchar_t *wstr = rxvt_mbstowcs (data, len);
382 char *str = rxvt_wcstoutf8 (wstr);
385 RETVAL = newSVpv (str, 0);
393 rxvt_term::_resource (char *name, int index, SV *newval = 0)
396 struct resval { const char *name; int value; } rslist [] = {
397 # define Rs_def(name) { # name, Rs_ ## name },
398 # define Rs_reserve(name,count)
404 struct resval *rs = rslist + sizeof (rslist) / sizeof (rslist [0]);
408 croak ("no such resource '%s', requested", name);
409 } while (strcmp (name, rs->name));
413 if (!IN_RANGE_EXC (index, 0, NUM_RESOURCES))
414 croak ("requested out-of-bound resource %s+%d,", name, index - rs->value);
416 if (GIMME_V != G_VOID)
417 XPUSHs (THIS->rs [index] ? sv_2mortal (newSVpv (THIS->rs [index], 0)) : &PL_sv_undef);
423 char *str = strdup (SvPVbyte_nolen (newval));
424 THIS->rs [index] = str;
425 THIS->allocated.push_back (str);
428 THIS->rs [index] = 0;
433 rxvt_term::selection_mark (...)
440 row_col_t &sel = ix == 1 ? THIS->selection.beg
441 : ix == 2 ? THIS->selection.end
442 : THIS->selection.mark;
444 if (GIMME_V != G_VOID)
447 PUSHs (sv_2mortal (newSViv (sel.row)));
448 PUSHs (sv_2mortal (newSViv (sel.col)));
453 sel.row = clamp (SvIV (ST (1)), -THIS->nsaved, THIS->nrow - 1);
454 sel.col = clamp (SvIV (ST (2)), 0, THIS->ncol - 1);
457 THIS->want_refresh = 1;
462 rxvt_term::selection_grab (int eventtime)
465 rxvt_term::selection (SV *newtext = 0)
468 if (GIMME_V != G_VOID)
470 char *sel = rxvt_wcstoutf8 (THIS->selection.text, THIS->selection.len);
471 SV *sv = newSVpv (sel, 0);
474 XPUSHs (sv_2mortal (sv));
479 free (THIS->selection.text);
481 THIS->selection.text = sv2wcs (newtext);
482 THIS->selection.len = wcslen (THIS->selection.text);
487 rxvt_term::scr_overlay_new (int x, int y, int w, int h)
490 rxvt_term::scr_overlay_off ()
493 rxvt_term::scr_overlay_set_char (int x, int y, U32 text, U32 rend = OVERLAY_RSTYLE)
495 THIS->scr_overlay_set (x, y, text, rend);
498 rxvt_term::scr_overlay_set (int x, int y, SV *text)
501 wchar_t *wtext = sv2wcs (text);
502 THIS->scr_overlay_set (x, y, wtext);
507 rxvt_term::tt_write (SV *octets)
510 char *str = SvPVbyte (octets, len);
512 (unsigned char *)str, len
514 MODULE = urxvt PACKAGE = urxvt::timer
519 timer *w = new timer;
520 RETVAL = newSVptr ((void *)w, "urxvt::timer");
521 w->self = (HV *)SvRV (RETVAL);
541 timer::set (NV tstamp)
549 timer::start (NV tstamp = THIS->at)
551 THIS->start (tstamp);
567 MODULE = urxvt PACKAGE = urxvt::iow
573 RETVAL = newSVptr ((void *)w, "urxvt::iow");
574 w->self = (HV *)SvRV (RETVAL);
595 iow::events (short events)
597 THIS->events = events;