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