diff options
Diffstat (limited to 'contrib/nvi/perl_api/perl.xs')
| -rw-r--r-- | contrib/nvi/perl_api/perl.xs | 1115 |
1 files changed, 1115 insertions, 0 deletions
diff --git a/contrib/nvi/perl_api/perl.xs b/contrib/nvi/perl_api/perl.xs new file mode 100644 index 000000000000..0b48cded5bfc --- /dev/null +++ b/contrib/nvi/perl_api/perl.xs @@ -0,0 +1,1115 @@ +/*- + * Copyright (c) 1992, 1993, 1994 + * The Regents of the University of California. All rights reserved. + * Copyright (c) 1992, 1993, 1994, 1995, 1996 + * Keith Bostic. All rights reserved. + * Copyright (c) 1995 + * George V. Neville-Neil. All rights reserved. + * Copyright (c) 1996 + * Sven Verdoolaege. All rights reserved. + * + * See the LICENSE file for redistribution information. + */ + +#include "config.h" + +#ifndef lint +static const char sccsid[] = "@(#)perl.xs 8.27 (Berkeley) 10/16/96"; +#endif /* not lint */ + +#include <sys/types.h> +#include <sys/queue.h> +#include <sys/time.h> + +#include <bitstring.h> +#include <ctype.h> +#include <limits.h> +#include <signal.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <termios.h> +#include <unistd.h> + +#include "../common/common.h" + +#include <EXTERN.h> +#include <perl.h> +#include <XSUB.h> + +#include "perl_extern.h" + +static void msghandler __P((SCR *, mtype_t, char *, size_t)); + +extern GS *__global_list; /* XXX */ + +static char *errmsg = 0; + +/* + * INITMESSAGE -- + * Macros to point messages at the Perl message handler. + */ +#define INITMESSAGE \ + scr_msg = __global_list->scr_msg; \ + __global_list->scr_msg = msghandler; +#define ENDMESSAGE \ + __global_list->scr_msg = scr_msg; \ + if (rval) croak(errmsg); + +static void xs_init __P((void)); + +/* + * perl_end -- + * Clean up perl interpreter + * + * PUBLIC: int perl_end __P((GS *)); + */ +int +perl_end(gp) + GS *gp; +{ + /* + * Call perl_run and perl_destuct to call END blocks and DESTROY + * methods. + */ + if (gp->perl_interp) { + /*Irestartop = 0; / * XXX */ + perl_run(gp->perl_interp); + perl_destruct(gp->perl_interp); +#if defined(DEBUG) || defined(PURIFY) || defined(LIBRARY) + perl_free(gp->perl_interp); +#endif + } +} + +/* + * perl_eval + * Evaluate a string + * We don't use mortal SVs because no one will clean up after us + */ +static void +perl_eval(string) + char *string; +{ +#ifdef HAVE_PERL_5_003_01 + SV* sv = newSVpv(string, 0); + + perl_eval_sv(sv, G_DISCARD | G_NOARGS); + SvREFCNT_dec(sv); +#else + char *argv[2]; + + argv[0] = string; + argv[1] = NULL; + perl_call_argv("_eval_", G_EVAL | G_DISCARD | G_KEEPERR, argv); +#endif +} + +/* + * perl_init -- + * Create the perl commands used by nvi. + * + * PUBLIC: int perl_init __P((SCR *)); + */ +int +perl_init(scrp) + SCR *scrp; +{ + AV * av; + GS *gp; + char *bootargs[] = { "VI", NULL }; +#ifndef USE_SFIO + SV *svcurscr; +#endif + +#ifndef HAVE_PERL_5_003_01 + static char *args[] = { "", "-e", "sub _eval_ { eval $_[0] }" }; +#else + static char *args[] = { "", "-e", "" }; +#endif + STRLEN length; + char *file = __FILE__; + + gp = scrp->gp; + gp->perl_interp = perl_alloc(); + perl_construct(gp->perl_interp); + if (perl_parse(gp->perl_interp, xs_init, 3, args, 0)) { + perl_destruct(gp->perl_interp); + perl_free(gp->perl_interp); + gp->perl_interp = NULL; + return 1; + } + perl_call_argv("VI::bootstrap", G_DISCARD, bootargs); + perl_eval("$SIG{__WARN__}='VI::Warn'"); + + av_unshift(av = GvAVn(incgv), 1); + av_store(av, 0, newSVpv(_PATH_PERLSCRIPTS, + sizeof(_PATH_PERLSCRIPTS)-1)); + +#ifdef USE_SFIO + sfdisc(PerlIO_stdout(), sfdcnewnvi(scrp)); + sfdisc(PerlIO_stderr(), sfdcnewnvi(scrp)); +#else + svcurscr = perl_get_sv("curscr", TRUE); + sv_magic((SV *)gv_fetchpv("STDOUT",TRUE, SVt_PVIO), svcurscr, + 'q', Nullch, 0); + sv_magic((SV *)gv_fetchpv("STDERR",TRUE, SVt_PVIO), svcurscr, + 'q', Nullch, 0); +#endif /* USE_SFIO */ + return (0); +} + +/* + * perl_screen_end + * Remove all refences to the screen to be destroyed + * + * PUBLIC: int perl_screen_end __P((SCR*)); + */ +int +perl_screen_end(scrp) + SCR *scrp; +{ + if (scrp->perl_private) { + sv_setiv((SV*) scrp->perl_private, 0); + } + return 0; +} + +static void +my_sighandler(i) + int i; +{ + croak("Perl command interrupted by SIGINT"); +} + +/* Create a new reference to an SV pointing to the SCR structure + * The perl_private part of the SCR structure points to the SV, + * so there can only be one such SV for a particular SCR structure. + * When the last reference has gone (DESTROY is called), + * perl_private is reset; When the screen goes away before + * all references are gone, the value of the SV is reset; + * any subsequent use of any of those reference will produce + * a warning. (see typemap) + */ +static SV * +newVIrv(rv, screen) + SV *rv; + SCR *screen; +{ + sv_upgrade(rv, SVt_RV); + if (!screen->perl_private) { + screen->perl_private = newSV(0); + sv_setiv(screen->perl_private, (IV) screen); + } + else SvREFCNT_inc(screen->perl_private); + SvRV(rv) = screen->perl_private; + SvROK_on(rv); + return sv_bless(rv, gv_stashpv("VI", TRUE)); +} + + +/* + * perl_ex_perl -- :[line [,line]] perl [command] + * Run a command through the perl interpreter. + * + * PUBLIC: int perl_ex_perl __P((SCR*, CHAR_T *, size_t, recno_t, recno_t)); + */ +int +perl_ex_perl(scrp, cmdp, cmdlen, f_lno, t_lno) + SCR *scrp; + CHAR_T *cmdp; + size_t cmdlen; + recno_t f_lno, t_lno; +{ + static SV *svcurscr = 0, *svstart, *svstop, *svid; + GS *gp; + STRLEN length; + size_t len; + char *err; + Signal_t (*istat)(); + + /* Initialize the interpreter. */ + gp = scrp->gp; + if (!svcurscr) { + if (gp->perl_interp == NULL && perl_init(scrp)) + return (1); + SvREADONLY_on(svcurscr = perl_get_sv("curscr", TRUE)); + SvREADONLY_on(svstart = perl_get_sv("VI::StartLine", TRUE)); + SvREADONLY_on(svstop = perl_get_sv("VI::StopLine", TRUE)); + SvREADONLY_on(svid = perl_get_sv("VI::ScreenId", TRUE)); + } + + sv_setiv(svstart, f_lno); + sv_setiv(svstop, t_lno); + newVIrv(svcurscr, scrp); + /* Backwards compatibility. */ + newVIrv(svid, scrp); + + istat = signal(SIGINT, my_sighandler); + perl_eval(cmdp); + signal(SIGINT, istat); + + SvREFCNT_dec(SvRV(svcurscr)); + SvROK_off(svcurscr); + SvREFCNT_dec(SvRV(svid)); + SvROK_off(svid); + + err = SvPV(GvSV(errgv), length); + if (!length) + return (0); + + err[length - 1] = '\0'; + msgq(scrp, M_ERR, "perl: %s", err); + return (1); +} + +/* + * replace_line + * replace a line with the contents of the perl variable $_ + * lines are split at '\n's + * if $_ is undef, the line is deleted + * returns possibly adjusted linenumber + */ +static int +replace_line(scrp, line, t_lno) + SCR *scrp; + recno_t line, *t_lno; +{ + char *str, *next; + size_t len; + + if (SvOK(GvSV(defgv))) { + str = SvPV(GvSV(defgv),len); + next = memchr(str, '\n', len); + api_sline(scrp, line, str, next ? (next - str) : len); + while (next++) { + len -= next - str; + next = memchr(str = next, '\n', len); + api_iline(scrp, ++line, str, next ? (next - str) : len); + (*t_lno)++; + } + } else { + api_dline(scrp, line--); + (*t_lno)--; + } + return line; +} + +/* + * perl_ex_perldo -- :[line [,line]] perl [command] + * Run a set of lines through the perl interpreter. + * + * PUBLIC: int perl_ex_perldo __P((SCR*, CHAR_T *, size_t, recno_t, recno_t)); + */ +int +perl_ex_perldo(scrp, cmdp, cmdlen, f_lno, t_lno) + SCR *scrp; + CHAR_T *cmdp; + size_t cmdlen; + recno_t f_lno, t_lno; +{ + static SV *svcurscr = 0, *svstart, *svstop, *svid; + CHAR_T *p; + GS *gp; + STRLEN length; + size_t len; + recno_t i; + char *str; +#ifndef HAVE_PERL_5_003_01 + char *argv[2]; +#else + SV* sv; +#endif + dSP; + + /* Initialize the interpreter. */ + gp = scrp->gp; + if (!svcurscr) { + if (gp->perl_interp == NULL && perl_init(scrp)) + return (1); + SPAGAIN; + SvREADONLY_on(svcurscr = perl_get_sv("curscr", TRUE)); + SvREADONLY_on(svstart = perl_get_sv("VI::StartLine", TRUE)); + SvREADONLY_on(svstop = perl_get_sv("VI::StopLine", TRUE)); + SvREADONLY_on(svid = perl_get_sv("VI::ScreenId", TRUE)); + } + +#ifndef HAVE_PERL_5_003_01 + argv[0] = cmdp; + argv[1] = NULL; +#else + length = strlen(cmdp); + sv = newSV(length + sizeof("sub VI::perldo {")-1 + 1 /* } */); + sv_setpvn(sv, "sub VI::perldo {", sizeof("sub VI::perldo {")-1); + sv_catpvn(sv, cmdp, length); + sv_catpvn(sv, "}", 1); + perl_eval_sv(sv, G_DISCARD | G_NOARGS); + SvREFCNT_dec(sv); + str = SvPV(GvSV(errgv),length); + if (length) + goto err; +#endif + + newVIrv(svcurscr, scrp); + /* Backwards compatibility. */ + newVIrv(svid, scrp); + + ENTER; + SAVETMPS; + for (i = f_lno; i <= t_lno && !api_gline(scrp, i, &str, &len); i++) { + sv_setpvn(GvSV(defgv),str,len); + sv_setiv(svstart, i); + sv_setiv(svstop, i); +#ifndef HAVE_PERL_5_003_01 + perl_call_argv("_eval_", G_SCALAR | G_EVAL | G_KEEPERR, argv); +#else + PUSHMARK(sp); + perl_call_pv("VI::perldo", G_SCALAR | G_EVAL); +#endif + str = SvPV(GvSV(errgv), length); + if (length) break; + SPAGAIN; + if(SvTRUEx(POPs)) + i = replace_line(scrp, i, &t_lno); + PUTBACK; + } + FREETMPS; + LEAVE; + + SvREFCNT_dec(SvRV(svcurscr)); + SvROK_off(svcurscr); + SvREFCNT_dec(SvRV(svid)); + SvROK_off(svid); + + if (!length) + return (0); + +err: str[length - 1] = '\0'; + msgq(scrp, M_ERR, "perl: %s", str); + return (1); +} + +/* + * msghandler -- + * Perl message routine so that error messages are processed in + * Perl, not in nvi. + */ +static void +msghandler(sp, mtype, msg, len) + SCR *sp; + mtype_t mtype; + char *msg; + size_t len; +{ + /* Replace the trailing <newline> with an EOS. */ + /* Let's do that later instead */ + if (errmsg) free (errmsg); + errmsg = malloc(len + 1); + memcpy(errmsg, msg, len); + errmsg[len] = '\0'; +} + +/* Register any extra external extensions */ + +extern void boot_DynaLoader _((CV* cv)); +extern void boot_VI _((CV* cv)); + +static void +xs_init() +{ +#ifdef HAVE_PERL_5_003_01 + dXSUB_SYS; +#endif + char *file = __FILE__; + + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); + newXS("VI::bootstrap", boot_VI, file); +} + +typedef SCR * VI; +typedef SCR * VI__OPT; +typedef SCR * VI__MAP; +typedef SCR * VI__MARK; +typedef AV * AVREF; + +MODULE = VI PACKAGE = VI + +# msg -- +# Set the message line to text. +# +# Perl Command: VI::Msg +# Usage: VI::Msg screenId text + +void +Msg(screen, text) + VI screen + char * text + + ALIAS: + PRINT = 1 + + CODE: + api_imessage(screen, text); + +# XS_VI_escreen -- +# End a screen. +# +# Perl Command: VI::EndScreen +# Usage: VI::EndScreen screenId + +void +EndScreen(screen) + VI screen + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + CODE: + INITMESSAGE; + rval = api_escreen(screen); + ENDMESSAGE; + +# XS_VI_iscreen -- +# Create a new screen. If a filename is specified then the screen +# is opened with that file. +# +# Perl Command: VI::NewScreen +# Usage: VI::NewScreen screenId [file] + +VI +Edit(screen, ...) + VI screen + + ALIAS: + NewScreen = 1 + + PROTOTYPE: $;$ + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + char *file; + SCR *nsp; + + CODE: + file = (items == 1) ? NULL : (char *)SvPV(ST(1),na); + INITMESSAGE; + rval = api_edit(screen, file, &nsp, ix); + ENDMESSAGE; + + RETVAL = ix ? nsp : screen; + + OUTPUT: + RETVAL + +# XS_VI_fscreen -- +# Return the screen id associated with file name. +# +# Perl Command: VI::FindScreen +# Usage: VI::FindScreen file + +VI +FindScreen(file) + char *file + + PREINIT: + SCR *fsp; + CODE: + RETVAL = api_fscreen(0, file); + +# XS_VI_aline -- +# -- Append the string text after the line in lineNumber. +# +# Perl Command: VI::AppendLine +# Usage: VI::AppendLine screenId lineNumber text + +void +AppendLine(screen, linenumber, text) + VI screen + int linenumber + char *text + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + STRLEN length; + + CODE: + SvPV(ST(2), length); + INITMESSAGE; + rval = api_aline(screen, linenumber, text, length); + ENDMESSAGE; + +# XS_VI_dline -- +# Delete lineNum. +# +# Perl Command: VI::DelLine +# Usage: VI::DelLine screenId lineNum + +void +DelLine(screen, linenumber) + VI screen + int linenumber + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + CODE: + INITMESSAGE; + rval = api_dline(screen, (recno_t)linenumber); + ENDMESSAGE; + +# XS_VI_gline -- +# Return lineNumber. +# +# Perl Command: VI::GetLine +# Usage: VI::GetLine screenId lineNumber + +char * +GetLine(screen, linenumber) + VI screen + int linenumber + + PREINIT: + size_t len; + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + char *line, *p; + + PPCODE: + INITMESSAGE; + rval = api_gline(screen, (recno_t)linenumber, &p, &len); + ENDMESSAGE; + + EXTEND(sp,1); + PUSHs(sv_2mortal(newSVpv(p, len))); + +# XS_VI_sline -- +# Set lineNumber to the text supplied. +# +# Perl Command: VI::SetLine +# Usage: VI::SetLine screenId lineNumber text + +void +SetLine(screen, linenumber, text) + VI screen + int linenumber + char *text + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + STRLEN length; + + CODE: + SvPV(ST(2), length); + INITMESSAGE; + rval = api_sline(screen, linenumber, text, length); + ENDMESSAGE; + +# XS_VI_iline -- +# Insert the string text before the line in lineNumber. +# +# Perl Command: VI::InsertLine +# Usage: VI::InsertLine screenId lineNumber text + +void +InsertLine(screen, linenumber, text) + VI screen + int linenumber + char *text + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + STRLEN length; + + CODE: + SvPV(ST(2), length); + INITMESSAGE; + rval = api_iline(screen, linenumber, text, length); + ENDMESSAGE; + +# XS_VI_lline -- +# Return the last line in the screen. +# +# Perl Command: VI::LastLine +# Usage: VI::LastLine screenId + +int +LastLine(screen) + VI screen + + PREINIT: + recno_t last; + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + CODE: + INITMESSAGE; + rval = api_lline(screen, &last); + ENDMESSAGE; + RETVAL=last; + + OUTPUT: + RETVAL + +# XS_VI_getmark -- +# Return the mark's cursor position as a list with two elements. +# {line, column}. +# +# Perl Command: VI::GetMark +# Usage: VI::GetMark screenId mark + +void +GetMark(screen, mark) + VI screen + char mark + + PREINIT: + struct _mark cursor; + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + PPCODE: + INITMESSAGE; + rval = api_getmark(screen, (int)mark, &cursor); + ENDMESSAGE; + + EXTEND(sp,2); + PUSHs(sv_2mortal(newSViv(cursor.lno))); + PUSHs(sv_2mortal(newSViv(cursor.cno))); + +# XS_VI_setmark -- +# Set the mark to the line and column numbers supplied. +# +# Perl Command: VI::SetMark +# Usage: VI::SetMark screenId mark line column + +void +SetMark(screen, mark, line, column) + VI screen + char mark + int line + int column + + PREINIT: + struct _mark cursor; + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + CODE: + INITMESSAGE; + cursor.lno = line; + cursor.cno = column; + rval = api_setmark(screen, (int)mark, &cursor); + ENDMESSAGE; + +# XS_VI_getcursor -- +# Return the current cursor position as a list with two elements. +# {line, column}. +# +# Perl Command: VI::GetCursor +# Usage: VI::GetCursor screenId + +void +GetCursor(screen) + VI screen + + PREINIT: + struct _mark cursor; + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + PPCODE: + INITMESSAGE; + rval = api_getcursor(screen, &cursor); + ENDMESSAGE; + + EXTEND(sp,2); + PUSHs(sv_2mortal(newSViv(cursor.lno))); + PUSHs(sv_2mortal(newSViv(cursor.cno))); + +# XS_VI_setcursor -- +# Set the cursor to the line and column numbers supplied. +# +# Perl Command: VI::SetCursor +# Usage: VI::SetCursor screenId line column + +void +SetCursor(screen, line, column) + VI screen + int line + int column + + PREINIT: + struct _mark cursor; + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + CODE: + INITMESSAGE; + cursor.lno = line; + cursor.cno = column; + rval = api_setcursor(screen, &cursor); + ENDMESSAGE; + +# XS_VI_swscreen -- +# Change the current focus to screen. +# +# Perl Command: VI::SwitchScreen +# Usage: VI::SwitchScreen screenId screenId + +void +SwitchScreen(screenFrom, screenTo) + VI screenFrom + VI screenTo + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + CODE: + INITMESSAGE; + rval = api_swscreen(screenFrom, screenTo); + ENDMESSAGE; + +# XS_VI_map -- +# Associate a key with a perl procedure. +# +# Perl Command: VI::MapKey +# Usage: VI::MapKey screenId key perlproc + +void +MapKey(screen, key, perlproc) + VI screen + char *key + SV *perlproc + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + int length; + char *command; + SV *svc; + + CODE: + INITMESSAGE; + svc = sv_2mortal(newSVpv(":perl ", 6)); + sv_catsv(svc, perlproc); + command = SvPV(svc, length); + rval = api_map(screen, key, command, length); + ENDMESSAGE; + +# XS_VI_unmap -- +# Unmap a key. +# +# Perl Command: VI::UnmapKey +# Usage: VI::UnmmapKey screenId key + +void +UnmapKey(screen, key) + VI screen + char *key + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + CODE: + INITMESSAGE; + rval = api_unmap(screen, key); + ENDMESSAGE; + +# XS_VI_opts_set -- +# Set an option. +# +# Perl Command: VI::SetOpt +# Usage: VI::SetOpt screenId setting + +void +SetOpt(screen, setting) + VI screen + char *setting + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + SV *svc; + + CODE: + INITMESSAGE; + svc = sv_2mortal(newSVpv(":set ", 5)); + sv_catpv(svc, setting); + rval = api_run_str(screen, SvPV(svc, na)); + ENDMESSAGE; + +# XS_VI_opts_get -- +# Return the value of an option. +# +# Perl Command: VI::GetOpt +# Usage: VI::GetOpt screenId option + +void +GetOpt(screen, option) + VI screen + char *option + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + char *value; + + PPCODE: + INITMESSAGE; + rval = api_opts_get(screen, option, &value, NULL); + ENDMESSAGE; + + EXTEND(SP,1); + PUSHs(sv_2mortal(newSVpv(value, 0))); + free(value); + +# XS_VI_run -- +# Run the ex command cmd. +# +# Perl Command: VI::Run +# Usage: VI::Run screenId cmd + +void +Run(screen, command) + VI screen + char *command; + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + CODE: + INITMESSAGE; + rval = api_run_str(screen, command); + ENDMESSAGE; + +void +DESTROY(screen) + VI screen + + CODE: + screen->perl_private = 0; + +void +Warn(warning) + char *warning; + + PREINIT: + int i; + CODE: + sv_catpv(GvSV(errgv),warning); + +#define TIED(package) \ + sv_magic((SV *) (hv = \ + (HV *)sv_2mortal((SV *)newHV())), \ + sv_setref_pv(sv_newmortal(), package, \ + newVIrv(newSV(0), screen)),\ + 'P', Nullch, 0);\ + RETVAL = newRV((SV *)hv) + +SV * +Opt(screen) + VI screen; + PREINIT: + HV *hv; + CODE: + TIED("VI::OPT"); + OUTPUT: + RETVAL + +SV * +Map(screen) + VI screen; + PREINIT: + HV *hv; + CODE: + TIED("VI::MAP"); + OUTPUT: + RETVAL + +SV * +Mark(screen) + VI screen + PREINIT: + HV *hv; + CODE: + TIED("VI::MARK"); + OUTPUT: + RETVAL + +MODULE = VI PACKAGE = VI::OPT + +void +DESTROY(screen) + VI::OPT screen + + CODE: + # typemap did all the checking + SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0)))); + +void +FETCH(screen, key) + VI::OPT screen + char *key + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + char *value; + int boolvalue; + + PPCODE: + INITMESSAGE; + rval = api_opts_get(screen, key, &value, &boolvalue); + if (!rval) { + EXTEND(SP,1); + PUSHs(sv_2mortal((boolvalue == -1) ? newSVpv(value, 0) + : newSViv(boolvalue))); + free(value); + } else ST(0) = &sv_undef; + rval = 0; + ENDMESSAGE; + +void +STORE(screen, key, value) + VI::OPT screen + char *key + SV *value + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + CODE: + INITMESSAGE; + rval = api_opts_set(screen, key, SvPV(value, na), SvIV(value), + SvTRUEx(value)); + ENDMESSAGE; + +MODULE = VI PACKAGE = VI::MAP + +void +DESTROY(screen) + VI::MAP screen + + CODE: + # typemap did all the checking + SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0)))); + +void +STORE(screen, key, perlproc) + VI::MAP screen + char *key + SV *perlproc + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + int length; + char *command; + SV *svc; + + CODE: + INITMESSAGE; + svc = sv_2mortal(newSVpv(":perl ", 6)); + sv_catsv(svc, perlproc); + command = SvPV(svc, length); + rval = api_map(screen, key, command, length); + ENDMESSAGE; + +void +DELETE(screen, key) + VI::MAP screen + char *key + + PREINIT: + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + CODE: + INITMESSAGE; + rval = api_unmap(screen, key); + ENDMESSAGE; + +MODULE = VI PACKAGE = VI::MARK + +void +DESTROY(screen) + VI::MARK screen + + CODE: + # typemap did all the checking + SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0)))); + +AV * +FETCH(screen, mark) + VI::MARK screen + char mark + + PREINIT: + struct _mark cursor; + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + CODE: + INITMESSAGE; + rval = api_getmark(screen, (int)mark, &cursor); + ENDMESSAGE; + RETVAL = newAV(); + av_push(RETVAL, newSViv(cursor.lno)); + av_push(RETVAL, newSViv(cursor.cno)); + + OUTPUT: + RETVAL + +void +STORE(screen, mark, pos) + VI::MARK screen + char mark + AVREF pos + + PREINIT: + struct _mark cursor; + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int rval; + + CODE: + if (av_len(pos) < 1) + croak("cursor position needs 2 elements"); + INITMESSAGE; + cursor.lno = SvIV(*av_fetch(pos, 0, 0)); + cursor.cno = SvIV(*av_fetch(pos, 1, 0)); + rval = api_setmark(screen, (int)mark, &cursor); + ENDMESSAGE; + +void +FIRSTKEY(screen, ...) + VI::MARK screen + + ALIAS: + NEXTKEY = 1 + + PROTOTYPE: $;$ + + PREINIT: + struct _mark cursor; + void (*scr_msg) __P((SCR *, mtype_t, char *, size_t)); + int next; + char key[] = {0, 0}; + + PPCODE: + if (items == 2) { + next = 1; + *key = *(char *)SvPV(ST(1),na); + } else next = 0; + if (api_nextmark(screen, next, key) != 1) { + EXTEND(sp, 1); + PUSHs(sv_2mortal(newSVpv(key, 1))); + } else ST(0) = &sv_undef; |