1 /* $OpenBSD: perl.xs,v 1.4 2009/10/27 23:59:47 deraadt Exp $ */
2
3 /*-
4 * Copyright (c) 1992, 1993, 1994
5 * The Regents of the University of California. All rights reserved.
6 * Copyright (c) 1992, 1993, 1994, 1995, 1996
7 * Keith Bostic. All rights reserved.
8 * Copyright (c) 1995
9 * George V. Neville-Neil. All rights reserved.
10 * Copyright (c) 1996
11 * Sven Verdoolaege. All rights reserved.
12 *
13 * See the LICENSE file for redistribution information.
14 */
15
16 #include "config.h"
17
18 #include <sys/param.h>
19 #include <sys/queue.h>
20 #include <sys/time.h>
21
22 #include <bitstring.h>
23 #include <ctype.h>
24 #include <limits.h>
25 #include <signal.h>
26 #include <stdio.h>
27 #include <stdlib.h>
28 #include <string.h>
29 #include <termios.h>
30 #include <unistd.h>
31
32 #include "../common/common.h"
33
34 #define PERL_POLLUTE
35 #include <EXTERN.h>
36 #include <perl.h>
37 #include <XSUB.h>
38
39 #include "perl_extern.h"
40
41 static void msghandler(SCR *, mtype_t, char *, size_t);
42
43 extern GS *__global_list; /* XXX */
44
45 static char *errmsg = 0;
46
47 /*
48 * INITMESSAGE --
49 * Macros to point messages at the Perl message handler.
50 */
51 #define INITMESSAGE \
52 scr_msg = __global_list->scr_msg; \
53 __global_list->scr_msg = msghandler;
54 #define ENDMESSAGE \
55 __global_list->scr_msg = scr_msg; \
56 if (rval) croak(errmsg);
57
58 static void xs_init(void);
59
60 /*
61 * perl_end --
62 * Clean up perl interpreter
63 *
64 * PUBLIC: int perl_end(GS *);
65 */
66 int
perl_end(gp)67 perl_end(gp)
68 GS *gp;
69 {
70 /*
71 * Call perl_run and perl_destuct to call END blocks and DESTROY
72 * methods.
73 */
74 if (gp->perl_interp) {
75 /*Irestartop = 0; / * XXX */
76 perl_run(gp->perl_interp);
77 perl_destruct(gp->perl_interp);
78 #if defined(DEBUG) || defined(PURIFY) || defined(LIBRARY)
79 perl_free(gp->perl_interp);
80 #endif
81 }
82 }
83
84 /*
85 * perl_eval
86 * Evaluate a string
87 * We don't use mortal SVs because no one will clean up after us
88 */
89 static void
perl_eval(string)90 perl_eval(string)
91 char *string;
92 {
93 #ifdef HAVE_PERL_5_003_01
94 SV* sv = newSVpv(string, 0);
95
96 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
97 SvREFCNT_dec(sv);
98 #else
99 char *argv[2];
100
101 argv[0] = string;
102 argv[1] = NULL;
103 perl_call_argv("_eval_", G_EVAL | G_DISCARD | G_KEEPERR, argv);
104 #endif
105 }
106
107 /*
108 * perl_init --
109 * Create the perl commands used by nvi.
110 *
111 * PUBLIC: int perl_init(SCR *);
112 */
113 int
perl_init(scrp)114 perl_init(scrp)
115 SCR *scrp;
116 {
117 AV * av;
118 GS *gp;
119 char *bootargs[] = { "VI", NULL };
120 #ifndef USE_SFIO
121 SV *svcurscr;
122 #endif
123
124 #ifndef HAVE_PERL_5_003_01
125 static char *args[] = { "", "-e", "sub _eval_ { eval $_[0] }" };
126 #else
127 static char *args[] = { "", "-e", "" };
128 #endif
129 STRLEN length;
130 char *file = __FILE__;
131
132 gp = scrp->gp;
133 gp->perl_interp = perl_alloc();
134 perl_construct(gp->perl_interp);
135 if (perl_parse(gp->perl_interp, xs_init, 3, args, 0)) {
136 perl_destruct(gp->perl_interp);
137 perl_free(gp->perl_interp);
138 gp->perl_interp = NULL;
139 return 1;
140 }
141 perl_call_argv("VI::bootstrap", G_DISCARD, bootargs);
142 perl_eval("$SIG{__WARN__}='VI::Warn'");
143
144 av_unshift(av = GvAVn(PL_incgv), 1);
145 av_store(av, 0, newSVpv(_PATH_PERLSCRIPTS,
146 sizeof(_PATH_PERLSCRIPTS)-1));
147
148 #ifdef USE_SFIO
149 sfdisc(PerlIO_stdout(), sfdcnewnvi(scrp));
150 sfdisc(PerlIO_stderr(), sfdcnewnvi(scrp));
151 #else
152 svcurscr = perl_get_sv("curscr", TRUE);
153 sv_magic((SV *)gv_fetchpv("STDOUT",TRUE, SVt_PVIO), svcurscr,
154 'q', Nullch, 0);
155 sv_magic((SV *)gv_fetchpv("STDERR",TRUE, SVt_PVIO), svcurscr,
156 'q', Nullch, 0);
157 #endif /* USE_SFIO */
158 return (0);
159 }
160
161 /*
162 * perl_screen_end
163 * Remove all refences to the screen to be destroyed
164 *
165 * PUBLIC: int perl_screen_end(SCR*);
166 */
167 int
perl_screen_end(scrp)168 perl_screen_end(scrp)
169 SCR *scrp;
170 {
171 if (scrp->perl_private) {
172 sv_setiv((SV*) scrp->perl_private, 0);
173 }
174 return 0;
175 }
176
177 static void
my_sighandler(i)178 my_sighandler(i)
179 int i;
180 {
181 croak("Perl command interrupted by SIGINT");
182 }
183
184 /* Create a new reference to an SV pointing to the SCR structure
185 * The perl_private part of the SCR structure points to the SV,
186 * so there can only be one such SV for a particular SCR structure.
187 * When the last reference has gone (DESTROY is called),
188 * perl_private is reset; When the screen goes away before
189 * all references are gone, the value of the SV is reset;
190 * any subsequent use of any of those reference will produce
191 * a warning. (see typemap)
192 */
193 static SV *
newVIrv(rv,screen)194 newVIrv(rv, screen)
195 SV *rv;
196 SCR *screen;
197 {
198 sv_upgrade(rv, SVt_RV);
199 if (!screen->perl_private) {
200 screen->perl_private = newSV(0);
201 sv_setiv(screen->perl_private, (IV) screen);
202 }
203 else SvREFCNT_inc(screen->perl_private);
204 SvRV(rv) = screen->perl_private;
205 SvROK_on(rv);
206 return sv_bless(rv, gv_stashpv("VI", TRUE));
207 }
208
209
210 /*
211 * perl_ex_perl -- :[line [,line]] perl [command]
212 * Run a command through the perl interpreter.
213 *
214 * PUBLIC: int perl_ex_perl(SCR*, CHAR_T *, size_t, recno_t, recno_t);
215 */
216 int
perl_ex_perl(scrp,cmdp,cmdlen,f_lno,t_lno)217 perl_ex_perl(scrp, cmdp, cmdlen, f_lno, t_lno)
218 SCR *scrp;
219 CHAR_T *cmdp;
220 size_t cmdlen;
221 recno_t f_lno, t_lno;
222 {
223 static SV *svcurscr = 0, *svstart, *svstop, *svid;
224 GS *gp;
225 STRLEN length;
226 size_t len;
227 char *err;
228 Signal_t (*istat)();
229
230 /* Initialize the interpreter. */
231 gp = scrp->gp;
232 if (!svcurscr) {
233 if (gp->perl_interp == NULL && perl_init(scrp))
234 return (1);
235 SvREADONLY_on(svcurscr = perl_get_sv("curscr", TRUE));
236 SvREADONLY_on(svstart = perl_get_sv("VI::StartLine", TRUE));
237 SvREADONLY_on(svstop = perl_get_sv("VI::StopLine", TRUE));
238 SvREADONLY_on(svid = perl_get_sv("VI::ScreenId", TRUE));
239 }
240
241 sv_setiv(svstart, f_lno);
242 sv_setiv(svstop, t_lno);
243 newVIrv(svcurscr, scrp);
244 /* Backwards compatibility. */
245 newVIrv(svid, scrp);
246
247 istat = signal(SIGINT, my_sighandler);
248 perl_eval(cmdp);
249 signal(SIGINT, istat);
250
251 SvREFCNT_dec(SvRV(svcurscr));
252 SvROK_off(svcurscr);
253 SvREFCNT_dec(SvRV(svid));
254 SvROK_off(svid);
255
256 err = SvPV(GvSV(errgv), length);
257 if (!length)
258 return (0);
259
260 err[length - 1] = '\0';
261 msgq(scrp, M_ERR, "perl: %s", err);
262 return (1);
263 }
264
265 /*
266 * replace_line
267 * replace a line with the contents of the perl variable $_
268 * lines are split at '\n's
269 * if $_ is undef, the line is deleted
270 * returns possibly adjusted linenumber
271 */
272 static int
replace_line(scrp,line,t_lno)273 replace_line(scrp, line, t_lno)
274 SCR *scrp;
275 recno_t line, *t_lno;
276 {
277 char *str, *next;
278 size_t len;
279
280 if (SvOK(GvSV(defgv))) {
281 str = SvPV(GvSV(defgv),len);
282 next = memchr(str, '\n', len);
283 api_sline(scrp, line, str, next ? (next - str) : len);
284 while (next++) {
285 len -= next - str;
286 next = memchr(str = next, '\n', len);
287 api_iline(scrp, ++line, str, next ? (next - str) : len);
288 (*t_lno)++;
289 }
290 } else {
291 api_dline(scrp, line--);
292 (*t_lno)--;
293 }
294 return line;
295 }
296
297 /*
298 * perl_ex_perldo -- :[line [,line]] perl [command]
299 * Run a set of lines through the perl interpreter.
300 *
301 * PUBLIC: int perl_ex_perldo(SCR*, CHAR_T *, size_t, recno_t, recno_t);
302 */
303 int
perl_ex_perldo(scrp,cmdp,cmdlen,f_lno,t_lno)304 perl_ex_perldo(scrp, cmdp, cmdlen, f_lno, t_lno)
305 SCR *scrp;
306 CHAR_T *cmdp;
307 size_t cmdlen;
308 recno_t f_lno, t_lno;
309 {
310 static SV *svcurscr = 0, *svstart, *svstop, *svid;
311 CHAR_T *p;
312 GS *gp;
313 STRLEN length;
314 size_t len;
315 recno_t i;
316 char *str;
317 #ifndef HAVE_PERL_5_003_01
318 char *argv[2];
319 #else
320 SV* sv;
321 #endif
322 dSP;
323
324 /* Initialize the interpreter. */
325 gp = scrp->gp;
326 if (!svcurscr) {
327 if (gp->perl_interp == NULL && perl_init(scrp))
328 return (1);
329 SPAGAIN;
330 SvREADONLY_on(svcurscr = perl_get_sv("curscr", TRUE));
331 SvREADONLY_on(svstart = perl_get_sv("VI::StartLine", TRUE));
332 SvREADONLY_on(svstop = perl_get_sv("VI::StopLine", TRUE));
333 SvREADONLY_on(svid = perl_get_sv("VI::ScreenId", TRUE));
334 }
335
336 #ifndef HAVE_PERL_5_003_01
337 argv[0] = cmdp;
338 argv[1] = NULL;
339 #else
340 length = strlen(cmdp);
341 sv = newSV(length + sizeof("sub VI::perldo {")-1 + 1 /* } */);
342 sv_setpvn(sv, "sub VI::perldo {", sizeof("sub VI::perldo {")-1);
343 sv_catpvn(sv, cmdp, length);
344 sv_catpvn(sv, "}", 1);
345 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
346 SvREFCNT_dec(sv);
347 str = SvPV(GvSV(errgv),length);
348 if (length)
349 goto err;
350 #endif
351
352 newVIrv(svcurscr, scrp);
353 /* Backwards compatibility. */
354 newVIrv(svid, scrp);
355
356 ENTER;
357 SAVETMPS;
358 for (i = f_lno; i <= t_lno && !api_gline(scrp, i, &str, &len); i++) {
359 sv_setpvn(GvSV(defgv),str,len);
360 sv_setiv(svstart, i);
361 sv_setiv(svstop, i);
362 #ifndef HAVE_PERL_5_003_01
363 perl_call_argv("_eval_", G_SCALAR | G_EVAL | G_KEEPERR, argv);
364 #else
365 PUSHMARK(sp);
366 perl_call_pv("VI::perldo", G_SCALAR | G_EVAL);
367 #endif
368 str = SvPV(GvSV(errgv), length);
369 if (length) break;
370 SPAGAIN;
371 if(SvTRUEx(POPs))
372 i = replace_line(scrp, i, &t_lno);
373 PUTBACK;
374 }
375 FREETMPS;
376 LEAVE;
377
378 SvREFCNT_dec(SvRV(svcurscr));
379 SvROK_off(svcurscr);
380 SvREFCNT_dec(SvRV(svid));
381 SvROK_off(svid);
382
383 if (!length)
384 return (0);
385
386 err: str[length - 1] = '\0';
387 msgq(scrp, M_ERR, "perl: %s", str);
388 return (1);
389 }
390
391 /*
392 * msghandler --
393 * Perl message routine so that error messages are processed in
394 * Perl, not in nvi.
395 */
396 static void
msghandler(sp,mtype,msg,len)397 msghandler(sp, mtype, msg, len)
398 SCR *sp;
399 mtype_t mtype;
400 char *msg;
401 size_t len;
402 {
403 /* Replace the trailing <newline> with an EOS. */
404 /* Let's do that later instead */
405 if (errmsg) free (errmsg);
406 errmsg = malloc(len + 1);
407 memcpy(errmsg, msg, len);
408 errmsg[len] = '\0';
409 }
410
411 /* Register any extra external extensions */
412
413 extern void boot_DynaLoader _((CV* cv));
414 extern void boot_VI _((CV* cv));
415
416 static void
xs_init()417 xs_init()
418 {
419 char *file = __FILE__;
420
421 #ifdef HAVE_PERL_5_003_01
422 dXSUB_SYS;
423 #endif
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)(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)(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)(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)(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)(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)(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)(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)(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)(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)(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)(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)(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)(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)(SCR *, mtype_t, char *, size_t);
792 int rval;
793 STRLEN 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)(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)(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)(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)(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)(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)(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)(SCR *, mtype_t, char *, size_t);
1014 int rval;
1015 STRLEN 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)(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)(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)(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)(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