Merge from vendor branch AWK:
[dragonfly.git] / contrib / nvi / perl_api / perl.xs
1 /*-
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.
6  * Copyright (c) 1995
7  *      George V. Neville-Neil. All rights reserved.
8  * Copyright (c) 1996
9  *      Sven Verdoolaege. All rights reserved.
10  *
11  * See the LICENSE file for redistribution information.
12  */
13
14 #include "config.h"
15
16 #ifndef lint
17 static const char sccsid[] = "@(#)perl.xs       8.27 (Berkeley) 10/16/96";
18 #endif /* not lint */
19
20 #include <sys/types.h>
21 #include <sys/param.h>
22 #include <sys/queue.h>
23 #include <sys/time.h>
24
25 #include <bitstring.h>
26 #include <ctype.h>
27 #include <limits.h>
28 #include <signal.h>
29 #include <stdio.h>
30 #include <stdlib.h>
31 #include <string.h>
32 #include <termios.h>
33 #include <unistd.h>
34 #include <errno.h>
35
36 #include "../common/common.h"
37
38 #include <EXTERN.h>
39 #include <perl.h>
40 #include <XSUB.h>
41
42 #include "perl_extern.h"
43
44 static void msghandler __P((SCR *, mtype_t, char *, size_t));
45
46 extern GS *__global_list;                       /* XXX */
47
48 static char *errmsg = 0;
49
50 /*
51  * INITMESSAGE --
52  *      Macros to point messages at the Perl message handler.
53  */
54 #define INITMESSAGE                                                     \
55         scr_msg = __global_list->scr_msg;                               \
56         __global_list->scr_msg = msghandler;
57 #define ENDMESSAGE                                                      \
58         __global_list->scr_msg = scr_msg;                               \
59         if (rval) croak(errmsg);
60
61 static void xs_init __P((void));
62
63 /*
64  * perl_end --
65  *      Clean up perl interpreter
66  *
67  * PUBLIC: int perl_end __P((GS *));
68  */
69 int
70 perl_end(gp)
71         GS *gp;
72 {
73         /*
74          * Call perl_run and perl_destuct to call END blocks and DESTROY
75          * methods.
76          */
77         if (gp->perl_interp) {
78                 /*Irestartop = 0;                               / * XXX */
79                 perl_run(gp->perl_interp);
80                 perl_destruct(gp->perl_interp);
81 #if defined(DEBUG) || defined(PURIFY) || defined(LIBRARY)
82                 perl_free(gp->perl_interp);
83 #endif
84         }
85 }
86
87 /*
88  * perl_eval
89  *      Evaluate a string
90  *      We don't use mortal SVs because no one will clean up after us
91  */
92 static void 
93 perl_eval(string)
94         char *string;
95 {
96 #ifdef HAVE_PERL_5_003_01
97         SV* sv = newSVpv(string, 0);
98
99         perl_eval_sv(sv, G_DISCARD | G_NOARGS);
100         SvREFCNT_dec(sv);
101 #else
102         char *argv[2];
103
104         argv[0] = string;
105         argv[1] = NULL;
106         perl_call_argv("_eval_", G_EVAL | G_DISCARD | G_KEEPERR, argv);
107 #endif
108 }
109
110 /*
111  * perl_init --
112  *      Create the perl commands used by nvi.
113  *
114  * PUBLIC: int perl_init __P((SCR *));
115  */
116 int
117 perl_init(scrp)
118         SCR *scrp;
119 {
120         AV * av;
121         GS *gp;
122         char *bootargs[] = { "VI", NULL };
123 #ifndef USE_SFIO
124         SV *svcurscr;
125 #endif
126
127 #ifndef HAVE_PERL_5_003_01
128         static char *args[] = { "", "-e", "sub _eval_ { eval $_[0] }" };
129 #else
130         static char *args[] = { "", "-e", "" };
131 #endif
132         STRLEN length;
133         char *file = __FILE__;
134
135         gp = scrp->gp;
136         gp->perl_interp = perl_alloc();
137         perl_construct(gp->perl_interp);
138         if (perl_parse(gp->perl_interp, xs_init, 3, args, 0)) {
139                 perl_destruct(gp->perl_interp);
140                 perl_free(gp->perl_interp);
141                 gp->perl_interp = NULL;
142                 return 1;
143         }
144         perl_call_argv("VI::bootstrap", G_DISCARD, bootargs);
145         perl_eval("$SIG{__WARN__}='VI::Warn'");
146
147         av_unshift(av = GvAVn(PL_incgv), 1);
148         av_store(av, 0, newSVpv(_PATH_PERLSCRIPTS,
149                                 sizeof(_PATH_PERLSCRIPTS)-1));
150
151 #ifdef USE_SFIO
152         sfdisc(PerlIO_stdout(), sfdcnewnvi(scrp));
153         sfdisc(PerlIO_stderr(), sfdcnewnvi(scrp));
154 #else
155         svcurscr = perl_get_sv("curscr", TRUE);
156         sv_magic((SV *)gv_fetchpv("STDOUT",TRUE, SVt_PVIO), svcurscr,
157                         'q', Nullch, 0);
158         sv_magic((SV *)gv_fetchpv("STDERR",TRUE, SVt_PVIO), svcurscr,
159                         'q', Nullch, 0);
160 #endif /* USE_SFIO */
161         return (0);
162 }
163
164 /*
165  * perl_screen_end
166  *      Remove all refences to the screen to be destroyed
167  *
168  * PUBLIC: int perl_screen_end __P((SCR*));
169  */
170 int
171 perl_screen_end(scrp)
172         SCR *scrp;
173 {
174         if (scrp->perl_private) {
175                 sv_setiv((SV*) scrp->perl_private, 0);
176         }
177         return 0;
178 }
179
180 static void
181 my_sighandler(i)
182         int i;
183 {
184         croak("Perl command interrupted by SIGINT");
185 }
186
187 /* Create a new reference to an SV pointing to the SCR structure
188  * The perl_private part of the SCR structure points to the SV,
189  * so there can only be one such SV for a particular SCR structure.
190  * When the last reference has gone (DESTROY is called),
191  * perl_private is reset; When the screen goes away before
192  * all references are gone, the value of the SV is reset;
193  * any subsequent use of any of those reference will produce
194  * a warning. (see typemap)
195  */
196 static SV *
197 newVIrv(rv, screen)
198         SV *rv;
199         SCR *screen;
200 {
201         sv_upgrade(rv, SVt_RV);
202         if (!screen->perl_private) {
203                 screen->perl_private = newSV(0);
204                 sv_setiv(screen->perl_private, (IV) screen);
205         } 
206         else SvREFCNT_inc(screen->perl_private);
207         SvRV(rv) = screen->perl_private;
208         SvROK_on(rv);
209         return sv_bless(rv, gv_stashpv("VI", TRUE));
210 }
211
212
213 /* 
214  * perl_ex_perl -- :[line [,line]] perl [command]
215  *      Run a command through the perl interpreter.
216  *
217  * PUBLIC: int perl_ex_perl __P((SCR*, CHAR_T *, size_t, recno_t, recno_t));
218  */
219 int 
220 perl_ex_perl(scrp, cmdp, cmdlen, f_lno, t_lno)
221         SCR *scrp;
222         CHAR_T *cmdp;
223         size_t cmdlen;
224         recno_t f_lno, t_lno;
225 {
226         static SV *svcurscr = 0, *svstart, *svstop, *svid;
227         GS *gp;
228         STRLEN length;
229         size_t len;
230         char *err;
231         Signal_t (*istat)();
232
233         /* Initialize the interpreter. */
234         gp = scrp->gp;
235         if (!svcurscr) {
236                 if (gp->perl_interp == NULL && perl_init(scrp))
237                         return (1);
238                 SvREADONLY_on(svcurscr = perl_get_sv("curscr", TRUE));
239                 SvREADONLY_on(svstart = perl_get_sv("VI::StartLine", TRUE));
240                 SvREADONLY_on(svstop = perl_get_sv("VI::StopLine", TRUE));
241                 SvREADONLY_on(svid = perl_get_sv("VI::ScreenId", TRUE));
242         }
243
244         sv_setiv(svstart, f_lno);
245         sv_setiv(svstop, t_lno);
246         newVIrv(svcurscr, scrp);
247         /* Backwards compatibility. */
248         newVIrv(svid, scrp);
249
250         istat = signal(SIGINT, my_sighandler);
251         perl_eval(cmdp);
252         signal(SIGINT, istat);
253
254         SvREFCNT_dec(SvRV(svcurscr));
255         SvROK_off(svcurscr);
256         SvREFCNT_dec(SvRV(svid));
257         SvROK_off(svid);
258
259         err = SvPV(GvSV(errgv), length);
260         if (!length)
261                 return (0);
262
263         err[length - 1] = '\0';
264         msgq(scrp, M_ERR, "perl: %s", err);
265         return (1);
266 }
267
268 /*
269  * replace_line
270  *      replace a line with the contents of the perl variable $_
271  *      lines are split at '\n's
272  *      if $_ is undef, the line is deleted
273  *      returns possibly adjusted linenumber
274  */
275 static int 
276 replace_line(scrp, line, t_lno)
277         SCR *scrp;
278         recno_t line, *t_lno;
279 {
280         char *str, *next;
281         size_t len;
282
283         if (SvOK(GvSV(defgv))) {
284                 str = SvPV(GvSV(defgv),len);
285                 next = memchr(str, '\n', len);
286                 api_sline(scrp, line, str, next ? (next - str) : len);
287                 while (next++) {
288                         len -= next - str;
289                         next = memchr(str = next, '\n', len);
290                         api_iline(scrp, ++line, str, next ? (next - str) : len);
291                         (*t_lno)++;
292                 }
293         } else {
294                 api_dline(scrp, line--);
295                 (*t_lno)--;
296         }
297         return line;
298 }
299
300 /* 
301  * perl_ex_perldo -- :[line [,line]] perl [command]
302  *      Run a set of lines through the perl interpreter.
303  *
304  * PUBLIC: int perl_ex_perldo __P((SCR*, CHAR_T *, size_t, recno_t, recno_t));
305  */
306 int 
307 perl_ex_perldo(scrp, cmdp, cmdlen, f_lno, t_lno)
308         SCR *scrp;
309         CHAR_T *cmdp;
310         size_t cmdlen;
311         recno_t f_lno, t_lno;
312 {
313         static SV *svcurscr = 0, *svstart, *svstop, *svid;
314         CHAR_T *p;
315         GS *gp;
316         STRLEN length;
317         size_t len;
318         recno_t i;
319         char *str;
320 #ifndef HAVE_PERL_5_003_01
321         char *argv[2];
322 #else
323         SV* sv;
324 #endif
325         dSP;
326
327         /* Initialize the interpreter. */
328         gp = scrp->gp;
329         if (!svcurscr) {
330                 if (gp->perl_interp == NULL && perl_init(scrp))
331                         return (1);
332                 SPAGAIN;
333                 SvREADONLY_on(svcurscr = perl_get_sv("curscr", TRUE));
334                 SvREADONLY_on(svstart = perl_get_sv("VI::StartLine", TRUE));
335                 SvREADONLY_on(svstop = perl_get_sv("VI::StopLine", TRUE));
336                 SvREADONLY_on(svid = perl_get_sv("VI::ScreenId", TRUE));
337         }
338
339 #ifndef HAVE_PERL_5_003_01
340         argv[0] = cmdp;
341         argv[1] = NULL;
342 #else
343         length = strlen(cmdp);
344         sv = newSV(length + sizeof("sub VI::perldo {")-1 + 1 /* } */);
345         sv_setpvn(sv, "sub VI::perldo {", sizeof("sub VI::perldo {")-1); 
346         sv_catpvn(sv, cmdp, length);
347         sv_catpvn(sv, "}", 1);
348         perl_eval_sv(sv, G_DISCARD | G_NOARGS);
349         SvREFCNT_dec(sv);
350         str = SvPV(GvSV(errgv),length);
351         if (length)
352                 goto err;
353 #endif
354
355         newVIrv(svcurscr, scrp);
356         /* Backwards compatibility. */
357         newVIrv(svid, scrp);
358
359         ENTER;
360         SAVETMPS;
361         for (i = f_lno; i <= t_lno && !api_gline(scrp, i, &str, &len); i++) {
362                 sv_setpvn(GvSV(defgv),str,len);
363                 sv_setiv(svstart, i);
364                 sv_setiv(svstop, i);
365 #ifndef HAVE_PERL_5_003_01
366                 perl_call_argv("_eval_", G_SCALAR | G_EVAL | G_KEEPERR, argv);
367 #else
368                 PUSHMARK(sp);
369                 perl_call_pv("VI::perldo", G_SCALAR | G_EVAL);
370 #endif
371                 str = SvPV(GvSV(errgv), length);
372                 if (length) break;
373                 SPAGAIN;
374                 if(SvTRUEx(POPs)) 
375                         i = replace_line(scrp, i, &t_lno);
376                 PUTBACK;
377         }
378         FREETMPS;
379         LEAVE;
380
381         SvREFCNT_dec(SvRV(svcurscr));
382         SvROK_off(svcurscr);
383         SvREFCNT_dec(SvRV(svid));
384         SvROK_off(svid);
385
386         if (!length)
387                 return (0);
388
389 err:    str[length - 1] = '\0';
390         msgq(scrp, M_ERR, "perl: %s", str);
391         return (1);
392 }
393
394 /*
395  * msghandler --
396  *      Perl message routine so that error messages are processed in
397  *      Perl, not in nvi.
398  */
399 static void
400 msghandler(sp, mtype, msg, len)
401         SCR *sp;
402         mtype_t mtype;
403         char *msg;
404         size_t len;
405 {
406         /* Replace the trailing <newline> with an EOS. */
407         /* Let's do that later instead */
408         if (errmsg) free (errmsg);
409         errmsg = malloc(len + 1);
410         memcpy(errmsg, msg, len);
411         errmsg[len] = '\0';
412 }
413
414 /* Register any extra external extensions */
415
416 extern void boot_DynaLoader _((CV* cv));
417 extern void boot_VI _((CV* cv));
418
419 static void
420 xs_init()
421 {
422         char *file = __FILE__;
423
424 #ifdef HAVE_PERL_5_003_01
425         dXSUB_SYS;
426 #endif
427         newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
428         newXS("VI::bootstrap", boot_VI, file);
429 }
430
431 typedef SCR *   VI;
432 typedef SCR *   VI__OPT;
433 typedef SCR *   VI__MAP;
434 typedef SCR *   VI__MARK;
435 typedef AV *    AVREF;
436
437 MODULE = VI     PACKAGE = VI
438
439 # msg --
440 #       Set the message line to text.
441 #
442 # Perl Command: VI::Msg
443 # Usage: VI::Msg screenId text
444
445 void
446 Msg(screen, text)
447         VI          screen
448         char *      text
449  
450         ALIAS:
451         PRINT = 1
452
453         CODE:
454         api_imessage(screen, text);
455
456 # XS_VI_escreen --
457 #       End a screen.
458 #
459 # Perl Command: VI::EndScreen
460 # Usage: VI::EndScreen screenId
461
462 void
463 EndScreen(screen)
464         VI      screen
465
466         PREINIT:
467         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
468         int rval;
469
470         CODE:
471         INITMESSAGE;
472         rval = api_escreen(screen);
473         ENDMESSAGE;
474
475 # XS_VI_iscreen --
476 #       Create a new screen.  If a filename is specified then the screen
477 #       is opened with that file.
478 #
479 # Perl Command: VI::NewScreen
480 # Usage: VI::NewScreen screenId [file]
481
482 VI
483 Edit(screen, ...)
484         VI screen
485
486         ALIAS:
487         NewScreen = 1
488
489         PROTOTYPE: $;$
490         PREINIT:
491         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
492         int rval;
493         char *file;
494         SCR *nsp;
495
496         CODE:
497         file = (items == 1) ? NULL : (char *)SvPV(ST(1),na);
498         INITMESSAGE;
499         rval = api_edit(screen, file, &nsp, ix);
500         ENDMESSAGE;
501         
502         RETVAL = ix ? nsp : screen;
503
504         OUTPUT:
505         RETVAL
506
507 # XS_VI_fscreen --
508 #       Return the screen id associated with file name.
509 #
510 # Perl Command: VI::FindScreen
511 # Usage: VI::FindScreen file
512
513 VI
514 FindScreen(file)
515         char *file
516
517         PREINIT:
518         SCR *fsp;
519         CODE:
520         RETVAL = api_fscreen(0, file);
521
522 # XS_VI_aline --
523 #       -- Append the string text after the line in lineNumber.
524 #
525 # Perl Command: VI::AppendLine
526 # Usage: VI::AppendLine screenId lineNumber text
527
528 void
529 AppendLine(screen, linenumber, text)
530         VI screen
531         int linenumber
532         char *text
533
534         PREINIT:
535         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
536         int rval;
537         STRLEN length;
538
539         CODE:
540         SvPV(ST(2), length);
541         INITMESSAGE;
542         rval = api_aline(screen, linenumber, text, length);
543         ENDMESSAGE;
544
545 # XS_VI_dline --
546 #       Delete lineNum.
547 #
548 # Perl Command: VI::DelLine
549 # Usage: VI::DelLine screenId lineNum
550
551 void 
552 DelLine(screen, linenumber)
553         VI screen
554         int linenumber
555
556         PREINIT:
557         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
558         int rval;
559
560         CODE:
561         INITMESSAGE;
562         rval = api_dline(screen, (recno_t)linenumber);
563         ENDMESSAGE;
564
565 # XS_VI_gline --
566 #       Return lineNumber.
567 #
568 # Perl Command: VI::GetLine
569 # Usage: VI::GetLine screenId lineNumber
570
571 char *
572 GetLine(screen, linenumber)
573         VI screen
574         int linenumber
575
576         PREINIT:
577         size_t len;
578         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
579         int rval;
580         char *line, *p;
581
582         PPCODE:
583         INITMESSAGE;
584         rval = api_gline(screen, (recno_t)linenumber, &p, &len);
585         ENDMESSAGE;
586
587         EXTEND(sp,1);
588         PUSHs(sv_2mortal(newSVpv(p, len)));
589
590 # XS_VI_sline --
591 #       Set lineNumber to the text supplied.
592 #
593 # Perl Command: VI::SetLine
594 # Usage: VI::SetLine screenId lineNumber text
595
596 void
597 SetLine(screen, linenumber, text)
598         VI screen
599         int linenumber
600         char *text
601
602         PREINIT:
603         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
604         int rval;
605         STRLEN length;
606
607         CODE:
608         SvPV(ST(2), length);
609         INITMESSAGE;
610         rval = api_sline(screen, linenumber, text, length);
611         ENDMESSAGE;
612
613 # XS_VI_iline --
614 #       Insert the string text before the line in lineNumber.
615 #
616 # Perl Command: VI::InsertLine
617 # Usage: VI::InsertLine screenId lineNumber text
618
619 void
620 InsertLine(screen, linenumber, text)
621         VI screen
622         int linenumber
623         char *text
624
625         PREINIT:
626         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
627         int rval;
628         STRLEN length;
629
630         CODE:
631         SvPV(ST(2), length);
632         INITMESSAGE;
633         rval = api_iline(screen, linenumber, text, length);
634         ENDMESSAGE;
635
636 # XS_VI_lline --
637 #       Return the last line in the screen.
638 #
639 # Perl Command: VI::LastLine
640 # Usage: VI::LastLine screenId
641
642 int 
643 LastLine(screen)
644         VI screen
645
646         PREINIT:
647         recno_t last;
648         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
649         int rval;
650
651         CODE:
652         INITMESSAGE;
653         rval = api_lline(screen, &last);
654         ENDMESSAGE;
655         RETVAL=last;
656
657         OUTPUT:
658         RETVAL
659
660 # XS_VI_getmark --
661 #       Return the mark's cursor position as a list with two elements.
662 #       {line, column}.
663 #
664 # Perl Command: VI::GetMark
665 # Usage: VI::GetMark screenId mark
666
667 void
668 GetMark(screen, mark)
669         VI screen
670         char mark
671
672         PREINIT:
673         struct _mark cursor;
674         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
675         int rval;
676
677         PPCODE:
678         INITMESSAGE;
679         rval = api_getmark(screen, (int)mark, &cursor);
680         ENDMESSAGE;
681
682         EXTEND(sp,2);
683         PUSHs(sv_2mortal(newSViv(cursor.lno)));
684         PUSHs(sv_2mortal(newSViv(cursor.cno)));
685
686 # XS_VI_setmark --
687 #       Set the mark to the line and column numbers supplied.
688 #
689 # Perl Command: VI::SetMark
690 # Usage: VI::SetMark screenId mark line column
691
692 void
693 SetMark(screen, mark, line, column)
694         VI screen
695         char mark
696         int line
697         int column
698
699         PREINIT:
700         struct _mark cursor;
701         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
702         int rval;
703
704         CODE:
705         INITMESSAGE;
706         cursor.lno = line;
707         cursor.cno = column;
708         rval = api_setmark(screen, (int)mark, &cursor);
709         ENDMESSAGE;
710
711 # XS_VI_getcursor --
712 #       Return the current cursor position as a list with two elements.
713 #       {line, column}.
714 #
715 # Perl Command: VI::GetCursor
716 # Usage: VI::GetCursor screenId
717
718 void
719 GetCursor(screen)
720         VI screen
721
722         PREINIT:
723         struct _mark cursor;
724         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
725         int rval;
726
727         PPCODE:
728         INITMESSAGE;
729         rval = api_getcursor(screen, &cursor);
730         ENDMESSAGE;
731
732         EXTEND(sp,2);
733         PUSHs(sv_2mortal(newSViv(cursor.lno)));
734         PUSHs(sv_2mortal(newSViv(cursor.cno)));
735
736 # XS_VI_setcursor --
737 #       Set the cursor to the line and column numbers supplied.
738 #
739 # Perl Command: VI::SetCursor
740 # Usage: VI::SetCursor screenId line column
741
742 void
743 SetCursor(screen, line, column)
744         VI screen
745         int line
746         int column
747
748         PREINIT:
749         struct _mark cursor;
750         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
751         int rval;
752
753         CODE:
754         INITMESSAGE;
755         cursor.lno = line;
756         cursor.cno = column;
757         rval = api_setcursor(screen, &cursor);
758         ENDMESSAGE;
759
760 # XS_VI_swscreen --
761 #       Change the current focus to screen.
762 #
763 # Perl Command: VI::SwitchScreen
764 # Usage: VI::SwitchScreen screenId screenId
765
766 void
767 SwitchScreen(screenFrom, screenTo)
768         VI screenFrom
769         VI screenTo
770
771         PREINIT:
772         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
773         int rval;
774
775         CODE:
776         INITMESSAGE;
777         rval = api_swscreen(screenFrom, screenTo);
778         ENDMESSAGE;
779
780 # XS_VI_map --
781 #       Associate a key with a perl procedure.
782 #
783 # Perl Command: VI::MapKey
784 # Usage: VI::MapKey screenId key perlproc
785
786 void
787 MapKey(screen, key, perlproc)
788         VI screen
789         char *key
790         SV *perlproc
791
792         PREINIT:
793         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
794         int rval;
795         int length;
796         char *command;
797         SV *svc;
798
799         CODE:
800         INITMESSAGE;
801         svc = sv_2mortal(newSVpv(":perl ", 6));
802         sv_catsv(svc, perlproc);
803         command = SvPV(svc, length);
804         rval = api_map(screen, key, command, length);
805         ENDMESSAGE;
806
807 # XS_VI_unmap --
808 #       Unmap a key.
809 #
810 # Perl Command: VI::UnmapKey
811 # Usage: VI::UnmmapKey screenId key
812
813 void
814 UnmapKey(screen, key)
815         VI screen
816         char *key
817
818         PREINIT:
819         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
820         int rval;
821
822         CODE:
823         INITMESSAGE;
824         rval = api_unmap(screen, key);
825         ENDMESSAGE;
826
827 # XS_VI_opts_set --
828 #       Set an option.
829 #
830 # Perl Command: VI::SetOpt
831 # Usage: VI::SetOpt screenId setting
832
833 void
834 SetOpt(screen, setting)
835         VI screen
836         char *setting
837
838         PREINIT:
839         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
840         int rval;
841         SV *svc;
842
843         CODE:
844         INITMESSAGE;
845         svc = sv_2mortal(newSVpv(":set ", 5));
846         sv_catpv(svc, setting);
847         rval = api_run_str(screen, SvPV(svc, na));
848         ENDMESSAGE;
849
850 # XS_VI_opts_get --
851 #       Return the value of an option.
852 #       
853 # Perl Command: VI::GetOpt
854 # Usage: VI::GetOpt screenId option
855
856 void
857 GetOpt(screen, option)
858         VI screen
859         char *option
860
861         PREINIT:
862         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
863         int rval;
864         char *value;
865
866         PPCODE:
867         INITMESSAGE;
868         rval = api_opts_get(screen, option, &value, NULL);
869         ENDMESSAGE;
870
871         EXTEND(SP,1);
872         PUSHs(sv_2mortal(newSVpv(value, 0)));
873         free(value);
874
875 # XS_VI_run --
876 #       Run the ex command cmd.
877 #
878 # Perl Command: VI::Run
879 # Usage: VI::Run screenId cmd
880
881 void
882 Run(screen, command)
883         VI screen
884         char *command;
885
886         PREINIT:
887         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
888         int rval;
889
890         CODE:
891         INITMESSAGE;
892         rval = api_run_str(screen, command);
893         ENDMESSAGE;
894
895 void 
896 DESTROY(screen)
897         VI screen
898
899         CODE:
900         screen->perl_private = 0;
901
902 void
903 Warn(warning)
904         char *warning;
905
906         PREINIT:
907         int i;
908         CODE:
909         sv_catpv(GvSV(errgv),warning);
910
911 #define TIED(package) \
912         sv_magic((SV *) (hv = \
913             (HV *)sv_2mortal((SV *)newHV())), \
914                 sv_setref_pv(sv_newmortal(), package, \
915                         newVIrv(newSV(0), screen)),\
916                 'P', Nullch, 0);\
917         RETVAL = newRV((SV *)hv)
918
919 SV *
920 Opt(screen)
921         VI screen;
922         PREINIT:
923         HV *hv;
924         CODE:
925         TIED("VI::OPT");
926         OUTPUT:
927         RETVAL
928
929 SV *
930 Map(screen)
931         VI screen;
932         PREINIT:
933         HV *hv;
934         CODE:
935         TIED("VI::MAP");
936         OUTPUT:
937         RETVAL
938
939 SV *
940 Mark(screen)
941         VI screen
942         PREINIT:
943         HV *hv;
944         CODE:
945         TIED("VI::MARK");
946         OUTPUT:
947         RETVAL
948
949 MODULE = VI     PACKAGE = VI::OPT
950
951 void 
952 DESTROY(screen)
953         VI::OPT screen
954
955         CODE:
956         # typemap did all the checking
957         SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
958
959 void
960 FETCH(screen, key)
961         VI::OPT screen
962         char *key
963
964         PREINIT:
965         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
966         int rval;
967         char *value;
968         int boolvalue;
969
970         PPCODE:
971         INITMESSAGE;
972         rval = api_opts_get(screen, key, &value, &boolvalue);
973         if (!rval) {
974                 EXTEND(SP,1);
975                 PUSHs(sv_2mortal((boolvalue == -1) ? newSVpv(value, 0)
976                                                    : newSViv(boolvalue)));
977                 free(value);
978         } else ST(0) = &sv_undef;
979         rval = 0;
980         ENDMESSAGE;
981
982 void
983 STORE(screen, key, value)
984         VI::OPT screen
985         char    *key
986         SV      *value
987
988         PREINIT:
989         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
990         int rval;
991
992         CODE:
993         INITMESSAGE;
994         rval = api_opts_set(screen, key, SvPV(value, na), SvIV(value), 
995                                          SvTRUEx(value));
996         ENDMESSAGE;
997
998 MODULE = VI     PACKAGE = VI::MAP
999
1000 void 
1001 DESTROY(screen)
1002         VI::MAP screen
1003
1004         CODE:
1005         # typemap did all the checking
1006         SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1007
1008 void
1009 STORE(screen, key, perlproc)
1010         VI::MAP screen
1011         char *key
1012         SV *perlproc
1013
1014         PREINIT:
1015         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1016         int rval;
1017         int length;
1018         char *command;
1019         SV *svc;
1020
1021         CODE:
1022         INITMESSAGE;
1023         svc = sv_2mortal(newSVpv(":perl ", 6));
1024         sv_catsv(svc, perlproc);
1025         command = SvPV(svc, length);
1026         rval = api_map(screen, key, command, length);
1027         ENDMESSAGE;
1028
1029 void
1030 DELETE(screen, key)
1031         VI::MAP screen
1032         char *key
1033
1034         PREINIT:
1035         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1036         int rval;
1037
1038         CODE:
1039         INITMESSAGE;
1040         rval = api_unmap(screen, key);
1041         ENDMESSAGE;
1042
1043 MODULE = VI     PACKAGE = VI::MARK
1044
1045 void 
1046 DESTROY(screen)
1047         VI::MARK screen
1048
1049         CODE:
1050         # typemap did all the checking
1051         SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0))));
1052
1053 AV *
1054 FETCH(screen, mark)
1055         VI::MARK screen
1056         char mark
1057
1058         PREINIT:
1059         struct _mark cursor;
1060         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1061         int rval;
1062
1063         CODE:
1064         INITMESSAGE;
1065         rval = api_getmark(screen, (int)mark, &cursor);
1066         ENDMESSAGE;
1067         RETVAL = newAV();
1068         av_push(RETVAL, newSViv(cursor.lno));
1069         av_push(RETVAL, newSViv(cursor.cno));
1070
1071         OUTPUT:
1072         RETVAL
1073
1074 void
1075 STORE(screen, mark, pos)
1076         VI::MARK screen
1077         char mark
1078         AVREF pos
1079
1080         PREINIT:
1081         struct _mark cursor;
1082         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1083         int rval;
1084
1085         CODE:
1086         if (av_len(pos) < 1) 
1087             croak("cursor position needs 2 elements");
1088         INITMESSAGE;
1089         cursor.lno = SvIV(*av_fetch(pos, 0, 0));
1090         cursor.cno = SvIV(*av_fetch(pos, 1, 0));
1091         rval = api_setmark(screen, (int)mark, &cursor);
1092         ENDMESSAGE;
1093
1094 void
1095 FIRSTKEY(screen, ...)
1096         VI::MARK screen
1097
1098         ALIAS:
1099         NEXTKEY = 1
1100         
1101         PROTOTYPE: $;$
1102
1103         PREINIT:
1104         struct _mark cursor;
1105         void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
1106         int next;
1107         char key[] = {0, 0};
1108
1109         PPCODE:
1110         if (items == 2) {
1111                 next = 1;
1112                 *key = *(char *)SvPV(ST(1),na);
1113         } else next = 0;
1114         if (api_nextmark(screen, next, key) != 1) {
1115                 EXTEND(sp, 1);
1116                 PUSHs(sv_2mortal(newSVpv(key, 1)));
1117         } else ST(0) = &sv_undef;