perl_api/perl.xs

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