1 /* vi:set ts=8 sts=4 sw=4:
3 * VIM - Vi IMproved by Bram Moolenaar
5 * Do ":help uganda" in Vim to read copying and usage conditions.
6 * Do ":help credits" in Vim to see a list of people who contributed.
9 * if_perl.xs: Main code for Perl interface support.
10 * Mostly written by Sven Verdoolaege.
13 #define _memory_h /* avoid memset redeclaration */
14 #define IN_PERL_FILE /* don't include if_perl.pro from proto.h */
20 * Work around clashes between Perl and Vim namespace. proto.h doesn't
21 * include if_perl.pro and perlsfio.pro when IN_PERL_FILE is defined, because
22 * we need the CV typedef. proto.h can't be moved to after including
23 * if_perl.h, because we get all sorts of name clashes then.
27 # include "proto/if_perl.pro"
28 # include "proto/if_perlsfio.pro"
32 /* Perl compatibility stuff. This should ensure compatibility with older
37 # include <patchlevel.h>
38 # define PERL_REVISION 5
39 # define PERL_VERSION PATCHLEVEL
40 # define PERL_SUBVERSION SUBVERSION
52 /* Compatibility hacks over */
54 static PerlInterpreter *perl_interp = NULL;
55 static void xs_init __ARGS((pTHX));
56 static void VIM_init __ARGS((void));
57 EXTERN_C void boot_DynaLoader __ARGS((pTHX_ CV*));
60 * For dynamic linked perl. (Windows)
62 #if defined(DYNAMIC_PERL) || defined(PROTO)
66 # define perl_alloc dll_perl_alloc
67 # define perl_construct dll_perl_construct
68 # define perl_parse dll_perl_parse
69 # define perl_run dll_perl_run
70 # define perl_destruct dll_perl_destruct
71 # define perl_free dll_perl_free
72 # define Perl_get_context dll_Perl_get_context
73 # define Perl_croak dll_Perl_croak
75 # define Perl_croak_nocontext dll_Perl_croak_nocontext
76 # define Perl_call_argv dll_Perl_call_argv
77 # define Perl_call_pv dll_Perl_call_pv
78 # define Perl_eval_sv dll_Perl_eval_sv
79 # define Perl_get_sv dll_Perl_get_sv
80 # define Perl_eval_pv dll_Perl_eval_pv
81 # define Perl_call_method dll_Perl_call_method
83 # define Perl_dowantarray dll_Perl_dowantarray
84 # define Perl_free_tmps dll_Perl_free_tmps
85 # define Perl_gv_stashpv dll_Perl_gv_stashpv
86 # define Perl_markstack_grow dll_Perl_markstack_grow
87 # define Perl_mg_find dll_Perl_mg_find
88 # define Perl_newXS dll_Perl_newXS
89 # define Perl_newSV dll_Perl_newSV
90 # define Perl_newSViv dll_Perl_newSViv
91 # define Perl_newSVpv dll_Perl_newSVpv
92 # define Perl_pop_scope dll_Perl_pop_scope
93 # define Perl_push_scope dll_Perl_push_scope
94 # define Perl_save_int dll_Perl_save_int
95 # define Perl_stack_grow dll_Perl_stack_grow
96 # define Perl_set_context dll_Perl_set_context
97 # define Perl_sv_2bool dll_Perl_sv_2bool
98 # define Perl_sv_2iv dll_Perl_sv_2iv
99 # define Perl_sv_2mortal dll_Perl_sv_2mortal
100 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
101 # define Perl_sv_2pv_flags dll_Perl_sv_2pv_flags
102 # define Perl_sv_2pv_nolen dll_Perl_sv_2pv_nolen
104 # define Perl_sv_2pv dll_Perl_sv_2pv
106 # define Perl_sv_bless dll_Perl_sv_bless
107 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
108 # define Perl_sv_catpvn_flags dll_Perl_sv_catpvn_flags
110 # define Perl_sv_catpvn dll_Perl_sv_catpvn
112 # define Perl_sv_free dll_Perl_sv_free
113 # define Perl_sv_isa dll_Perl_sv_isa
114 # define Perl_sv_magic dll_Perl_sv_magic
115 # define Perl_sv_setiv dll_Perl_sv_setiv
116 # define Perl_sv_setpv dll_Perl_sv_setpv
117 # define Perl_sv_setpvn dll_Perl_sv_setpvn
118 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
119 # define Perl_sv_setsv_flags dll_Perl_sv_setsv_flags
121 # define Perl_sv_setsv dll_Perl_sv_setsv
123 # define Perl_sv_upgrade dll_Perl_sv_upgrade
124 # define Perl_Tstack_sp_ptr dll_Perl_Tstack_sp_ptr
125 # define Perl_Top_ptr dll_Perl_Top_ptr
126 # define Perl_Tstack_base_ptr dll_Perl_Tstack_base_ptr
127 # define Perl_Tstack_max_ptr dll_Perl_Tstack_max_ptr
128 # define Perl_Ttmps_ix_ptr dll_Perl_Ttmps_ix_ptr
129 # define Perl_Ttmps_floor_ptr dll_Perl_Ttmps_floor_ptr
130 # define Perl_Tmarkstack_ptr_ptr dll_Perl_Tmarkstack_ptr_ptr
131 # define Perl_Tmarkstack_max_ptr dll_Perl_Tmarkstack_max_ptr
132 # define Perl_TSv_ptr dll_Perl_TSv_ptr
133 # define Perl_TXpv_ptr dll_Perl_TXpv_ptr
134 # define Perl_Tna_ptr dll_Perl_Tna_ptr
135 # define Perl_Idefgv_ptr dll_Perl_Idefgv_ptr
136 # define Perl_Ierrgv_ptr dll_Perl_Ierrgv_ptr
137 # define Perl_Isv_yes_ptr dll_Perl_Isv_yes_ptr
138 # define boot_DynaLoader dll_boot_DynaLoader
140 #ifndef DYNAMIC_PERL /* just generating prototypes */
142 typedef int XSINIT_t;
143 typedef int XSUBADDR_t;
147 * Declare HANDLE for perl.dll and function pointers.
149 static HANDLE hPerlLib = NULL;
151 static PerlInterpreter* (*perl_alloc)();
152 static void (*perl_construct)(PerlInterpreter*);
153 static void (*perl_destruct)(PerlInterpreter*);
154 static void (*perl_free)(PerlInterpreter*);
155 static int (*perl_run)(PerlInterpreter*);
156 static int (*perl_parse)(PerlInterpreter*, XSINIT_t, int, char**, char**);
157 static void* (*Perl_get_context)(void);
158 static void (*Perl_croak)(pTHX_ const char*, ...);
159 static void (*Perl_croak_nocontext)(const char*, ...);
160 static I32 (*Perl_dowantarray)(pTHX);
161 static void (*Perl_free_tmps)(pTHX);
162 static HV* (*Perl_gv_stashpv)(pTHX_ const char*, I32);
163 static void (*Perl_markstack_grow)(pTHX);
164 static MAGIC* (*Perl_mg_find)(pTHX_ SV*, int);
165 static CV* (*Perl_newXS)(pTHX_ char*, XSUBADDR_t, char*);
166 static SV* (*Perl_newSV)(pTHX_ STRLEN);
167 static SV* (*Perl_newSViv)(pTHX_ IV);
168 static SV* (*Perl_newSVpv)(pTHX_ const char*, STRLEN);
169 static I32 (*Perl_call_argv)(pTHX_ const char*, I32, char**);
170 static I32 (*Perl_call_pv)(pTHX_ const char*, I32);
171 static I32 (*Perl_eval_sv)(pTHX_ SV*, I32);
172 static SV* (*Perl_get_sv)(pTHX_ const char*, I32);
173 static SV* (*Perl_eval_pv)(pTHX_ const char*, I32);
174 static SV* (*Perl_call_method)(pTHX_ const char*, I32);
175 static void (*Perl_pop_scope)(pTHX);
176 static void (*Perl_push_scope)(pTHX);
177 static void (*Perl_save_int)(pTHX_ int*);
178 static SV** (*Perl_stack_grow)(pTHX_ SV**, SV**p, int);
179 static SV** (*Perl_set_context)(void*);
180 static bool (*Perl_sv_2bool)(pTHX_ SV*);
181 static IV (*Perl_sv_2iv)(pTHX_ SV*);
182 static SV* (*Perl_sv_2mortal)(pTHX_ SV*);
183 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
184 static char* (*Perl_sv_2pv_flags)(pTHX_ SV*, STRLEN*, I32);
185 static char* (*Perl_sv_2pv_nolen)(pTHX_ SV*);
187 static char* (*Perl_sv_2pv)(pTHX_ SV*, STRLEN*);
189 static SV* (*Perl_sv_bless)(pTHX_ SV*, HV*);
190 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
191 static void (*Perl_sv_catpvn_flags)(pTHX_ SV* , const char*, STRLEN, I32);
193 static void (*Perl_sv_catpvn)(pTHX_ SV*, const char*, STRLEN);
195 static void (*Perl_sv_free)(pTHX_ SV*);
196 static int (*Perl_sv_isa)(pTHX_ SV*, const char*);
197 static void (*Perl_sv_magic)(pTHX_ SV*, SV*, int, const char*, I32);
198 static void (*Perl_sv_setiv)(pTHX_ SV*, IV);
199 static void (*Perl_sv_setpv)(pTHX_ SV*, const char*);
200 static void (*Perl_sv_setpvn)(pTHX_ SV*, const char*, STRLEN);
201 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
202 static void (*Perl_sv_setsv_flags)(pTHX_ SV*, SV*, I32);
204 static void (*Perl_sv_setsv)(pTHX_ SV*, SV*);
206 static bool (*Perl_sv_upgrade)(pTHX_ SV*, U32);
207 static SV*** (*Perl_Tstack_sp_ptr)(register PerlInterpreter*);
208 static OP** (*Perl_Top_ptr)(register PerlInterpreter*);
209 static SV*** (*Perl_Tstack_base_ptr)(register PerlInterpreter*);
210 static SV*** (*Perl_Tstack_max_ptr)(register PerlInterpreter*);
211 static I32* (*Perl_Ttmps_ix_ptr)(register PerlInterpreter*);
212 static I32* (*Perl_Ttmps_floor_ptr)(register PerlInterpreter*);
213 static I32** (*Perl_Tmarkstack_ptr_ptr)(register PerlInterpreter*);
214 static I32** (*Perl_Tmarkstack_max_ptr)(register PerlInterpreter*);
215 static SV** (*Perl_TSv_ptr)(register PerlInterpreter*);
216 static XPV** (*Perl_TXpv_ptr)(register PerlInterpreter*);
217 static STRLEN* (*Perl_Tna_ptr)(register PerlInterpreter*);
218 static GV** (*Perl_Idefgv_ptr)(register PerlInterpreter*);
219 static GV** (*Perl_Ierrgv_ptr)(register PerlInterpreter*);
220 static SV* (*Perl_Isv_yes_ptr)(register PerlInterpreter*);
221 static void (*boot_DynaLoader)_((pTHX_ CV*));
225 * Table of name to function pointer of perl.
227 #define PERL_PROC FARPROC
231 } perl_funcname_table[] = {
232 {"perl_alloc", (PERL_PROC*)&perl_alloc},
233 {"perl_construct", (PERL_PROC*)&perl_construct},
234 {"perl_destruct", (PERL_PROC*)&perl_destruct},
235 {"perl_free", (PERL_PROC*)&perl_free},
236 {"perl_run", (PERL_PROC*)&perl_run},
237 {"perl_parse", (PERL_PROC*)&perl_parse},
238 {"Perl_get_context", (PERL_PROC*)&Perl_get_context},
239 {"Perl_croak", (PERL_PROC*)&Perl_croak},
240 {"Perl_croak_nocontext", (PERL_PROC*)&Perl_croak_nocontext},
241 {"Perl_dowantarray", (PERL_PROC*)&Perl_dowantarray},
242 {"Perl_free_tmps", (PERL_PROC*)&Perl_free_tmps},
243 {"Perl_gv_stashpv", (PERL_PROC*)&Perl_gv_stashpv},
244 {"Perl_markstack_grow", (PERL_PROC*)&Perl_markstack_grow},
245 {"Perl_mg_find", (PERL_PROC*)&Perl_mg_find},
246 {"Perl_newXS", (PERL_PROC*)&Perl_newXS},
247 {"Perl_newSV", (PERL_PROC*)&Perl_newSV},
248 {"Perl_newSViv", (PERL_PROC*)&Perl_newSViv},
249 {"Perl_newSVpv", (PERL_PROC*)&Perl_newSVpv},
250 {"Perl_call_argv", (PERL_PROC*)&Perl_call_argv},
251 {"Perl_call_pv", (PERL_PROC*)&Perl_call_pv},
252 {"Perl_eval_sv", (PERL_PROC*)&Perl_eval_sv},
253 {"Perl_get_sv", (PERL_PROC*)&Perl_get_sv},
254 {"Perl_eval_pv", (PERL_PROC*)&Perl_eval_pv},
255 {"Perl_call_method", (PERL_PROC*)&Perl_call_method},
256 {"Perl_pop_scope", (PERL_PROC*)&Perl_pop_scope},
257 {"Perl_push_scope", (PERL_PROC*)&Perl_push_scope},
258 {"Perl_save_int", (PERL_PROC*)&Perl_save_int},
259 {"Perl_stack_grow", (PERL_PROC*)&Perl_stack_grow},
260 {"Perl_set_context", (PERL_PROC*)&Perl_set_context},
261 {"Perl_sv_2bool", (PERL_PROC*)&Perl_sv_2bool},
262 {"Perl_sv_2iv", (PERL_PROC*)&Perl_sv_2iv},
263 {"Perl_sv_2mortal", (PERL_PROC*)&Perl_sv_2mortal},
264 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
265 {"Perl_sv_2pv_flags", (PERL_PROC*)&Perl_sv_2pv_flags},
266 {"Perl_sv_2pv_nolen", (PERL_PROC*)&Perl_sv_2pv_nolen},
268 {"Perl_sv_2pv", (PERL_PROC*)&Perl_sv_2pv},
270 {"Perl_sv_bless", (PERL_PROC*)&Perl_sv_bless},
271 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
272 {"Perl_sv_catpvn_flags", (PERL_PROC*)&Perl_sv_catpvn_flags},
274 {"Perl_sv_catpvn", (PERL_PROC*)&Perl_sv_catpvn},
276 {"Perl_sv_free", (PERL_PROC*)&Perl_sv_free},
277 {"Perl_sv_isa", (PERL_PROC*)&Perl_sv_isa},
278 {"Perl_sv_magic", (PERL_PROC*)&Perl_sv_magic},
279 {"Perl_sv_setiv", (PERL_PROC*)&Perl_sv_setiv},
280 {"Perl_sv_setpv", (PERL_PROC*)&Perl_sv_setpv},
281 {"Perl_sv_setpvn", (PERL_PROC*)&Perl_sv_setpvn},
282 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
283 {"Perl_sv_setsv_flags", (PERL_PROC*)&Perl_sv_setsv_flags},
285 {"Perl_sv_setsv", (PERL_PROC*)&Perl_sv_setsv},
287 {"Perl_sv_upgrade", (PERL_PROC*)&Perl_sv_upgrade},
288 {"Perl_Tstack_sp_ptr", (PERL_PROC*)&Perl_Tstack_sp_ptr},
289 {"Perl_Top_ptr", (PERL_PROC*)&Perl_Top_ptr},
290 {"Perl_Tstack_base_ptr", (PERL_PROC*)&Perl_Tstack_base_ptr},
291 {"Perl_Tstack_max_ptr", (PERL_PROC*)&Perl_Tstack_max_ptr},
292 {"Perl_Ttmps_ix_ptr", (PERL_PROC*)&Perl_Ttmps_ix_ptr},
293 {"Perl_Ttmps_floor_ptr", (PERL_PROC*)&Perl_Ttmps_floor_ptr},
294 {"Perl_Tmarkstack_ptr_ptr", (PERL_PROC*)&Perl_Tmarkstack_ptr_ptr},
295 {"Perl_Tmarkstack_max_ptr", (PERL_PROC*)&Perl_Tmarkstack_max_ptr},
296 {"Perl_TSv_ptr", (PERL_PROC*)&Perl_TSv_ptr},
297 {"Perl_TXpv_ptr", (PERL_PROC*)&Perl_TXpv_ptr},
298 {"Perl_Tna_ptr", (PERL_PROC*)&Perl_Tna_ptr},
299 {"Perl_Idefgv_ptr", (PERL_PROC*)&Perl_Idefgv_ptr},
300 {"Perl_Ierrgv_ptr", (PERL_PROC*)&Perl_Ierrgv_ptr},
301 {"Perl_Isv_yes_ptr", (PERL_PROC*)&Perl_Isv_yes_ptr},
302 {"boot_DynaLoader", (PERL_PROC*)&boot_DynaLoader},
307 * Make all runtime-links of perl.
309 * 1. Get module handle using LoadLibraryEx.
310 * 2. Get pointer to perl function by GetProcAddress.
311 * 3. Repeat 2, until get all functions will be used.
313 * Parameter 'libname' provides name of DLL.
317 perl_runtime_link_init(char *libname, int verbose)
321 if (hPerlLib != NULL)
323 if (!(hPerlLib = LoadLibraryEx(libname, NULL, 0)))
326 EMSG2(_("E370: Could not load library %s"), libname);
329 for (i = 0; perl_funcname_table[i].ptr; ++i)
331 if (!(*perl_funcname_table[i].ptr = GetProcAddress(hPerlLib,
332 perl_funcname_table[i].name)))
334 FreeLibrary(hPerlLib);
337 EMSG2(_(e_loadfunc), perl_funcname_table[i].name);
345 * If runtime-link-perl(DLL) was loaded successfully, return TRUE.
346 * There were no DLL loaded, return FALSE.
349 perl_enabled(verbose)
352 return perl_runtime_link_init(DYNAMIC_PERL_DLL, verbose) == OK;
354 #endif /* DYNAMIC_PERL */
357 * perl_init(): initialize perl interpreter
358 * We have to call perl_parse to initialize some structures,
359 * there's nothing to actually parse.
364 char *bootargs[] = { "VI", NULL };
365 static char *args[] = { "", "-e", "" };
367 perl_interp = perl_alloc();
368 perl_construct(perl_interp);
369 perl_parse(perl_interp, xs_init, 3, args, 0);
370 perl_call_argv("VIM::bootstrap", (long)G_DISCARD, bootargs);
373 sfdisc(PerlIO_stdout(), sfdcnewvim());
374 sfdisc(PerlIO_stderr(), sfdcnewvim());
375 sfsetbuf(PerlIO_stdout(), NULL, 0);
376 sfsetbuf(PerlIO_stderr(), NULL, 0);
381 * perl_end(): clean up after ourselves
388 perl_run(perl_interp);
389 perl_destruct(perl_interp);
390 perl_free(perl_interp);
396 FreeLibrary(hPerlLib);
403 * msg_split(): send a message to the message handling routines
404 * split at '\n' first though.
409 int attr; /* highlighting attributes */
412 char *token = (char *)s;
414 while ((next = strchr(token, '\n')))
416 *next++ = '\0'; /* replace \n with \0 */
417 msg_attr((char_u *)token, attr);
421 msg_attr((char_u *)token, attr);
426 * This stub is needed because an "#ifdef FEAT_EVAL" around Eval() doesn't
430 eval_to_string(arg, nextcmd, dolist)
440 * Create a new reference to an SV pointing to the SCR structure
441 * The b_perl_private/w_perl_private part of the SCR structure points to the
442 * SV, so there can only be one such SV for a particular SCR structure. When
443 * the last reference has gone (DESTROY is called),
444 * b_perl_private/w_perl_private is reset; When the screen goes away before
445 * all references are gone, the value of the SV is reset;
446 * any subsequent use of any of those reference will produce
447 * a warning. (see typemap)
455 sv_upgrade(rv, SVt_RV);
456 if (ptr->w_perl_private == NULL)
458 ptr->w_perl_private = newSV(0);
459 sv_setiv(ptr->w_perl_private, (IV)ptr);
462 SvREFCNT_inc(ptr->w_perl_private);
463 SvRV(rv) = ptr->w_perl_private;
465 return sv_bless(rv, gv_stashpv("VIWIN", TRUE));
473 sv_upgrade(rv, SVt_RV);
474 if (ptr->b_perl_private == NULL)
476 ptr->b_perl_private = newSV(0);
477 sv_setiv(ptr->b_perl_private, (IV)ptr);
480 SvREFCNT_inc(ptr->b_perl_private);
481 SvRV(rv) = ptr->b_perl_private;
483 return sv_bless(rv, gv_stashpv("VIBUF", TRUE));
488 * Remove all refences to the window to be destroyed
494 if (wp->w_perl_private)
495 sv_setiv((SV *)wp->w_perl_private, 0);
503 if (bp->b_perl_private)
504 sv_setiv((SV *)bp->b_perl_private, 0);
509 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
510 I32 cur_val(pTHX_ IV iv, SV *sv);
512 I32 cur_val(IV iv, SV *sv);
516 * Handler for the magic variables $main::curwin and $main::curbuf.
517 * The handler is put into the magic vtbl for these variables.
518 * (This is effectively a C-level equivalent of a tied variable).
519 * There is no "set" function as the variables are read-only.
521 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
522 I32 cur_val(pTHX_ IV iv, SV *sv)
524 I32 cur_val(IV iv, SV *sv)
529 rv = newWINrv(newSV(0), curwin);
531 rv = newBUFrv(newSV(0), curbuf);
537 struct ufuncs cw_funcs = { cur_val, 0, 0 };
538 struct ufuncs cb_funcs = { cur_val, 0, 1 };
541 * VIM_init(): Vim-specific initialisation.
542 * Make the magical main::curwin and main::curbuf variables
547 static char cw[] = "main::curwin";
548 static char cb[] = "main::curbuf";
551 sv = perl_get_sv(cw, TRUE);
552 sv_magic(sv, NULL, 'U', (char *)&cw_funcs, sizeof(cw_funcs));
555 sv = perl_get_sv(cb, TRUE);
556 sv_magic(sv, NULL, 'U', (char *)&cb_funcs, sizeof(cb_funcs));
560 * Setup the Safe compartment.
561 * It shouldn't be a fatal error if the Safe module is missing.
562 * XXX: Only shares the 'Msg' routine (which has to be called
565 (void)perl_eval_pv( "if ( eval( 'require Safe' ) ) { $VIM::safe = Safe->new(); $VIM::safe->share_from( 'VIM', ['Msg'] ); }", G_DISCARD | G_VOID );
570 static char *e_noperl = N_("Sorry, this command is disabled: the Perl library could not be loaded.");
586 script = (char *)script_get(eap, eap->arg);
593 if (perl_interp == NULL)
596 if (!perl_enabled(TRUE))
612 sv = newSVpv((char *)eap->arg, 0);
615 sv = newSVpv(script, 0);
622 if ((safe = perl_get_sv( "VIM::safe", FALSE )) == NULL || !SvTRUE(safe))
623 EMSG(_("E299: Perl evaluation forbidden in sandbox without the Safe module"));
630 perl_call_method("reval", G_DISCARD);
635 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
639 err = SvPV(GvSV(PL_errgv), length);
647 msg_split((char_u *)err, highlight_attr[HLF_E]);
653 replace_line(line, end)
654 linenr_T *line, *end;
658 if (SvOK(GvSV(PL_defgv)))
660 str = SvPV(GvSV(PL_defgv), PL_na);
661 ml_replace(*line, (char_u *)str, 1);
662 changed_bytes(*line, 0);
666 ml_delete(*line, FALSE);
667 deleted_lines_mark(*line, 1L);
689 if (perl_interp == NULL)
692 if (!perl_enabled(TRUE))
702 length = strlen((char *)eap->arg);
703 sv = newSV(length + sizeof("sub VIM::perldo {") - 1 + 1);
704 sv_setpvn(sv, "sub VIM::perldo {", sizeof("sub VIM::perldo {") - 1);
705 sv_catpvn(sv, (char *)eap->arg, length);
706 sv_catpvn(sv, "}", 1);
707 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
709 str = SvPV(GvSV(PL_errgv), length);
713 if (u_save(eap->line1 - 1, eap->line2 + 1) != OK)
718 for (i = eap->line1; i <= eap->line2; i++)
720 sv_setpv(GvSV(PL_defgv), (char *)ml_get(i));
722 perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
723 str = SvPV(GvSV(PL_errgv), length);
729 if (replace_line(&i, &eap->line2) != OK)
740 update_screen(NOT_VALID);
745 msg_split((char_u *)str, highlight_attr[HLF_E]);
751 XS(XS_VIM_SetOption);
752 XS(XS_VIM_DoCommand);
756 XS(XS_VIWIN_DESTROY);
758 XS(XS_VIWIN_SetHeight);
760 XS(XS_VIBUF_DESTROY);
773 char *file = __FILE__;
775 /* DynaLoader is a special case */
776 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
777 newXS("VIM::bootstrap", boot_VIM, file);
780 typedef win_T * VIWIN;
781 typedef buf_T * VIBUF;
783 MODULE = VIM PACKAGE = VIM
800 id = syn_name2id((char_u *)hl);
802 attr = syn_id2attr(id);
804 msg_split((char_u *)text, attr);
813 do_set((char_u *)line, 0);
814 update_screen(NOT_VALID);
822 do_cmdline_cmd((char_u *)line);
831 value = eval_to_string((char_u *)str, (char_u **)0, TRUE);
834 XPUSHs(sv_2mortal(newSViv(0)));
835 XPUSHs(sv_2mortal(newSVpv("", 0)));
839 XPUSHs(sv_2mortal(newSViv(1)));
840 XPUSHs(sv_2mortal(newSVpv((char *)value, 0)));
854 if (GIMME == G_SCALAR)
857 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
860 XPUSHs(sv_2mortal(newSViv(i)));
864 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
865 XPUSHs(newBUFrv(newSV(0), vimbuf));
870 for (i = 0; i < items; i++)
880 pat = (char_u *)SvPV(sv, len);
882 b = buflist_findpat(pat, pat+len, FALSE, FALSE);
888 vimbuf = buflist_findnr(b);
890 XPUSHs(newBUFrv(newSV(0), vimbuf));
905 if (GIMME == G_SCALAR)
906 XPUSHs(sv_2mortal(newSViv(win_count())));
909 for (vimwin = firstwin; vimwin != NULL; vimwin = W_NEXT(vimwin))
910 XPUSHs(newWINrv(newSV(0), vimwin));
915 for (i = 0; i < items; i++)
918 vimwin = win_find_nr(w);
920 XPUSHs(newWINrv(newSV(0), vimwin));
924 MODULE = VIM PACKAGE = VIWIN
932 win->w_perl_private = 0;
941 RETVAL = newBUFrv(newSV(0), win->w_buffer);
946 SetHeight(win, height)
958 win_setheight(height);
971 PUSHs(sv_2mortal(newSViv(win->w_cursor.lnum)));
972 PUSHs(sv_2mortal(newSViv(win->w_cursor.col)));
982 win->w_cursor.lnum = lnum;
983 win->w_cursor.col = col;
984 check_cursor(); /* put cursor on an existing line */
985 update_screen(NOT_VALID);
988 MODULE = VIM PACKAGE = VIBUF
995 if (buf_valid(vimbuf))
996 vimbuf->b_perl_private = 0;
1003 if (!buf_valid(vimbuf))
1005 /* No file name returns an empty string */
1006 if (vimbuf->b_fname == NULL)
1007 XPUSHs(sv_2mortal(newSVpv("", 0)));
1009 XPUSHs(sv_2mortal(newSVpv((char *)vimbuf->b_fname, 0)));
1016 if (!buf_valid(vimbuf))
1018 XPUSHs(sv_2mortal(newSViv(vimbuf->b_fnum)));
1025 if (!buf_valid(vimbuf))
1027 XPUSHs(sv_2mortal(newSViv(vimbuf->b_ml.ml_line_count)));
1038 if (buf_valid(vimbuf))
1040 for (i = 1; i < items; i++)
1043 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1045 line = ml_get_buf(vimbuf, lnum, FALSE);
1046 XPUSHs(sv_2mortal(newSVpv((char *)line, 0)));
1060 if (buf_valid(vimbuf))
1063 croak("Usage: VIBUF::Set(vimbuf, lnum, @lines)");
1066 for(i = 2; i < items; i++, lnum++)
1068 line = SvPV(ST(i),PL_na);
1069 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1073 /* set curwin/curbuf for "vimbuf" and save some things */
1074 aucmd_prepbuf(&aco, vimbuf);
1076 if (u_savesub(lnum) == OK)
1078 ml_replace(lnum, (char_u *)line, TRUE);
1079 changed_bytes(lnum, 0);
1082 /* restore curwin/curbuf and a few other things */
1083 aucmd_restbuf(&aco);
1084 /* Careful: autocommands may have made "vimbuf" invalid! */
1094 long i, lnum = 0, count = 0;
1096 if (buf_valid(vimbuf))
1103 else if (items == 3)
1106 count = 1 + SvIV(ST(2)) - lnum;
1117 for (i = 0; i < count; i++)
1119 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1123 /* set curwin/curbuf for "vimbuf" and save some things */
1124 aucmd_prepbuf(&aco, vimbuf);
1126 if (u_savedel(lnum, 1) == OK)
1129 deleted_lines_mark(lnum, 1L);
1130 if (aco.save_buf == curbuf)
1134 /* restore curwin/curbuf and a few other things */
1135 aucmd_restbuf(&aco);
1136 /* Careful: autocommands may have made "vimbuf" invalid! */
1138 update_curbuf(VALID);
1153 if (buf_valid(vimbuf))
1156 croak("Usage: VIBUF::Append(vimbuf, lnum, @lines)");
1159 for (i = 2; i < items; i++, lnum++)
1161 line = SvPV(ST(i),PL_na);
1162 if (lnum >= 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1166 /* set curwin/curbuf for "vimbuf" and save some things */
1167 aucmd_prepbuf(&aco, vimbuf);
1169 if (u_inssub(lnum + 1) == OK)
1171 ml_append(lnum, (char_u *)line, (colnr_T)0, FALSE);
1172 appended_lines_mark(lnum, 1L);
1175 /* restore curwin/curbuf and a few other things */
1176 aucmd_restbuf(&aco);
1177 /* Careful: autocommands may have made "vimbuf" invalid! */
1179 update_curbuf(VALID);