ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/rxvtperl.xs
Revision: 1.11
Committed: Tue Jan 3 02:01:27 2006 UTC (18 years, 5 months ago) by root
Branch: MAIN
Changes since 1.10: +36 -1 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 #undef LINENO
41 #define LINENO(n) MOD (THIS->term_start + int(n), THIS->total_rows)
42 #undef ROW
43 #define ROW(n) THIS->row_buf [LINENO (n)]
44
45 /////////////////////////////////////////////////////////////////////////////
46
47 static wchar_t *
48 sv2wcs (SV *sv)
49 {
50 STRLEN len;
51 char *str = SvPVutf8 (sv, len);
52 return rxvt_utf8towcs (str, len);
53 }
54
55 static SV *
56 new_ref (HV *hv, const char *klass)
57 {
58 return sv_bless (newRV ((SV *)hv), gv_stashpv (klass, 1));
59 }
60
61 //TODO: use magic
62 static SV *
63 newSVptr (void *ptr, const char *klass)
64 {
65 HV *hv = newHV ();
66 hv_store (hv, "_ptr", 4, newSViv ((long)ptr), 0);
67 return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
68 }
69
70 static long
71 SvPTR (SV *sv, const char *klass)
72 {
73 if (!sv_derived_from (sv, klass))
74 croak ("object of type %s expected", klass);
75
76 IV iv = SvIV (*hv_fetch ((HV *)SvRV (sv), "_ptr", 4, 1));
77
78 if (!iv)
79 croak ("perl code used %s object, but C++ object is already destroyed, caught", klass);
80
81 return (long)iv;
82 }
83
84 #define newSVterm(term) SvREFCNT_inc ((SV *)term->self)
85 #define SvTERM(sv) (rxvt_term *)SvPTR (sv, "urxvt::term")
86
87 /////////////////////////////////////////////////////////////////////////////
88
89 struct perl_watcher
90 {
91 SV *cbsv;
92 HV *self;
93
94 perl_watcher ()
95 : cbsv (newSV (0))
96 {
97 }
98
99 ~perl_watcher ()
100 {
101 SvREFCNT_dec (cbsv);
102 }
103
104 void cb (SV *cb)
105 {
106 sv_setsv (cbsv, cb);
107 }
108
109 void invoke (const char *type, SV *self, int arg = -1);
110 };
111
112 void
113 perl_watcher::invoke (const char *type, SV *self, int arg)
114 {
115 dSP;
116
117 ENTER;
118 SAVETMPS;
119
120 PUSHMARK (SP);
121
122 XPUSHs (sv_2mortal (self));
123
124 if (arg >= 0)
125 XPUSHs (sv_2mortal (newSViv (arg)));
126
127 PUTBACK;
128 call_sv (cbsv, G_VOID | G_EVAL | G_DISCARD);
129 SPAGAIN;
130
131 PUTBACK;
132 FREETMPS;
133 LEAVE;
134
135 if (SvTRUE (ERRSV))
136 rxvt_warn ("%s callback evaluation error: %s", type, SvPV_nolen (ERRSV));
137 }
138
139 #define newSVtimer(timer) new_ref (timer->self, "urxvt::timer")
140 #define SvTIMER(sv) (timer *)SvPTR (sv, "urxvt::timer")
141
142 struct timer : time_watcher, perl_watcher
143 {
144 timer ()
145 : time_watcher (this, &timer::execute)
146 {
147 }
148
149 void execute (time_watcher &w)
150 {
151 invoke ("urxvt::timer", newSVtimer (this));
152 }
153 };
154
155 #define newSViow(iow) new_ref (iow->self, "urxvt::iow")
156 #define SvIOW(sv) (iow *)SvPTR (sv, "urxvt::iow")
157
158 struct iow : io_watcher, perl_watcher
159 {
160 iow ()
161 : io_watcher (this, &iow::execute)
162 {
163 }
164
165 void execute (io_watcher &w, short revents)
166 {
167 invoke ("urxvt::iow", newSViow (this), revents);
168 }
169 };
170
171 /////////////////////////////////////////////////////////////////////////////
172
173 struct rxvt_perl_interp rxvt_perl;
174
175 static PerlInterpreter *perl;
176
177 rxvt_perl_interp::rxvt_perl_interp ()
178 {
179 }
180
181 rxvt_perl_interp::~rxvt_perl_interp ()
182 {
183 if (perl)
184 {
185 perl_destruct (perl);
186 perl_free (perl);
187 }
188 }
189
190 void
191 rxvt_perl_interp::init ()
192 {
193 if (!perl)
194 {
195 char *argv[] = {
196 "",
197 "-edo '" LIBDIR "/urxvt.pm' or ($@ and die $@) or exit 1",
198 };
199
200 perl = perl_alloc ();
201 perl_construct (perl);
202
203 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL)
204 || perl_run (perl))
205 {
206 rxvt_warn ("unable to initialize perl-interpreter, continuing without.\n");
207
208 perl_destruct (perl);
209 perl_free (perl);
210 perl = 0;
211 }
212 }
213 }
214
215 bool
216 rxvt_perl_interp::invoke (rxvt_term *term, hook_type htype, ...)
217 {
218 if (!perl
219 || (!should_invoke [htype] && htype != HOOK_INIT && htype != HOOK_DESTROY))
220 return false;
221
222 if (htype == HOOK_INIT) // first hook ever called
223 term->self = (void *)newSVptr ((void *)term, "urxvt::term");
224
225 dSP;
226 va_list ap;
227
228 va_start (ap, htype);
229
230 ENTER;
231 SAVETMPS;
232
233 PUSHMARK (SP);
234
235 XPUSHs (sv_2mortal (newSVterm (term)));
236 XPUSHs (sv_2mortal (newSViv (htype)));
237
238 for (;;) {
239 data_type dt = (data_type)va_arg (ap, int);
240
241 switch (dt)
242 {
243 case DT_INT:
244 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int))));
245 break;
246
247 case DT_LONG:
248 XPUSHs (sv_2mortal (newSViv (va_arg (ap, long))));
249 break;
250
251 case DT_STRING:
252 XPUSHs (sv_2mortal (newSVpv (va_arg (ap, char *), 0)));
253 break;
254
255 case DT_END:
256 {
257 va_end (ap);
258
259 PUTBACK;
260 int count = call_pv ("urxvt::invoke", G_ARRAY | G_EVAL);
261 SPAGAIN;
262
263 if (count)
264 {
265 SV *status = POPs;
266 count = SvTRUE (status);
267 }
268
269 PUTBACK;
270 FREETMPS;
271 LEAVE;
272
273 if (SvTRUE (ERRSV))
274 rxvt_warn ("perl hook %d evaluation error: %s", htype, SvPV_nolen (ERRSV));
275
276 if (htype == HOOK_DESTROY)
277 {
278 // TODO: clear magic
279 hv_clear ((HV *)SvRV ((SV *)term->self));
280 SvREFCNT_dec ((SV *)term->self);
281 }
282
283 return count;
284 }
285
286 default:
287 rxvt_fatal ("FATAL: unable to pass data type %d\n", dt);
288 }
289 }
290 }
291
292 /////////////////////////////////////////////////////////////////////////////
293
294 MODULE = urxvt PACKAGE = urxvt
295
296 PROTOTYPES: ENABLE
297
298 BOOT:
299 {
300 # define set_hookname(sym) av_store (hookname, PP_CONCAT(HOOK_, sym), newSVpv (PP_STRINGIFY(sym), 0))
301 # define export_const(name) newCONSTSUB (gv_stashpv ("urxvt", 1), #name, newSViv (name));
302 AV *hookname = get_av ("urxvt::HOOKNAME", 1);
303 set_hookname (INIT);
304 set_hookname (RESET);
305 set_hookname (START);
306 set_hookname (DESTROY);
307 set_hookname (SEL_BEGIN);
308 set_hookname (SEL_EXTEND);
309 set_hookname (SEL_MAKE);
310 set_hookname (SEL_GRAB);
311 set_hookname (FOCUS_IN);
312 set_hookname (FOCUS_OUT);
313 set_hookname (VIEW_CHANGE);
314 set_hookname (SCROLL_BACK);
315 set_hookname (TTY_ACTIVITY);
316 set_hookname (REFRESH_BEGIN);
317 set_hookname (REFRESH_END);
318 set_hookname (KEYBOARD_COMMAND);
319
320 export_const (DEFAULT_RSTYLE);
321 export_const (OVERLAY_RSTYLE);
322 export_const (RS_Bold);
323 export_const (RS_Italic);
324 export_const (RS_Blink);
325 export_const (RS_RVid);
326 export_const (RS_Uline);
327
328 sv_setpv (get_sv ("urxvt::LIBDIR", 1), LIBDIR);
329 }
330
331 void
332 set_should_invoke (int htype, int value)
333 CODE:
334 rxvt_perl.should_invoke [htype] = value;
335
336 void
337 warn (const char *msg)
338 CODE:
339 rxvt_warn ("%s", msg);
340
341 void
342 fatal (const char *msg)
343 CODE:
344 rxvt_fatal ("%s", msg);
345
346 NV
347 NOW ()
348 CODE:
349 RETVAL = NOW;
350 OUTPUT:
351 RETVAL
352
353 int
354 GET_BASEFG (int rend)
355 CODE:
356 RETVAL = GET_BASEFG (rend);
357 OUTPUT:
358 RETVAL
359
360 int
361 GET_BASEBG (int rend)
362 CODE:
363 RETVAL = GET_BASEBG (rend);
364 OUTPUT:
365 RETVAL
366
367 int
368 SET_FGCOLOR (int rend, int color)
369 CODE:
370 RETVAL = SET_FGCOLOR (rend, color);
371 OUTPUT:
372 RETVAL
373
374 int
375 SET_BGCOLOR (int rend, int color)
376 CODE:
377 RETVAL = SET_BGCOLOR (rend, color);
378 OUTPUT:
379 RETVAL
380
381 MODULE = urxvt PACKAGE = urxvt::term
382
383 int
384 rxvt_term::strwidth (SV *str)
385 CODE:
386 {
387 wchar_t *wstr = sv2wcs (str);
388
389 rxvt_push_locale (THIS->locale);
390 RETVAL = wcswidth (wstr, wcslen (wstr));
391 rxvt_pop_locale ();
392
393 free (wstr);
394 }
395 OUTPUT:
396 RETVAL
397
398 SV *
399 rxvt_term::locale_encode (SV *str)
400 CODE:
401 {
402 wchar_t *wstr = sv2wcs (str);
403
404 rxvt_push_locale (THIS->locale);
405 char *mbstr = rxvt_wcstombs (wstr);
406 rxvt_pop_locale ();
407
408 free (wstr);
409
410 RETVAL = newSVpv (mbstr, 0);
411 free (mbstr);
412 }
413 OUTPUT:
414 RETVAL
415
416 SV *
417 rxvt_term::locale_decode (SV *octets)
418 CODE:
419 {
420 STRLEN len;
421 char *data = SvPVbyte (octets, len);
422
423 rxvt_push_locale (THIS->locale);
424 wchar_t *wstr = rxvt_mbstowcs (data, len);
425 rxvt_pop_locale ();
426
427 char *str = rxvt_wcstoutf8 (wstr);
428 free (wstr);
429
430 RETVAL = newSVpv (str, 0);
431 SvUTF8_on (RETVAL);
432 free (str);
433 }
434 OUTPUT:
435 RETVAL
436
437 int
438 rxvt_term::nsaved ()
439 CODE:
440 RETVAL = THIS->nsaved;
441 OUTPUT:
442 RETVAL
443
444 int
445 rxvt_term::view_start (int newval = -1)
446 CODE:
447 {
448 RETVAL = THIS->view_start;
449
450 if (newval >= 0)
451 {
452 THIS->view_start = min (newval, THIS->nsaved);
453 THIS->scr_changeview (RETVAL);
454 }
455 }
456 OUTPUT:
457 RETVAL
458
459 int
460 rxvt_term::nrow ()
461 CODE:
462 RETVAL = THIS->nrow;
463 OUTPUT:
464 RETVAL
465
466 int
467 rxvt_term::ncol ()
468 CODE:
469 RETVAL = THIS->ncol;
470 OUTPUT:
471 RETVAL
472
473 void
474 rxvt_term::want_refresh ()
475 CODE:
476 THIS->want_refresh = 1;
477
478 void
479 rxvt_term::ROW_t (int row_number, SV *new_text = 0, int start_col = 0)
480 PPCODE:
481 {
482 if (!IN_RANGE_EXC (row_number, -THIS->nsaved, THIS->nrow))
483 croak ("row_number number of out range");
484
485 line_t &l = ROW(row_number);
486
487 if (GIMME_V != G_VOID)
488 {
489 wchar_t *wstr = new wchar_t [THIS->ncol];
490
491 for (int col = 0; col <THIS->ncol; col++)
492 wstr [col] = l.t [col];
493
494 char *str = rxvt_wcstoutf8 (wstr, THIS->ncol);
495 free (wstr);
496
497 SV *sv = newSVpv (str, 0);
498 SvUTF8_on (sv);
499 XPUSHs (sv_2mortal (sv));
500 free (str);
501 }
502
503 if (new_text)
504 {
505 STRLEN slen;
506 char *str = SvPVutf8 (new_text, slen);
507 wchar_t *wstr = rxvt_utf8towcs (str, slen);
508
509 int len = wcslen (wstr);
510
511 if (!IN_RANGE_INC (start_col, 0, THIS->ncol - len))
512 {
513 free (wstr);
514 croak ("new_text extends beyond horizontal margins");
515 }
516
517 for (int col = start_col; col < start_col + len; col++)
518 {
519 l.t [col] = wstr [col - start_col];
520 l.r [col] = SET_FONT (l.r [col], THIS->fontset [GET_STYLE (l.r [col])]->find_font (l.t [col]));
521 }
522
523 free (wstr);
524 }
525 }
526
527 void
528 rxvt_term::ROW_r (int row_number, SV *new_rend = 0, int start_col = 0)
529 PPCODE:
530 {
531 if (!IN_RANGE_EXC (row_number, -THIS->nsaved, THIS->nrow))
532 croak ("row_number number of out range");
533
534 line_t &l = ROW(row_number);
535
536 if (GIMME_V != G_VOID)
537 {
538 AV *av = newAV ();
539
540 av_extend (av, THIS->ncol - 1);
541 for (int col = 0; col < THIS->ncol; col++)
542 av_store (av, col, newSViv (l.r [col]));
543
544 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
545 }
546
547 if (new_rend)
548 {
549 if (!SvROK (new_rend) || SvTYPE (SvRV (new_rend)) != SVt_PVAV)
550 croak ("new_rend must be arrayref");
551
552 AV *av = (AV *)SvRV (new_rend);
553 int len = av_len (av) + 1;
554
555 if (!IN_RANGE_INC (start_col, 0, THIS->ncol - len))
556 croak ("new_rend array extends beyond horizontal margins");
557
558 for (int col = start_col; col < start_col + len; col++)
559 {
560 rend_t r = SvIV (*av_fetch (av, col - start_col, 1)) & ~RS_fontMask;
561
562 l.r [col] = SET_FONT (r, THIS->fontset [GET_STYLE (r)]->find_font (l.t [col]));
563 }
564 }
565 }
566
567 int
568 rxvt_term::ROW_l (int row_number, int new_length = -2)
569 CODE:
570 {
571 if (!IN_RANGE_EXC (row_number, -THIS->nsaved, THIS->nrow))
572 croak ("row_number number of out range");
573
574 line_t &l = ROW(row_number);
575 RETVAL = l.l;
576
577 if (new_length >= -1)
578 l.l = new_length;
579 }
580 OUTPUT:
581 RETVAL
582
583 SV *
584 rxvt_term::special_encode (SV *str)
585 CODE:
586 abort ();//TODO
587
588 SV *
589 rxvt_term::special_decode (SV *str)
590 CODE:
591 abort ();//TODO
592
593 void
594 rxvt_term::_resource (char *name, int index, SV *newval = 0)
595 PPCODE:
596 {
597 struct resval { const char *name; int value; } rslist [] = {
598 # define Rs_def(name) { # name, Rs_ ## name },
599 # define Rs_reserve(name,count)
600 # include "rsinc.h"
601 # undef Rs_def
602 # undef Rs_reserve
603 };
604
605 struct resval *rs = rslist + sizeof (rslist) / sizeof (rslist [0]);
606
607 do {
608 if (rs-- == rslist)
609 croak ("no such resource '%s', requested", name);
610 } while (strcmp (name, rs->name));
611
612 index += rs->value;
613
614 if (!IN_RANGE_EXC (index, 0, NUM_RESOURCES))
615 croak ("requested out-of-bound resource %s+%d,", name, index - rs->value);
616
617 if (GIMME_V != G_VOID)
618 XPUSHs (THIS->rs [index] ? sv_2mortal (newSVpv (THIS->rs [index], 0)) : &PL_sv_undef);
619
620 if (newval)
621 {
622 if (SvOK (newval))
623 {
624 char *str = strdup (SvPVbyte_nolen (newval));
625 THIS->rs [index] = str;
626 THIS->allocated.push_back (str);
627 }
628 else
629 THIS->rs [index] = 0;
630 }
631 }
632
633 void
634 rxvt_term::selection_mark (...)
635 PROTOTYPE: $;$$
636 ALIAS:
637 selection_beg = 1
638 selection_end = 2
639 PPCODE:
640 {
641 row_col_t &sel = ix == 1 ? THIS->selection.beg
642 : ix == 2 ? THIS->selection.end
643 : THIS->selection.mark;
644
645 if (GIMME_V != G_VOID)
646 {
647 EXTEND (SP, 2);
648 PUSHs (sv_2mortal (newSViv (sel.row)));
649 PUSHs (sv_2mortal (newSViv (sel.col)));
650 }
651
652 if (items == 3)
653 {
654 sel.row = clamp (SvIV (ST (1)), -THIS->nsaved, THIS->nrow - 1);
655 sel.col = clamp (SvIV (ST (2)), 0, THIS->ncol - 1);
656
657 if (ix)
658 THIS->want_refresh = 1;
659 }
660 }
661
662 int
663 rxvt_term::selection_grab (int eventtime)
664
665 void
666 rxvt_term::selection (SV *newtext = 0)
667 PPCODE:
668 {
669 if (GIMME_V != G_VOID)
670 {
671 char *sel = rxvt_wcstoutf8 (THIS->selection.text, THIS->selection.len);
672 SV *sv = newSVpv (sel, 0);
673 SvUTF8_on (sv);
674 free (sel);
675 XPUSHs (sv_2mortal (sv));
676 }
677
678 if (newtext)
679 {
680 free (THIS->selection.text);
681
682 THIS->selection.text = sv2wcs (newtext);
683 THIS->selection.len = wcslen (THIS->selection.text);
684 }
685 }
686
687 void
688 rxvt_term::scr_overlay_new (int x, int y, int w, int h)
689
690 void
691 rxvt_term::scr_overlay_off ()
692
693 void
694 rxvt_term::scr_overlay_set_char (int x, int y, U32 text, U32 rend = OVERLAY_RSTYLE)
695 CODE:
696 THIS->scr_overlay_set (x, y, text, rend);
697
698 void
699 rxvt_term::scr_overlay_set (int x, int y, SV *text)
700 CODE:
701 {
702 wchar_t *wtext = sv2wcs (text);
703 THIS->scr_overlay_set (x, y, wtext);
704 free (wtext);
705 }
706
707 void
708 rxvt_term::tt_write (SV *octets)
709 INIT:
710 STRLEN len;
711 char *str = SvPVbyte (octets, len);
712 C_ARGS:
713 (unsigned char *)str, len
714
715 MODULE = urxvt PACKAGE = urxvt::timer
716
717 SV *
718 timer::new ()
719 CODE:
720 timer *w = new timer;
721 RETVAL = newSVptr ((void *)w, "urxvt::timer");
722 w->self = (HV *)SvRV (RETVAL);
723 OUTPUT:
724 RETVAL
725
726 timer *
727 timer::cb (SV *cb)
728 CODE:
729 THIS->cb (cb);
730 RETVAL = THIS;
731 OUTPUT:
732 RETVAL
733
734 NV
735 timer::at ()
736 CODE:
737 RETVAL = THIS->at;
738 OUTPUT:
739 RETVAL
740
741 timer *
742 timer::set (NV tstamp)
743 CODE:
744 THIS->set (tstamp);
745 RETVAL = THIS;
746 OUTPUT:
747 RETVAL
748
749 timer *
750 timer::start (NV tstamp = THIS->at)
751 CODE:
752 THIS->start (tstamp);
753 RETVAL = THIS;
754 OUTPUT:
755 RETVAL
756
757 timer *
758 timer::stop ()
759 CODE:
760 THIS->stop ();
761 RETVAL = THIS;
762 OUTPUT:
763 RETVAL
764
765 void
766 timer::DESTROY ()
767
768 MODULE = urxvt PACKAGE = urxvt::iow
769
770 SV *
771 iow::new ()
772 CODE:
773 iow *w = new iow;
774 RETVAL = newSVptr ((void *)w, "urxvt::iow");
775 w->self = (HV *)SvRV (RETVAL);
776 OUTPUT:
777 RETVAL
778
779 iow *
780 iow::cb (SV *cb)
781 CODE:
782 THIS->cb (cb);
783 RETVAL = THIS;
784 OUTPUT:
785 RETVAL
786
787 iow *
788 iow::fd (int fd)
789 CODE:
790 THIS->fd = fd;
791 RETVAL = THIS;
792 OUTPUT:
793 RETVAL
794
795 iow *
796 iow::events (short events)
797 CODE:
798 THIS->events = events;
799 RETVAL = THIS;
800 OUTPUT:
801 RETVAL
802
803 iow *
804 iow::start ()
805 CODE:
806 THIS->start ();
807 RETVAL = THIS;
808 OUTPUT:
809 RETVAL
810
811 iow *
812 iow::stop ()
813 CODE:
814 THIS->stop ();
815 RETVAL = THIS;
816 OUTPUT:
817 RETVAL
818
819 void
820 iow::DESTROY ()
821
822