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