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.
7 * George V. Neville-Neil. All rights reserved.
9 * Sven Verdoolaege. All rights reserved.
11 * See the LICENSE file for redistribution information.
17 static const char sccsid[] = "@(#)perl.xs 8.27 (Berkeley) 10/16/96";
20 #include <sys/types.h>
21 #include <sys/param.h>
22 #include <sys/queue.h>
25 #include <bitstring.h>
36 #include "../common/common.h"
42 #include "perl_extern.h"
44 static void msghandler __P((SCR *, mtype_t, char *, size_t));
46 extern GS *__global_list; /* XXX */
48 static char *errmsg = 0;
52 * Macros to point messages at the Perl message handler.
55 scr_msg = __global_list->scr_msg; \
56 __global_list->scr_msg = msghandler;
58 __global_list->scr_msg = scr_msg; \
59 if (rval) croak(errmsg);
61 static void xs_init __P((void));
65 * Clean up perl interpreter
67 * PUBLIC: int perl_end __P((GS *));
74 * Call perl_run and perl_destuct to call END blocks and DESTROY
77 if (gp->perl_interp) {
78 /*Irestartop = 0; / * XXX */
79 perl_run(gp->perl_interp);
80 perl_destruct(gp->perl_interp);
81 #if defined(DEBUG) || defined(PURIFY) || defined(LIBRARY)
82 perl_free(gp->perl_interp);
90 * We don't use mortal SVs because no one will clean up after us
96 #ifdef HAVE_PERL_5_003_01
97 SV* sv = newSVpv(string, 0);
99 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
106 perl_call_argv("_eval_", G_EVAL | G_DISCARD | G_KEEPERR, argv);
112 * Create the perl commands used by nvi.
114 * PUBLIC: int perl_init __P((SCR *));
122 char *bootargs[] = { "VI", NULL };
127 #ifndef HAVE_PERL_5_003_01
128 static char *args[] = { "", "-e", "sub _eval_ { eval $_[0] }" };
130 static char *args[] = { "", "-e", "" };
133 char *file = __FILE__;
136 gp->perl_interp = perl_alloc();
137 perl_construct(gp->perl_interp);
138 if (perl_parse(gp->perl_interp, xs_init, 3, args, 0)) {
139 perl_destruct(gp->perl_interp);
140 perl_free(gp->perl_interp);
141 gp->perl_interp = NULL;
144 perl_call_argv("VI::bootstrap", G_DISCARD, bootargs);
145 perl_eval("$SIG{__WARN__}='VI::Warn'");
147 av_unshift(av = GvAVn(PL_incgv), 1);
148 av_store(av, 0, newSVpv(_PATH_PERLSCRIPTS,
149 sizeof(_PATH_PERLSCRIPTS)-1));
152 sfdisc(PerlIO_stdout(), sfdcnewnvi(scrp));
153 sfdisc(PerlIO_stderr(), sfdcnewnvi(scrp));
155 svcurscr = perl_get_sv("curscr", TRUE);
156 sv_magic((SV *)gv_fetchpv("STDOUT",TRUE, SVt_PVIO), svcurscr,
158 sv_magic((SV *)gv_fetchpv("STDERR",TRUE, SVt_PVIO), svcurscr,
160 #endif /* USE_SFIO */
166 * Remove all refences to the screen to be destroyed
168 * PUBLIC: int perl_screen_end __P((SCR*));
171 perl_screen_end(scrp)
174 if (scrp->perl_private) {
175 sv_setiv((SV*) scrp->perl_private, 0);
184 croak("Perl command interrupted by SIGINT");
187 /* Create a new reference to an SV pointing to the SCR structure
188 * The perl_private part of the SCR structure points to the SV,
189 * so there can only be one such SV for a particular SCR structure.
190 * When the last reference has gone (DESTROY is called),
191 * perl_private is reset; When the screen goes away before
192 * all references are gone, the value of the SV is reset;
193 * any subsequent use of any of those reference will produce
194 * a warning. (see typemap)
201 sv_upgrade(rv, SVt_RV);
202 if (!screen->perl_private) {
203 screen->perl_private = newSV(0);
204 sv_setiv(screen->perl_private, (IV) screen);
206 else SvREFCNT_inc(screen->perl_private);
207 SvRV(rv) = screen->perl_private;
209 return sv_bless(rv, gv_stashpv("VI", TRUE));
214 * perl_ex_perl -- :[line [,line]] perl [command]
215 * Run a command through the perl interpreter.
217 * PUBLIC: int perl_ex_perl __P((SCR*, CHAR_T *, size_t, recno_t, recno_t));
220 perl_ex_perl(scrp, cmdp, cmdlen, f_lno, t_lno)
224 recno_t f_lno, t_lno;
226 static SV *svcurscr = 0, *svstart, *svstop, *svid;
233 /* Initialize the interpreter. */
236 if (gp->perl_interp == NULL && perl_init(scrp))
238 SvREADONLY_on(svcurscr = perl_get_sv("curscr", TRUE));
239 SvREADONLY_on(svstart = perl_get_sv("VI::StartLine", TRUE));
240 SvREADONLY_on(svstop = perl_get_sv("VI::StopLine", TRUE));
241 SvREADONLY_on(svid = perl_get_sv("VI::ScreenId", TRUE));
244 sv_setiv(svstart, f_lno);
245 sv_setiv(svstop, t_lno);
246 newVIrv(svcurscr, scrp);
247 /* Backwards compatibility. */
250 istat = signal(SIGINT, my_sighandler);
252 signal(SIGINT, istat);
254 SvREFCNT_dec(SvRV(svcurscr));
256 SvREFCNT_dec(SvRV(svid));
259 err = SvPV(GvSV(errgv), length);
263 err[length - 1] = '\0';
264 msgq(scrp, M_ERR, "perl: %s", err);
270 * replace a line with the contents of the perl variable $_
271 * lines are split at '\n's
272 * if $_ is undef, the line is deleted
273 * returns possibly adjusted linenumber
276 replace_line(scrp, line, t_lno)
278 recno_t line, *t_lno;
283 if (SvOK(GvSV(defgv))) {
284 str = SvPV(GvSV(defgv),len);
285 next = memchr(str, '\n', len);
286 api_sline(scrp, line, str, next ? (next - str) : len);
289 next = memchr(str = next, '\n', len);
290 api_iline(scrp, ++line, str, next ? (next - str) : len);
294 api_dline(scrp, line--);
301 * perl_ex_perldo -- :[line [,line]] perl [command]
302 * Run a set of lines through the perl interpreter.
304 * PUBLIC: int perl_ex_perldo __P((SCR*, CHAR_T *, size_t, recno_t, recno_t));
307 perl_ex_perldo(scrp, cmdp, cmdlen, f_lno, t_lno)
311 recno_t f_lno, t_lno;
313 static SV *svcurscr = 0, *svstart, *svstop, *svid;
320 #ifndef HAVE_PERL_5_003_01
327 /* Initialize the interpreter. */
330 if (gp->perl_interp == NULL && perl_init(scrp))
333 SvREADONLY_on(svcurscr = perl_get_sv("curscr", TRUE));
334 SvREADONLY_on(svstart = perl_get_sv("VI::StartLine", TRUE));
335 SvREADONLY_on(svstop = perl_get_sv("VI::StopLine", TRUE));
336 SvREADONLY_on(svid = perl_get_sv("VI::ScreenId", TRUE));
339 #ifndef HAVE_PERL_5_003_01
343 length = strlen(cmdp);
344 sv = newSV(length + sizeof("sub VI::perldo {")-1 + 1 /* } */);
345 sv_setpvn(sv, "sub VI::perldo {", sizeof("sub VI::perldo {")-1);
346 sv_catpvn(sv, cmdp, length);
347 sv_catpvn(sv, "}", 1);
348 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
350 str = SvPV(GvSV(errgv),length);
355 newVIrv(svcurscr, scrp);
356 /* Backwards compatibility. */
361 for (i = f_lno; i <= t_lno && !api_gline(scrp, i, &str, &len); i++) {
362 sv_setpvn(GvSV(defgv),str,len);
363 sv_setiv(svstart, i);
365 #ifndef HAVE_PERL_5_003_01
366 perl_call_argv("_eval_", G_SCALAR | G_EVAL | G_KEEPERR, argv);
369 perl_call_pv("VI::perldo", G_SCALAR | G_EVAL);
371 str = SvPV(GvSV(errgv), length);
375 i = replace_line(scrp, i, &t_lno);
381 SvREFCNT_dec(SvRV(svcurscr));
383 SvREFCNT_dec(SvRV(svid));
389 err: str[length - 1] = '\0';
390 msgq(scrp, M_ERR, "perl: %s", str);
396 * Perl message routine so that error messages are processed in
400 msghandler(sp, mtype, msg, len)
406 /* Replace the trailing <newline> with an EOS. */
407 /* Let's do that later instead */
408 if (errmsg) free (errmsg);
409 errmsg = malloc(len + 1);
410 memcpy(errmsg, msg, len);
414 /* Register any extra external extensions */
416 extern void boot_DynaLoader _((CV* cv));
417 extern void boot_VI _((CV* cv));
422 char *file = __FILE__;
424 #ifdef HAVE_PERL_5_003_01
427 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
428 newXS("VI::bootstrap", boot_VI, file);
432 typedef SCR * VI__OPT;
433 typedef SCR * VI__MAP;
434 typedef SCR * VI__MARK;
437 MODULE = VI PACKAGE = VI
440 # Set the message line to text.
442 # Perl Command: VI::Msg
443 # Usage: VI::Msg screenId text
454 api_imessage(screen, text);
459 # Perl Command: VI::EndScreen
460 # Usage: VI::EndScreen screenId
467 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
472 rval = api_escreen(screen);
476 # Create a new screen. If a filename is specified then the screen
477 # is opened with that file.
479 # Perl Command: VI::NewScreen
480 # Usage: VI::NewScreen screenId [file]
491 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
497 file = (items == 1) ? NULL : (char *)SvPV(ST(1),na);
499 rval = api_edit(screen, file, &nsp, ix);
502 RETVAL = ix ? nsp : screen;
508 # Return the screen id associated with file name.
510 # Perl Command: VI::FindScreen
511 # Usage: VI::FindScreen file
520 RETVAL = api_fscreen(0, file);
523 # -- Append the string text after the line in lineNumber.
525 # Perl Command: VI::AppendLine
526 # Usage: VI::AppendLine screenId lineNumber text
529 AppendLine(screen, linenumber, text)
535 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
542 rval = api_aline(screen, linenumber, text, length);
548 # Perl Command: VI::DelLine
549 # Usage: VI::DelLine screenId lineNum
552 DelLine(screen, linenumber)
557 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
562 rval = api_dline(screen, (recno_t)linenumber);
568 # Perl Command: VI::GetLine
569 # Usage: VI::GetLine screenId lineNumber
572 GetLine(screen, linenumber)
578 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
584 rval = api_gline(screen, (recno_t)linenumber, &p, &len);
588 PUSHs(sv_2mortal(newSVpv(p, len)));
591 # Set lineNumber to the text supplied.
593 # Perl Command: VI::SetLine
594 # Usage: VI::SetLine screenId lineNumber text
597 SetLine(screen, linenumber, text)
603 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
610 rval = api_sline(screen, linenumber, text, length);
614 # Insert the string text before the line in lineNumber.
616 # Perl Command: VI::InsertLine
617 # Usage: VI::InsertLine screenId lineNumber text
620 InsertLine(screen, linenumber, text)
626 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
633 rval = api_iline(screen, linenumber, text, length);
637 # Return the last line in the screen.
639 # Perl Command: VI::LastLine
640 # Usage: VI::LastLine screenId
648 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
653 rval = api_lline(screen, &last);
661 # Return the mark's cursor position as a list with two elements.
664 # Perl Command: VI::GetMark
665 # Usage: VI::GetMark screenId mark
668 GetMark(screen, mark)
674 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
679 rval = api_getmark(screen, (int)mark, &cursor);
683 PUSHs(sv_2mortal(newSViv(cursor.lno)));
684 PUSHs(sv_2mortal(newSViv(cursor.cno)));
687 # Set the mark to the line and column numbers supplied.
689 # Perl Command: VI::SetMark
690 # Usage: VI::SetMark screenId mark line column
693 SetMark(screen, mark, line, column)
701 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
708 rval = api_setmark(screen, (int)mark, &cursor);
712 # Return the current cursor position as a list with two elements.
715 # Perl Command: VI::GetCursor
716 # Usage: VI::GetCursor screenId
724 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
729 rval = api_getcursor(screen, &cursor);
733 PUSHs(sv_2mortal(newSViv(cursor.lno)));
734 PUSHs(sv_2mortal(newSViv(cursor.cno)));
737 # Set the cursor to the line and column numbers supplied.
739 # Perl Command: VI::SetCursor
740 # Usage: VI::SetCursor screenId line column
743 SetCursor(screen, line, column)
750 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
757 rval = api_setcursor(screen, &cursor);
761 # Change the current focus to screen.
763 # Perl Command: VI::SwitchScreen
764 # Usage: VI::SwitchScreen screenId screenId
767 SwitchScreen(screenFrom, screenTo)
772 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
777 rval = api_swscreen(screenFrom, screenTo);
781 # Associate a key with a perl procedure.
783 # Perl Command: VI::MapKey
784 # Usage: VI::MapKey screenId key perlproc
787 MapKey(screen, key, perlproc)
793 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
801 svc = sv_2mortal(newSVpv(":perl ", 6));
802 sv_catsv(svc, perlproc);
803 command = SvPV(svc, length);
804 rval = api_map(screen, key, command, length);
810 # Perl Command: VI::UnmapKey
811 # Usage: VI::UnmmapKey screenId key
814 UnmapKey(screen, key)
819 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
824 rval = api_unmap(screen, key);
830 # Perl Command: VI::SetOpt
831 # Usage: VI::SetOpt screenId setting
834 SetOpt(screen, setting)
839 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
845 svc = sv_2mortal(newSVpv(":set ", 5));
846 sv_catpv(svc, setting);
847 rval = api_run_str(screen, SvPV(svc, na));
851 # Return the value of an option.
853 # Perl Command: VI::GetOpt
854 # Usage: VI::GetOpt screenId option
857 GetOpt(screen, option)
862 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
868 rval = api_opts_get(screen, option, &value, NULL);
872 PUSHs(sv_2mortal(newSVpv(value, 0)));
876 # Run the ex command cmd.
878 # Perl Command: VI::Run
879 # Usage: VI::Run screenId cmd
887 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
892 rval = api_run_str(screen, command);
900 screen->perl_private = 0;
909 sv_catpv(GvSV(errgv),warning);
911 #define TIED(package) \
912 sv_magic((SV *) (hv = \
913 (HV *)sv_2mortal((SV *)newHV())), \
914 sv_setref_pv(sv_newmortal(), package, \
915 newVIrv(newSV(0), screen)),\
917 RETVAL = newRV((SV *)hv)
949 MODULE = VI PACKAGE = VI::OPT
956 # typemap did all the checking
957 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
965 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
972 rval = api_opts_get(screen, key, &value, &boolvalue);
975 PUSHs(sv_2mortal((boolvalue == -1) ? newSVpv(value, 0)
976 : newSViv(boolvalue)));
978 } else ST(0) = &sv_undef;
983 STORE(screen, key, value)
989 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
994 rval = api_opts_set(screen, key, SvPV(value, na), SvIV(value),
998 MODULE = VI PACKAGE = VI::MAP
1005 # typemap did all the checking
1006 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1009 STORE(screen, key, perlproc)
1015 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1023 svc = sv_2mortal(newSVpv(":perl ", 6));
1024 sv_catsv(svc, perlproc);
1025 command = SvPV(svc, length);
1026 rval = api_map(screen, key, command, length);
1035 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1040 rval = api_unmap(screen, key);
1043 MODULE = VI PACKAGE = VI::MARK
1050 # typemap did all the checking
1051 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1059 struct _mark cursor;
1060 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1065 rval = api_getmark(screen, (int)mark, &cursor);
1068 av_push(RETVAL, newSViv(cursor.lno));
1069 av_push(RETVAL, newSViv(cursor.cno));
1075 STORE(screen, mark, pos)
1081 struct _mark cursor;
1082 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1086 if (av_len(pos) < 1)
1087 croak("cursor position needs 2 elements");
1089 cursor.lno = SvIV(*av_fetch(pos, 0, 0));
1090 cursor.cno = SvIV(*av_fetch(pos, 1, 0));
1091 rval = api_setmark(screen, (int)mark, &cursor);
1095 FIRSTKEY(screen, ...)
1104 struct _mark cursor;
1105 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1107 char key[] = {0, 0};
1112 *key = *(char *)SvPV(ST(1),na);
1114 if (api_nextmark(screen, next, key) != 1) {
1116 PUSHs(sv_2mortal(newSVpv(key, 1)));
1117 } else ST(0) = &sv_undef;