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