contrib/nvi/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  * $FreeBSD$
  14  */
  15
  16 #include "config.h"
  17
  18 #ifndef lint
  19 static const char sccsid[] = "@(#)perl.xs       8.27 (Berkeley) 10/16/96";
  20 #endif /* not lint */
  21
  22 #include <sys/types.h>
  23 #include <sys/param.h>
  24 #include <sys/queue.h>
  25 #include <sys/time.h>
  26
  27 #include <bitstring.h>
  28 #include <ctype.h>
  29 #include <limits.h>
  30 #include <signal.h>
  31 #include <stdio.h>
  32 #include <stdlib.h>
  33 #include <string.h>
  34 #include <termios.h>
  35 #include <unistd.h>
  36 #include <errno.h>
  37
  38 #include "../common/common.h"
  39
  40 #include <EXTERN.h>
  41 #include <perl.h>
  42 #include <XSUB.h>
  43
  44 #include "perl_extern.h"
  45
  46 static void msghandler __P((SCR *, mtype_t, char *, size_t));
  47
  48 extern GS *__global_list;                       /* XXX */
  49
  50 static char *errmsg = 0;
  51
  52 /*
  53  * INITMESSAGE --
  54  *      Macros to point messages at the Perl message handler.
  55  */
  56 #define INITMESSAGE                                                     \
  57         scr_msg = __global_list->scr_msg;                               \
  58         __global_list->scr_msg = msghandler;
  59 #define ENDMESSAGE                                                      \
  60         __global_list->scr_msg = scr_msg;                               \
  61         if (rval) croak(errmsg);
  62
  63 static void xs_init __P((void));
  64
  65 /*
  66  * perl_end --
  67  *      Clean up perl interpreter
  68  *
  69  * PUBLIC: int perl_end __P((GS *));
  70  */
  71 int
  72 perl_end(gp)
  73         GS *gp;
  74 {
  75         /*
  76          * Call perl_run and perl_destuct to call END blocks and DESTROY
  77          * methods.
  78          */
  79         if (gp->perl_interp) {
  80                 /*Irestartop = 0;                               / * XXX */
  81                 perl_run(gp->perl_interp);
  82                 perl_destruct(gp->perl_interp);
  83 #if defined(DEBUG) || defined(PURIFY) || defined(LIBRARY)
  84                 perl_free(gp->perl_interp);
  85 #endif
  86         }
  87 }
  88
  89 /*
  90  * perl_eval
  91  *      Evaluate a string
  92  *      We don't use mortal SVs because no one will clean up after us
  93  */
  94 static void
  95 perl_eval(string)
  96         char *string;
  97 {
  98 #ifdef HAVE_PERL_5_003_01
  99         SV* sv = newSVpv(string, 0);
 100
 101         perl_eval_sv(sv, G_DISCARD | G_NOARGS);
 102         SvREFCNT_dec(sv);
 103 #else
 104         char *argv[2];
 105
 106         argv[0] = string;
 107         argv[1] = NULL;
 108         perl_call_argv("_eval_", G_EVAL | G_DISCARD | G_KEEPERR, argv);
 109 #endif
 110 }
 111
 112 /*
 113  * perl_init --
 114  *      Create the perl commands used by nvi.
 115  *
 116  * PUBLIC: int perl_init __P((SCR *));
 117  */
 118 int
 119 perl_init(scrp)
 120         SCR *scrp;
 121 {
 122         AV * av;
 123         GS *gp;
 124         char *bootargs[] = { "VI", NULL };
 125 #ifndef USE_SFIO
 126         SV *svcurscr;
 127 #endif
 128
 129 #ifndef HAVE_PERL_5_003_01
 130         static char *args[] = { "", "-e", "sub _eval_ { eval $_[0] }" };
 131 #else
 132         static char *args[] = { "", "-e", "" };
 133 #endif
 134         STRLEN length;
 135         char *file = __FILE__;
 136
 137         gp = scrp->gp;
 138         gp->perl_interp = perl_alloc();
 139         perl_construct(gp->perl_interp);
 140         if (perl_parse(gp->perl_interp, xs_init, 3, args, 0)) {
 141                 perl_destruct(gp->perl_interp);
 142                 perl_free(gp->perl_interp);
 143                 gp->perl_interp = NULL;
 144                 return 1;
 145         }
 146         perl_call_argv("VI::bootstrap", G_DISCARD, bootargs);
 147         perl_eval("$SIG{__WARN__}='VI::Warn'");
 148
 149         av_unshift(av = GvAVn(PL_incgv), 1);
 150         av_store(av, 0, newSVpv(_PATH_PERLSCRIPTS,
 151                                 sizeof(_PATH_PERLSCRIPTS)-1));
 152
 153 #ifdef USE_SFIO
 154         sfdisc(PerlIO_stdout(), sfdcnewnvi(scrp));
 155         sfdisc(PerlIO_stderr(), sfdcnewnvi(scrp));
 156 #else
 157         svcurscr = perl_get_sv("curscr", TRUE);
 158         sv_magic((SV *)gv_fetchpv("STDOUT",TRUE, SVt_PVIO), svcurscr,
 159                         'q', Nullch, 0);
 160         sv_magic((SV *)gv_fetchpv("STDERR",TRUE, SVt_PVIO), svcurscr,
 161                         'q', Nullch, 0);
 162 #endif /* USE_SFIO */
 163         return (0);
 164 }
 165
 166 /*
 167  * perl_screen_end
 168  *      Remove all refences to the screen to be destroyed
 169  *
 170  * PUBLIC: int perl_screen_end __P((SCR*));
 171  */
 172 int
 173 perl_screen_end(scrp)
 174         SCR *scrp;
 175 {
 176         if (scrp->perl_private) {
 177                 sv_setiv((SV*) scrp->perl_private, 0);
 178         }
 179         return 0;
 180 }
 181
 182 static void
 183 my_sighandler(i)
 184         int i;
 185 {
 186         croak("Perl command interrupted by SIGINT");
 187 }
 188
 189 /* Create a new reference to an SV pointing to the SCR structure
 190  * The perl_private part of the SCR structure points to the SV,
 191  * so there can only be one such SV for a particular SCR structure.
 192  * When the last reference has gone (DESTROY is called),
 193  * perl_private is reset; When the screen goes away before
 194  * all references are gone, the value of the SV is reset;
 195  * any subsequent use of any of those reference will produce
 196  * a warning. (see typemap)
 197  */
 198 static SV *
 199 newVIrv(rv, screen)
 200         SV *rv;
 201         SCR *screen;
 202 {
 203         sv_upgrade(rv, SVt_RV);
 204         if (!screen->perl_private) {
 205                 screen->perl_private = newSV(0);
 206                 sv_setiv(screen->perl_private, (IV) screen);
 207         }
 208         else SvREFCNT_inc(screen->perl_private);
 209         SvRV(rv) = screen->perl_private;
 210         SvROK_on(rv);
 211         return sv_bless(rv, gv_stashpv("VI", TRUE));
 212 }
 213
 214
 215 /*
 216  * perl_ex_perl -- :[line [,line]] perl [command]
 217  *      Run a command through the perl interpreter.
 218  *
 219  * PUBLIC: int perl_ex_perl __P((SCR*, CHAR_T *, size_t, recno_t, recno_t));
 220  */
 221 int
 222 perl_ex_perl(scrp, cmdp, cmdlen, f_lno, t_lno)
 223         SCR *scrp;
 224         CHAR_T *cmdp;
 225         size_t cmdlen;
 226         recno_t f_lno, t_lno;
 227 {
 228         static SV *svcurscr = 0, *svstart, *svstop, *svid;
 229         GS *gp;
 230         STRLEN length;
 231         size_t len;
 232         char *err;
 233         Signal_t (*istat)();
 234
 235         /* Initialize the interpreter. */
 236         gp = scrp->gp;
 237         if (!svcurscr) {
 238                 if (gp->perl_interp == NULL && perl_init(scrp))
 239                         return (1);
 240                 SvREADONLY_on(svcurscr = perl_get_sv("curscr", TRUE));
 241                 SvREADONLY_on(svstart = perl_get_sv("VI::StartLine", TRUE));
 242                 SvREADONLY_on(svstop = perl_get_sv("VI::StopLine", TRUE));
 243                 SvREADONLY_on(svid = perl_get_sv("VI::ScreenId", TRUE));
 244         }
 245
 246         sv_setiv(svstart, f_lno);
 247         sv_setiv(svstop, t_lno);
 248         newVIrv(svcurscr, scrp);
 249         /* Backwards compatibility. */
 250         newVIrv(svid, scrp);
 251
 252         istat = signal(SIGINT, my_sighandler);
 253         perl_eval(cmdp);
 254         signal(SIGINT, istat);
 255
 256         SvREFCNT_dec(SvRV(svcurscr));
 257         SvROK_off(svcurscr);
 258         SvREFCNT_dec(SvRV(svid));
 259         SvROK_off(svid);
 260
 261         err = SvPV(GvSV(PL_errgv), length);
 262         if (!length)
 263                 return (0);
 264
 265         err[length - 1] = '\0';
 266         msgq(scrp, M_ERR, "perl: %s", err);
 267         return (1);
 268 }
 269
 270 /*
 271  * replace_line
 272  *      replace a line with the contents of the perl variable $_
 273  *      lines are split at '\n's
 274  *      if $_ is undef, the line is deleted
 275  *      returns possibly adjusted linenumber
 276  */
 277 static int
 278 replace_line(scrp, line, t_lno)
 279         SCR *scrp;
 280         recno_t line, *t_lno;
 281 {
 282         char *str, *next;
 283         size_t len;
 284
 285         if (SvOK(GvSV(PL_defgv))) {
 286                 str = SvPV(GvSV(PL_defgv),len);
 287                 next = memchr(str, '\n', len);
 288                 api_sline(scrp, line, str, next ? (next - str) : len);
 289                 while (next++) {
 290                         len -= next - str;
 291                         next = memchr(str = next, '\n', len);
 292                         api_iline(scrp, ++line, str, next ? (next - str) : len);
 293                         (*t_lno)++;
 294                 }
 295         } else {
 296                 api_dline(scrp, line--);
 297                 (*t_lno)--;
 298         }
 299         return line;
 300 }
 301
 302 /*
 303  * perl_ex_perldo -- :[line [,line]] perl [command]
 304  *      Run a set of lines through the perl interpreter.
 305  *
 306  * PUBLIC: int perl_ex_perldo __P((SCR*, CHAR_T *, size_t, recno_t, recno_t));
 307  */
 308 int
 309 perl_ex_perldo(scrp, cmdp, cmdlen, f_lno, t_lno)
 310         SCR *scrp;
 311         CHAR_T *cmdp;
 312         size_t cmdlen;
 313         recno_t f_lno, t_lno;
 314 {
 315         static SV *svcurscr = 0, *svstart, *svstop, *svid;
 316         CHAR_T *p;
 317         GS *gp;
 318         STRLEN length;
 319         size_t len;
 320         recno_t i;
 321         char *str;
 322 #ifndef HAVE_PERL_5_003_01
 323         char *argv[2];
 324 #else
 325         SV* sv;
 326 #endif
 327         dSP;
 328
 329         /* Initialize the interpreter. */
 330         gp = scrp->gp;
 331         if (!svcurscr) {
 332                 if (gp->perl_interp == NULL && perl_init(scrp))
 333                         return (1);
 334                 SPAGAIN;
 335                 SvREADONLY_on(svcurscr = perl_get_sv("curscr", TRUE));
 336                 SvREADONLY_on(svstart = perl_get_sv("VI::StartLine", TRUE));
 337                 SvREADONLY_on(svstop = perl_get_sv("VI::StopLine", TRUE));
 338                 SvREADONLY_on(svid = perl_get_sv("VI::ScreenId", TRUE));
 339         }
 340
 341 #ifndef HAVE_PERL_5_003_01
 342         argv[0] = cmdp;
 343         argv[1] = NULL;
 344 #else
 345         length = strlen(cmdp);
 346         sv = newSV(length + sizeof("sub VI::perldo {")-1 + 1 /* } */);
 347         sv_setpvn(sv, "sub VI::perldo {", sizeof("sub VI::perldo {")-1);
 348         sv_catpvn(sv, cmdp, length);
 349         sv_catpvn(sv, "}", 1);
 350         perl_eval_sv(sv, G_DISCARD | G_NOARGS);
 351         SvREFCNT_dec(sv);
 352         str = SvPV(GvSV(PL_errgv),length);
 353         if (length)
 354                 goto err;
 355 #endif
 356
 357         newVIrv(svcurscr, scrp);
 358         /* Backwards compatibility. */
 359         newVIrv(svid, scrp);
 360
 361         ENTER;
 362         SAVETMPS;
 363         for (i = f_lno; i <= t_lno && !api_gline(scrp, i, &str, &len); i++) {
 364                 sv_setpvn(GvSV(PL_defgv),str,len);
 365                 sv_setiv(svstart, i);
 366                 sv_setiv(svstop, i);
 367 #ifndef HAVE_PERL_5_003_01
 368                 perl_call_argv("_eval_", G_SCALAR | G_EVAL | G_KEEPERR, argv);
 369 #else
 370                 PUSHMARK(sp);
 371                 perl_call_pv("VI::perldo", G_SCALAR | G_EVAL);
 372 #endif
 373                 str = SvPV(GvSV(PL_errgv), length);
 374                 if (length) break;
 375                 SPAGAIN;
 376                 if(SvTRUEx(POPs))
 377                         i = replace_line(scrp, i, &t_lno);
 378                 PUTBACK;
 379         }
 380         FREETMPS;
 381         LEAVE;
 382
 383         SvREFCNT_dec(SvRV(svcurscr));
 384         SvROK_off(svcurscr);
 385         SvREFCNT_dec(SvRV(svid));
 386         SvROK_off(svid);
 387
 388         if (!length)
 389                 return (0);
 390
 391 err:    str[length - 1] = '\0';
 392         msgq(scrp, M_ERR, "perl: %s", str);
 393         return (1);
 394 }
 395
 396 /*
 397  * msghandler --
 398  *      Perl message routine so that error messages are processed in
 399  *      Perl, not in nvi.
 400  */
 401 static void
 402 msghandler(sp, mtype, msg, len)
 403         SCR *sp;
 404         mtype_t mtype;
 405         char *msg;
 406         size_t len;
 407 {
 408         /* Replace the trailing <newline> with an EOS. */
 409         /* Let's do that later instead */
 410         if (errmsg) free (errmsg);
 411         errmsg = malloc(len + 1);
 412         memcpy(errmsg, msg, len);
 413         errmsg[len] = '\0';
 414 }
 415
 416 /* Register any extra external extensions */
 417
 418 extern void boot_DynaLoader _((CV* cv));
 419 extern void boot_VI _((CV* cv));
 420
 421 static void
 422 xs_init()
 423 {
 424         char *file = __FILE__;
 425
 426 #ifdef HAVE_PERL_5_003_01
 427         dXSUB_SYS
 428 #endif
 429         newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
 430         newXS("VI::bootstrap", boot_VI, file);
 431 }
 432
 433 typedef SCR *   VI;
 434 typedef SCR *   VI__OPT;
 435 typedef SCR *   VI__MAP;
 436 typedef SCR *   VI__MARK;
 437 typedef AV *    AVREF;
 438
 439 MODULE = VI     PACKAGE = VI
 440
 441 # msg --
 442 #       Set the message line to text.
 443 #
 444 # Perl Command: VI::Msg
 445 # Usage: VI::Msg screenId text
 446
 447 void
 448 Msg(screen, text)
 449         VI          screen
 450         char *      text
 451
 452         ALIAS:
 453         PRINT = 1
 454
 455         CODE:
 456         api_imessage(screen, text);
 457
 458 # XS_VI_escreen --
 459 #       End a screen.
 460 #
 461 # Perl Command: VI::EndScreen
 462 # Usage: VI::EndScreen screenId
 463
 464 void
 465 EndScreen(screen)
 466         VI      screen
 467
 468         PREINIT:
 469         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 470         int rval;
 471
 472         CODE:
 473         INITMESSAGE;
 474         rval = api_escreen(screen);
 475         ENDMESSAGE;
 476
 477 # XS_VI_iscreen --
 478 #       Create a new screen.  If a filename is specified then the screen
 479 #       is opened with that file.
 480 #
 481 # Perl Command: VI::NewScreen
 482 # Usage: VI::NewScreen screenId [file]
 483
 484 VI
 485 Edit(screen, ...)
 486         VI screen
 487
 488         ALIAS:
 489         NewScreen = 1
 490
 491         PROTOTYPE: $;$
 492         PREINIT:
 493         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 494         int rval;
 495         char *file;
 496         SCR *nsp;
 497
 498         CODE:
 499         file = (items == 1) ? NULL : (char *)SvPV(ST(1),PL_na);
 500         INITMESSAGE;
 501         rval = api_edit(screen, file, &nsp, ix);
 502         ENDMESSAGE;
 503
 504         RETVAL = ix ? nsp : screen;
 505
 506         OUTPUT:
 507         RETVAL
 508
 509 # XS_VI_fscreen --
 510 #       Return the screen id associated with file name.
 511 #
 512 # Perl Command: VI::FindScreen
 513 # Usage: VI::FindScreen file
 514
 515 VI
 516 FindScreen(file)
 517         char *file
 518
 519         PREINIT:
 520         SCR *fsp;
 521         CODE:
 522         RETVAL = api_fscreen(0, file);
 523
 524 # XS_VI_aline --
 525 #       -- Append the string text after the line in lineNumber.
 526 #
 527 # Perl Command: VI::AppendLine
 528 # Usage: VI::AppendLine screenId lineNumber text
 529
 530 void
 531 AppendLine(screen, linenumber, text)
 532         VI screen
 533         int linenumber
 534         char *text
 535
 536         PREINIT:
 537         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 538         int rval;
 539         STRLEN length;
 540
 541         CODE:
 542         SvPV(ST(2), length);
 543         INITMESSAGE;
 544         rval = api_aline(screen, linenumber, text, length);
 545         ENDMESSAGE;
 546
 547 # XS_VI_dline --
 548 #       Delete lineNum.
 549 #
 550 # Perl Command: VI::DelLine
 551 # Usage: VI::DelLine screenId lineNum
 552
 553 void
 554 DelLine(screen, linenumber)
 555         VI screen
 556         int linenumber
 557
 558         PREINIT:
 559         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 560         int rval;
 561
 562         CODE:
 563         INITMESSAGE;
 564         rval = api_dline(screen, (recno_t)linenumber);
 565         ENDMESSAGE;
 566
 567 # XS_VI_gline --
 568 #       Return lineNumber.
 569 #
 570 # Perl Command: VI::GetLine
 571 # Usage: VI::GetLine screenId lineNumber
 572
 573 char *
 574 GetLine(screen, linenumber)
 575         VI screen
 576         int linenumber
 577
 578         PREINIT:
 579         size_t len;
 580         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 581         int rval;
 582         char *line, *p;
 583
 584         PPCODE:
 585         INITMESSAGE;
 586         rval = api_gline(screen, (recno_t)linenumber, &p, &len);
 587         ENDMESSAGE;
 588
 589         EXTEND(sp,1);
 590         PUSHs(sv_2mortal(newSVpv(p, len)));
 591
 592 # XS_VI_sline --
 593 #       Set lineNumber to the text supplied.
 594 #
 595 # Perl Command: VI::SetLine
 596 # Usage: VI::SetLine screenId lineNumber text
 597
 598 void
 599 SetLine(screen, linenumber, text)
 600         VI screen
 601         int linenumber
 602         char *text
 603
 604         PREINIT:
 605         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 606         int rval;
 607         STRLEN length;
 608
 609         CODE:
 610         SvPV(ST(2), length);
 611         INITMESSAGE;
 612         rval = api_sline(screen, linenumber, text, length);
 613         ENDMESSAGE;
 614
 615 # XS_VI_iline --
 616 #       Insert the string text before the line in lineNumber.
 617 #
 618 # Perl Command: VI::InsertLine
 619 # Usage: VI::InsertLine screenId lineNumber text
 620
 621 void
 622 InsertLine(screen, linenumber, text)
 623         VI screen
 624         int linenumber
 625         char *text
 626
 627         PREINIT:
 628         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 629         int rval;
 630         STRLEN length;
 631
 632         CODE:
 633         SvPV(ST(2), length);
 634         INITMESSAGE;
 635         rval = api_iline(screen, linenumber, text, length);
 636         ENDMESSAGE;
 637
 638 # XS_VI_lline --
 639 #       Return the last line in the screen.
 640 #
 641 # Perl Command: VI::LastLine
 642 # Usage: VI::LastLine screenId
 643
 644 int
 645 LastLine(screen)
 646         VI screen
 647
 648         PREINIT:
 649         recno_t last;
 650         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 651         int rval;
 652
 653         CODE:
 654         INITMESSAGE;
 655         rval = api_lline(screen, &last);
 656         ENDMESSAGE;
 657         RETVAL=last;
 658
 659         OUTPUT:
 660         RETVAL
 661
 662 # XS_VI_getmark --
 663 #       Return the mark's cursor position as a list with two elements.
 664 #       {line, column}.
 665 #
 666 # Perl Command: VI::GetMark
 667 # Usage: VI::GetMark screenId mark
 668
 669 void
 670 GetMark(screen, mark)
 671         VI screen
 672         char mark
 673
 674         PREINIT:
 675         struct _mark cursor;
 676         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 677         int rval;
 678
 679         PPCODE:
 680         INITMESSAGE;
 681         rval = api_getmark(screen, (int)mark, &cursor);
 682         ENDMESSAGE;
 683
 684         EXTEND(sp,2);
 685         PUSHs(sv_2mortal(newSViv(cursor.lno)));
 686         PUSHs(sv_2mortal(newSViv(cursor.cno)));
 687
 688 # XS_VI_setmark --
 689 #       Set the mark to the line and column numbers supplied.
 690 #
 691 # Perl Command: VI::SetMark
 692 # Usage: VI::SetMark screenId mark line column
 693
 694 void
 695 SetMark(screen, mark, line, column)
 696         VI screen
 697         char mark
 698         int line
 699         int column
 700
 701         PREINIT:
 702         struct _mark cursor;
 703         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 704         int rval;
 705
 706         CODE:
 707         INITMESSAGE;
 708         cursor.lno = line;
 709         cursor.cno = column;
 710         rval = api_setmark(screen, (int)mark, &cursor);
 711         ENDMESSAGE;
 712
 713 # XS_VI_getcursor --
 714 #       Return the current cursor position as a list with two elements.
 715 #       {line, column}.
 716 #
 717 # Perl Command: VI::GetCursor
 718 # Usage: VI::GetCursor screenId
 719
 720 void
 721 GetCursor(screen)
 722         VI screen
 723
 724         PREINIT:
 725         struct _mark cursor;
 726         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 727         int rval;
 728
 729         PPCODE:
 730         INITMESSAGE;
 731         rval = api_getcursor(screen, &cursor);
 732         ENDMESSAGE;
 733
 734         EXTEND(sp,2);
 735         PUSHs(sv_2mortal(newSViv(cursor.lno)));
 736         PUSHs(sv_2mortal(newSViv(cursor.cno)));
 737
 738 # XS_VI_setcursor --
 739 #       Set the cursor to the line and column numbers supplied.
 740 #
 741 # Perl Command: VI::SetCursor
 742 # Usage: VI::SetCursor screenId line column
 743
 744 void
 745 SetCursor(screen, line, column)
 746         VI screen
 747         int line
 748         int column
 749
 750         PREINIT:
 751         struct _mark cursor;
 752         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 753         int rval;
 754
 755         CODE:
 756         INITMESSAGE;
 757         cursor.lno = line;
 758         cursor.cno = column;
 759         rval = api_setcursor(screen, &cursor);
 760         ENDMESSAGE;
 761
 762 # XS_VI_swscreen --
 763 #       Change the current focus to screen.
 764 #
 765 # Perl Command: VI::SwitchScreen
 766 # Usage: VI::SwitchScreen screenId screenId
 767
 768 void
 769 SwitchScreen(screenFrom, screenTo)
 770         VI screenFrom
 771         VI screenTo
 772
 773         PREINIT:
 774         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 775         int rval;
 776
 777         CODE:
 778         INITMESSAGE;
 779         rval = api_swscreen(screenFrom, screenTo);
 780         ENDMESSAGE;
 781
 782 # XS_VI_map --
 783 #       Associate a key with a perl procedure.
 784 #
 785 # Perl Command: VI::MapKey
 786 # Usage: VI::MapKey screenId key perlproc
 787
 788 void
 789 MapKey(screen, key, perlproc)
 790         VI screen
 791         char *key
 792         SV *perlproc
 793
 794         PREINIT:
 795         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 796         int rval;
 797         int length;
 798         char *command;
 799         SV *svc;
 800
 801         CODE:
 802         INITMESSAGE;
 803         svc = sv_2mortal(newSVpv(":perl ", 6));
 804         sv_catsv(svc, perlproc);
 805         command = SvPV(svc, length);
 806         rval = api_map(screen, key, command, length);
 807         ENDMESSAGE;
 808
 809 # XS_VI_unmap --
 810 #       Unmap a key.
 811 #
 812 # Perl Command: VI::UnmapKey
 813 # Usage: VI::UnmmapKey screenId key
 814
 815 void
 816 UnmapKey(screen, key)
 817         VI screen
 818         char *key
 819
 820         PREINIT:
 821         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 822         int rval;
 823
 824         CODE:
 825         INITMESSAGE;
 826         rval = api_unmap(screen, key);
 827         ENDMESSAGE;
 828
 829 # XS_VI_opts_set --
 830 #       Set an option.
 831 #
 832 # Perl Command: VI::SetOpt
 833 # Usage: VI::SetOpt screenId setting
 834
 835 void
 836 SetOpt(screen, setting)
 837         VI screen
 838         char *setting
 839
 840         PREINIT:
 841         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 842         int rval;
 843         SV *svc;
 844
 845         CODE:
 846         INITMESSAGE;
 847         svc = sv_2mortal(newSVpv(":set ", 5));
 848         sv_catpv(svc, setting);
 849         rval = api_run_str(screen, SvPV(svc, PL_na));
 850         ENDMESSAGE;
 851
 852 # XS_VI_opts_get --
 853 #       Return the value of an option.
 854 #
 855 # Perl Command: VI::GetOpt
 856 # Usage: VI::GetOpt screenId option
 857
 858 void
 859 GetOpt(screen, option)
 860         VI screen
 861         char *option
 862
 863         PREINIT:
 864         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 865         int rval;
 866         char *value;
 867
 868         PPCODE:
 869         INITMESSAGE;
 870         rval = api_opts_get(screen, option, &value, NULL);
 871         ENDMESSAGE;
 872
 873         EXTEND(SP,1);
 874         PUSHs(sv_2mortal(newSVpv(value, 0)));
 875         free(value);
 876
 877 # XS_VI_run --
 878 #       Run the ex command cmd.
 879 #
 880 # Perl Command: VI::Run
 881 # Usage: VI::Run screenId cmd
 882
 883 void
 884 Run(screen, command)
 885         VI screen
 886         char *command;
 887
 888         PREINIT:
 889         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 890         int rval;
 891
 892         CODE:
 893         INITMESSAGE;
 894         rval = api_run_str(screen, command);
 895         ENDMESSAGE;
 896
 897 void
 898 DESTROY(screen)
 899         VI screen
 900
 901         CODE:
 902         screen->perl_private = 0;
 903
 904 void
 905 Warn(warning)
 906         char *warning;
 907
 908         PREINIT:
 909         int i;
 910         CODE:
 911         sv_catpv(GvSV(PL_errgv),warning);
 912
 913 #define TIED(package) \
 914         sv_magic((SV *) (hv = \
 915             (HV *)sv_2mortal((SV *)newHV())), \
 916                 sv_setref_pv(sv_newmortal(), package, \
 917                         newVIrv(newSV(0), screen)),\
 918                 'P', Nullch, 0);\
 919         RETVAL = newRV((SV *)hv)
 920
 921 SV *
 922 Opt(screen)
 923         VI screen;
 924         PREINIT:
 925         HV *hv;
 926         CODE:
 927         TIED("VI::OPT");
 928         OUTPUT:
 929         RETVAL
 930
 931 SV *
 932 Map(screen)
 933         VI screen;
 934         PREINIT:
 935         HV *hv;
 936         CODE:
 937         TIED("VI::MAP");
 938         OUTPUT:
 939         RETVAL
 940
 941 SV *
 942 Mark(screen)
 943         VI screen
 944         PREINIT:
 945         HV *hv;
 946         CODE:
 947         TIED("VI::MARK");
 948         OUTPUT:
 949         RETVAL
 950
 951 MODULE = VI     PACKAGE = VI::OPT
 952
 953 void
 954 DESTROY(screen)
 955         VI::OPT screen
 956
 957         CODE:
 958         # typemap did all the checking
 959         SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
 960
 961 void
 962 FETCH(screen, key)
 963         VI::OPT screen
 964         char *key
 965
 966         PREINIT:
 967         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 968         int rval;
 969         char *value;
 970         int boolvalue;
 971
 972         PPCODE:
 973         INITMESSAGE;
 974         rval = api_opts_get(screen, key, &value, &boolvalue);
 975         if (!rval) {
 976                 EXTEND(SP,1);
 977                 PUSHs(sv_2mortal((boolvalue == -1) ? newSVpv(value, 0)
 978                                                    : newSViv(boolvalue)));
 979                 free(value);
 980         } else ST(0) = &PL_sv_undef;
 981         rval = 0;
 982         ENDMESSAGE;
 983
 984 void
 985 STORE(screen, key, value)
 986         VI::OPT screen
 987         char    *key
 988         SV      *value
 989
 990         PREINIT:
 991         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
 992         int rval;
 993
 994         CODE:
 995         INITMESSAGE;
 996         rval = api_opts_set(screen, key, SvPV(value, PL_na), SvIV(value),
 997                                          SvTRUEx(value));
 998         ENDMESSAGE;
 999
