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