src/rxvtperl.xs

   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   AV *hookname = get_av ("urxvt::HOOKNAME", 1);
 302   set_hookname (INIT);
 303   set_hookname (RESET);
 304   set_hookname (START);
 305   set_hookname (DESTROY);
 306   set_hookname (SEL_BEGIN);
 307   set_hookname (SEL_EXTEND);
 308   set_hookname (SEL_MAKE);
 309   set_hookname (SEL_GRAB);
 310   set_hookname (FOCUS_IN);
 311   set_hookname (FOCUS_OUT);
 312   set_hookname (VIEW_CHANGE);
 313   set_hookname (SCROLL_BACK);
 314   set_hookname (TTY_ACTIVITY);
 315   set_hookname (REFRESH_BEGIN);
 316   set_hookname (REFRESH_END);
 317   set_hookname (KEYBOARD_COMMAND);
 318
 319   sv_setpv (get_sv ("urxvt::LIBDIR", 1), LIBDIR);
 320 }
 321
 322 void
 323 set_should_invoke (int htype, int value)
 324         CODE:
 325         rxvt_perl.should_invoke [htype] = value;
 326
 327 void
 328 warn (const char *msg)
 329         CODE:
 330         rxvt_warn ("%s", msg);
 331
 332 void
 333 fatal (const char *msg)
 334         CODE:
 335         rxvt_fatal ("%s", msg);
 336
 337 NV
 338 NOW ()
 339         CODE:
 340         RETVAL = NOW;
 341         OUTPUT:
 342         RETVAL
 343
 344 MODULE = urxvt             PACKAGE = urxvt::term
 345
 346 int
 347 rxvt_term::strwidth (SV *str)
 348         CODE:
 349 {
 350         wchar_t *wstr = sv2wcs (str);
 351
 352         rxvt_push_locale (THIS->locale);
 353         RETVAL = wcswidth (wstr, wcslen (wstr));
 354         rxvt_pop_locale ();
 355
 356         free (wstr);
 357 }
 358         OUTPUT:
 359         RETVAL
 360
 361 SV *
 362 rxvt_term::locale_encode (SV *str)
 363         CODE:
 364 {
 365         wchar_t *wstr = sv2wcs (str);
 366
 367         rxvt_push_locale (THIS->locale);
 368         char *mbstr = rxvt_wcstombs (wstr);
 369         rxvt_pop_locale ();
 370
 371         free (wstr);
 372
 373         RETVAL = newSVpv (mbstr, 0);
 374         free (mbstr);
 375 }
 376         OUTPUT:
 377         RETVAL
 378
 379 SV *
 380 rxvt_term::locale_decode (SV *octets)
 381         CODE:
 382 {
 383         STRLEN len;
 384         char *data = SvPVbyte (octets, len);
 385
 386         rxvt_push_locale (THIS->locale);
 387         wchar_t *wstr = rxvt_mbstowcs (data, len);
 388         rxvt_pop_locale ();
 389
 390         char *str = rxvt_wcstoutf8 (wstr);
 391         free (wstr);
 392
 393         RETVAL = newSVpv (str, 0);
 394         SvUTF8_on (RETVAL);
 395         free (str);
 396 }
 397         OUTPUT:
 398         RETVAL
 399
 400 int
 401 rxvt_term::nsaved ()
 402         CODE:
 403         RETVAL = THIS->nsaved;
 404         OUTPUT:
 405         RETVAL
 406
 407 int
 408 rxvt_term::view_start (int newval = -1)
 409         CODE:
 410 {
 411         RETVAL = THIS->view_start;
 412
 413         if (newval >= 0)
 414           {
 415             THIS->view_start = min (newval, THIS->nsaved);
 416             THIS->scr_changeview (RETVAL);
 417           }
 418 }
 419         OUTPUT:
 420         RETVAL
 421
 422 int
 423 rxvt_term::nrow ()
 424         CODE:
 425         RETVAL = THIS->nrow;
 426         OUTPUT:
 427         RETVAL
 428
 429 int
 430 rxvt_term::ncol ()
 431         CODE:
 432         RETVAL = THIS->ncol;
 433         OUTPUT:
 434         RETVAL
 435
 436 void
 437 rxvt_term::ROW_t (int row_number, SV *new_text = 0, int start_col = 0)
 438         PPCODE:
 439 {
 440         if (!IN_RANGE_EXC (row_number, -THIS->nsaved, THIS->nrow))
 441           croak ("row_number number of out range");
 442
 443         line_t &l = ROW(row_number);
 444
 445         if (GIMME_V != G_VOID)
 446           {
 447             wchar_t *wstr = new wchar_t [THIS->ncol];
 448
 449             for (int col = 0; col <THIS->ncol; col++)
 450               wstr [col] = l.t [col];
 451
 452             char *str = rxvt_wcstoutf8 (wstr, THIS->ncol);
 453             free (wstr);
 454
 455             SV *sv = newSVpv (str, 0);
 456             SvUTF8_on (sv);
 457             XPUSHs (sv_2mortal (sv));
 458             free (str);
 459           }
 460
 461         if (new_text)
 462           {
 463             STRLEN slen;
 464             char *str = SvPVutf8 (new_text, slen);
 465             wchar_t *wstr = rxvt_utf8towcs (str, slen);
 466
 467             int len = wcslen (wstr);
 468
 469             if (start_col + len > THIS->ncol)
 470               {
 471                 free (wstr);
 472                 croak ("new_text extends beyond right margin");
 473               }
 474
 475             for (int col = start_col; col < start_col + len; col++)
 476               {
 477                 l.t [col] = wstr [col];
 478                 l.r [col] = SET_FONT (l.r [col], THIS->fontset [GET_STYLE (l.r [col])]->find_font (l.t [col]));
 479               }
 480           }
 481 }
 482
 483 void
 484 rxvt_term::ROW_r (int row_number, SV *new_rend = 0, int start_col = 0)
 485         PPCODE:
 486 {
 487         if (!IN_RANGE_EXC (row_number, -THIS->nsaved, THIS->nrow))
 488           croak ("row_number number of out range");
 489
 490         line_t &l = ROW(row_number);
 491
 492         if (GIMME_V != G_VOID)
 493           {
 494             AV *av = newAV ();
 495
 496             av_extend (av, THIS->ncol - 1);
 497             for (int col = 0; col < THIS->ncol; col++)
 498               av_store (av, col, newSViv (l.r [col]));
 499
 500             XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
 501           }
 502
 503         if (new_rend)
 504           {
 505             if (!SvROK (new_rend) || SvTYPE (SvRV (new_rend)) != SVt_PVAV)
 506               croak ("new_rend must be arrayref");
 507
 508             AV *av = (AV *)SvRV (new_rend);
 509             int len = av_len (av) + 1;
 510
 511             if (start_col + len > THIS->ncol)
 512               croak ("new_rend array extends beyond right margin");
 513
 514             for (int col = start_col; col < start_col + len; col++)
 515               {
 516                 rend_t r = SvIV (*av_fetch (av, col, 1)) & ~RS_fontMask;
 517
 518                 l.r [col] = SET_FONT (r, THIS->fontset [GET_STYLE (r)]->find_font (l.t [col]));
 519               }
 520           }
 521 }
 522
 523 int
 524 rxvt_term::ROW_l (int row_number, int new_length = -2)
 525         CODE:
 526 {
 527         if (!IN_RANGE_EXC (row_number, -THIS->nsaved, THIS->nrow))
 528           croak ("row_number number of out range");
 529
 530         line_t &l = ROW(row_number);
 531         RETVAL = l.l;
 532
 533         if (new_length >= -1)
 534           l.l = new_length;
 535 }
 536         OUTPUT:
 537         RETVAL
 538
 539 SV *
 540 rxvt_term::special_encode (SV *str)
 541         CODE:
 542         abort ();//TODO
 543
 544 SV *
 545 rxvt_term::special_decode (SV *str)
 546         CODE:
 547         abort ();//TODO
 548
 549 void
 550 rxvt_term::_resource (char *name, int index, SV *newval = 0)
 551         PPCODE:
 552 {
 553         struct resval { const char *name; int value; } rslist [] = {
 554 #         define Rs_def(name) { # name, Rs_ ## name },
 555 #         define Rs_reserve(name,count)
 556 #         include "rsinc.h"
 557 #         undef Rs_def
 558 #         undef Rs_reserve
 559         };
 560
 561         struct resval *rs = rslist + sizeof (rslist) / sizeof (rslist [0]);
 562
 563         do {
 564           if (rs-- == rslist)
 565             croak ("no such resource '%s', requested", name);
 566         } while (strcmp (name, rs->name));
 567
 568         index += rs->value;
 569
 570         if (!IN_RANGE_EXC (index, 0, NUM_RESOURCES))
 571           croak ("requested out-of-bound resource %s+%d,", name, index - rs->value);
 572
 573         if (GIMME_V != G_VOID)
 574           XPUSHs (THIS->rs [index] ? sv_2mortal (newSVpv (THIS->rs [index], 0)) : &PL_sv_undef);
 575
 576         if (newval)
 577           {
 578             if (SvOK (newval))
 579               {
 580                 char *str = strdup (SvPVbyte_nolen (newval));
 581                 THIS->rs [index] = str;
 582                 THIS->allocated.push_back (str);
 583               }
 584             else
 585               THIS->rs [index] = 0;
 586           }
 587 }
 588
 589 void
 590 rxvt_term::selection_mark (...)
 591         PROTOTYPE: $;$$
 592         ALIAS:
 593            selection_beg = 1
 594            selection_end = 2
 595         PPCODE:
 596 {
 597         row_col_t &sel = ix == 1 ? THIS->selection.beg
 598                        : ix == 2 ? THIS->selection.end
 599                        :           THIS->selection.mark;
 600
 601         if (GIMME_V != G_VOID)
 602           {
 603             EXTEND (SP, 2);
 604             PUSHs (sv_2mortal (newSViv (sel.row)));
 605             PUSHs (sv_2mortal (newSViv (sel.col)));
 606           }
 607
 608         if (items == 3)
 609           {
 610             sel.row = clamp (SvIV (ST (1)), -THIS->nsaved, THIS->nrow - 1);
 611             sel.col = clamp (SvIV (ST (2)), 0, THIS->ncol - 1);
 612
 613             if (ix)
 614               THIS->want_refresh = 1;
 615           }
 616 }
 617
 618 int
 619 rxvt_term::selection_grab (int eventtime)
 620
 621 void
 622 rxvt_term::selection (SV *newtext = 0)
 623         PPCODE:
 624 {
 625         if (GIMME_V != G_VOID)
 626           {
 627             char *sel = rxvt_wcstoutf8 (THIS->selection.text, THIS->selection.len);
 628             SV *sv = newSVpv (sel, 0);
 629             SvUTF8_on (sv);
 630             free (sel);
 631             XPUSHs (sv_2mortal (sv));
 632           }
 633
 634         if (newtext)
 635           {
 636             free (THIS->selection.text);
 637
 638             THIS->selection.text = sv2wcs (newtext);
 639             THIS->selection.len = wcslen (THIS->selection.text);
 640           }
 641 }
 642
 643 void
 644 rxvt_term::scr_overlay_new (int x, int y, int w, int h)
 645
 646 void
 647 rxvt_term::scr_overlay_off ()
 648
 649 void
 650 rxvt_term::scr_overlay_set_char (int x, int y, U32 text, U32 rend = OVERLAY_RSTYLE)
 651         CODE:
 652         THIS->scr_overlay_set (x, y, text, rend);
 653
 654 void
 655 rxvt_term::scr_overlay_set (int x, int y, SV *text)
 656         CODE:
 657 {
 658         wchar_t *wtext = sv2wcs (text);
 659         THIS->scr_overlay_set (x, y, wtext);
 660         free (wtext);
 661 }
 662
 663 void
 664 rxvt_term::tt_write (SV *octets)
 665         INIT:
 666           STRLEN len;
 667           char *str = SvPVbyte (octets, len);
 668         C_ARGS:
 669           (unsigned char *)str, len
 670
 671 MODULE = urxvt             PACKAGE = urxvt::timer
 672
 673 SV *
 674 timer::new ()
 675         CODE:
 676         timer *w =  new timer;
 677         RETVAL = newSVptr ((void *)w, "urxvt::timer");
 678         w->self = (HV *)SvRV (RETVAL);
 679         OUTPUT:
 680         RETVAL
 681
 682 timer *
 683 timer::cb (SV *cb)
 684         CODE:
 685         THIS->cb (cb);
 686         RETVAL = THIS;
 687         OUTPUT:
 688         RETVAL
 689
 690 NV
 691 timer::at ()
 692         CODE:
 693         RETVAL = THIS->at;
 694         OUTPUT:
 695         RETVAL
 696
 697 timer *
 698 timer::set (NV tstamp)
 699         CODE:
 700         THIS->set (tstamp);
 701         RETVAL = THIS;
 702         OUTPUT:
 703         RETVAL
 704
 705 timer *
 706 timer::start (NV tstamp = THIS->at)
 707         CODE:
 708         THIS->start (tstamp);
 709         RETVAL = THIS;
 710         OUTPUT:
 711         RETVAL
 712
 713 timer *
 714 timer::stop ()
 715         CODE:
 716         THIS->stop ();
 717         RETVAL = THIS;
 718         OUTPUT:
 719         RETVAL
 720
 721 void
 722 timer::DESTROY ()
 723
 724 MODULE = urxvt             PACKAGE = urxvt::iow
 725
 726 SV *
 727 iow::new ()
 728         CODE:
 729         iow *w =  new iow;
 730         RETVAL = newSVptr ((void *)w, "urxvt::iow");
 731         w->self = (HV *)SvRV (RETVAL);
 732         OUTPUT:
 733         RETVAL
 734
 735 iow *
 736 iow::cb (SV *cb)
 737         CODE:
 738         THIS->cb (cb);
 739         RETVAL = THIS;
 740         OUTPUT:
 741         RETVAL
 742
 743 iow *
 744 iow::fd (int fd)
 745         CODE:
 746         THIS->fd = fd;
 747         RETVAL = THIS;
 748         OUTPUT:
 749         RETVAL
 750
 751 iow *
 752 iow::events (short events)
 753         CODE:
 754         THIS->events = events;
 755         RETVAL = THIS;
 756         OUTPUT:
 757         RETVAL
 758
 759 iow *
 760 iow::start ()
 761         CODE:
 762         THIS->start ();
 763         RETVAL = THIS;
 764         OUTPUT:
 765         RETVAL
 766
 767 iow *
 768 iow::stop ()
 769         CODE:
 770         THIS->stop ();
 771         RETVAL = THIS;
 772         OUTPUT:
 773         RETVAL
 774
 775 void
 776 iow::DESTROY ()
 777
 778