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
perl_end(gp)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
perl_eval(string)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
perl_init(scrp)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
perl_screen_end(scrp)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
my_sighandler(i)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 *
newVIrv(rv,screen)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
perl_setenv(SCR * scrp,const char * name,const char * value)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
perl_ex_perl(scrp,cmdp,cmdlen,f_lno,t_lno)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
replace_line(scrp,line,t_lno,defsv)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
perl_ex_perldo(scrp,cmdp,cmdlen,f_lno,t_lno)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
msghandler(sp,mtype,msg,len)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
DESTROY(screensv)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