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