diff options
author | peter <peter@FreeBSD.org> | 1996-11-01 06:45:43 +0000 |
---|---|---|
committer | peter <peter@FreeBSD.org> | 1996-11-01 06:45:43 +0000 |
commit | 59cc89c2c2e686da3bdab2d5cfac4f33462d29fe (patch) | |
tree | 88f923c9c0be2e2a225a9b21716fd582de668b42 /contrib/nvi/perl_api | |
download | FreeBSD-src-59cc89c2c2e686da3bdab2d5cfac4f33462d29fe.zip FreeBSD-src-59cc89c2c2e686da3bdab2d5cfac4f33462d29fe.tar.gz |
Import of nvi-1.79, minus a few bits that we dont need (eg: postscript
files, curses, db, regex etc that we already have). The other glue will
follow shortly.
Obtained from: Keith Bostic <bostic@bostic.com>
Diffstat (limited to 'contrib/nvi/perl_api')
-rw-r--r-- | contrib/nvi/perl_api/VI.pod | 218 | ||||
-rw-r--r-- | contrib/nvi/perl_api/nviperl.pod | 43 | ||||
-rw-r--r-- | contrib/nvi/perl_api/perl.xs | 1115 | ||||
-rw-r--r-- | contrib/nvi/perl_api/perlsfio.c | 85 | ||||
-rw-r--r-- | contrib/nvi/perl_api/typemap | 42 |
5 files changed, 1503 insertions, 0 deletions
diff --git a/contrib/nvi/perl_api/VI.pod b/contrib/nvi/perl_api/VI.pod new file mode 100644 index 0000000..a87e24d --- /dev/null +++ b/contrib/nvi/perl_api/VI.pod @@ -0,0 +1,218 @@ +=head1 NAME + +VI - VI module within perl embedded nvi + +=head1 SYNOPSIS + + sub wc { + my $words; + $i = $VI::StartLine; + while ($i <= $VI::StopLine) { + $_ = VI::GetLine($VI::ScreenId, $i++); + $words+=split; + } + VI::Msg($VI::ScreenId,"$words words"); + } + +=head1 DESCRIPTION + +This pseudo module is available to perl programs run from within nvi and +provides access to the files being edited and some internal data. + +Beware that you should not use this module from within a C<perldo> or +from within an C<END> block or a C<DESTROY> method. + +=head2 Variables + +These are set by nvi before starting each perl command. + +=over 8 + +=item * $ScreenId + +Screen id of the current screen. + +=item * $StartLine + +Line number of the first line of the selected range or of the file if no +range was specified. + +=item * $StopLine + +Line number of the last line of the selected range or of the file if no +range was specified. + +=back + +=head2 Functions + +=over 8 + +=item * AppendLine + + VI::AppendLine(screenId,lineNumber,text); + +Append the string text after the line in lineNumber. + +=item * DelLine + + VI::DelLine(screenId,lineNum); + +Delete lineNum. + +=item * EndScreen + +VI::EndScreen(screenId); + +End a screen. + +=item * FindScreen + + VI::FindScreen(file); + +Return the screen id associated with file name. + +=item * GetCursor + + ($line, $column) = VI::GetCursor(screenId); + +Return the current cursor position as a list with two elements. + +=item * GetLine + + VI::GetLine(screenId,lineNumber); + +Return lineNumber. + +=item * GetMark + + ($line, $column) = VI::GetMark(screenId,mark); + +Return the mark's cursor position as a list with two elements. + +=item * GetOpt + + VI::GetOpt(screenId,option); + +Return the value of an option. + +=item * InsertLine + + VI::InsertLine(screenId,lineNumber,text); + +Insert the string text before the line in lineNumber. + +=item * LastLine + + VI::LastLine(screenId); + +Return the last line in the screen. + +=item * MapKey + + VI::MapKey(screenId,key,perlproc); + +Associate a key with a perl procedure. + +=item * Msg + + VI::Msg(screenId,text); + +Set the message line to text. + +=item * NewScreen + + VI::NewScreen(screenId); + VI::NewScreen(screenId,file); + +Create a new screen. If a filename is specified then the screen is +opened with that file. + +=item * Run + + VI::Run(screenId,cmd); + +Run the ex command cmd. + +=item * SetCursor + + VI::SetCursor(screenId,line,column); + +Set the cursor to the line and column numbers supplied. + +=item * SetLine + + VI::SetLine(screenId,lineNumber,text); + +Set lineNumber to the text supplied. + +=item * SetMark + + VI::SetMark(screenId,mark,line,column); + +Set the mark to the line and column numbers supplied. + +=item * SetOpt + + VI::SetOpt(screenId,command); + +Set an option. + +=item * SwitchScreen + + VI::SwitchScreen(screenId,screenId); + +Change the current focus to screen. + +=item * UnmapKey + + VI::UnmmapKey(screenId,key); + +Unmap a key. + +=item * Warn + +This is the default warning handler. +It adds any warnings to the error string. + +=back + +=head1 EXAMPLES + + sub showmarks { + my ($mark, $all); + for $mark ('a' .. 'z') { + eval {VI::GetMark($VI::ScreenId, $mark)}; + $all .= $mark unless ($@); + } + VI::Msg($VI::ScreenId,"Set marks: $all"); + } + + sub forall { + my ($code) = shift; + my ($i) = $VI::StartLine-1; + while (++$i <= $VI::StopLine) { + $_ = VI::GetLine($VI::ScreenId, $i); + VI::SetLine($VI::ScreenId, $i, $_) if(&$code); + } + } + +Now you can do + + :perl forall sub{s/perlre/substitution/} + +Although you'll probably use + + :perldo s/perlre/substitution/ + +instead. + +See L<perlre> for perl regular expressions. + +=head1 SEE ALSO + +L<nviperl> + +=head1 AUTHOR + +Sven Verdoolaege <skimo@dns.ufsia.ac.be> diff --git a/contrib/nvi/perl_api/nviperl.pod b/contrib/nvi/perl_api/nviperl.pod new file mode 100644 index 0000000..43850d8 --- /dev/null +++ b/contrib/nvi/perl_api/nviperl.pod @@ -0,0 +1,43 @@ +=head1 NAME + +nviperl - nvi with embedded perl + +=head1 SYNOPSIS + + :perl require 'wc.pl' + :perl wc + :,$perldo $_=reverse($_) + +=head1 DESCRIPTION + +nvi with embedded perl allows you to run perl commands from within nvi. +Two additional commands are made available when you enable the perl +interpreter: + +=over 8 + +=item * perl cmd + +The perl command passes the specified commands to the perl interpreter. +The C<$VI::ScreenId>, C<$VI::StartLine> and C<$VI::StopLine> are set. +To find out how to maniplulate the nvi screens, see L<VI>. + +=item * perldo cmd + +The perldo command runs the specified commands on each line of the range +(every line of the file if no range specified). Before running the +command the line is copied into $_. If the command returns a true value +the line is replaced by the new value of $_. + +The perldo commando does B<not> set the C<VI> variables. (If you think +this is a bad idea, tell me.) + +=back + +=head1 SEE ALSO + +L<VI> + +=head1 AUTHOR + +Sven Verdoolaege <skimo@dns.ufsia.ac.be> diff --git a/contrib/nvi/perl_api/perl.xs b/contrib/nvi/perl_api/perl.xs new file mode 100644 index 0000000..0b48cde --- /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; diff --git a/contrib/nvi/perl_api/perlsfio.c b/contrib/nvi/perl_api/perlsfio.c new file mode 100644 index 0000000..20ff477 --- /dev/null +++ b/contrib/nvi/perl_api/perlsfio.c @@ -0,0 +1,85 @@ +/*- + * Copyright (c) 1996 + * Keith Bostic. 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[] = "@(#)perlsfio.c 8.1 (Berkeley) 9/24/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" + +/* + * PUBLIC: #ifdef USE_SFIO + */ +#ifdef USE_SFIO + +#define NIL(type) ((type)0) + +static int +sfnviwrite(f, buf, n, disc) +Sfio_t* f; /* stream involved */ +char* buf; /* buffer to read into */ +int n; /* number of bytes to read */ +Sfdisc_t* disc; /* discipline */ +{ + SCR *scrp; + + scrp = (SCR *)SvIV((SV*)SvRV(perl_get_sv("curscr", FALSE))); + msgq(scrp, M_INFO, "%.*s", n, buf); + return n; +} + +/* + * sfdcnewnvi -- + * Create nvi discipline + * + * PUBLIC: Sfdisc_t* sfdcnewnvi __P((SCR*)); + */ + +Sfdisc_t * +sfdcnewnvi(scrp) + SCR *scrp; +{ + Sfdisc_t* disc; + + MALLOC(scrp, disc, Sfdisc_t*, sizeof(Sfdisc_t)); + if (!disc) return disc; + + disc->readf = (Sfread_f)NULL; + disc->writef = sfnviwrite; + disc->seekf = (Sfseek_f)NULL; + disc->exceptf = (Sfexcept_f)NULL; + return disc; +} + +/* + * PUBLIC: #endif + */ +#endif /* USE_SFIO */ diff --git a/contrib/nvi/perl_api/typemap b/contrib/nvi/perl_api/typemap new file mode 100644 index 0000000..0e38a9c --- /dev/null +++ b/contrib/nvi/perl_api/typemap @@ -0,0 +1,42 @@ +TYPEMAP +# Grr can't let it end in OBJ 'cause xsubpp would +# s/OBJ$/REF/ that for the DESTROY function +VI T_VIOBJNOMUNGE +VI::OPT T_VIOBJREF +VI::MAP T_VIOBJREF +VI::MARK T_VIOBJREF +AVREF T_AVREFREF + +INPUT +T_AVREFREF + if (SvROK($arg) && SvTYPE(SvRV($arg)) == SVt_PVAV) + $var = (AV *)SvRV($arg); + else + croak(\"$var is not a reference to an array\") +T_VIOBJNOMUNGE + if (sv_isa($arg, \"VI\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = ($type) tmp; + if (!tmp) + croak(\"screen no longer exists\"); + } + else + croak(\"$var is not of type ${ntype}\") +T_VIOBJREF + if (sv_isa($arg, \"${ntype}\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + if (sv_isa((SV *)tmp, \"VI\")) { + IV tmp2 = SvIV((SV*)SvRV((SV *)tmp)); + $var = ($type) tmp2; + if (!tmp2) + croak(\"screen no longer exists\"); + } + else + croak(\"$var is not of type ${ntype}\"); + } + else + croak(\"$var is not of type ${ntype}\") + +OUTPUT +T_VIOBJNOMUNGE + newVIrv($arg, $var); |