ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/rxvtperl.xs
Revision: 1.3
Committed: Mon Jan 2 18:20:23 2006 UTC (18 years, 5 months ago) by root
Branch: MAIN
Changes since 1.2: +57 -6 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 /*----------------------------------------------------------------------*
2 * File: rxvtperl.xs
3 *----------------------------------------------------------------------*
4 *
5 * All portions of code are copyright by their respective author/s.
6 * Copyright (c) 2005-2005 Marc Lehmann <pcg@goof.com>
7 *
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.
12 *
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.
17 *
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 *----------------------------------------------------------------------*/
22
23 #define line_t perl_line_t
24 #include <EXTERN.h>
25 #include <perl.h>
26 #include <XSUB.h>
27 #undef line_t
28
29 #include "../config.h"
30
31 #include <cstdarg>
32
33 #include "rxvt.h"
34 #include "iom.h"
35 #include "rxvtutil.h"
36 #include "rxvtperl.h"
37
38 #include "perlxsi.c"
39
40 /////////////////////////////////////////////////////////////////////////////
41
42 static wchar_t *
43 sv2wcs (SV *sv)
44 {
45 STRLEN len;
46 char *str = SvPVutf8 (sv, len);
47 return rxvt_utf8towcs (str, len);
48 }
49
50 static SV *
51 new_ref (HV *hv, const char *klass)
52 {
53 return sv_bless (newRV ((SV *)hv), gv_stashpv (klass, 1));
54 }
55
56 //TODO: use magic
57 static SV *
58 newSVptr (void *ptr, const char *klass)
59 {
60 HV *hv = newHV ();
61 hv_store (hv, "_ptr", 4, newSViv ((long)ptr), 0);
62 return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
63 }
64
65 static long
66 SvPTR (SV *sv, const char *klass)
67 {
68 if (!sv_derived_from (sv, klass))
69 croak ("object of type %s expected", klass);
70
71 IV iv = SvIV (*hv_fetch ((HV *)SvRV (sv), "_ptr", 4, 1));
72
73 if (!iv)
74 croak ("perl code used %s object, but C++ object is already destroyed, caught", klass);
75
76 return (long)iv;
77 }
78
79 #define newSVterm(term) SvREFCNT_inc ((SV *)term->self)
80 #define SvTERM(sv) (rxvt_term *)SvPTR (sv, "urxvt::term")
81
82 /////////////////////////////////////////////////////////////////////////////
83
84 struct perl_watcher
85 {
86 SV *cbsv;
87 HV *self;
88
89 perl_watcher ()
90 : cbsv (newSV (0))
91 {
92 }
93
94 ~perl_watcher ()
95 {
96 SvREFCNT_dec (cbsv);
97 }
98
99 void cb (SV *cb)
100 {
101 sv_setsv (cbsv, cb);
102 }
103
104 void invoke (const char *type, SV *self, int arg = -1);
105 };
106
107 void
108 perl_watcher::invoke (const char *type, SV *self, int arg)
109 {
110 dSP;
111
112 ENTER;
113 SAVETMPS;
114
115 PUSHMARK (SP);
116
117 XPUSHs (sv_2mortal (self));
118
119 if (arg >= 0)
120 XPUSHs (sv_2mortal (newSViv (arg)));
121
122 PUTBACK;
123 call_sv (cbsv, G_VOID | G_EVAL | G_DISCARD);
124 SPAGAIN;
125
126 PUTBACK;
127 FREETMPS;
128 LEAVE;
129
130 if (SvTRUE (ERRSV))
131 rxvt_warn ("%s callback evaluation error: %s", type, SvPV_nolen (ERRSV));
132 }
133
134 #define newSVtimer(timer) new_ref (timer->self, "urxvt::timer")
135 #define SvTIMER(sv) (timer *)SvPTR (sv, "urxvt::timer")
136
137 struct timer : time_watcher, perl_watcher
138 {
139 timer ()
140 : time_watcher (this, &timer::execute)
141 {
142 }
143
144 void execute (time_watcher &w)
145 {
146 invoke ("urxvt::timer", newSVtimer (this));
147 }
148 };
149
150 #define newSViow(iow) new_ref (iow->self, "urxvt::iow")
151 #define SvIOW(sv) (iow *)SvPTR (sv, "urxvt::iow")
152
153 struct iow : io_watcher, perl_watcher
154 {
155 iow ()
156 : io_watcher (this, &iow::execute)
157 {
158 }
159
160 void execute (io_watcher &w, short revents)
161 {
162 invoke ("urxvt::iow", newSViow (this), revents);
163 }
164 };
165
166 /////////////////////////////////////////////////////////////////////////////
167
168 struct rxvt_perl_interp rxvt_perl;
169
170 static PerlInterpreter *perl;
171
172 rxvt_perl_interp::rxvt_perl_interp ()
173 {
174 }
175
176 rxvt_perl_interp::~rxvt_perl_interp ()
177 {
178 if (perl)
179 {
180 perl_destruct (perl);
181 perl_free (perl);
182 }
183 }
184
185 void
186 rxvt_perl_interp::init ()
187 {
188 if (!perl)
189 {
190 char *argv[] = {
191 "",
192 "-edo '" LIBDIR "/urxvt.pm' or ($@ and die $@) or exit 1",
193 };
194
195 perl = perl_alloc ();
196 perl_construct (perl);
197
198 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL)
199 || perl_run (perl))
200 {
201 rxvt_warn ("unable to initialize perl-interpreter, continuing without.\n");
202
203 perl_destruct (perl);
204 perl_free (perl);
205 perl = 0;
206 }
207 }
208 }
209
210 bool
211 rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...)
212 {
213 if (!perl)
214 return false;
215
216 if (htype == HOOK_INIT) // first hook ever called
217 term->self = (void *)newSVptr ((void *)term, "urxvt::term");
218 else if (htype == HOOK_DESTROY)
219 {
220 // TODO: clear magic
221 hv_clear ((HV *)SvRV ((SV *)term->self));
222 SvREFCNT_dec ((SV *)term->self);
223 }
224
225 if (!should_invoke [htype])
226 return false;
227
228 dSP;
229 va_list ap;
230
231 va_start (ap, htype);
232
233 ENTER;
234 SAVETMPS;
235
236 PUSHMARK (SP);
237
238 XPUSHs (sv_2mortal (newSVterm (term)));
239 XPUSHs (sv_2mortal (newSViv (htype)));
240
241 for (;;) {
242 data_type dt = (data_type)va_arg (ap, int);
243
244 switch (dt)
245 {
246 case DT_INT:
247 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int))));
248 break;
249
250 case DT_LONG:
251 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long))));
252 break;
253
254 case DT_END:
255 {
256 va_end (ap);
257
258 PUTBACK;
259 int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL);
260 SPAGAIN;
261
262 if (count)
263 {
264 SV *status = POPs;
265 count = SvTRUE (status);
266 }
267
268 PUTBACK;
269 FREETMPS;
270 LEAVE;
271
272 if (SvTRUE (ERRSV))
273 rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV));
274
275 return count;
276 }
277
278 default:
279 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt);
280 }
281 }
282 }
283
284 /////////////////////////////////////////////////////////////////////////////
285
286 MODULE = urxvt PACKAGE = urxvt
287
288 PROTOTYPES: ENABLE
289
290 BOOT:
291 {
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);
294 set_hookname (LOAD);
295 set_hookname (INIT);
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);
310
311 sv_setpv (get_sv ("urxvt::LIBDIR", 1), LIBDIR);
312 }
313
314 void
315 set_should_invoke (int htype, int value)
316 CODE:
317 rxvt_perl.should_invoke [htype] = value;
318
319 void
320 warn (const char *msg)
321 CODE:
322 rxvt_warn ("%s", msg);
323
324 void
325 fatal (const char *msg)
326 CODE:
327 rxvt_fatal ("%s", msg);
328
329 NV
330 NOW ()
331 CODE:
332 RETVAL = NOW;
333 OUTPUT:
334 RETVAL
335
336 MODULE = urxvt PACKAGE = urxvt::term
337
338 int
339 rxvt_term::strwidth (SV *str)
340 CODE:
341 {
342 wchar_t *wstr = sv2wcs (str);
343
344 rxvt_push_locale (THIS->locale);
345 RETVAL = wcswidth (wstr, wcslen (wstr));
346 rxvt_pop_locale ();
347
348 free (wstr);
349 }
350 OUTPUT:
351 RETVAL
352
353 SV *
354 rxvt_term::locale_encode (SV *str)
355 CODE:
356 {
357 wchar_t *wstr = sv2wcs (str);
358
359 rxvt_push_locale (THIS->locale);
360 char *mbstr = rxvt_wcstombs (wstr);
361 rxvt_pop_locale ();
362
363 free (wstr);
364
365 RETVAL = newSVpv (mbstr, 0);
366 free (mbstr);
367 }
368 OUTPUT:
369 RETVAL
370
371 SV *
372 rxvt_term::locale_decode (SV *octets)
373 CODE:
374 {
375 STRLEN len;
376 char *data = SvPVbyte (octets, len);
377
378 rxvt_push_locale (THIS->locale);
379 wchar_t *wstr = rxvt_mbstowcs (data, len);
380 rxvt_pop_locale ();
381
382 char *str = rxvt_wcstoutf8 (wstr);
383 free (wstr);
384
385 RETVAL = newSVpv (str, 0);
386 SvUTF8_on (RETVAL);
387 free (str);
388 }
389 OUTPUT:
390 RETVAL
391
392 void
393 rxvt_term::_resource (char *name, int index, SV *newval = 0)
394 PPCODE:
395 {
396 struct resval { const char *name; int value; } rslist [] = {
397 # define Rs_def(name) { # name, Rs_ ## name },
398 # define Rs_reserve(name,count)
399 # include "rsinc.h"
400 # undef Rs_def
401 # undef Rs_reserve
402 };
403
404 struct resval *rs = rslist + sizeof (rslist) / sizeof (rslist [0]);
405
406 do {
407 if (rs-- == rslist)
408 croak ("no such resource '%s', requested", name);
409 } while (strcmp (name, rs->name));
410
411 index += rs->value;
412
413 if (!IN_RANGE_EXC (index, 0, NUM_RESOURCES))
414 croak ("requested out-of-bound resource %s+%d,", name, index - rs->value);
415
416 if (GIMME_V != G_VOID)
417 XPUSHs (THIS->rs [index] ? sv_2mortal (newSVpv (THIS->rs [index], 0)) : &PL_sv_undef);
418
419 if (newval)
420 {
421 if (SvOK (newval))
422 {
423 char *str = strdup (SvPVbyte_nolen (newval));
424 THIS->rs [index] = str;
425 THIS->allocated.push_back (str);
426 }
427 else
428 THIS->rs [index] = 0;
429 }
430 }
431
432 void
433 rxvt_term::selection_mark (...)
434 PROTOTYPE: $;$$
435 ALIAS:
436 selection_beg = 1
437 selection_end = 2
438 PPCODE:
439 {
440 row_col_t &sel = ix == 1 ? THIS->selection.beg
441 : ix == 2 ? THIS->selection.end
442 : THIS->selection.mark;
443
444 if (GIMME_V != G_VOID)
445 {
446 EXTEND (SP, 2);
447 PUSHs (sv_2mortal (newSViv (sel.row)));
448 PUSHs (sv_2mortal (newSViv (sel.col)));
449 }
450
451 if (items == 3)
452 {
453 sel.row = clamp (SvIV (ST (1)), -THIS->nsaved, THIS->nrow - 1);
454 sel.col = clamp (SvIV (ST (2)), 0, THIS->ncol - 1);
455
456 if (ix)
457 THIS->want_refresh = 1;
458 }
459 }
460
461 int
462 rxvt_term::selection_grab (int eventtime)
463
464 void
465 rxvt_term::selection (SV *newtext = 0)
466 PPCODE:
467 {
468 if (GIMME_V != G_VOID)
469 {
470 char *sel = rxvt_wcstoutf8 (THIS->selection.text, THIS->selection.len);
471 SV *sv = newSVpv (sel, 0);
472 SvUTF8_on (sv);
473 free (sel);
474 XPUSHs (sv_2mortal (sv));
475 }
476
477 if (newtext)
478 {
479 free (THIS->selection.text);
480
481 THIS->selection.text = sv2wcs (newtext);
482 THIS->selection.len = wcslen (THIS->selection.text);
483 }
484 }
485
486 void
487 rxvt_term::scr_overlay_new (int x, int y, int w, int h)
488
489 void
490 rxvt_term::scr_overlay_off ()
491
492 void
493 rxvt_term::scr_overlay_set_char (int x, int y, U32 text, U32 rend = OVERLAY_RSTYLE)
494 CODE:
495 THIS->scr_overlay_set (x, y, text, rend);
496
497 void
498 rxvt_term::scr_overlay_set (int x, int y, SV *text)
499 CODE:
500 {
501 wchar_t *wtext = sv2wcs (text);
502 THIS->scr_overlay_set (x, y, wtext);
503 free (wtext);
504 }
505
506 void
507 rxvt_term::tt_write (SV *octets)
508 INIT:
509 STRLEN len;
510 char *str = SvPVbyte (octets, len);
511 C_ARGS:
512 (unsigned char *)str, len
513
514 MODULE = urxvt PACKAGE = urxvt::timer
515
516 SV *
517 timer::new ()
518 CODE:
519 timer *w = new timer;
520 RETVAL = newSVptr ((void *)w, "urxvt::timer");
521 w->self = (HV *)SvRV (RETVAL);
522 OUTPUT:
523 RETVAL
524
525 timer *
526 timer::cb (SV *cb)
527 CODE:
528 THIS->cb (cb);
529 RETVAL = THIS;
530 OUTPUT:
531 RETVAL
532
533 NV
534 timer::at ()
535 CODE:
536 RETVAL = THIS->at;
537 OUTPUT:
538 RETVAL
539
540 timer *
541 timer::set (NV tstamp)
542 CODE:
543 THIS->set (tstamp);
544 RETVAL = THIS;
545 OUTPUT:
546 RETVAL
547
548 timer *
549 timer::start (NV tstamp = THIS->at)
550 CODE:
551 THIS->start (tstamp);
552 RETVAL = THIS;
553 OUTPUT:
554 RETVAL
555
556 timer *
557 timer::stop ()
558 CODE:
559 THIS->stop ();
560 RETVAL = THIS;
561 OUTPUT:
562 RETVAL
563
564 void
565 timer::DESTROY ()
566
567 MODULE = urxvt PACKAGE = urxvt::iow
568
569 SV *
570 iow::new ()
571 CODE:
572 iow *w = new iow;
573 RETVAL = newSVptr ((void *)w, "urxvt::iow");
574 w->self = (HV *)SvRV (RETVAL);
575 OUTPUT:
576 RETVAL
577
578 iow *
579 iow::cb (SV *cb)
580 CODE:
581 THIS->cb (cb);
582 RETVAL = THIS;
583 OUTPUT:
584 RETVAL
585
586 iow *
587 iow::fd (int fd)
588 CODE:
589 THIS->fd = fd;
590 RETVAL = THIS;
591 OUTPUT:
592 RETVAL
593
594 iow *
595 iow::events (short events)
596 CODE:
597 THIS->events = events;
598 RETVAL = THIS;
599 OUTPUT:
600 RETVAL
601
602 iow *
603 iow::start ()
604 CODE:
605 THIS->start ();
606 RETVAL = THIS;
607 OUTPUT:
608 RETVAL
609
610 iow *
611 iow::stop ()
612 CODE:
613 THIS->stop ();
614 RETVAL = THIS;
615 OUTPUT:
616 RETVAL
617
618 void
619 iow::DESTROY ()
620
621