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