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.
19 static const char sccsid[] = "@(#)perl.xs 8.27 (Berkeley) 10/16/96";
22 #include <sys/types.h>
23 #include <sys/param.h>
24 #include <sys/queue.h>
27 #include <bitstring.h>
38 #include "../common/common.h"
44 #include "perl_extern.h"
46 static void msghandler __P((SCR *, mtype_t, char *, size_t));
48 extern GS *__global_list; /* XXX */
50 static char *errmsg = 0;
54 * Macros to point messages at the Perl message handler.
57 scr_msg = __global_list->scr_msg; \
58 __global_list->scr_msg = msghandler;
60 __global_list->scr_msg = scr_msg; \
61 if (rval) croak(errmsg);
63 static void xs_init __P((void));
67 * Clean up perl interpreter
69 * PUBLIC: int perl_end __P((GS *));
76 * Call perl_run and perl_destuct to call END blocks and DESTROY
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);
92 * We don't use mortal SVs because no one will clean up after us
98 #ifdef HAVE_PERL_5_003_01
99 SV* sv = newSVpv(string, 0);
101 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
108 perl_call_argv("_eval_", G_EVAL | G_DISCARD | G_KEEPERR, argv);
114 * Create the perl commands used by nvi.
116 * PUBLIC: int perl_init __P((SCR *));
124 char *bootargs[] = { "VI", NULL };
129 #ifndef HAVE_PERL_5_003_01
130 static char *args[] = { "", "-e", "sub _eval_ { eval $_[0] }" };
132 static char *args[] = { "", "-e", "" };
135 char *file = __FILE__;
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;
146 perl_call_argv("VI::bootstrap", G_DISCARD, bootargs);
147 perl_eval("$SIG{__WARN__}='VI::Warn'");
149 av_unshift(av = GvAVn(PL_incgv), 1);
150 av_store(av, 0, newSVpv(_PATH_PERLSCRIPTS,
151 sizeof(_PATH_PERLSCRIPTS)-1));
154 sfdisc(PerlIO_stdout(), sfdcnewnvi(scrp));
155 sfdisc(PerlIO_stderr(), sfdcnewnvi(scrp));
157 svcurscr = perl_get_sv("curscr", TRUE);
158 sv_magic((SV *)gv_fetchpv("STDOUT",TRUE, SVt_PVIO), svcurscr,
160 sv_magic((SV *)gv_fetchpv("STDERR",TRUE, SVt_PVIO), svcurscr,
162 #endif /* USE_SFIO */
168 * Remove all refences to the screen to be destroyed
170 * PUBLIC: int perl_screen_end __P((SCR*));
173 perl_screen_end(scrp)
176 if (scrp->perl_private) {
177 sv_setiv((SV*) scrp->perl_private, 0);
186 croak("Perl command interrupted by SIGINT");
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)
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);
208 else SvREFCNT_inc(screen->perl_private);
209 SvRV(rv) = screen->perl_private;
211 return sv_bless(rv, gv_stashpv("VI", TRUE));
216 * perl_ex_perl -- :[line [,line]] perl [command]
217 * Run a command through the perl interpreter.
219 * PUBLIC: int perl_ex_perl __P((SCR*, CHAR_T *, size_t, recno_t, recno_t));
222 perl_ex_perl(scrp, cmdp, cmdlen, f_lno, t_lno)
226 recno_t f_lno, t_lno;
228 static SV *svcurscr = 0, *svstart, *svstop, *svid;
235 /* Initialize the interpreter. */
238 if (gp->perl_interp == NULL && perl_init(scrp))
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));
246 sv_setiv(svstart, f_lno);
247 sv_setiv(svstop, t_lno);
248 newVIrv(svcurscr, scrp);
249 /* Backwards compatibility. */
252 istat = signal(SIGINT, my_sighandler);
254 signal(SIGINT, istat);
256 SvREFCNT_dec(SvRV(svcurscr));
258 SvREFCNT_dec(SvRV(svid));
261 err = SvPV(GvSV(PL_errgv), length);
265 err[length - 1] = '\0';
266 msgq(scrp, M_ERR, "perl: %s", err);
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
278 replace_line(scrp, line, t_lno)
280 recno_t line, *t_lno;
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);
291 next = memchr(str = next, '\n', len);
292 api_iline(scrp, ++line, str, next ? (next - str) : len);
296 api_dline(scrp, line--);
303 * perl_ex_perldo -- :[line [,line]] perl [command]
304 * Run a set of lines through the perl interpreter.
306 * PUBLIC: int perl_ex_perldo __P((SCR*, CHAR_T *, size_t, recno_t, recno_t));
309 perl_ex_perldo(scrp, cmdp, cmdlen, f_lno, t_lno)
313 recno_t f_lno, t_lno;
315 static SV *svcurscr = 0, *svstart, *svstop, *svid;
322 #ifndef HAVE_PERL_5_003_01
329 /* Initialize the interpreter. */
332 if (gp->perl_interp == NULL && perl_init(scrp))
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));
341 #ifndef HAVE_PERL_5_003_01
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);
352 str = SvPV(GvSV(PL_errgv),length);
357 newVIrv(svcurscr, scrp);
358 /* Backwards compatibility. */
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);
367 #ifndef HAVE_PERL_5_003_01
368 perl_call_argv("_eval_", G_SCALAR | G_EVAL | G_KEEPERR, argv);
371 perl_call_pv("VI::perldo", G_SCALAR | G_EVAL);
373 str = SvPV(GvSV(PL_errgv), length);
377 i = replace_line(scrp, i, &t_lno);
383 SvREFCNT_dec(SvRV(svcurscr));
385 SvREFCNT_dec(SvRV(svid));
391 err: str[length - 1] = '\0';
392 msgq(scrp, M_ERR, "perl: %s", str);
398 * Perl message routine so that error messages are processed in
402 msghandler(sp, mtype, msg, len)
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);
416 /* Register any extra external extensions */
418 extern void boot_DynaLoader _((CV* cv));
419 extern void boot_VI _((CV* cv));
424 char *file = __FILE__;
426 #ifdef HAVE_PERL_5_003_01
429 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
430 newXS("VI::bootstrap", boot_VI, file);
434 typedef SCR * VI__OPT;
435 typedef SCR * VI__MAP;
436 typedef SCR * VI__MARK;
439 MODULE = VI PACKAGE = VI
442 # Set the message line to text.
444 # Perl Command: VI::Msg
445 # Usage: VI::Msg screenId text
456 api_imessage(screen, text);
461 # Perl Command: VI::EndScreen
462 # Usage: VI::EndScreen screenId
469 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
474 rval = api_escreen(screen);
478 # Create a new screen. If a filename is specified then the screen
479 # is opened with that file.
481 # Perl Command: VI::NewScreen
482 # Usage: VI::NewScreen screenId [file]
493 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
499 file = (items == 1) ? NULL : (char *)SvPV(ST(1),PL_na);
501 rval = api_edit(screen, file, &nsp, ix);
504 RETVAL = ix ? nsp : screen;
510 # Return the screen id associated with file name.
512 # Perl Command: VI::FindScreen
513 # Usage: VI::FindScreen file
522 RETVAL = api_fscreen(0, file);
525 # -- Append the string text after the line in lineNumber.
527 # Perl Command: VI::AppendLine
528 # Usage: VI::AppendLine screenId lineNumber text
531 AppendLine(screen, linenumber, text)
537 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
544 rval = api_aline(screen, linenumber, text, length);
550 # Perl Command: VI::DelLine
551 # Usage: VI::DelLine screenId lineNum
554 DelLine(screen, linenumber)
559 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
564 rval = api_dline(screen, (recno_t)linenumber);
570 # Perl Command: VI::GetLine
571 # Usage: VI::GetLine screenId lineNumber
574 GetLine(screen, linenumber)
580 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
586 rval = api_gline(screen, (recno_t)linenumber, &p, &len);
590 PUSHs(sv_2mortal(newSVpv(p, len)));
593 # Set lineNumber to the text supplied.
595 # Perl Command: VI::SetLine
596 # Usage: VI::SetLine screenId lineNumber text
599 SetLine(screen, linenumber, text)
605 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
612 rval = api_sline(screen, linenumber, text, length);
616 # Insert the string text before the line in lineNumber.
618 # Perl Command: VI::InsertLine
619 # Usage: VI::InsertLine screenId lineNumber text
622 InsertLine(screen, linenumber, text)
628 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
635 rval = api_iline(screen, linenumber, text, length);
639 # Return the last line in the screen.
641 # Perl Command: VI::LastLine
642 # Usage: VI::LastLine screenId
650 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
655 rval = api_lline(screen, &last);
663 # Return the mark's cursor position as a list with two elements.
666 # Perl Command: VI::GetMark
667 # Usage: VI::GetMark screenId mark
670 GetMark(screen, mark)
676 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
681 rval = api_getmark(screen, (int)mark, &cursor);
685 PUSHs(sv_2mortal(newSViv(cursor.lno)));
686 PUSHs(sv_2mortal(newSViv(cursor.cno)));
689 # Set the mark to the line and column numbers supplied.
691 # Perl Command: VI::SetMark
692 # Usage: VI::SetMark screenId mark line column
695 SetMark(screen, mark, line, column)
703 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
710 rval = api_setmark(screen, (int)mark, &cursor);
714 # Return the current cursor position as a list with two elements.
717 # Perl Command: VI::GetCursor
718 # Usage: VI::GetCursor screenId
726 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
731 rval = api_getcursor(screen, &cursor);
735 PUSHs(sv_2mortal(newSViv(cursor.lno)));
736 PUSHs(sv_2mortal(newSViv(cursor.cno)));
739 # Set the cursor to the line and column numbers supplied.
741 # Perl Command: VI::SetCursor
742 # Usage: VI::SetCursor screenId line column
745 SetCursor(screen, line, column)
752 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
759 rval = api_setcursor(screen, &cursor);
763 # Change the current focus to screen.
765 # Perl Command: VI::SwitchScreen
766 # Usage: VI::SwitchScreen screenId screenId
769 SwitchScreen(screenFrom, screenTo)
774 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
779 rval = api_swscreen(screenFrom, screenTo);
783 # Associate a key with a perl procedure.
785 # Perl Command: VI::MapKey
786 # Usage: VI::MapKey screenId key perlproc
789 MapKey(screen, key, perlproc)
795 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
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);
812 # Perl Command: VI::UnmapKey
813 # Usage: VI::UnmmapKey screenId key
816 UnmapKey(screen, key)
821 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
826 rval = api_unmap(screen, key);
832 # Perl Command: VI::SetOpt
833 # Usage: VI::SetOpt screenId setting
836 SetOpt(screen, setting)
841 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
847 svc = sv_2mortal(newSVpv(":set ", 5));
848 sv_catpv(svc, setting);
849 rval = api_run_str(screen, SvPV(svc, PL_na));
853 # Return the value of an option.
855 # Perl Command: VI::GetOpt
856 # Usage: VI::GetOpt screenId option
859 GetOpt(screen, option)
864 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
870 rval = api_opts_get(screen, option, &value, NULL);
874 PUSHs(sv_2mortal(newSVpv(value, 0)));
878 # Run the ex command cmd.
880 # Perl Command: VI::Run
881 # Usage: VI::Run screenId cmd
889 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
894 rval = api_run_str(screen, command);
902 screen->perl_private = 0;
911 sv_catpv(GvSV(PL_errgv),warning);
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)),\
919 RETVAL = newRV((SV *)hv)
951 MODULE = VI PACKAGE = VI::OPT
958 # typemap did all the checking
959 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
967 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
974 rval = api_opts_get(screen, key, &value, &boolvalue);
977 PUSHs(sv_2mortal((boolvalue == -1) ? newSVpv(value, 0)
978 : newSViv(boolvalue)));
980 } else ST(0) = &PL_sv_undef;
985 STORE(screen, key, value)
991 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
996 rval = api_opts_set(screen, key, SvPV(value, PL_na), SvIV(value),
1000 MODULE = VI PACKAGE = VI::MAP
1007 # typemap did all the checking
1008 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1011 STORE(screen, key, perlproc)
1017 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
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);
1037 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1042 rval = api_unmap(screen, key);
1045 MODULE = VI PACKAGE = VI::MARK
1052 # typemap did all the checking
1053 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1061 struct _mark cursor;
1062 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1067 rval = api_getmark(screen, (int)mark, &cursor);
1070 av_push(RETVAL, newSViv(cursor.lno));
1071 av_push(RETVAL, newSViv(cursor.cno));
1077 STORE(screen, mark, pos)
1083 struct _mark cursor;
1084 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1088 if (av_len(pos) < 1)
1089 croak("cursor position needs 2 elements");
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);
1097 FIRSTKEY(screen, ...)
1106 struct _mark cursor;
1107 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1109 char key[] = {0, 0};
1114 *key = *(char *)SvPV(ST(1),PL_na);
1116 if (api_nextmark(screen, next, key) != 1) {
1118 PUSHs(sv_2mortal(newSVpv(key, 1)));
1119 } else ST(0) = &PL_sv_undef;