1000 MODULE = VI     PACKAGE = VI::MAP
1001
1002 void
1003 DESTROY(screen)
1004         VI::MAP screen
1005
1006         CODE:
1007         # typemap did all the checking
1008         SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1009
1010 void
1011 STORE(screen, key, perlproc)
1012         VI::MAP screen
1013         char *key
1014         SV *perlproc
1015
1016         PREINIT:
1017         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1018         int rval;
1019         int length;
1020         char *command;
1021         SV *svc;
1022
1023         CODE:
1024         INITMESSAGE;
1025         svc = sv_2mortal(newSVpv(":perl ", 6));
1026         sv_catsv(svc, perlproc);
1027         command = SvPV(svc, length);
1028         rval = api_map(screen, key, command, length);
1029         ENDMESSAGE;
1030
1031 void
1032 DELETE(screen, key)
1033         VI::MAP screen
1034         char *key
1035
1036         PREINIT:
1037         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1038         int rval;
1039
1040         CODE:
1041         INITMESSAGE;
1042         rval = api_unmap(screen, key);
1043         ENDMESSAGE;
1044
1045 MODULE = VI     PACKAGE = VI::MARK
1046
1047 void
1048 DESTROY(screen)
1049         VI::MARK screen
1050
1051         CODE:
1052         # typemap did all the checking
1053         SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1054
1055 AV *
1056 FETCH(screen, mark)
1057         VI::MARK screen
1058         char mark
1059
1060         PREINIT:
1061         struct _mark cursor;
1062         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1063         int rval;
1064
1065         CODE:
1066         INITMESSAGE;
1067         rval = api_getmark(screen, (int)mark, &cursor);
1068         ENDMESSAGE;
1069         RETVAL = newAV();
1070         av_push(RETVAL, newSViv(cursor.lno));
1071         av_push(RETVAL, newSViv(cursor.cno));
1072
1073         OUTPUT:
1074         RETVAL
1075
1076 void
1077 STORE(screen, mark, pos)
1078         VI::MARK screen
1079         char mark
1080         AVREF pos
1081
1082         PREINIT:
1083         struct _mark cursor;
1084         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1085         int rval;
1086
1087         CODE:
1088         if (av_len(pos) < 1)
1089             croak("cursor position needs 2 elements");
1090         INITMESSAGE;
1091         cursor.lno = SvIV(*av_fetch(pos, 0, 0));
1092         cursor.cno = SvIV(*av_fetch(pos, 1, 0));
1093         rval = api_setmark(screen, (int)mark, &cursor);
1094         ENDMESSAGE;
1095
1096 void
1097 FIRSTKEY(screen, ...)
1098         VI::MARK screen
1099
1100         ALIAS:
1101         NEXTKEY = 1
1102
1103         PROTOTYPE: $;$
1104
1105         PREINIT:
1106         struct _mark cursor;
1107         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1108         int next;
1109         char key[] = {0, 0};
1110
1111         PPCODE:
1112         if (items == 2) {
1113                 next = 1;
1114                 *key = *(char *)SvPV(ST(1),PL_na);
1115         } else next = 0;
1116         if (api_nextmark(screen, next, key) != 1) {
1117                 EXTEND(sp, 1);
1118                 PUSHs(sv_2mortal(newSVpv(key, 1)));
1119         } else ST(0) = &PL_sv_undef;