perl_api/perl.xs

   1 /*-
   2  * Copyright (c) 1992, 1993, 1994
   3  *      The Regents of the University of California.  All rights reserved.
   4  * Copyright (c) 1992, 1993, 1994, 1995, 1996
   5  *      Keith Bostic.  All rights reserved.
   6  * Copyright (c) 1995
   7  *      George V. Neville-Neil. All rights reserved.
   8  * Copyright (c) 1996
   9  *      Sven Verdoolaege. All rights reserved.
  10  *
  11  * See the LICENSE file for redistribution information.
  12  */
  13
  14 #undef VI
  15
  16 #ifndef lint
  17 static const char sccsid[] = "$Id: perl.xs,v 8.36 2000/07/07 22:28:18 skimo Exp $ (Berkeley) $Date: 2000/07/07 22:28:18 $";
  18 #endif /* not lint */
  19
  20 #include <sys/types.h>
  21 #include <sys/queue.h>
  22 #include <sys/time.h>
  23
  24 #include <bitstring.h>
  25 #include <ctype.h>
  26 #include <limits.h>
  27 #include <signal.h>
  28 #include <stdio.h>
  29 #include <stdlib.h>
  30 #include <string.h>
  31 #include <termios.h>
  32 #include <unistd.h>
  33
  34 #include <EXTERN.h>
  35 #include <perl.h>
  36 #include <XSUB.h>
  37
  38 /* perl redefines them
  39  * avoid warnings
  40  */
  41 #undef USE_DYNAMIC_LOADING
  42 #undef DEBUG
  43 #undef PACKAGE
  44 #undef ARGS
  45 #define ARGS ARGS
  46
  47 #include "config.h"
  48
  49 #include "../common/common.h"
  50 #include "../perl_api/extern.h"
  51
  52 #ifndef DEFSV
  53 #define DEFSV GvSV(defgv)
  54 #endif
  55 #ifndef ERRSV
  56 #define ERRSV GvSV(errgv)
  57 #endif
  58 #ifndef dTHX
  59 #define dTHXs
  60 #else
  61 #define dTHXs dTHX;
  62 #endif
  63
  64 static void msghandler __P((SCR *, mtype_t, char *, size_t));
  65
  66 static char *errmsg = 0;
  67
  68 typedef struct _perl_data {
  69         PerlInterpreter*        interp;
  70         SV *svcurscr, *svstart, *svstop, *svid;
  71 } perl_data_t;
  72
  73 /*
  74  * INITMESSAGE --
  75  *      Macros to point messages at the Perl message handler.
  76  */
  77 #define INITMESSAGE(sp)                                                 \
  78         scr_msg = sp->gp->scr_msg;                                      \
  79         sp->gp->scr_msg = msghandler;
  80 #define ENDMESSAGE(sp)                                                  \
  81         sp->gp->scr_msg = scr_msg;                                      \
  82         if (rval) croak(errmsg);
  83
  84 void xs_init __P((void));
  85
  86 /*
  87  * perl_end --
  88  *      Clean up perl interpreter
  89  *
  90  * PUBLIC: int perl_end __P((GS *));
  91  */
  92 int
  93 perl_end(gp)
  94         GS *gp;
  95 {
  96         /*
  97          * Call perl_run and perl_destuct to call END blocks and DESTROY
  98          * methods.
  99          */
 100         if (gp->perl_interp) {
 101                 perl_run(gp->perl_interp);
 102                 perl_destruct(gp->perl_interp);
 103 #if defined(DEBUG) || defined(PURIFY) || defined(LIBRARY)
 104                 perl_free(gp->perl_interp);
 105 #endif
 106                 /* XXX rather make sure only one thread calls perl_end */
 107                 gp->perl_interp = 0;
 108         }
 109 }
 110
 111 /*
 112  * perl_eval
 113  *      Evaluate a string
 114  *      We don't use mortal SVs because no one will clean up after us
 115  */
 116 static void
 117 perl_eval(string)
 118         char *string;
 119 {
 120         dTHXs
 121
 122         SV* sv = newSVpv(string, 0);
 123
 124         /* G_KEEPERR to catch syntax error; better way ? */
 125         sv_setpv(ERRSV,"");
 126         perl_eval_sv(sv, G_DISCARD | G_NOARGS | G_KEEPERR);
 127         SvREFCNT_dec(sv);
 128 }
 129
 130 /*
 131  * perl_init --
 132  *      Create the perl commands used by nvi.
 133  *
 134  * PUBLIC: int perl_init __P((SCR *));
 135  */
 136 int
 137 perl_init(scrp)
 138         SCR *scrp;
 139 {
 140         AV * av;
 141         GS *gp;
 142         WIN *wp;
 143         char *bootargs[] = { "VI", NULL };
 144 #ifndef USE_SFIO
 145         SV *svcurscr;
 146 #endif
 147         perl_data_t *pp;
 148
 149         static char *args[] = { "", "-e", "" };
 150         STRLEN length;
 151         char *file = __FILE__;
 152
 153         gp = scrp->gp;
 154         wp = scrp->wp;
 155
 156         if (gp->perl_interp == NULL) {
 157         gp->perl_interp = perl_alloc();
 158         perl_construct(gp->perl_interp);
 159         if (perl_parse(gp->perl_interp, xs_init, 3, args, 0)) {
 160                 perl_destruct(gp->perl_interp);
 161                 perl_free(gp->perl_interp);
 162                 gp->perl_interp = NULL;
 163                 return 1;
 164         }
 165         {
 166         dTHXs
 167
 168         perl_call_argv("VI::bootstrap", G_DISCARD, bootargs);
 169         perl_eval("$SIG{__WARN__}='VI::Warn'");
 170
 171         av_unshift(av = GvAVn(PL_incgv), 1);
 172         av_store(av, 0, newSVpv(_PATH_PERLSCRIPTS,
 173                                 sizeof(_PATH_PERLSCRIPTS)-1));
 174
 175 #ifdef USE_SFIO
 176         sfdisc(PerlIO_stdout(), sfdcnewnvi(scrp));
 177         sfdisc(PerlIO_stderr(), sfdcnewnvi(scrp));
 178 #else
 179         svcurscr = perl_get_sv("curscr", TRUE);
 180         sv_magic((SV *)gv_fetchpv("STDOUT",TRUE, SVt_PVIO), svcurscr,
 181                         'q', Nullch, 0);
 182         sv_magic((SV *)gv_fetchpv("STDERR",TRUE, SVt_PVIO), svcurscr,
 183                         'q', Nullch, 0);
 184 #endif /* USE_SFIO */
 185         }
 186         }
 187         MALLOC(scrp, pp, perl_data_t *, sizeof(perl_data_t));
 188         wp->perl_private = pp;
 189 #ifdef USE_ITHREADS
 190         pp->interp = perl_clone(gp->perl_interp, 0);
 191         if (1) { /* hack for bug fixed in perl-current (5.6.1) */
 192             dTHXa(pp->interp);
 193             if (PL_scopestack_ix == 0) {
 194                 ENTER;
 195             }
 196         }
 197 #else
 198         pp->interp = gp->perl_interp;
 199 #endif
 200         {
 201                 dTHXs
 202
 203                 SvREADONLY_on(pp->svcurscr = perl_get_sv("curscr", TRUE));
 204                 SvREADONLY_on(pp->svstart = perl_get_sv("VI::StartLine", TRUE));
 205                 SvREADONLY_on(pp->svstop = perl_get_sv("VI::StopLine", TRUE));
 206                 SvREADONLY_on(pp->svid = perl_get_sv("VI::ScreenId", TRUE));
 207         }
 208         return (0);
 209 }
 210
 211 /*
 212  * perl_screen_end
 213  *      Remove all refences to the screen to be destroyed
 214  *
 215  * PUBLIC: int perl_screen_end __P((SCR*));
 216  */
 217 int
 218 perl_screen_end(scrp)
 219         SCR *scrp;
 220 {
 221         dTHXs
 222
 223         if (scrp->perl_private) {
 224                 sv_setiv((SV*) scrp->perl_private, 0);
 225         }
 226         return 0;
 227 }
 228
 229 static void
 230 my_sighandler(i)
 231         int i;
 232 {
 233         croak("Perl command interrupted by SIGINT");
 234 }
 235
 236 /* Create a new reference to an SV pointing to the SCR structure
 237  * The perl_private part of the SCR structure points to the SV,
 238  * so there can only be one such SV for a particular SCR structure.
 239  * When the last reference has gone (DESTROY is called),
 240  * perl_private is reset; When the screen goes away before
 241  * all references are gone, the value of the SV is reset;
 242  * any subsequent use of any of those reference will produce
 243  * a warning. (see typemap)
 244  */
 245 static SV *
 246 newVIrv(rv, screen)
 247         SV *rv;
 248         SCR *screen;
 249 {
 250         dTHXs
 251
 252         if (!screen) return sv_setsv(rv, &PL_sv_undef), rv;
 253         sv_upgrade(rv, SVt_RV);
 254         if (!screen->perl_private) {
 255                 screen->perl_private = newSV(0);
 256                 sv_setiv(screen->perl_private, (IV) screen);
 257         }
 258         else SvREFCNT_inc(screen->perl_private);
 259         SvRV(rv) = screen->perl_private;
 260         SvROK_on(rv);
 261         return sv_bless(rv, gv_stashpv("VI", TRUE));
 262 }
 263
 264
 265 /*
 266  * perl_ex_perl -- :[line [,line]] perl [command]
 267  *      Run a command through the perl interpreter.
 268  *
 269  * PUBLIC: int perl_ex_perl __P((SCR*, CHAR_T *, size_t, db_recno_t, db_recno_t));
 270  */
 271 int
 272 perl_ex_perl(scrp, cmdp, cmdlen, f_lno, t_lno)
 273         SCR *scrp;
 274         CHAR_T *cmdp;
 275         size_t cmdlen;
 276         db_recno_t f_lno, t_lno;
 277 {
 278         WIN *wp;
 279         STRLEN length;
 280         size_t len;
 281         char *err;
 282         Signal_t (*istat)();
 283         perl_data_t *pp;
 284
 285         /* Initialize the interpreter. */
 286         if (scrp->wp->perl_private == NULL && perl_init(scrp))
 287                         return (1);
 288         pp = scrp->wp->perl_private;
 289     {
 290         dTHXs
 291         dSP;
 292
 293         sv_setiv(pp->svstart, f_lno);
 294         sv_setiv(pp->svstop, t_lno);
 295         newVIrv(pp->svcurscr, scrp);
 296         /* Backwards compatibility. */
 297         newVIrv(pp->svid, scrp);
 298
 299         istat = signal(SIGINT, my_sighandler);
 300         perl_eval(cmdp);
 301         signal(SIGINT, istat);
 302
 303         SvREFCNT_dec(SvRV(pp->svcurscr));
 304         SvROK_off(pp->svcurscr);
 305         SvREFCNT_dec(SvRV(pp->svid));
 306         SvROK_off(pp->svid);
 307
 308         err = SvPV(ERRSV, length);
 309         if (!length)
 310                 return (0);
 311
 312         err[length - 1] = '\0';
 313         msgq(scrp, M_ERR, "perl: %s", err);
 314         return (1);
 315     }
 316 }
 317
 318 /*
 319  * replace_line
 320  *      replace a line with the contents of the perl variable $_
 321  *      lines are split at '\n's
 322  *      if $_ is undef, the line is deleted
 323  *      returns possibly adjusted linenumber
 324  */
 325 static int
 326 replace_line(scrp, line, t_lno, defsv)
 327         SCR *scrp;
 328         db_recno_t line, *t_lno;
 329         SV *defsv;
 330 {
 331         char *str, *next;
 332         size_t len;
 333         dTHXs
 334
 335         if (SvOK(defsv)) {
 336                 str = SvPV(defsv,len);
 337                 next = memchr(str, '\n', len);
 338                 api_sline(scrp, line, str, next ? (next - str) : len);
 339                 while (next++) {
 340                         len -= next - str;
 341                         next = memchr(str = next, '\n', len);
 342                         api_iline(scrp, ++line, str, next ? (next - str) : len);
 343                         (*t_lno)++;
 344                 }
 345         } else {
 346                 api_dline(scrp, line--);
 347                 (*t_lno)--;
 348         }
 349         return line;
 350 }
 351
 352 /*
 353  * perl_ex_perldo -- :[line [,line]] perl [command]
 354  *      Run a set of lines through the perl interpreter.
 355  *
 356  * PUBLIC: int perl_ex_perldo __P((SCR*, CHAR_T *, size_t, db_recno_t, db_recno_t));
 357  */
 358 int
 359 perl_ex_perldo(scrp, cmdp, cmdlen, f_lno, t_lno)
 360         SCR *scrp;
 361         CHAR_T *cmdp;
 362         size_t cmdlen;
 363         db_recno_t f_lno, t_lno;
 364 {
 365         CHAR_T *p;
 366         WIN *wp;
 367         STRLEN length;
 368         size_t len;
 369         db_recno_t i;
 370         CHAR_T *str;
 371         SV* cv;
 372         char *command;
 373         perl_data_t *pp;
 374
 375         /* Initialize the interpreter. */
 376         if (scrp->wp->perl_private == NULL && perl_init(scrp))
 377                         return (1);
 378         pp = scrp->wp->perl_private;
 379     {
 380         dTHXs
 381         dSP;
 382
 383         newVIrv(pp->svcurscr, scrp);
 384         /* Backwards compatibility. */
 385         newVIrv(pp->svid, scrp);
 386
 387         if (!(command = malloc(length = strlen(cmdp) + sizeof("sub {}"))))
 388                 return 1;
 389         snprintf(command, length, "sub {%s}", cmdp);
 390
 391         ENTER;
 392         SAVETMPS;
 393
 394         cv = perl_eval_pv(command, FALSE);
 395         free (command);
 396
 397         str = SvPV(ERRSV,length);
 398         if (length)
 399                 goto err;
 400
 401         for (i = f_lno; i <= t_lno && !api_gline(scrp, i, &str, &len); i++) {
 402                 sv_setpvn(DEFSV,str,len);
 403                 sv_setiv(pp->svstart, i);
 404                 sv_setiv(pp->svstop, i);
 405                 PUSHMARK(sp);
 406                 perl_call_sv(cv, G_SCALAR | G_EVAL);
 407                 str = SvPV(ERRSV, length);
 408                 if (length) break;
 409                 SPAGAIN;
 410                 if(SvTRUEx(POPs))
 411                         i = replace_line(scrp, i, &t_lno, DEFSV);
 412                 PUTBACK;
 413         }
 414         FREETMPS;
 415         LEAVE;
 416
 417         SvREFCNT_dec(SvRV(pp->svcurscr));
 418         SvROK_off(pp->svcurscr);
 419         SvREFCNT_dec(SvRV(pp->svid));
 420         SvROK_off(pp->svid);
 421
 422         if (!length)
 423                 return (0);
 424
 425 err:    str[length - 1] = '\0';
 426         msgq(scrp, M_ERR, "perl: %s", str);
 427         return (1);
 428     }
 429 }
 430
 431 /*
 432  * msghandler --
 433  *      Perl message routine so that error messages are processed in
 434  *      Perl, not in nvi.
 435  */
 436 static void
 437 msghandler(sp, mtype, msg, len)
 438         SCR *sp;
 439         mtype_t mtype;
 440         char *msg;
 441         size_t len;
 442 {
 443         /* Replace the trailing <newline> with an EOS. */
 444         /* Let's do that later instead */
 445         if (errmsg) free (errmsg);
 446         errmsg = malloc(len + 1);
 447         memcpy(errmsg, msg, len);
 448         errmsg[len] = '\0';
 449 }
 450
 451
 452 typedef SCR *   VI;
 453 typedef SCR *   VI__OPT;
 454 typedef SCR *   VI__MAP;
 455 typedef SCR *   VI__MARK;
 456 typedef SCR *   VI__LINE;
 457 typedef AV *    AVREF;
 458
 459 typedef struct {
 460     SV      *sprv;
 461     TAGQ    *tqp;
 462 } perl_tagq;
 463
 464 typedef perl_tagq *  VI__TAGQ;
 465 typedef perl_tagq *  VI__TAGQ2;
 466
 467 MODULE = VI     PACKAGE = VI
 468
 469 # msg --
 470 #       Set the message line to text.
 471 #
 472 # Perl Command: VI::Msg
 473 # Usage: VI::Msg screenId text
 474
 475 void
 476 Msg(screen, text)
 477         VI          screen
 478         char *      text
 479
 480         ALIAS:
 481         PRINT = 1
 482
 483         CODE:
 484         api_imessage(screen, text);
 485
 486 # XS_VI_escreen --
 487 #       End a screen.
 488 #
 489 # Perl Command: VI::EndScreen
 490 # Usage: VI::EndScreen screenId
 491
 492 void
 493 EndScreen(screen)
 494         VI      screen
 495
 496         PREINIT:
 497         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 498         int rval;
 499
 500         CODE:
 501         INITMESSAGE(screen);
 502         rval = api_escreen(screen);
 503         ENDMESSAGE(screen);
 504
 505 # XS_VI_iscreen --
 506 #       Create a new screen.  If a filename is specified then the screen
 507 #       is opened with that file.
 508 #
 509 # Perl Command: VI::NewScreen
 510 # Usage: VI::NewScreen screenId [file]
 511
 512 VI
 513 Edit(screen, ...)
 514         VI screen
 515
 516         ALIAS:
 517         NewScreen = 1
 518
 519         PROTOTYPE: $;$
 520         PREINIT:
 521         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 522         int rval;
 523         char *file;
 524         SCR *nsp;
 525
 526         CODE:
 527         file = (items == 1) ? NULL : (char *)SvPV(ST(1),PL_na);
 528         INITMESSAGE(screen);
 529         rval = api_edit(screen, file, &nsp, ix);
 530         ENDMESSAGE(screen);
 531
 532         RETVAL = ix ? nsp : screen;
 533
 534         OUTPUT:
 535         RETVAL
 536
 537 # XS_VI_fscreen --
 538 #       Return the screen id associated with file name.
 539 #
 540 # Perl Command: VI::FindScreen
 541 # Usage: VI::FindScreen file
 542
 543 VI
 544 FindScreen(file)
 545         char *file
 546
 547         PREINIT:
 548         SCR *fsp;
 549         CODE:
 550         RETVAL = api_fscreen(0, file);
 551
 552         OUTPUT:
 553         RETVAL
 554
 555 # XS_VI_GetFileName --
 556 #       Return the file name of the screen
 557 #
 558 # Perl Command: VI::GetFileName
 559 # Usage: VI::GetFileName screenId
 560
 561 char *
 562 GetFileName(screen)
 563         VI screen;
 564
 565         PPCODE:
 566         EXTEND(sp,1);
 567         PUSHs(sv_2mortal(newSVpv(screen->frp->name, 0)));
 568
 569 # XS_VI_aline --
 570 #       -- Append the string text after the line in lineNumber.
 571 #
 572 # Perl Command: VI::AppendLine
 573 # Usage: VI::AppendLine screenId lineNumber text
 574
 575 void
 576 AppendLine(screen, linenumber, text)
 577         VI screen
 578         int linenumber
 579         char *text
 580
 581         PREINIT:
 582         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 583         int rval;
 584         STRLEN length;
 585
 586         CODE:
 587         SvPV(ST(2), length);
 588         INITMESSAGE(screen);
 589         rval = api_aline(screen, linenumber, text, length);
 590         ENDMESSAGE(screen);
 591
 592 # XS_VI_dline --
 593 #       Delete lineNum.
 594 #
 595 # Perl Command: VI::DelLine
 596 # Usage: VI::DelLine screenId lineNum
 597
 598 void
 599 DelLine(screen, linenumber)
 600         VI screen
 601         int linenumber
 602
 603         PREINIT:
 604         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 605         int rval;
 606
 607         CODE:
 608         INITMESSAGE(screen);
 609         rval = api_dline(screen, (db_recno_t)linenumber);
 610         ENDMESSAGE(screen);
 611
 612 # XS_VI_gline --
 613 #       Return lineNumber.
 614 #
 615 # Perl Command: VI::GetLine
 616 # Usage: VI::GetLine screenId lineNumber
 617
 618 char *
 619 GetLine(screen, linenumber)
 620         VI screen
 621         int linenumber
 622
 623         PREINIT:
 624         size_t len;
 625         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 626         int rval;
 627         char *line;
 628         CHAR_T *p;
 629
 630         PPCODE:
 631         INITMESSAGE(screen);
 632         rval = api_gline(screen, (db_recno_t)linenumber, &p, &len);
 633         ENDMESSAGE(screen);
 634
 635         EXTEND(sp,1);
 636         PUSHs(sv_2mortal(newSVpv(len ? (char *)p : "", len)));
 637
 638 # XS_VI_sline --
 639 #       Set lineNumber to the text supplied.
 640 #
 641 # Perl Command: VI::SetLine
 642 # Usage: VI::SetLine screenId lineNumber text
 643
 644 void
 645 SetLine(screen, linenumber, text)
 646         VI screen
 647         int linenumber
 648         char *text
 649
 650         PREINIT:
 651         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 652         int rval;
 653         STRLEN length;
 654
 655         CODE:
 656         SvPV(ST(2), length);
 657         INITMESSAGE(screen);
 658         rval = api_sline(screen, linenumber, text, length);
 659         ENDMESSAGE(screen);
 660
 661 # XS_VI_iline --
 662 #       Insert the string text before the line in lineNumber.
 663 #
 664 # Perl Command: VI::InsertLine
 665 # Usage: VI::InsertLine screenId lineNumber text
 666
 667 void
 668 InsertLine(screen, linenumber, text)
 669         VI screen
 670         int linenumber
 671         char *text
 672
 673         PREINIT:
 674         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 675         int rval;
 676         STRLEN length;
 677
 678         CODE:
 679         SvPV(ST(2), length);
 680         INITMESSAGE(screen);
 681         rval = api_iline(screen, linenumber, text, length);
 682         ENDMESSAGE(screen);
 683
 684 # XS_VI_lline --
 685 #       Return the last line in the screen.
 686 #
 687 # Perl Command: VI::LastLine
 688 # Usage: VI::LastLine screenId
 689
 690 int
 691 LastLine(screen)
 692         VI screen
 693
 694         PREINIT:
 695         db_recno_t last;
 696         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 697         int rval;
 698
 699         CODE:
 700         INITMESSAGE(screen);
 701         rval = api_lline(screen, &last);
 702         ENDMESSAGE(screen);
 703         RETVAL=last;
 704
 705         OUTPUT:
 706         RETVAL
 707
 708 # XS_VI_getmark --
 709 #       Return the mark's cursor position as a list with two elements.
 710 #       {line, column}.
 711 #
 712 # Perl Command: VI::GetMark
 713 # Usage: VI::GetMark screenId mark
 714
 715 void
 716 GetMark(screen, mark)
 717         VI screen
 718         char mark
 719
 720         PREINIT:
 721         struct _mark cursor;
 722         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 723         int rval;
 724
 725         PPCODE:
 726         INITMESSAGE(screen);
 727         rval = api_getmark(screen, (int)mark, &cursor);
 728         ENDMESSAGE(screen);
 729
 730         EXTEND(sp,2);
 731         PUSHs(sv_2mortal(newSViv(cursor.lno)));
 732         PUSHs(sv_2mortal(newSViv(cursor.cno)));
 733
 734 # XS_VI_setmark --
 735 #       Set the mark to the line and column numbers supplied.
 736 #
 737 # Perl Command: VI::SetMark
 738 # Usage: VI::SetMark screenId mark line column
 739
 740 void
 741 SetMark(screen, mark, line, column)
 742         VI screen
 743         char mark
 744         int line
 745         int column
 746
 747         PREINIT:
 748         struct _mark cursor;
 749         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 750         int rval;
 751
 752         CODE:
 753         INITMESSAGE(screen);
 754         cursor.lno = line;
 755         cursor.cno = column;
 756         rval = api_setmark(screen, (int)mark, &cursor);
 757         ENDMESSAGE(screen);
 758
 759 # XS_VI_getcursor --
 760 #       Return the current cursor position as a list with two elements.
 761 #       {line, column}.
 762 #
 763 # Perl Command: VI::GetCursor
 764 # Usage: VI::GetCursor screenId
 765
 766 void
 767 GetCursor(screen)
 768         VI screen
 769
 770         PREINIT:
 771         struct _mark cursor;
 772         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 773         int rval;
 774
 775         PPCODE:
 776         INITMESSAGE(screen);
 777         rval = api_getcursor(screen, &cursor);
 778         ENDMESSAGE(screen);
 779
 780         EXTEND(sp,2);
 781         PUSHs(sv_2mortal(newSViv(cursor.lno)));
 782         PUSHs(sv_2mortal(newSViv(cursor.cno)));
 783
 784 # XS_VI_setcursor --
 785 #       Set the cursor to the line and column numbers supplied.
 786 #
 787 # Perl Command: VI::SetCursor
 788 # Usage: VI::SetCursor screenId line column
 789
 790 void
 791 SetCursor(screen, line, column)
 792         VI screen
 793         int line
 794         int column
 795
 796         PREINIT:
 797         struct _mark cursor;
 798         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 799         int rval;
 800
 801         CODE:
 802         INITMESSAGE(screen);
 803         cursor.lno = line;
 804         cursor.cno = column;
 805         rval = api_setcursor(screen, &cursor);
 806         ENDMESSAGE(screen);
 807
 808 # XS_VI_swscreen --
 809 #       Change the current focus to screen.
 810 #
 811 # Perl Command: VI::SwitchScreen
 812 # Usage: VI::SwitchScreen screenId screenId
 813
 814 void
 815 SwitchScreen(screenFrom, screenTo)
 816         VI screenFrom
 817         VI screenTo
 818
 819         PREINIT:
 820         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 821         int rval;
 822
 823         CODE:
 824         INITMESSAGE(screenFrom);
 825         rval = api_swscreen(screenFrom, screenTo);
 826         ENDMESSAGE(screenFrom);
 827
 828 # XS_VI_map --
 829 #       Associate a key with a perl procedure.
 830 #
 831 # Perl Command: VI::MapKey
 832 # Usage: VI::MapKey screenId key perlproc
 833
 834 void
 835 MapKey(screen, key, perlproc)
 836         VI screen
 837         char *key
 838         SV *perlproc
 839
 840         PREINIT:
 841         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 842         int rval;
 843         int length;
 844         char *command;
 845         SV *svc;
 846         SV *svn;
 847
 848         CODE:
 849         INITMESSAGE(screen);
 850         svc = sv_2mortal(newSVpv(":perl ", 6));
 851         sv_catsv(svc, perlproc);
 852         svn = sv_2mortal(newSVpv("\r", 1));
 853         sv_catsv(svc, svn);
 854         command = SvPV(svc, length);
 855         rval = api_map(screen, key, command, length);
 856         ENDMESSAGE(screen);
 857
 858 # XS_VI_unmap --
 859 #       Unmap a key.
 860 #
 861 # Perl Command: VI::UnmapKey
 862 # Usage: VI::UnmmapKey screenId key
 863
 864 void
 865 UnmapKey(screen, key)
 866         VI screen
 867         char *key
 868
 869         PREINIT:
 870         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 871         int rval;
 872
 873         CODE:
 874         INITMESSAGE(screen);
 875         rval = api_unmap(screen, key);
 876         ENDMESSAGE(screen);
 877
 878 # XS_VI_opts_set --
 879 #       Set an option.
 880 #
 881 # Perl Command: VI::SetOpt
 882 # Usage: VI::SetOpt screenId setting
 883
 884 void
 885 SetOpt(screen, setting)
 886         VI screen
 887         char *setting
 888
 889         PREINIT:
 890         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 891         int rval;
 892         SV *svc;
 893
 894         CODE:
 895         INITMESSAGE(screen);
 896         svc = sv_2mortal(newSVpv(":set ", 5));
 897         sv_catpv(svc, setting);
 898         rval = api_run_str(screen, SvPV(svc, PL_na));
 899         ENDMESSAGE(screen);
 900
 901 # XS_VI_opts_get --
 902 #       Return the value of an option.
 903 #
 904 # Perl Command: VI::GetOpt
 905 # Usage: VI::GetOpt screenId option
 906
 907 void
 908 GetOpt(screen, option)
 909         VI screen
 910         char *option
 911
 912         PREINIT:
 913         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 914         int rval;
 915         char *value;
 916
 917         PPCODE:
 918         INITMESSAGE(screen);
 919         rval = api_opts_get(screen, option, &value, NULL);
 920         ENDMESSAGE(screen);
 921
 922         EXTEND(SP,1);
 923         PUSHs(sv_2mortal(newSVpv(value, 0)));
 924         free(value);
 925
 926 # XS_VI_run --
 927 #       Run the ex command cmd.
 928 #
 929 # Perl Command: VI::Run
 930 # Usage: VI::Run screenId cmd
 931
 932 void
 933 Run(screen, command)
 934         VI screen
 935         char *command;
 936
 937         PREINIT:
 938         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 939         int rval;
 940
 941         CODE:
 942         INITMESSAGE(screen);
 943         rval = api_run_str(screen, command);
 944         ENDMESSAGE(screen);
 945
 946 void
 947 DESTROY(screensv)
 948         SV* screensv
 949
 950         PREINIT:
 951         VI  screen;
 952
 953         CODE:
 954         if (sv_isa(screensv, "VI")) {
 955                 IV tmp = SvIV((SV*)SvRV(screensv));
 956                 screen = (SCR *) tmp;
 957         }
 958         else
 959                 croak("screen is not of type VI");
 960
 961         if (screen)
 962         screen->perl_private = 0;
 963
 964 void
 965 Warn(warning)
 966         char *warning;
 967
 968         CODE:
 969         sv_catpv(ERRSV,warning);
 970
 971 #define TIED(kind,package) \
 972         sv_magic((SV *) (var = \
 973             (##kind##V *)sv_2mortal((SV *)new##kind##V())), \
 974                 sv_setref_pv(sv_newmortal(), package, \
 975                         newVIrv(newSV(0), screen)),\
 976                 'P', Nullch, 0);\
 977         RETVAL = newRV((SV *)var)
 978
 979 SV *
 980 Opt(screen)
 981         VI screen;
 982         PREINIT:
 983         HV *var;
 984         CODE:
 985         TIED(H,"VI::OPT");
 986         OUTPUT:
 987         RETVAL
 988
 989 SV *
 990 Map(screen)
 991         VI screen;
 992         PREINIT:
 993         HV *var;
 994         CODE:
 995         TIED(H,"VI::MAP");
 996         OUTPUT:
 997         RETVAL
 998
 999 SV *
1000 Mark(screen)
1001         VI screen
1002         PREINIT:
1003         HV *var;
1004         CODE:
1005         TIED(H,"VI::MARK");
1006         OUTPUT:
1007         RETVAL
1008
1009 SV *
1010 Line(screen)
1011         VI screen
1012         PREINIT:
1013         AV *var;
1014         CODE:
1015         TIED(A,"VI::LINE");
1016         OUTPUT:
1017         RETVAL
1018
1019 SV *
1020 TagQ(screen, tag)
1021         VI screen
1022         char *tag;
1023
1024         PREINIT:
1025         perl_tagq *ptag;
1026
1027         PPCODE:
1028         if ((ptag = malloc(sizeof(perl_tagq))) == NULL)
1029                 goto err;
1030
1031         ptag->sprv = newVIrv(newSV(0), screen);
1032         ptag->tqp = api_tagq_new(screen, tag);
1033         if (ptag->tqp != NULL) {
1034                 EXTEND(SP,1);
1035                 PUSHs(sv_2mortal(sv_setref_pv(newSV(0), "VI::TAGQ", ptag)));
1036         } else {
1037 err:
1038                 ST(0) = &PL_sv_undef;
1039                 return;
1040         }
1041
1042 MODULE = VI     PACKAGE = VI::OPT
1043
1044 void
1045 DESTROY(screen)
1046         VI::OPT screen
1047
1048         CODE:
1049         # typemap did all the checking
1050         SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1051
1052 void
1053 FETCH(screen, key)
1054         VI::OPT screen
1055         char *key
1056
1057         PREINIT:
1058         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1059         int rval;
1060         char *value;
1061         int boolvalue;
1062
1063         PPCODE:
1064         INITMESSAGE(screen);
1065         rval = api_opts_get(screen, key, &value, &boolvalue);
1066         if (!rval) {
1067                 EXTEND(SP,1);
1068                 PUSHs(sv_2mortal((boolvalue == -1) ? newSVpv(value, 0)
1069                                                    : newSViv(boolvalue)));
1070                 free(value);
1071         } else ST(0) = &PL_sv_undef;
1072         rval = 0;
1073         ENDMESSAGE(screen);
1074
1075 void
1076 STORE(screen, key, value)
1077         VI::OPT screen
1078         char    *key
1079         SV      *value
1080
1081         PREINIT:
1082         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1083         int rval;
1084
1085         CODE:
1086         INITMESSAGE(screen);
1087         rval = api_opts_set(screen, key, SvPV(value, PL_na), SvIV(value),
1088                                          SvTRUEx(value));
1089         ENDMESSAGE(screen);
1090
1091 MODULE = VI     PACKAGE = VI::MAP
1092
1093 void
1094 DESTROY(screen)
1095         VI::MAP screen
1096
1097         CODE:
1098         # typemap did all the checking
1099         SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1100
1101 void
1102 STORE(screen, key, perlproc)
1103         VI::MAP screen
1104         char *key
1105         SV *perlproc
1106
1107         PREINIT:
1108         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1109         int rval;
1110         int length;
1111         char *command;
1112         SV *svc;
1113         SV *svn;
1114
1115         CODE:
1116         INITMESSAGE(screen);
1117         svc = sv_2mortal(newSVpv(":perl ", 6));
1118         sv_catsv(svc, perlproc);
1119         svn = sv_2mortal(newSVpv("\r", 1));
1120         sv_catsv(svc, svn);
1121         command = SvPV(svc, length);
1122         rval = api_map(screen, key, command, length);
1123         ENDMESSAGE(screen);
1124
1125 void
1126 DELETE(screen, key)
1127         VI::MAP screen
1128         char *key
1129
1130         PREINIT:
1131         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1132         int rval;
1133
1134         CODE:
1135         INITMESSAGE(screen);
1136         rval = api_unmap(screen, key);
1137         ENDMESSAGE(screen);
1138
1139 MODULE = VI     PACKAGE = VI::MARK
1140
1141 void
1142 DESTROY(screen)
1143         VI::MARK screen
1144
1145         CODE:
1146         # typemap did all the checking
1147         SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1148
1149 AV *
1150 FETCH(screen, mark)
1151         VI::MARK screen
1152         char mark
1153
1154         PREINIT:
1155         struct _mark cursor;
1156         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1157         int rval;
1158
1159         CODE:
1160         INITMESSAGE(screen);
1161         rval = api_getmark(screen, (int)mark, &cursor);
1162         ENDMESSAGE(screen);
1163         RETVAL = newAV();
1164         av_push(RETVAL, newSViv(cursor.lno));
1165         av_push(RETVAL, newSViv(cursor.cno));
1166
1167         OUTPUT:
1168         RETVAL
1169
1170 void
1171 STORE(screen, mark, pos)
1172         VI::MARK screen
1173         char mark
1174         AVREF pos
1175
1176         PREINIT:
1177         struct _mark cursor;
1178         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1179         int rval;
1180
1181         CODE:
1182         if (av_len(pos) < 1)
1183             croak("cursor position needs 2 elements");
1184         INITMESSAGE(screen);
1185         cursor.lno = SvIV(*av_fetch(pos, 0, 0));
1186         cursor.cno = SvIV(*av_fetch(pos, 1, 0));
1187         rval = api_setmark(screen, (int)mark, &cursor);
1188         ENDMESSAGE(screen);
1189
1190 void
1191 FIRSTKEY(screen, ...)
1192         VI::MARK screen
1193
1194         ALIAS:
1195         NEXTKEY = 1
1196
1197         PROTOTYPE: $;$
1198
1199         PREINIT:
1200         int next;
1201         char key[] = {0, 0};
1202
1203         PPCODE:
1204         if (items == 2) {
1205                 next = 1;
1206                 *key = *(char *)SvPV(ST(1),PL_na);
1207         } else next = 0;
1208         if (api_nextmark(screen, next, key) != 1) {
1209                 EXTEND(sp, 1);
1210                 PUSHs(sv_2mortal(newSVpv(key, 1)));
1211         } else ST(0) = &PL_sv_undef;
1212
1213 MODULE = VI     PACKAGE = VI::LINE
1214
1215 void
1216 DESTROY(screen)
1217         VI::LINE screen
1218
1219         CODE:
1220         # typemap did all the checking
1221         SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1222
1223 # similar to SetLine
1224
1225 void
1226 STORE(screen, linenumber, text)
1227         VI::LINE screen
1228         int linenumber
1229         char *text
1230
1231         PREINIT:
1232         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1233         int rval;
1234         STRLEN length;
1235         db_recno_t last;
1236
1237         CODE:
1238         ++linenumber;   /* vi 1 based ; perl 0 based */
1239         SvPV(ST(2), length);
1240         INITMESSAGE(screen);
1241         rval = api_lline(screen, &last);
1242         if (!rval) {
1243             if (linenumber > last)
1244                 rval = api_extend(screen, linenumber);
1245             if (!rval)
1246                 rval = api_sline(screen, linenumber, text, length);
1247         }
1248         ENDMESSAGE(screen);
1249
1250 # similar to GetLine
1251
1252 char *
1253 FETCH(screen, linenumber)
1254         VI::LINE screen
1255         int linenumber
1256
1257         PREINIT:
1258         size_t len;
1259         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1260         int rval;
1261         char *line;
1262         CHAR_T *p;
1263
1264         PPCODE:
1265         ++linenumber;   /* vi 1 based ; perl 0 based */
1266         INITMESSAGE(screen);
1267         rval = api_gline(screen, (db_recno_t)linenumber, &p, &len);
1268         ENDMESSAGE(screen);
1269
1270         EXTEND(sp,1);
1271         PUSHs(sv_2mortal(newSVpv(len ? (char*)p : "", len)));
1272
1273 # similar to LastLine
1274
1275 int
1276 FETCHSIZE(screen)
1277         VI::LINE screen
1278
1279         PREINIT:
1280         db_recno_t last;
1281         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1282         int rval;
1283
1284         CODE:
1285         INITMESSAGE(screen);
1286         rval = api_lline(screen, &last);
1287         ENDMESSAGE(screen);
1288         RETVAL=last;
1289
1290         OUTPUT:
1291         RETVAL
1292
1293 void
1294 STORESIZE(screen, count)
1295         VI::LINE screen
1296         int count
1297
1298         PREINIT:
1299         db_recno_t last;
1300         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1301         int rval;
1302
1303         CODE:
1304         INITMESSAGE(screen);
1305         rval = api_lline(screen, &last);
1306         if (!rval) {
1307             if (count > last)
1308                 rval = api_extend(screen, count);
1309             else while(last && last > count) {
1310                 rval = api_dline(screen, last--);
1311                 if (rval) break;
1312             }
1313         }
1314         ENDMESSAGE(screen);
1315
1316 void
1317 EXTEND(screen, count)
1318         VI::LINE screen
1319         int count
1320
1321         CODE:
1322
1323 void
1324 CLEAR(screen)
1325         VI::LINE screen
1326
1327         PREINIT:
1328         db_recno_t last;
1329         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1330         int rval;
1331
1332         CODE:
1333         INITMESSAGE(screen);
1334         rval = api_lline(screen, &last);
1335         if (!rval) {
1336             while(last) {
1337                 rval = api_dline(screen, last--);
1338                 if (rval) break;
1339             }
1340         }
1341         ENDMESSAGE(screen);
1342
1343 void
1344 PUSH(screen, ...)
1345         VI::LINE screen;
1346
1347         PREINIT:
1348         db_recno_t last;
1349         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1350         int rval, i, len;
1351         char *line;
1352
1353         CODE:
1354         INITMESSAGE(screen);
1355         rval = api_lline(screen, &last);
1356
1357         if (!rval)
1358                 for (i = 1; i < items; ++i) {
1359                         line = SvPV(ST(i), len);
1360                         if ((rval = api_aline(screen, last++, line, len)))
1361                                 break;
1362                 }
1363         ENDMESSAGE(screen);
1364
1365 SV *
1366 POP(screen)
1367         VI::LINE screen;
1368
1369         PREINIT:
1370         db_recno_t last;
1371         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1372         int rval, i, len;
1373         CHAR_T *line;
1374
1375         PPCODE:
1376         INITMESSAGE(screen);
1377         rval = api_lline(screen, &last);
1378         if (rval || last < 1)
1379                 ST(0) = &PL_sv_undef;
1380         else {
1381                 rval = api_gline(screen, last, &line, &len) ||
1382                        api_dline(screen, last);
1383                 EXTEND(sp,1);
1384                 PUSHs(sv_2mortal(newSVpv(len ? (char *)line : "", len)));
1385         }
1386         ENDMESSAGE(screen);
1387
1388 SV *
1389 SHIFT(screen)
1390         VI::LINE screen;
1391
1392         PREINIT:
1393         db_recno_t last;
1394         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1395         int rval, i, len;
1396         CHAR_T *line;
1397
1398         PPCODE:
1399         INITMESSAGE(screen);
1400         rval = api_lline(screen, &last);
1401         if (rval || last < 1)
1402                 ST(0) = &PL_sv_undef;
1403         else {
1404                 rval = api_gline(screen, (db_recno_t)1, &line, &len) ||
1405                        api_dline(screen, (db_recno_t)1);
1406                 EXTEND(sp,1);
1407                 PUSHs(sv_2mortal(newSVpv(len ? (char *)line : "", len)));
1408         }
1409         ENDMESSAGE(screen);
1410
1411 void
1412 UNSHIFT(screen, ...)
1413         VI::LINE screen;
1414
1415         PREINIT:
1416         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1417         int rval, i, len;
1418         char *line;
1419
1420         CODE:
1421         INITMESSAGE(screen);
1422         while (--items != 0) {
1423                 line = SvPV(ST(items), len);
1424                 if ((rval = api_iline(screen, (db_recno_t)1, line, len)))
1425                         break;
1426         }
1427         ENDMESSAGE(screen);
1428
1429 void
1430 SPLICE(screen, ...)
1431         VI::LINE screen;
1432
1433         PREINIT:
1434         db_recno_t last, db_offset;
1435         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1436         int rval, length, common, len, i, offset;
1437         CHAR_T *line;
1438
1439         PPCODE:
1440         INITMESSAGE(screen);
1441         rval = api_lline(screen, &last);
1442         offset = items > 1 ? (int)SvIV(ST(1)) : 0;
1443         if (offset < 0) offset += last;
1444         if (offset < 0) {
1445             ENDMESSAGE(screen);
1446             croak("Invalid offset");
1447         }
1448         length = items > 2 ? (int)SvIV(ST(2)) : last - offset;
1449         if (length > last - offset)
1450                 length = last - offset;
1451         db_offset = offset + 1; /* 1 based */
1452         EXTEND(sp,length);
1453         for (common = MIN(length, items - 3), i = 3; common > 0;
1454             --common, ++db_offset, --length, ++i) {
1455                 rval |= api_gline(screen, db_offset, &line, &len);
1456                 PUSHs(sv_2mortal(newSVpv(len ? (char *)line : "", len)));
1457                 line = SvPV(ST(i), len);
1458                 rval |= api_sline(screen, db_offset, line, len);
1459         }
1460         for (; length; --length) {
1461                 rval |= api_gline(screen, db_offset, &line, &len);
1462                 PUSHs(sv_2mortal(newSVpv(len ? (char *)line : "", len)));
1463                 rval |= api_dline(screen, db_offset);
1464         }
1465         for (; i < items; ++i) {
1466                 line = SvPV(ST(i), len);
1467                 rval |= api_iline(screen, db_offset, line, len);
1468         }
1469         ENDMESSAGE(screen);
1470
1471 MODULE = VI     PACKAGE = VI::TAGQ
1472
1473 void
1474 Add(tagq, filename, search, msg)
1475         VI::TAGQ    tagq;
1476         char       *filename;
1477         char       *search;
1478         char       *msg;
1479
1480         PREINIT:
1481         SCR *sp;
1482
1483         CODE:
1484         sp = (SCR *)SvIV((SV*)SvRV(tagq->sprv));
1485         if (!sp)
1486                 croak("screen no longer exists");
1487         api_tagq_add(sp, tagq->tqp, filename, search, msg);
1488
1489 void
1490 Push(tagq)
1491         VI::TAGQ    tagq;
1492
1493         PREINIT:
1494         SCR *sp;
1495
1496         CODE:
1497         sp = (SCR *)SvIV((SV*)SvRV(tagq->sprv));
1498         if (!sp)
1499                 croak("screen no longer exists");
1500         api_tagq_push(sp, &tagq->tqp);
1501
1502 void
1503 DESTROY(tagq)
1504         # Can already be invalidated by push
1505         VI::TAGQ2    tagq;
1506
1507         PREINIT:
1508         SCR *sp;
1509
1510         CODE:
1511         sp = (SCR *)SvIV((SV*)SvRV(tagq->sprv));
1512         if (sp)
1513                 api_tagq_free(sp, tagq->tqp);
1514         SvREFCNT_dec(tagq->sprv);
1515         free(tagq);