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[] = "$Id: perl.xs,v 8.27 1996/10/16 14:16:34 bostic Exp $ (Berkeley) $Date: 1996/10/16 14:16:34 $";
20 #include <sys/types.h>
21 #include <sys/queue.h>
24 #include <bitstring.h>
34 #include "../common/common.h"
40 #include "perl_extern.h"
42 static void msghandler __P((SCR *, mtype_t, char *, size_t));
44 extern GS *__global_list; /* XXX */
46 static char *errmsg = 0;
50 * Macros to point messages at the Perl message handler.
53 scr_msg = __global_list->scr_msg; \
54 __global_list->scr_msg = msghandler;
56 __global_list->scr_msg = scr_msg; \
57 if (rval) croak(errmsg);
59 static void xs_init __P((void));
63 * Clean up perl interpreter
65 * PUBLIC: int perl_end __P((GS *));
72 * Call perl_run and perl_destuct to call END blocks and DESTROY
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);
88 * We don't use mortal SVs because no one will clean up after us
94 #ifdef HAVE_PERL_5_003_01
95 SV* sv = newSVpv(string, 0);
97 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
104 perl_call_argv("_eval_", G_EVAL | G_DISCARD | G_KEEPERR, argv);
110 * Create the perl commands used by nvi.
112 * PUBLIC: int perl_init __P((SCR *));
120 char *bootargs[] = { "VI", NULL };
125 #ifndef HAVE_PERL_5_003_01
126 static char *args[] = { "", "-e", "sub _eval_ { eval $_[0] }" };
128 static char *args[] = { "", "-e", "" };
131 char *file = __FILE__;
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;
142 perl_call_argv("VI::bootstrap", G_DISCARD, bootargs);
143 perl_eval("$SIG{__WARN__}='VI::Warn'");
145 av_unshift(av = GvAVn(incgv), 1);
146 av_store(av, 0, newSVpv(_PATH_PERLSCRIPTS,
147 sizeof(_PATH_PERLSCRIPTS)-1));
150 sfdisc(PerlIO_stdout(), sfdcnewnvi(scrp));
151 sfdisc(PerlIO_stderr(), sfdcnewnvi(scrp));
153 svcurscr = perl_get_sv("curscr", TRUE);
154 sv_magic((SV *)gv_fetchpv("STDOUT",TRUE, SVt_PVIO), svcurscr,
156 sv_magic((SV *)gv_fetchpv("STDERR",TRUE, SVt_PVIO), svcurscr,
158 #endif /* USE_SFIO */
164 * Remove all refences to the screen to be destroyed
166 * PUBLIC: int perl_screen_end __P((SCR*));
169 perl_screen_end(scrp)
172 if (scrp->perl_private) {
173 sv_setiv((SV*) scrp->perl_private, 0);
182 croak("Perl command interrupted by SIGINT");
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)
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);
204 else SvREFCNT_inc(screen->perl_private);
205 SvRV(rv) = screen->perl_private;
207 return sv_bless(rv, gv_stashpv("VI", TRUE));
212 * perl_ex_perl -- :[line [,line]] perl [command]
213 * Run a command through the perl interpreter.
215 * PUBLIC: int perl_ex_perl __P((SCR*, CHAR_T *, size_t, recno_t, recno_t));
218 perl_ex_perl(scrp, cmdp, cmdlen, f_lno, t_lno)
222 recno_t f_lno, t_lno;
224 static SV *svcurscr = 0, *svstart, *svstop, *svid;
231 /* Initialize the interpreter. */
234 if (gp->perl_interp == NULL && perl_init(scrp))
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));
242 sv_setiv(svstart, f_lno);
243 sv_setiv(svstop, t_lno);
244 newVIrv(svcurscr, scrp);
245 /* Backwards compatibility. */
248 istat = signal(SIGINT, my_sighandler);
250 signal(SIGINT, istat);
252 SvREFCNT_dec(SvRV(svcurscr));
254 SvREFCNT_dec(SvRV(svid));
257 err = SvPV(GvSV(errgv), length);
261 err[length - 1] = '\0';
262 msgq(scrp, M_ERR, "perl: %s", err);
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
274 replace_line(scrp, line, t_lno)
276 recno_t line, *t_lno;
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);
287 next = memchr(str = next, '\n', len);
288 api_iline(scrp, ++line, str, next ? (next - str) : len);
292 api_dline(scrp, line--);
299 * perl_ex_perldo -- :[line [,line]] perl [command]
300 * Run a set of lines through the perl interpreter.
302 * PUBLIC: int perl_ex_perldo __P((SCR*, CHAR_T *, size_t, recno_t, recno_t));
305 perl_ex_perldo(scrp, cmdp, cmdlen, f_lno, t_lno)
309 recno_t f_lno, t_lno;
311 static SV *svcurscr = 0, *svstart, *svstop, *svid;
318 #ifndef HAVE_PERL_5_003_01
325 /* Initialize the interpreter. */
328 if (gp->perl_interp == NULL && perl_init(scrp))
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));
337 #ifndef HAVE_PERL_5_003_01
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);
348 str = SvPV(GvSV(errgv),length);
353 newVIrv(svcurscr, scrp);
354 /* Backwards compatibility. */
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);
363 #ifndef HAVE_PERL_5_003_01
364 perl_call_argv("_eval_", G_SCALAR | G_EVAL | G_KEEPERR, argv);
367 perl_call_pv("VI::perldo", G_SCALAR | G_EVAL);
369 str = SvPV(GvSV(errgv), length);
373 i = replace_line(scrp, i, &t_lno);
379 SvREFCNT_dec(SvRV(svcurscr));
381 SvREFCNT_dec(SvRV(svid));
387 err: str[length - 1] = '\0';
388 msgq(scrp, M_ERR, "perl: %s", str);
394 * Perl message routine so that error messages are processed in
398 msghandler(sp, mtype, msg, len)
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);
412 /* Register any extra external extensions */
414 extern void boot_DynaLoader _((CV* cv));
415 extern void boot_VI _((CV* cv));
420 #ifdef HAVE_PERL_5_003_01
423 char *file = __FILE__;
425 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
426 newXS("VI::bootstrap", boot_VI, file);
430 typedef SCR * VI__OPT;
431 typedef SCR * VI__MAP;
432 typedef SCR * VI__MARK;
435 MODULE = VI PACKAGE = VI
438 # Set the message line to text.
440 # Perl Command: VI::Msg
441 # Usage: VI::Msg screenId text
452 api_imessage(screen, text);
457 # Perl Command: VI::EndScreen
458 # Usage: VI::EndScreen screenId
465 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
470 rval = api_escreen(screen);
474 # Create a new screen. If a filename is specified then the screen
475 # is opened with that file.
477 # Perl Command: VI::NewScreen
478 # Usage: VI::NewScreen screenId [file]
489 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
495 file = (items == 1) ? NULL : (char *)SvPV(ST(1),na);
497 rval = api_edit(screen, file, &nsp, ix);
500 RETVAL = ix ? nsp : screen;
506 # Return the screen id associated with file name.
508 # Perl Command: VI::FindScreen
509 # Usage: VI::FindScreen file
518 RETVAL = api_fscreen(0, file);
521 # -- Append the string text after the line in lineNumber.
523 # Perl Command: VI::AppendLine
524 # Usage: VI::AppendLine screenId lineNumber text
527 AppendLine(screen, linenumber, text)
533 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
540 rval = api_aline(screen, linenumber, text, length);
546 # Perl Command: VI::DelLine
547 # Usage: VI::DelLine screenId lineNum
550 DelLine(screen, linenumber)
555 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
560 rval = api_dline(screen, (recno_t)linenumber);
566 # Perl Command: VI::GetLine
567 # Usage: VI::GetLine screenId lineNumber
570 GetLine(screen, linenumber)
576 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
582 rval = api_gline(screen, (recno_t)linenumber, &p, &len);
586 PUSHs(sv_2mortal(newSVpv(p, len)));
589 # Set lineNumber to the text supplied.
591 # Perl Command: VI::SetLine
592 # Usage: VI::SetLine screenId lineNumber text
595 SetLine(screen, linenumber, text)
601 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
608 rval = api_sline(screen, linenumber, text, length);
612 # Insert the string text before the line in lineNumber.
614 # Perl Command: VI::InsertLine
615 # Usage: VI::InsertLine screenId lineNumber text
618 InsertLine(screen, linenumber, text)
624 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
631 rval = api_iline(screen, linenumber, text, length);
635 # Return the last line in the screen.
637 # Perl Command: VI::LastLine
638 # Usage: VI::LastLine screenId
646 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
651 rval = api_lline(screen, &last);
659 # Return the mark's cursor position as a list with two elements.
662 # Perl Command: VI::GetMark
663 # Usage: VI::GetMark screenId mark
666 GetMark(screen, mark)
672 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
677 rval = api_getmark(screen, (int)mark, &cursor);
681 PUSHs(sv_2mortal(newSViv(cursor.lno)));
682 PUSHs(sv_2mortal(newSViv(cursor.cno)));
685 # Set the mark to the line and column numbers supplied.
687 # Perl Command: VI::SetMark
688 # Usage: VI::SetMark screenId mark line column
691 SetMark(screen, mark, line, column)
699 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
706 rval = api_setmark(screen, (int)mark, &cursor);
710 # Return the current cursor position as a list with two elements.
713 # Perl Command: VI::GetCursor
714 # Usage: VI::GetCursor screenId
722 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
727 rval = api_getcursor(screen, &cursor);
731 PUSHs(sv_2mortal(newSViv(cursor.lno)));
732 PUSHs(sv_2mortal(newSViv(cursor.cno)));
735 # Set the cursor to the line and column numbers supplied.
737 # Perl Command: VI::SetCursor
738 # Usage: VI::SetCursor screenId line column
741 SetCursor(screen, line, column)
748 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
755 rval = api_setcursor(screen, &cursor);
759 # Change the current focus to screen.
761 # Perl Command: VI::SwitchScreen
762 # Usage: VI::SwitchScreen screenId screenId
765 SwitchScreen(screenFrom, screenTo)
770 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
775 rval = api_swscreen(screenFrom, screenTo);
779 # Associate a key with a perl procedure.
781 # Perl Command: VI::MapKey
782 # Usage: VI::MapKey screenId key perlproc
785 MapKey(screen, key, perlproc)
791 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
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);
808 # Perl Command: VI::UnmapKey
809 # Usage: VI::UnmmapKey screenId key
812 UnmapKey(screen, key)
817 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
822 rval = api_unmap(screen, key);
828 # Perl Command: VI::SetOpt
829 # Usage: VI::SetOpt screenId setting
832 SetOpt(screen, setting)
837 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
843 svc = sv_2mortal(newSVpv(":set ", 5));
844 sv_catpv(svc, setting);
845 rval = api_run_str(screen, SvPV(svc, na));
849 # Return the value of an option.
851 # Perl Command: VI::GetOpt
852 # Usage: VI::GetOpt screenId option
855 GetOpt(screen, option)
860 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
866 rval = api_opts_get(screen, option, &value, NULL);
870 PUSHs(sv_2mortal(newSVpv(value, 0)));
874 # Run the ex command cmd.
876 # Perl Command: VI::Run
877 # Usage: VI::Run screenId cmd
885 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
890 rval = api_run_str(screen, command);
898 screen->perl_private = 0;
907 sv_catpv(GvSV(errgv),warning);
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)),\
915 RETVAL = newRV((SV *)hv)
947 MODULE = VI PACKAGE = VI::OPT
954 # typemap did all the checking
955 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
963 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
970 rval = api_opts_get(screen, key, &value, &boolvalue);
973 PUSHs(sv_2mortal((boolvalue == -1) ? newSVpv(value, 0)
974 : newSViv(boolvalue)));
976 } else ST(0) = &sv_undef;
981 STORE(screen, key, value)
987 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
992 rval = api_opts_set(screen, key, SvPV(value, na), SvIV(value),
996 MODULE = VI PACKAGE = VI::MAP
1003 # typemap did all the checking
1004 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1007 STORE(screen, key, perlproc)
1013 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
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);
1033 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1038 rval = api_unmap(screen, key);
1041 MODULE = VI PACKAGE = VI::MARK
1048 # typemap did all the checking
1049 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1057 struct _mark cursor;
1058 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1063 rval = api_getmark(screen, (int)mark, &cursor);
1066 av_push(RETVAL, newSViv(cursor.lno));
1067 av_push(RETVAL, newSViv(cursor.cno));
1073 STORE(screen, mark, pos)
1079 struct _mark cursor;
1080 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1084 if (av_len(pos) < 1)
1085 croak("cursor position needs 2 elements");
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);
1093 FIRSTKEY(screen, ...)
1102 struct _mark cursor;
1103 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1105 char key[] = {0, 0};
1110 *key = *(char *)SvPV(ST(1),na);
1112 if (api_nextmark(screen, next, key) != 1) {
1114 PUSHs(sv_2mortal(newSVpv(key, 1)));
1115 } else ST(0) = &sv_undef;