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.
8 * Copyright (c) 1996-2001
9 * Sven Verdoolaege. All rights reserved.
11 * See the LICENSE file for redistribution information.
17 static const char sccsid[] = "Id: perl.xs,v 8.46 2001/08/28 11:33:42 skimo Exp (Berkeley) Date: 2001/08/28 11:33:42";
20 #include <sys/types.h>
21 #include <sys/queue.h>
24 #include <bitstring.h>
38 /* perl redefines them
41 #undef USE_DYNAMIC_LOADING
49 #include "../common/common.h"
50 #include "../perl_api/extern.h"
53 #define DEFSV GvSV(defgv)
56 #define ERRSV GvSV(errgv)
64 static void msghandler __P((SCR *, mtype_t, char *, size_t));
66 typedef struct _perl_data {
67 PerlInterpreter* interp;
68 SV *svcurscr, *svstart, *svstop, *svid;
73 #define PERLP(sp) ((perl_data_t *)sp->wp->perl_private)
75 #define CHAR2INTP(sp,n,nlen,w,wlen) \
76 CHAR2INT5(sp,((perl_data_t *)sp->wp->perl_private)->cw,n,nlen,w,wlen)
80 * Macros to point messages at the Perl message handler.
82 #define INITMESSAGE(sp) \
83 scr_msg = sp->wp->scr_msg; \
84 sp->wp->scr_msg = msghandler;
85 #define ENDMESSAGE(sp) \
86 sp->wp->scr_msg = scr_msg; \
87 if (rval) croak(PERLP(sp)->errmsg);
89 void xs_init __P((pTHXo));
93 * Clean up perl interpreter
95 * PUBLIC: int perl_end __P((GS *));
102 * Call perl_run and perl_destuct to call END blocks and DESTROY
105 if (gp->perl_interp) {
106 perl_run(gp->perl_interp);
107 perl_destruct(gp->perl_interp);
108 #if defined(DEBUG) || defined(PURIFY) || defined(LIBRARY)
109 perl_free(gp->perl_interp);
111 /* XXX rather make sure only one thread calls perl_end */
119 * We don't use mortal SVs because no one will clean up after us
127 SV* sv = newSVpv(string, 0);
129 /* G_KEEPERR to catch syntax error; better way ? */
131 perl_eval_sv(sv, G_DISCARD | G_NOARGS | G_KEEPERR);
137 * Create the perl commands used by nvi.
139 * PUBLIC: int perl_init __P((SCR *));
148 char *bootargs[] = { "VI", NULL };
154 static char *args[] = { "", "-e", "" };
156 char *file = __FILE__;
161 if (gp->perl_interp == NULL) {
162 gp->perl_interp = perl_alloc();
163 perl_construct(gp->perl_interp);
164 if (perl_parse(gp->perl_interp, xs_init, 3, args, 0)) {
165 perl_destruct(gp->perl_interp);
166 perl_free(gp->perl_interp);
167 gp->perl_interp = NULL;
173 perl_call_argv("VI::bootstrap", G_DISCARD, bootargs);
174 perl_eval("$SIG{__WARN__}='VI::Warn'");
176 av_unshift(av = GvAVn(PL_incgv), 1);
177 av_store(av, 0, newSVpv(_PATH_PERLSCRIPTS,
178 sizeof(_PATH_PERLSCRIPTS)-1));
181 sfdisc(PerlIO_stdout(), sfdcnewnvi(scrp));
182 sfdisc(PerlIO_stderr(), sfdcnewnvi(scrp));
184 svcurscr = perl_get_sv("curscr", TRUE);
185 sv_magic((SV *)gv_fetchpv("STDOUT",TRUE, SVt_PVIO), svcurscr,
187 sv_magic((SV *)gv_fetchpv("STDERR",TRUE, SVt_PVIO), svcurscr,
189 #endif /* USE_SFIO */
192 MALLOC(scrp, pp, perl_data_t *, sizeof(perl_data_t));
193 wp->perl_private = pp;
194 memset(&pp->cw, 0, sizeof(pp->cw));
196 pp->interp = perl_clone(gp->perl_interp, 0);
197 if (1) { /* hack for bug fixed in perl-current (5.6.1) */
199 if (PL_scopestack_ix == 0) {
204 pp->interp = gp->perl_interp;
210 SvREADONLY_on(pp->svcurscr = perl_get_sv("curscr", TRUE));
211 SvREADONLY_on(pp->svstart = perl_get_sv("VI::StartLine", TRUE));
212 SvREADONLY_on(pp->svstop = perl_get_sv("VI::StopLine", TRUE));
213 SvREADONLY_on(pp->svid = perl_get_sv("VI::ScreenId", TRUE));
220 * Remove all refences to the screen to be destroyed
222 * PUBLIC: int perl_screen_end __P((SCR*));
225 perl_screen_end(scrp)
230 if (scrp->perl_private) {
231 sv_setiv((SV*) scrp->perl_private, 0);
240 croak("Perl command interrupted by SIGINT");
243 /* Create a new reference to an SV pointing to the SCR structure
244 * The perl_private part of the SCR structure points to the SV,
245 * so there can only be one such SV for a particular SCR structure.
246 * When the last reference has gone (DESTROY is called),
247 * perl_private is reset; When the screen goes away before
248 * all references are gone, the value of the SV is reset;
249 * any subsequent use of any of those reference will produce
250 * a warning. (see typemap)
259 if (!screen) return sv_setsv(rv, &PL_sv_undef), rv;
260 sv_upgrade(rv, SVt_RV);
261 if (!screen->perl_private) {
262 screen->perl_private = newSV(0);
263 sv_setiv(screen->perl_private, (IV) screen);
265 else SvREFCNT_inc(screen->perl_private);
266 SvRV(rv) = screen->perl_private;
268 return sv_bless(rv, gv_stashpv("VI", TRUE));
273 * Use perl's setenv if perl interpreter has been started.
274 * Perl uses its own setenv and gets confused if we change
275 * the environment after it has started.
277 * PUBLIC: int perl_setenv __P((SCR* sp, const char *name, const char *value));
280 perl_setenv(SCR* scrp, const char *name, const char *value)
282 if (scrp->wp->perl_private == NULL) {
286 setenv(name, value, 1);
288 my_setenv(name, value);
293 * perl_ex_perl -- :[line [,line]] perl [command]
294 * Run a command through the perl interpreter.
296 * PUBLIC: int perl_ex_perl __P((SCR*, CHAR_T *, size_t, db_recno_t, db_recno_t));
299 perl_ex_perl(scrp, cmdp, cmdlen, f_lno, t_lno)
303 db_recno_t f_lno, t_lno;
314 /* Initialize the interpreter. */
315 if (scrp->wp->perl_private == NULL && perl_init(scrp))
317 pp = scrp->wp->perl_private;
322 sv_setiv(pp->svstart, f_lno);
323 sv_setiv(pp->svstop, t_lno);
324 newVIrv(pp->svcurscr, scrp);
325 /* Backwards compatibility. */
326 newVIrv(pp->svid, scrp);
328 istat = signal(SIGINT, my_sighandler);
329 INT2CHAR(scrp, cmdp, STRLEN(cmdp)+1, np, nlen);
331 signal(SIGINT, istat);
333 SvREFCNT_dec(SvRV(pp->svcurscr));
334 SvROK_off(pp->svcurscr);
335 SvREFCNT_dec(SvRV(pp->svid));
338 err = SvPV(ERRSV, length);
342 err[length - 1] = '\0';
343 msgq(scrp, M_ERR, "perl: %s", err);
350 * replace a line with the contents of the perl variable $_
351 * lines are split at '\n's
352 * if $_ is undef, the line is deleted
353 * returns possibly adjusted linenumber
356 replace_line(scrp, line, t_lno, defsv)
358 db_recno_t line, *t_lno;
367 str = SvPV(defsv,len);
368 next = memchr(str, '\n', len);
369 CHAR2INTP(scrp, str, next ? (next - str) : len, wp, wlen);
370 api_sline(scrp, line, wp, wlen);
373 next = memchr(str = next, '\n', len);
374 CHAR2INTP(scrp, str, next ? (next - str) : len,
376 api_iline(scrp, ++line, wp, wlen);
380 api_dline(scrp, line--);
387 * perl_ex_perldo -- :[line [,line]] perl [command]
388 * Run a set of lines through the perl interpreter.
390 * PUBLIC: int perl_ex_perldo __P((SCR*, CHAR_T *, size_t, db_recno_t, db_recno_t));
393 perl_ex_perldo(scrp, cmdp, cmdlen, f_lno, t_lno)
397 db_recno_t f_lno, t_lno;
412 /* Initialize the interpreter. */
413 if (scrp->wp->perl_private == NULL && perl_init(scrp))
415 pp = scrp->wp->perl_private;
420 newVIrv(pp->svcurscr, scrp);
421 /* Backwards compatibility. */
422 newVIrv(pp->svid, scrp);
424 INT2CHAR(scrp, cmdp, STRLEN(cmdp)+1, np, nlen);
425 if (!(command = malloc(length = nlen - 1 + sizeof("sub {}"))))
427 snprintf(command, length, "sub {%s}", np);
432 cv = perl_eval_pv(command, FALSE);
435 estr = SvPV(ERRSV,length);
439 for (i = f_lno; i <= t_lno && !api_gline(scrp, i, &str, &len); i++) {
440 INT2CHAR(scrp, str, len, np, nlen);
441 sv_setpvn(DEFSV,np,nlen);
442 sv_setiv(pp->svstart, i);
443 sv_setiv(pp->svstop, i);
445 perl_call_sv(cv, G_SCALAR | G_EVAL);
446 estr = SvPV(ERRSV, length);
450 i = replace_line(scrp, i, &t_lno, DEFSV);
456 SvREFCNT_dec(SvRV(pp->svcurscr));
457 SvROK_off(pp->svcurscr);
458 SvREFCNT_dec(SvRV(pp->svid));
464 err: estr[length - 1] = '\0';
465 msgq(scrp, M_ERR, "perl: %s", estr);
472 * Perl message routine so that error messages are processed in
476 msghandler(sp, mtype, msg, len)
484 errmsg = PERLP(sp)->errmsg;
486 /* Replace the trailing <newline> with an EOS. */
487 /* Let's do that later instead */
488 if (errmsg) free (errmsg);
489 errmsg = malloc(len + 1);
490 memcpy(errmsg, msg, len);
492 PERLP(sp)->errmsg = errmsg;
497 typedef SCR * VI__OPT;
498 typedef SCR * VI__MAP;
499 typedef SCR * VI__MARK;
500 typedef SCR * VI__LINE;
508 typedef perl_tagq * VI__TAGQ;
509 typedef perl_tagq * VI__TAGQ2;
511 MODULE = VI PACKAGE = VI
514 # Set the message line to text.
516 # Perl Command: VI::Msg
517 # Usage: VI::Msg screenId text
528 api_imessage(screen, text);
533 # Perl Command: VI::EndScreen
534 # Usage: VI::EndScreen screenId
541 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
546 rval = api_escreen(screen);
550 # Create a new screen. If a filename is specified then the screen
551 # is opened with that file.
553 # Perl Command: VI::NewScreen
554 # Usage: VI::NewScreen screenId [file]
565 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
571 file = (items == 1) ? NULL : (char *)SvPV(ST(1),PL_na);
573 rval = api_edit(screen, file, &nsp, ix);
576 RETVAL = ix ? nsp : screen;
582 # Return the screen id associated with file name.
584 # Perl Command: VI::FindScreen
585 # Usage: VI::FindScreen file
594 RETVAL = api_fscreen(0, file);
599 # XS_VI_GetFileName --
600 # Return the file name of the screen
602 # Perl Command: VI::GetFileName
603 # Usage: VI::GetFileName screenId
611 PUSHs(sv_2mortal(newSVpv(screen->frp->name, 0)));
614 # -- Append the string text after the line in lineNumber.
616 # Perl Command: VI::AppendLine
617 # Usage: VI::AppendLine screenId lineNumber text
620 AppendLine(screen, linenumber, text)
626 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
633 rval = api_aline(screen, linenumber, text, length);
639 # Perl Command: VI::DelLine
640 # Usage: VI::DelLine screenId lineNum
643 DelLine(screen, linenumber)
648 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
653 rval = api_dline(screen, (db_recno_t)linenumber);
659 # Perl Command: VI::GetLine
660 # Usage: VI::GetLine screenId lineNumber
663 GetLine(screen, linenumber)
669 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
676 rval = api_gline(screen, (db_recno_t)linenumber, &p, &len);
680 PUSHs(sv_2mortal(newSVpv(len ? (char *)p : "", len)));
683 # Set lineNumber to the text supplied.
685 # Perl Command: VI::SetLine
686 # Usage: VI::SetLine screenId lineNumber text
689 SetLine(screen, linenumber, text)
695 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
704 CHAR2INTP(screen, text, length, line, len);
705 rval = api_sline(screen, linenumber, line, len);
709 # Insert the string text before the line in lineNumber.
711 # Perl Command: VI::InsertLine
712 # Usage: VI::InsertLine screenId lineNumber text
715 InsertLine(screen, linenumber, text)
721 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
730 CHAR2INTP(screen, text, length, line, len);
731 rval = api_iline(screen, linenumber, line, len);
735 # Return the last line in the screen.
737 # Perl Command: VI::LastLine
738 # Usage: VI::LastLine screenId
746 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
751 rval = api_lline(screen, &last);
759 # Return the mark's cursor position as a list with two elements.
762 # Perl Command: VI::GetMark
763 # Usage: VI::GetMark screenId mark
766 GetMark(screen, mark)
772 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
777 rval = api_getmark(screen, (int)mark, &cursor);
781 PUSHs(sv_2mortal(newSViv(cursor.lno)));
782 PUSHs(sv_2mortal(newSViv(cursor.cno)));
785 # Set the mark to the line and column numbers supplied.
787 # Perl Command: VI::SetMark
788 # Usage: VI::SetMark screenId mark line column
791 SetMark(screen, mark, line, column)
799 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
806 rval = api_setmark(screen, (int)mark, &cursor);
810 # Return the current cursor position as a list with two elements.
813 # Perl Command: VI::GetCursor
814 # Usage: VI::GetCursor screenId
822 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
827 rval = api_getcursor(screen, &cursor);
831 PUSHs(sv_2mortal(newSViv(cursor.lno)));
832 PUSHs(sv_2mortal(newSViv(cursor.cno)));
835 # Set the cursor to the line and column numbers supplied.
837 # Perl Command: VI::SetCursor
838 # Usage: VI::SetCursor screenId line column
841 SetCursor(screen, line, column)
848 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
855 rval = api_setcursor(screen, &cursor);
859 # Change the current focus to screen.
861 # Perl Command: VI::SwitchScreen
862 # Usage: VI::SwitchScreen screenId screenId
865 SwitchScreen(screenFrom, screenTo)
870 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
874 INITMESSAGE(screenFrom);
875 rval = api_swscreen(screenFrom, screenTo);
876 ENDMESSAGE(screenFrom);
879 # Associate a key with a perl procedure.
881 # Perl Command: VI::MapKey
882 # Usage: VI::MapKey screenId key perlproc
885 MapKey(screen, key, commandsv)
891 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
898 command = SvPV(commandsv, length);
899 rval = api_map(screen, key, command, length);
905 # Perl Command: VI::UnmapKey
906 # Usage: VI::UnmmapKey screenId key
909 UnmapKey(screen, key)
914 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
919 rval = api_unmap(screen, key);
925 # Perl Command: VI::SetOpt
926 # Usage: VI::SetOpt screenId setting
929 SetOpt(screen, setting)
934 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
940 svc = sv_2mortal(newSVpv(":set ", 5));
941 sv_catpv(svc, setting);
942 rval = api_run_str(screen, SvPV(svc, PL_na));
946 # Return the value of an option.
948 # Perl Command: VI::GetOpt
949 # Usage: VI::GetOpt screenId option
952 GetOpt(screen, option)
957 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
965 CHAR2INTP(screen, option, strlen(option)+1, wp, wlen);
966 rval = api_opts_get(screen, wp, &value, NULL);
970 PUSHs(sv_2mortal(newSVpv(value, 0)));
974 # Run the ex command cmd.
976 # Perl Command: VI::Run
977 # Usage: VI::Run screenId cmd
985 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
990 rval = api_run_str(screen, command);
1001 if (sv_isa(screensv, "VI")) {
1002 IV tmp = SvIV((SV*)SvRV(screensv));
1003 screen = (SCR *) tmp;
1006 croak("screen is not of type VI");
1009 screen->perl_private = 0;
1016 sv_catpv(ERRSV,warning);
1018 #define TIED(kind,package) \
1019 sv_magic((SV *) (var = \
1020 (kind##V *)sv_2mortal((SV *)new##kind##V())), \
1021 sv_setref_pv(sv_newmortal(), package, \
1022 newVIrv(newSV(0), screen)),\
1024 RETVAL = newRV((SV *)var)
1075 if ((ptag = malloc(sizeof(perl_tagq))) == NULL)
1078 ptag->sprv = newVIrv(newSV(0), screen);
1079 ptag->tqp = api_tagq_new(screen, tag);
1080 if (ptag->tqp != NULL) {
1082 PUSHs(sv_2mortal(sv_setref_pv(newSV(0), "VI::TAGQ", ptag)));
1085 ST(0) = &PL_sv_undef;
1089 MODULE = VI PACKAGE = VI::OPT
1096 # typemap did all the checking
1097 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1105 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1113 INITMESSAGE(screen);
1114 CHAR2INTP(screen, key, strlen(key)+1, wp, wlen);
1115 rval = api_opts_get(screen, wp, &value, &boolvalue);
1118 PUSHs(sv_2mortal((boolvalue == -1) ? newSVpv(value, 0)
1119 : newSViv(boolvalue)));
1121 } else ST(0) = &PL_sv_undef;
1126 STORE(screen, key, value)
1132 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1138 INITMESSAGE(screen);
1139 CHAR2INTP(screen, key, strlen(key)+1, wp, wlen);
1140 rval = api_opts_set(screen, wp, SvPV(value, PL_na), SvIV(value),
1144 MODULE = VI PACKAGE = VI::MAP
1151 # typemap did all the checking
1152 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1155 STORE(screen, key, commandsv)
1161 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1167 INITMESSAGE(screen);
1168 command = SvPV(commandsv, length);
1169 rval = api_map(screen, key, command, length);
1178 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1182 INITMESSAGE(screen);
1183 rval = api_unmap(screen, key);
1186 MODULE = VI PACKAGE = VI::MARK
1193 # typemap did all the checking
1194 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1197 EXISTS(screen, mark)
1202 struct _mark cursor;
1203 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1204 int rval = 0; /* never croak */
1208 INITMESSAGE(screen);
1209 missing = api_getmark(screen, (int)mark, &cursor);
1222 struct _mark cursor;
1223 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1227 INITMESSAGE(screen);
1228 rval = api_getmark(screen, (int)mark, &cursor);
1231 av_push(RETVAL, newSViv(cursor.lno));
1232 av_push(RETVAL, newSViv(cursor.cno));
1238 STORE(screen, mark, pos)
1244 struct _mark cursor;
1245 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1249 if (av_len(pos) < 1)
1250 croak("cursor position needs 2 elements");
1251 INITMESSAGE(screen);
1252 cursor.lno = SvIV(*av_fetch(pos, 0, 0));
1253 cursor.cno = SvIV(*av_fetch(pos, 1, 0));
1254 rval = api_setmark(screen, (int)mark, &cursor);
1258 FIRSTKEY(screen, ...)
1268 char key[] = {0, 0};
1273 *key = *(char *)SvPV(ST(1),PL_na);
1275 if (api_nextmark(screen, next, key) != 1) {
1277 PUSHs(sv_2mortal(newSVpv(key, 1)));
1278 } else ST(0) = &PL_sv_undef;
1280 MODULE = VI PACKAGE = VI::LINE
1287 # typemap did all the checking
1288 SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1290 # similar to SetLine
1293 STORE(screen, linenumber, text)
1299 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1307 ++linenumber; /* vi 1 based ; perl 0 based */
1308 SvPV(ST(2), length);
1309 INITMESSAGE(screen);
1310 rval = api_lline(screen, &last);
1312 if (linenumber > last)
1313 rval = api_extend(screen, linenumber);
1315 CHAR2INTP(screen, text, length, line, len);
1316 rval = api_sline(screen, linenumber, line, len);
1320 # similar to GetLine
1323 FETCH(screen, linenumber)
1329 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1335 ++linenumber; /* vi 1 based ; perl 0 based */
1336 INITMESSAGE(screen);
1337 rval = api_gline(screen, (db_recno_t)linenumber, &p, &len);
1341 PUSHs(sv_2mortal(newSVpv(len ? (char*)p : "", len)));
1343 # similar to LastLine
1351 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1355 INITMESSAGE(screen);
1356 rval = api_lline(screen, &last);
1364 STORESIZE(screen, count)
1370 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1374 INITMESSAGE(screen);
1375 rval = api_lline(screen, &last);
1378 rval = api_extend(screen, count);
1379 else while(last && last > count) {
1380 rval = api_dline(screen, last--);
1387 EXTEND(screen, count)
1399 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1403 INITMESSAGE(screen);
1404 rval = api_lline(screen, &last);
1407 rval = api_dline(screen, last--);
1419 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1424 INITMESSAGE(screen);
1425 rval = api_lline(screen, &last);
1428 for (i = 1; i < items; ++i) {
1429 line = SvPV(ST(i), len);
1430 if ((rval = api_aline(screen, last++, line, len)))
1441 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1446 INITMESSAGE(screen);
1447 rval = api_lline(screen, &last);
1448 if (rval || last < 1)
1449 ST(0) = &PL_sv_undef;
1451 rval = api_gline(screen, last, &line, &len) ||
1452 api_dline(screen, last);
1454 PUSHs(sv_2mortal(newSVpv(len ? (char *)line : "", len)));
1464 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1469 INITMESSAGE(screen);
1470 rval = api_lline(screen, &last);
1471 if (rval || last < 1)
1472 ST(0) = &PL_sv_undef;
1474 rval = api_gline(screen, (db_recno_t)1, &line, &len) ||
1475 api_dline(screen, (db_recno_t)1);
1477 PUSHs(sv_2mortal(newSVpv(len ? (char *)line : "", len)));
1482 UNSHIFT(screen, ...)
1486 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1493 INITMESSAGE(screen);
1494 while (--items != 0) {
1495 np = SvPV(ST(items), nlen);
1496 CHAR2INTP(screen, np, nlen, line, len);
1497 if ((rval = api_iline(screen, (db_recno_t)1, line, len)))
1507 db_recno_t last, db_offset;
1508 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1509 int rval, length, common, len, i, offset;
1515 INITMESSAGE(screen);
1516 rval = api_lline(screen, &last);
1517 offset = items > 1 ? (int)SvIV(ST(1)) : 0;
1518 if (offset < 0) offset += last;
1521 croak("Invalid offset");
1523 length = items > 2 ? (int)SvIV(ST(2)) : last - offset;
1524 if (length > last - offset)
1525 length = last - offset;
1526 db_offset = offset + 1; /* 1 based */
1528 for (common = MIN(length, items - 3), i = 3; common > 0;
1529 --common, ++db_offset, --length, ++i) {
1530 rval |= api_gline(screen, db_offset, &line, &len);
1531 INT2CHAR(screen, line, len, np, nlen);
1532 PUSHs(sv_2mortal(newSVpv(nlen ? np : "", nlen)));
1533 np = SvPV(ST(i), nlen);
1534 CHAR2INTP(screen, np, nlen, line, len);
1535 rval |= api_sline(screen, db_offset, line, len);
1537 for (; length; --length) {
1538 rval |= api_gline(screen, db_offset, &line, &len);
1539 INT2CHAR(screen, line, len, np, nlen);
1540 PUSHs(sv_2mortal(newSVpv(len ? np : "", nlen)));
1541 rval |= api_dline(screen, db_offset);
1543 for (; i < items; ++i) {
1544 np = SvPV(ST(i), len);
1545 CHAR2INTP(screen, np, len, line, nlen);
1546 rval |= api_iline(screen, db_offset, line, nlen);
1550 MODULE = VI PACKAGE = VI::TAGQ
1553 Add(tagq, filename, search, msg)
1563 sp = (SCR *)SvIV((SV*)SvRV(tagq->sprv));
1565 croak("screen no longer exists");
1566 api_tagq_add(sp, tagq->tqp, filename, search, msg);
1576 sp = (SCR *)SvIV((SV*)SvRV(tagq->sprv));
1578 croak("screen no longer exists");
1579 api_tagq_push(sp, &tagq->tqp);
1583 # Can already be invalidated by push
1590 sp = (SCR *)SvIV((SV*)SvRV(tagq->sprv));
1592 api_tagq_free(sp, tagq->tqp);
1593 SvREFCNT_dec(tagq->sprv);