|
7
|
1 /* vi:set ts=8 sts=4 sw=4:
|
|
|
2 *
|
|
|
3 * VIM - Vi IMproved by Bram Moolenaar
|
|
|
4 *
|
|
|
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.
|
|
|
7 */
|
|
|
8 /*
|
|
|
9 * if_perl.xs: Main code for Perl interface support.
|
|
|
10 * Mostly written by Sven Verdoolaege.
|
|
|
11 */
|
|
|
12
|
|
|
13 #define _memory_h /* avoid memset redeclaration */
|
|
|
14 #define IN_PERL_FILE /* don't include if_perl.pro from proto.h */
|
|
|
15
|
|
|
16 #include "vim.h"
|
|
|
17
|
|
|
18
|
|
|
19 /*
|
|
|
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.
|
|
|
24 */
|
|
|
25 #ifndef PROTO
|
|
|
26 #ifndef __MINGW32__
|
|
|
27 # include "proto/if_perl.pro"
|
|
|
28 # include "proto/if_perlsfio.pro"
|
|
|
29 #endif
|
|
|
30 #endif
|
|
|
31
|
|
|
32 /* Perl compatibility stuff. This should ensure compatibility with older
|
|
|
33 * versions of Perl.
|
|
|
34 */
|
|
|
35
|
|
|
36 #ifndef PERL_VERSION
|
|
|
37 # include <patchlevel.h>
|
|
|
38 # define PERL_REVISION 5
|
|
|
39 # define PERL_VERSION PATCHLEVEL
|
|
|
40 # define PERL_SUBVERSION SUBVERSION
|
|
|
41 #endif
|
|
|
42
|
|
1387
|
43 /*
|
|
|
44 * Quoting Jan Dubois of Active State:
|
|
|
45 * ActivePerl build 822 still identifies itself as 5.8.8 but already
|
|
|
46 * contains many of the changes from the upcoming Perl 5.8.9 release.
|
|
|
47 *
|
|
|
48 * The changes include addition of two symbols (Perl_sv_2iv_flags,
|
|
|
49 * Perl_newXS_flags) not present in earlier releases.
|
|
|
50 *
|
|
1395
|
51 * Jan Dubois suggested the following guarding scheme.
|
|
|
52 *
|
|
|
53 * Active State defined ACTIVEPERL_VERSION as a string in versions before
|
|
|
54 * 5.8.8; and so the comparison to 822 below needs to be guarded.
|
|
1387
|
55 */
|
|
1395
|
56 #if (PERL_REVISION == 5) && (PERL_VERSION == 8) && (PERL_SUBVERSION >= 8)
|
|
|
57 # if (ACTIVEPERL_VERSION >= 822) || (PERL_SUBVERSION >= 9)
|
|
|
58 # define PERL589_OR_LATER
|
|
|
59 # endif
|
|
1387
|
60 #endif
|
|
|
61 #if (PERL_REVISION == 5) && (PERL_VERSION >= 9)
|
|
|
62 # define PERL589_OR_LATER
|
|
|
63 #endif
|
|
|
64
|
|
7
|
65 #ifndef pTHX
|
|
|
66 # define pTHX void
|
|
|
67 # define pTHX_
|
|
|
68 #endif
|
|
|
69
|
|
|
70 #ifndef EXTERN_C
|
|
|
71 # define EXTERN_C
|
|
|
72 #endif
|
|
|
73
|
|
|
74 /* Compatibility hacks over */
|
|
|
75
|
|
|
76 static PerlInterpreter *perl_interp = NULL;
|
|
|
77 static void xs_init __ARGS((pTHX));
|
|
|
78 static void VIM_init __ARGS((void));
|
|
|
79 EXTERN_C void boot_DynaLoader __ARGS((pTHX_ CV*));
|
|
|
80
|
|
|
81 /*
|
|
|
82 * For dynamic linked perl. (Windows)
|
|
|
83 */
|
|
|
84 #if defined(DYNAMIC_PERL) || defined(PROTO)
|
|
|
85 /*
|
|
|
86 * Wrapper defines
|
|
|
87 */
|
|
|
88 # define perl_alloc dll_perl_alloc
|
|
|
89 # define perl_construct dll_perl_construct
|
|
|
90 # define perl_parse dll_perl_parse
|
|
|
91 # define perl_run dll_perl_run
|
|
|
92 # define perl_destruct dll_perl_destruct
|
|
|
93 # define perl_free dll_perl_free
|
|
|
94 # define Perl_get_context dll_Perl_get_context
|
|
|
95 # define Perl_croak dll_Perl_croak
|
|
|
96 # ifndef PROTO
|
|
|
97 # define Perl_croak_nocontext dll_Perl_croak_nocontext
|
|
|
98 # define Perl_call_argv dll_Perl_call_argv
|
|
|
99 # define Perl_call_pv dll_Perl_call_pv
|
|
|
100 # define Perl_eval_sv dll_Perl_eval_sv
|
|
|
101 # define Perl_get_sv dll_Perl_get_sv
|
|
|
102 # define Perl_eval_pv dll_Perl_eval_pv
|
|
|
103 # define Perl_call_method dll_Perl_call_method
|
|
|
104 # endif
|
|
|
105 # define Perl_dowantarray dll_Perl_dowantarray
|
|
|
106 # define Perl_free_tmps dll_Perl_free_tmps
|
|
|
107 # define Perl_gv_stashpv dll_Perl_gv_stashpv
|
|
|
108 # define Perl_markstack_grow dll_Perl_markstack_grow
|
|
|
109 # define Perl_mg_find dll_Perl_mg_find
|
|
|
110 # define Perl_newXS dll_Perl_newXS
|
|
|
111 # define Perl_newSV dll_Perl_newSV
|
|
|
112 # define Perl_newSViv dll_Perl_newSViv
|
|
|
113 # define Perl_newSVpv dll_Perl_newSVpv
|
|
|
114 # define Perl_pop_scope dll_Perl_pop_scope
|
|
|
115 # define Perl_push_scope dll_Perl_push_scope
|
|
|
116 # define Perl_save_int dll_Perl_save_int
|
|
|
117 # define Perl_stack_grow dll_Perl_stack_grow
|
|
|
118 # define Perl_set_context dll_Perl_set_context
|
|
|
119 # define Perl_sv_2bool dll_Perl_sv_2bool
|
|
|
120 # define Perl_sv_2iv dll_Perl_sv_2iv
|
|
|
121 # define Perl_sv_2mortal dll_Perl_sv_2mortal
|
|
|
122 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
|
|
|
123 # define Perl_sv_2pv_flags dll_Perl_sv_2pv_flags
|
|
|
124 # define Perl_sv_2pv_nolen dll_Perl_sv_2pv_nolen
|
|
|
125 # else
|
|
|
126 # define Perl_sv_2pv dll_Perl_sv_2pv
|
|
|
127 # endif
|
|
|
128 # define Perl_sv_bless dll_Perl_sv_bless
|
|
|
129 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
|
|
|
130 # define Perl_sv_catpvn_flags dll_Perl_sv_catpvn_flags
|
|
|
131 # else
|
|
|
132 # define Perl_sv_catpvn dll_Perl_sv_catpvn
|
|
|
133 # endif
|
|
1387
|
134 #ifdef PERL589_OR_LATER
|
|
|
135 # define Perl_sv_2iv_flags dll_Perl_sv_2iv_flags
|
|
|
136 # define Perl_newXS_flags dll_Perl_newXS_flags
|
|
|
137 #endif
|
|
7
|
138 # define Perl_sv_free dll_Perl_sv_free
|
|
1711
|
139 # if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
|
|
|
140 # define Perl_sv_free2 dll_Perl_sv_free2
|
|
|
141 # endif
|
|
7
|
142 # define Perl_sv_isa dll_Perl_sv_isa
|
|
|
143 # define Perl_sv_magic dll_Perl_sv_magic
|
|
|
144 # define Perl_sv_setiv dll_Perl_sv_setiv
|
|
|
145 # define Perl_sv_setpv dll_Perl_sv_setpv
|
|
|
146 # define Perl_sv_setpvn dll_Perl_sv_setpvn
|
|
|
147 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
|
|
|
148 # define Perl_sv_setsv_flags dll_Perl_sv_setsv_flags
|
|
|
149 # else
|
|
|
150 # define Perl_sv_setsv dll_Perl_sv_setsv
|
|
|
151 # endif
|
|
|
152 # define Perl_sv_upgrade dll_Perl_sv_upgrade
|
|
|
153 # define Perl_Tstack_sp_ptr dll_Perl_Tstack_sp_ptr
|
|
|
154 # define Perl_Top_ptr dll_Perl_Top_ptr
|
|
|
155 # define Perl_Tstack_base_ptr dll_Perl_Tstack_base_ptr
|
|
|
156 # define Perl_Tstack_max_ptr dll_Perl_Tstack_max_ptr
|
|
|
157 # define Perl_Ttmps_ix_ptr dll_Perl_Ttmps_ix_ptr
|
|
|
158 # define Perl_Ttmps_floor_ptr dll_Perl_Ttmps_floor_ptr
|
|
|
159 # define Perl_Tmarkstack_ptr_ptr dll_Perl_Tmarkstack_ptr_ptr
|
|
|
160 # define Perl_Tmarkstack_max_ptr dll_Perl_Tmarkstack_max_ptr
|
|
|
161 # define Perl_TSv_ptr dll_Perl_TSv_ptr
|
|
|
162 # define Perl_TXpv_ptr dll_Perl_TXpv_ptr
|
|
|
163 # define Perl_Tna_ptr dll_Perl_Tna_ptr
|
|
|
164 # define Perl_Idefgv_ptr dll_Perl_Idefgv_ptr
|
|
|
165 # define Perl_Ierrgv_ptr dll_Perl_Ierrgv_ptr
|
|
|
166 # define Perl_Isv_yes_ptr dll_Perl_Isv_yes_ptr
|
|
|
167 # define boot_DynaLoader dll_boot_DynaLoader
|
|
|
168
|
|
1765
|
169 # define Perl_sys_init dll_Perl_sys_init
|
|
1668
|
170 # define Perl_sys_term dll_Perl_sys_term
|
|
|
171 # define Perl_ISv_ptr dll_Perl_ISv_ptr
|
|
|
172 # define Perl_Istack_max_ptr dll_Perl_Istack_max_ptr
|
|
|
173 # define Perl_Istack_base_ptr dll_Perl_Istack_base_ptr
|
|
|
174 # define Perl_Itmps_ix_ptr dll_Perl_Itmps_ix_ptr
|
|
|
175 # define Perl_Itmps_floor_ptr dll_Perl_Itmps_floor_ptr
|
|
|
176 # define Perl_IXpv_ptr dll_Perl_IXpv_ptr
|
|
|
177 # define Perl_Ina_ptr dll_Perl_Ina_ptr
|
|
|
178 # define Perl_Imarkstack_ptr_ptr dll_Perl_Imarkstack_ptr_ptr
|
|
|
179 # define Perl_Imarkstack_max_ptr dll_Perl_Imarkstack_max_ptr
|
|
|
180 # define Perl_Istack_sp_ptr dll_Perl_Istack_sp_ptr
|
|
|
181 # define Perl_Iop_ptr dll_Perl_Iop_ptr
|
|
|
182 # define Perl_call_list dll_Perl_call_list
|
|
|
183 # define Perl_Iscopestack_ix_ptr dll_Perl_Iscopestack_ix_ptr
|
|
|
184 # define Perl_Iunitcheckav_ptr dll_Perl_Iunitcheckav_ptr
|
|
|
185
|
|
7
|
186 #ifndef DYNAMIC_PERL /* just generating prototypes */
|
|
|
187 typedef int HANDLE;
|
|
|
188 typedef int XSINIT_t;
|
|
|
189 typedef int XSUBADDR_t;
|
|
|
190 #endif
|
|
|
191
|
|
|
192 /*
|
|
|
193 * Declare HANDLE for perl.dll and function pointers.
|
|
|
194 */
|
|
|
195 static HANDLE hPerlLib = NULL;
|
|
|
196
|
|
|
197 static PerlInterpreter* (*perl_alloc)();
|
|
|
198 static void (*perl_construct)(PerlInterpreter*);
|
|
|
199 static void (*perl_destruct)(PerlInterpreter*);
|
|
|
200 static void (*perl_free)(PerlInterpreter*);
|
|
|
201 static int (*perl_run)(PerlInterpreter*);
|
|
|
202 static int (*perl_parse)(PerlInterpreter*, XSINIT_t, int, char**, char**);
|
|
|
203 static void* (*Perl_get_context)(void);
|
|
933
|
204 static void (*Perl_croak)(pTHX_ const char*, ...);
|
|
|
205 static void (*Perl_croak_nocontext)(const char*, ...);
|
|
7
|
206 static I32 (*Perl_dowantarray)(pTHX);
|
|
|
207 static void (*Perl_free_tmps)(pTHX);
|
|
|
208 static HV* (*Perl_gv_stashpv)(pTHX_ const char*, I32);
|
|
|
209 static void (*Perl_markstack_grow)(pTHX);
|
|
|
210 static MAGIC* (*Perl_mg_find)(pTHX_ SV*, int);
|
|
|
211 static CV* (*Perl_newXS)(pTHX_ char*, XSUBADDR_t, char*);
|
|
|
212 static SV* (*Perl_newSV)(pTHX_ STRLEN);
|
|
|
213 static SV* (*Perl_newSViv)(pTHX_ IV);
|
|
|
214 static SV* (*Perl_newSVpv)(pTHX_ const char*, STRLEN);
|
|
|
215 static I32 (*Perl_call_argv)(pTHX_ const char*, I32, char**);
|
|
|
216 static I32 (*Perl_call_pv)(pTHX_ const char*, I32);
|
|
|
217 static I32 (*Perl_eval_sv)(pTHX_ SV*, I32);
|
|
|
218 static SV* (*Perl_get_sv)(pTHX_ const char*, I32);
|
|
|
219 static SV* (*Perl_eval_pv)(pTHX_ const char*, I32);
|
|
|
220 static SV* (*Perl_call_method)(pTHX_ const char*, I32);
|
|
|
221 static void (*Perl_pop_scope)(pTHX);
|
|
|
222 static void (*Perl_push_scope)(pTHX);
|
|
|
223 static void (*Perl_save_int)(pTHX_ int*);
|
|
|
224 static SV** (*Perl_stack_grow)(pTHX_ SV**, SV**p, int);
|
|
|
225 static SV** (*Perl_set_context)(void*);
|
|
|
226 static bool (*Perl_sv_2bool)(pTHX_ SV*);
|
|
|
227 static IV (*Perl_sv_2iv)(pTHX_ SV*);
|
|
|
228 static SV* (*Perl_sv_2mortal)(pTHX_ SV*);
|
|
|
229 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
|
|
|
230 static char* (*Perl_sv_2pv_flags)(pTHX_ SV*, STRLEN*, I32);
|
|
|
231 static char* (*Perl_sv_2pv_nolen)(pTHX_ SV*);
|
|
|
232 #else
|
|
|
233 static char* (*Perl_sv_2pv)(pTHX_ SV*, STRLEN*);
|
|
|
234 #endif
|
|
|
235 static SV* (*Perl_sv_bless)(pTHX_ SV*, HV*);
|
|
|
236 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
|
|
|
237 static void (*Perl_sv_catpvn_flags)(pTHX_ SV* , const char*, STRLEN, I32);
|
|
|
238 #else
|
|
|
239 static void (*Perl_sv_catpvn)(pTHX_ SV*, const char*, STRLEN);
|
|
|
240 #endif
|
|
1387
|
241 #ifdef PERL589_OR_LATER
|
|
|
242 static IV (*Perl_sv_2iv_flags)(pTHX_ SV* sv, I32 flags);
|
|
|
243 static CV * (*Perl_newXS_flags)(pTHX_ const char *name, XSUBADDR_t subaddr, const char *const filename, const char *const proto, U32 flags);
|
|
|
244 #endif
|
|
7
|
245 static void (*Perl_sv_free)(pTHX_ SV*);
|
|
|
246 static int (*Perl_sv_isa)(pTHX_ SV*, const char*);
|
|
|
247 static void (*Perl_sv_magic)(pTHX_ SV*, SV*, int, const char*, I32);
|
|
|
248 static void (*Perl_sv_setiv)(pTHX_ SV*, IV);
|
|
|
249 static void (*Perl_sv_setpv)(pTHX_ SV*, const char*);
|
|
|
250 static void (*Perl_sv_setpvn)(pTHX_ SV*, const char*, STRLEN);
|
|
|
251 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
|
|
|
252 static void (*Perl_sv_setsv_flags)(pTHX_ SV*, SV*, I32);
|
|
|
253 #else
|
|
|
254 static void (*Perl_sv_setsv)(pTHX_ SV*, SV*);
|
|
|
255 #endif
|
|
|
256 static bool (*Perl_sv_upgrade)(pTHX_ SV*, U32);
|
|
|
257 static SV*** (*Perl_Tstack_sp_ptr)(register PerlInterpreter*);
|
|
|
258 static OP** (*Perl_Top_ptr)(register PerlInterpreter*);
|
|
|
259 static SV*** (*Perl_Tstack_base_ptr)(register PerlInterpreter*);
|
|
|
260 static SV*** (*Perl_Tstack_max_ptr)(register PerlInterpreter*);
|
|
|
261 static I32* (*Perl_Ttmps_ix_ptr)(register PerlInterpreter*);
|
|
|
262 static I32* (*Perl_Ttmps_floor_ptr)(register PerlInterpreter*);
|
|
|
263 static I32** (*Perl_Tmarkstack_ptr_ptr)(register PerlInterpreter*);
|
|
|
264 static I32** (*Perl_Tmarkstack_max_ptr)(register PerlInterpreter*);
|
|
|
265 static SV** (*Perl_TSv_ptr)(register PerlInterpreter*);
|
|
|
266 static XPV** (*Perl_TXpv_ptr)(register PerlInterpreter*);
|
|
|
267 static STRLEN* (*Perl_Tna_ptr)(register PerlInterpreter*);
|
|
|
268 static GV** (*Perl_Idefgv_ptr)(register PerlInterpreter*);
|
|
|
269 static GV** (*Perl_Ierrgv_ptr)(register PerlInterpreter*);
|
|
|
270 static SV* (*Perl_Isv_yes_ptr)(register PerlInterpreter*);
|
|
|
271 static void (*boot_DynaLoader)_((pTHX_ CV*));
|
|
|
272
|
|
1668
|
273 #if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
|
|
1711
|
274 static void (*Perl_sv_free2)(pTHX_ SV*);
|
|
1765
|
275 static void (*Perl_sys_init)(int* argc, char*** argv);
|
|
1668
|
276 static void (*Perl_sys_term)(void);
|
|
|
277 static SV** (*Perl_ISv_ptr)(register PerlInterpreter*);
|
|
|
278 static SV*** (*Perl_Istack_max_ptr)(register PerlInterpreter*);
|
|
|
279 static SV*** (*Perl_Istack_base_ptr)(register PerlInterpreter*);
|
|
|
280 static XPV** (*Perl_IXpv_ptr)(register PerlInterpreter*);
|
|
|
281 static I32* (*Perl_Itmps_ix_ptr)(register PerlInterpreter*);
|
|
|
282 static I32* (*Perl_Itmps_floor_ptr)(register PerlInterpreter*);
|
|
|
283 static STRLEN* (*Perl_Ina_ptr)(register PerlInterpreter*);
|
|
|
284 static I32** (*Perl_Imarkstack_ptr_ptr)(register PerlInterpreter*);
|
|
|
285 static I32** (*Perl_Imarkstack_max_ptr)(register PerlInterpreter*);
|
|
|
286 static SV*** (*Perl_Istack_sp_ptr)(register PerlInterpreter*);
|
|
|
287 static OP** (*Perl_Iop_ptr)(register PerlInterpreter*);
|
|
|
288 static void (*Perl_call_list)(pTHX_ I32, AV*);
|
|
|
289 static I32* (*Perl_Iscopestack_ix_ptr)(register PerlInterpreter*);
|
|
|
290 static AV** (*Perl_Iunitcheckav_ptr)(register PerlInterpreter*);
|
|
|
291 #endif
|
|
7
|
292
|
|
|
293 /*
|
|
|
294 * Table of name to function pointer of perl.
|
|
|
295 */
|
|
|
296 #define PERL_PROC FARPROC
|
|
|
297 static struct {
|
|
|
298 char* name;
|
|
|
299 PERL_PROC* ptr;
|
|
|
300 } perl_funcname_table[] = {
|
|
|
301 {"perl_alloc", (PERL_PROC*)&perl_alloc},
|
|
|
302 {"perl_construct", (PERL_PROC*)&perl_construct},
|
|
|
303 {"perl_destruct", (PERL_PROC*)&perl_destruct},
|
|
|
304 {"perl_free", (PERL_PROC*)&perl_free},
|
|
|
305 {"perl_run", (PERL_PROC*)&perl_run},
|
|
|
306 {"perl_parse", (PERL_PROC*)&perl_parse},
|
|
|
307 {"Perl_get_context", (PERL_PROC*)&Perl_get_context},
|
|
|
308 {"Perl_croak", (PERL_PROC*)&Perl_croak},
|
|
|
309 {"Perl_croak_nocontext", (PERL_PROC*)&Perl_croak_nocontext},
|
|
|
310 {"Perl_dowantarray", (PERL_PROC*)&Perl_dowantarray},
|
|
|
311 {"Perl_free_tmps", (PERL_PROC*)&Perl_free_tmps},
|
|
|
312 {"Perl_gv_stashpv", (PERL_PROC*)&Perl_gv_stashpv},
|
|
|
313 {"Perl_markstack_grow", (PERL_PROC*)&Perl_markstack_grow},
|
|
|
314 {"Perl_mg_find", (PERL_PROC*)&Perl_mg_find},
|
|
|
315 {"Perl_newXS", (PERL_PROC*)&Perl_newXS},
|
|
|
316 {"Perl_newSV", (PERL_PROC*)&Perl_newSV},
|
|
|
317 {"Perl_newSViv", (PERL_PROC*)&Perl_newSViv},
|
|
|
318 {"Perl_newSVpv", (PERL_PROC*)&Perl_newSVpv},
|
|
|
319 {"Perl_call_argv", (PERL_PROC*)&Perl_call_argv},
|
|
|
320 {"Perl_call_pv", (PERL_PROC*)&Perl_call_pv},
|
|
|
321 {"Perl_eval_sv", (PERL_PROC*)&Perl_eval_sv},
|
|
|
322 {"Perl_get_sv", (PERL_PROC*)&Perl_get_sv},
|
|
|
323 {"Perl_eval_pv", (PERL_PROC*)&Perl_eval_pv},
|
|
|
324 {"Perl_call_method", (PERL_PROC*)&Perl_call_method},
|
|
|
325 {"Perl_pop_scope", (PERL_PROC*)&Perl_pop_scope},
|
|
|
326 {"Perl_push_scope", (PERL_PROC*)&Perl_push_scope},
|
|
|
327 {"Perl_save_int", (PERL_PROC*)&Perl_save_int},
|
|
|
328 {"Perl_stack_grow", (PERL_PROC*)&Perl_stack_grow},
|
|
|
329 {"Perl_set_context", (PERL_PROC*)&Perl_set_context},
|
|
|
330 {"Perl_sv_2bool", (PERL_PROC*)&Perl_sv_2bool},
|
|
|
331 {"Perl_sv_2iv", (PERL_PROC*)&Perl_sv_2iv},
|
|
|
332 {"Perl_sv_2mortal", (PERL_PROC*)&Perl_sv_2mortal},
|
|
|
333 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
|
|
|
334 {"Perl_sv_2pv_flags", (PERL_PROC*)&Perl_sv_2pv_flags},
|
|
|
335 {"Perl_sv_2pv_nolen", (PERL_PROC*)&Perl_sv_2pv_nolen},
|
|
|
336 #else
|
|
|
337 {"Perl_sv_2pv", (PERL_PROC*)&Perl_sv_2pv},
|
|
|
338 #endif
|
|
1387
|
339 #ifdef PERL589_OR_LATER
|
|
|
340 {"Perl_sv_2iv_flags", (PERL_PROC*)&Perl_sv_2iv_flags},
|
|
|
341 {"Perl_newXS_flags", (PERL_PROC*)&Perl_newXS_flags},
|
|
|
342 #endif
|
|
7
|
343 {"Perl_sv_bless", (PERL_PROC*)&Perl_sv_bless},
|
|
|
344 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
|
|
|
345 {"Perl_sv_catpvn_flags", (PERL_PROC*)&Perl_sv_catpvn_flags},
|
|
|
346 #else
|
|
|
347 {"Perl_sv_catpvn", (PERL_PROC*)&Perl_sv_catpvn},
|
|
|
348 #endif
|
|
|
349 {"Perl_sv_free", (PERL_PROC*)&Perl_sv_free},
|
|
|
350 {"Perl_sv_isa", (PERL_PROC*)&Perl_sv_isa},
|
|
|
351 {"Perl_sv_magic", (PERL_PROC*)&Perl_sv_magic},
|
|
|
352 {"Perl_sv_setiv", (PERL_PROC*)&Perl_sv_setiv},
|
|
|
353 {"Perl_sv_setpv", (PERL_PROC*)&Perl_sv_setpv},
|
|
|
354 {"Perl_sv_setpvn", (PERL_PROC*)&Perl_sv_setpvn},
|
|
|
355 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
|
|
|
356 {"Perl_sv_setsv_flags", (PERL_PROC*)&Perl_sv_setsv_flags},
|
|
|
357 #else
|
|
|
358 {"Perl_sv_setsv", (PERL_PROC*)&Perl_sv_setsv},
|
|
|
359 #endif
|
|
|
360 {"Perl_sv_upgrade", (PERL_PROC*)&Perl_sv_upgrade},
|
|
1668
|
361 #if (PERL_REVISION == 5) && (PERL_VERSION < 10)
|
|
7
|
362 {"Perl_Tstack_sp_ptr", (PERL_PROC*)&Perl_Tstack_sp_ptr},
|
|
|
363 {"Perl_Top_ptr", (PERL_PROC*)&Perl_Top_ptr},
|
|
|
364 {"Perl_Tstack_base_ptr", (PERL_PROC*)&Perl_Tstack_base_ptr},
|
|
|
365 {"Perl_Tstack_max_ptr", (PERL_PROC*)&Perl_Tstack_max_ptr},
|
|
|
366 {"Perl_Ttmps_ix_ptr", (PERL_PROC*)&Perl_Ttmps_ix_ptr},
|
|
|
367 {"Perl_Ttmps_floor_ptr", (PERL_PROC*)&Perl_Ttmps_floor_ptr},
|
|
|
368 {"Perl_Tmarkstack_ptr_ptr", (PERL_PROC*)&Perl_Tmarkstack_ptr_ptr},
|
|
|
369 {"Perl_Tmarkstack_max_ptr", (PERL_PROC*)&Perl_Tmarkstack_max_ptr},
|
|
|
370 {"Perl_TSv_ptr", (PERL_PROC*)&Perl_TSv_ptr},
|
|
|
371 {"Perl_TXpv_ptr", (PERL_PROC*)&Perl_TXpv_ptr},
|
|
|
372 {"Perl_Tna_ptr", (PERL_PROC*)&Perl_Tna_ptr},
|
|
1668
|
373 #else
|
|
1711
|
374 {"Perl_sv_free2", (PERL_PROC*)&Perl_sv_free2},
|
|
1765
|
375 {"Perl_sys_init", (PERL_PROC*)&Perl_sys_init},
|
|
1668
|
376 {"Perl_sys_term", (PERL_PROC*)&Perl_sys_term},
|
|
|
377 {"Perl_ISv_ptr", (PERL_PROC*)&Perl_ISv_ptr},
|
|
|
378 {"Perl_Istack_sp_ptr", (PERL_PROC*)&Perl_Istack_sp_ptr},
|
|
|
379 {"Perl_Iop_ptr", (PERL_PROC*)&Perl_Iop_ptr},
|
|
|
380 {"Perl_Istack_base_ptr", (PERL_PROC*)&Perl_Istack_base_ptr},
|
|
|
381 {"Perl_Istack_max_ptr", (PERL_PROC*)&Perl_Istack_max_ptr},
|
|
|
382 {"Perl_Itmps_ix_ptr", (PERL_PROC*)&Perl_Itmps_ix_ptr},
|
|
|
383 {"Perl_Itmps_floor_ptr", (PERL_PROC*)&Perl_Itmps_floor_ptr},
|
|
|
384 {"Perl_Imarkstack_ptr_ptr", (PERL_PROC*)&Perl_Imarkstack_ptr_ptr},
|
|
|
385 {"Perl_Imarkstack_max_ptr", (PERL_PROC*)&Perl_Imarkstack_max_ptr},
|
|
|
386 {"Perl_ISv_ptr", (PERL_PROC*)&Perl_ISv_ptr},
|
|
|
387 {"Perl_IXpv_ptr", (PERL_PROC*)&Perl_IXpv_ptr},
|
|
|
388 {"Perl_Ina_ptr", (PERL_PROC*)&Perl_Ina_ptr},
|
|
|
389 {"Perl_call_list", (PERL_PROC*)&Perl_call_list},
|
|
|
390 {"Perl_Iscopestack_ix_ptr", (PERL_PROC*)&Perl_Iscopestack_ix_ptr},
|
|
|
391 {"Perl_Iunitcheckav_ptr", (PERL_PROC*)&Perl_Iunitcheckav_ptr},
|
|
|
392 #endif
|
|
7
|
393 {"Perl_Idefgv_ptr", (PERL_PROC*)&Perl_Idefgv_ptr},
|
|
|
394 {"Perl_Ierrgv_ptr", (PERL_PROC*)&Perl_Ierrgv_ptr},
|
|
|
395 {"Perl_Isv_yes_ptr", (PERL_PROC*)&Perl_Isv_yes_ptr},
|
|
|
396 {"boot_DynaLoader", (PERL_PROC*)&boot_DynaLoader},
|
|
|
397 {"", NULL},
|
|
|
398 };
|
|
|
399
|
|
|
400 /*
|
|
|
401 * Make all runtime-links of perl.
|
|
|
402 *
|
|
|
403 * 1. Get module handle using LoadLibraryEx.
|
|
|
404 * 2. Get pointer to perl function by GetProcAddress.
|
|
|
405 * 3. Repeat 2, until get all functions will be used.
|
|
|
406 *
|
|
|
407 * Parameter 'libname' provides name of DLL.
|
|
|
408 * Return OK or FAIL.
|
|
|
409 */
|
|
|
410 static int
|
|
|
411 perl_runtime_link_init(char *libname, int verbose)
|
|
|
412 {
|
|
|
413 int i;
|
|
|
414
|
|
|
415 if (hPerlLib != NULL)
|
|
|
416 return OK;
|
|
|
417 if (!(hPerlLib = LoadLibraryEx(libname, NULL, 0)))
|
|
|
418 {
|
|
|
419 if (verbose)
|
|
|
420 EMSG2(_("E370: Could not load library %s"), libname);
|
|
|
421 return FAIL;
|
|
|
422 }
|
|
|
423 for (i = 0; perl_funcname_table[i].ptr; ++i)
|
|
|
424 {
|
|
|
425 if (!(*perl_funcname_table[i].ptr = GetProcAddress(hPerlLib,
|
|
|
426 perl_funcname_table[i].name)))
|
|
|
427 {
|
|
|
428 FreeLibrary(hPerlLib);
|
|
|
429 hPerlLib = NULL;
|
|
|
430 if (verbose)
|
|
|
431 EMSG2(_(e_loadfunc), perl_funcname_table[i].name);
|
|
|
432 return FAIL;
|
|
|
433 }
|
|
|
434 }
|
|
|
435 return OK;
|
|
|
436 }
|
|
|
437
|
|
|
438 /*
|
|
|
439 * If runtime-link-perl(DLL) was loaded successfully, return TRUE.
|
|
|
440 * There were no DLL loaded, return FALSE.
|
|
|
441 */
|
|
|
442 int
|
|
|
443 perl_enabled(verbose)
|
|
|
444 int verbose;
|
|
|
445 {
|
|
|
446 return perl_runtime_link_init(DYNAMIC_PERL_DLL, verbose) == OK;
|
|
|
447 }
|
|
|
448 #endif /* DYNAMIC_PERL */
|
|
|
449
|
|
|
450 /*
|
|
|
451 * perl_init(): initialize perl interpreter
|
|
|
452 * We have to call perl_parse to initialize some structures,
|
|
|
453 * there's nothing to actually parse.
|
|
|
454 */
|
|
|
455 static void
|
|
|
456 perl_init()
|
|
|
457 {
|
|
1668
|
458 char *bootargs[] = { "VI", NULL };
|
|
|
459 int argc = 3;
|
|
|
460 static char *argv[] = { "", "-e", "" };
|
|
7
|
461
|
|
1668
|
462 #if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
|
|
1765
|
463 Perl_sys_init(&argc, (char***)&argv);
|
|
1668
|
464 #endif
|
|
7
|
465 perl_interp = perl_alloc();
|
|
|
466 perl_construct(perl_interp);
|
|
1668
|
467 perl_parse(perl_interp, xs_init, argc, argv, 0);
|
|
7
|
468 perl_call_argv("VIM::bootstrap", (long)G_DISCARD, bootargs);
|
|
|
469 VIM_init();
|
|
|
470 #ifdef USE_SFIO
|
|
|
471 sfdisc(PerlIO_stdout(), sfdcnewvim());
|
|
|
472 sfdisc(PerlIO_stderr(), sfdcnewvim());
|
|
|
473 sfsetbuf(PerlIO_stdout(), NULL, 0);
|
|
|
474 sfsetbuf(PerlIO_stderr(), NULL, 0);
|
|
|
475 #endif
|
|
|
476 }
|
|
|
477
|
|
|
478 /*
|
|
|
479 * perl_end(): clean up after ourselves
|
|
|
480 */
|
|
|
481 void
|
|
|
482 perl_end()
|
|
|
483 {
|
|
|
484 if (perl_interp)
|
|
|
485 {
|
|
|
486 perl_run(perl_interp);
|
|
|
487 perl_destruct(perl_interp);
|
|
|
488 perl_free(perl_interp);
|
|
|
489 perl_interp = NULL;
|
|
1668
|
490 #if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
|
|
|
491 Perl_sys_term();
|
|
|
492 #endif
|
|
7
|
493 }
|
|
|
494 #ifdef DYNAMIC_PERL
|
|
|
495 if (hPerlLib)
|
|
|
496 {
|
|
|
497 FreeLibrary(hPerlLib);
|
|
|
498 hPerlLib = NULL;
|
|
|
499 }
|
|
|
500 #endif
|
|
|
501 }
|
|
|
502
|
|
|
503 /*
|
|
|
504 * msg_split(): send a message to the message handling routines
|
|
|
505 * split at '\n' first though.
|
|
|
506 */
|
|
|
507 void
|
|
|
508 msg_split(s, attr)
|
|
|
509 char_u *s;
|
|
|
510 int attr; /* highlighting attributes */
|
|
|
511 {
|
|
|
512 char *next;
|
|
|
513 char *token = (char *)s;
|
|
|
514
|
|
1423
|
515 while ((next = strchr(token, '\n')) && !got_int)
|
|
7
|
516 {
|
|
|
517 *next++ = '\0'; /* replace \n with \0 */
|
|
|
518 msg_attr((char_u *)token, attr);
|
|
|
519 token = next;
|
|
|
520 }
|
|
1423
|
521 if (*token && !got_int)
|
|
7
|
522 msg_attr((char_u *)token, attr);
|
|
|
523 }
|
|
|
524
|
|
|
525 #ifndef FEAT_EVAL
|
|
|
526 /*
|
|
|
527 * This stub is needed because an "#ifdef FEAT_EVAL" around Eval() doesn't
|
|
|
528 * work properly.
|
|
|
529 */
|
|
|
530 char_u *
|
|
714
|
531 eval_to_string(arg, nextcmd, dolist)
|
|
7
|
532 char_u *arg;
|
|
|
533 char_u **nextcmd;
|
|
714
|
534 int dolist;
|
|
7
|
535 {
|
|
|
536 return NULL;
|
|
|
537 }
|
|
|
538 #endif
|
|
|
539
|
|
|
540 /*
|
|
|
541 * Create a new reference to an SV pointing to the SCR structure
|
|
502
|
542 * The b_perl_private/w_perl_private part of the SCR structure points to the
|
|
|
543 * SV, so there can only be one such SV for a particular SCR structure. When
|
|
|
544 * the last reference has gone (DESTROY is called),
|
|
|
545 * b_perl_private/w_perl_private is reset; When the screen goes away before
|
|
7
|
546 * all references are gone, the value of the SV is reset;
|
|
|
547 * any subsequent use of any of those reference will produce
|
|
|
548 * a warning. (see typemap)
|
|
|
549 */
|
|
502
|
550
|
|
|
551 static SV *
|
|
|
552 newWINrv(rv, ptr)
|
|
|
553 SV *rv;
|
|
|
554 win_T *ptr;
|
|
|
555 {
|
|
|
556 sv_upgrade(rv, SVt_RV);
|
|
|
557 if (ptr->w_perl_private == NULL)
|
|
|
558 {
|
|
|
559 ptr->w_perl_private = newSV(0);
|
|
|
560 sv_setiv(ptr->w_perl_private, (IV)ptr);
|
|
|
561 }
|
|
|
562 else
|
|
|
563 SvREFCNT_inc(ptr->w_perl_private);
|
|
|
564 SvRV(rv) = ptr->w_perl_private;
|
|
|
565 SvROK_on(rv);
|
|
|
566 return sv_bless(rv, gv_stashpv("VIWIN", TRUE));
|
|
7
|
567 }
|
|
|
568
|
|
502
|
569 static SV *
|
|
|
570 newBUFrv(rv, ptr)
|
|
|
571 SV *rv;
|
|
|
572 buf_T *ptr;
|
|
|
573 {
|
|
|
574 sv_upgrade(rv, SVt_RV);
|
|
|
575 if (ptr->b_perl_private == NULL)
|
|
|
576 {
|
|
|
577 ptr->b_perl_private = newSV(0);
|
|
|
578 sv_setiv(ptr->b_perl_private, (IV)ptr);
|
|
|
579 }
|
|
|
580 else
|
|
|
581 SvREFCNT_inc(ptr->b_perl_private);
|
|
|
582 SvRV(rv) = ptr->b_perl_private;
|
|
|
583 SvROK_on(rv);
|
|
|
584 return sv_bless(rv, gv_stashpv("VIBUF", TRUE));
|
|
|
585 }
|
|
7
|
586
|
|
|
587 /*
|
|
|
588 * perl_win_free
|
|
|
589 * Remove all refences to the window to be destroyed
|
|
|
590 */
|
|
|
591 void
|
|
|
592 perl_win_free(wp)
|
|
|
593 win_T *wp;
|
|
|
594 {
|
|
502
|
595 if (wp->w_perl_private)
|
|
|
596 sv_setiv((SV *)wp->w_perl_private, 0);
|
|
7
|
597 return;
|
|
|
598 }
|
|
|
599
|
|
|
600 void
|
|
|
601 perl_buf_free(bp)
|
|
|
602 buf_T *bp;
|
|
|
603 {
|
|
502
|
604 if (bp->b_perl_private)
|
|
|
605 sv_setiv((SV *)bp->b_perl_private, 0);
|
|
7
|
606 return;
|
|
|
607 }
|
|
|
608
|
|
|
609 #ifndef PROTO
|
|
|
610 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
|
|
|
611 I32 cur_val(pTHX_ IV iv, SV *sv);
|
|
|
612 # else
|
|
|
613 I32 cur_val(IV iv, SV *sv);
|
|
|
614 #endif
|
|
|
615
|
|
|
616 /*
|
|
|
617 * Handler for the magic variables $main::curwin and $main::curbuf.
|
|
|
618 * The handler is put into the magic vtbl for these variables.
|
|
|
619 * (This is effectively a C-level equivalent of a tied variable).
|
|
|
620 * There is no "set" function as the variables are read-only.
|
|
|
621 */
|
|
|
622 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
|
|
|
623 I32 cur_val(pTHX_ IV iv, SV *sv)
|
|
|
624 # else
|
|
|
625 I32 cur_val(IV iv, SV *sv)
|
|
|
626 # endif
|
|
|
627 {
|
|
|
628 SV *rv;
|
|
|
629 if (iv == 0)
|
|
|
630 rv = newWINrv(newSV(0), curwin);
|
|
|
631 else
|
|
|
632 rv = newBUFrv(newSV(0), curbuf);
|
|
|
633 sv_setsv(sv, rv);
|
|
|
634 return 0;
|
|
|
635 }
|
|
|
636 #endif /* !PROTO */
|
|
|
637
|
|
|
638 struct ufuncs cw_funcs = { cur_val, 0, 0 };
|
|
|
639 struct ufuncs cb_funcs = { cur_val, 0, 1 };
|
|
|
640
|
|
|
641 /*
|
|
|
642 * VIM_init(): Vim-specific initialisation.
|
|
|
643 * Make the magical main::curwin and main::curbuf variables
|
|
|
644 */
|
|
|
645 static void
|
|
|
646 VIM_init()
|
|
|
647 {
|
|
|
648 static char cw[] = "main::curwin";
|
|
|
649 static char cb[] = "main::curbuf";
|
|
|
650 SV *sv;
|
|
|
651
|
|
|
652 sv = perl_get_sv(cw, TRUE);
|
|
|
653 sv_magic(sv, NULL, 'U', (char *)&cw_funcs, sizeof(cw_funcs));
|
|
|
654 SvREADONLY_on(sv);
|
|
|
655
|
|
|
656 sv = perl_get_sv(cb, TRUE);
|
|
|
657 sv_magic(sv, NULL, 'U', (char *)&cb_funcs, sizeof(cb_funcs));
|
|
|
658 SvREADONLY_on(sv);
|
|
|
659
|
|
|
660 /*
|
|
|
661 * Setup the Safe compartment.
|
|
|
662 * It shouldn't be a fatal error if the Safe module is missing.
|
|
|
663 * XXX: Only shares the 'Msg' routine (which has to be called
|
|
|
664 * like 'Msg(...)').
|
|
|
665 */
|
|
|
666 (void)perl_eval_pv( "if ( eval( 'require Safe' ) ) { $VIM::safe = Safe->new(); $VIM::safe->share_from( 'VIM', ['Msg'] ); }", G_DISCARD | G_VOID );
|
|
|
667
|
|
|
668 }
|
|
|
669
|
|
|
670 #ifdef DYNAMIC_PERL
|
|
|
671 static char *e_noperl = N_("Sorry, this command is disabled: the Perl library could not be loaded.");
|
|
|
672 #endif
|
|
|
673
|
|
|
674 /*
|
|
|
675 * ":perl"
|
|
|
676 */
|
|
|
677 void
|
|
|
678 ex_perl(eap)
|
|
|
679 exarg_T *eap;
|
|
|
680 {
|
|
|
681 char *err;
|
|
|
682 char *script;
|
|
|
683 STRLEN length;
|
|
|
684 SV *sv;
|
|
|
685 SV *safe;
|
|
|
686
|
|
|
687 script = (char *)script_get(eap, eap->arg);
|
|
|
688 if (eap->skip)
|
|
|
689 {
|
|
|
690 vim_free(script);
|
|
|
691 return;
|
|
|
692 }
|
|
|
693
|
|
|
694 if (perl_interp == NULL)
|
|
|
695 {
|
|
|
696 #ifdef DYNAMIC_PERL
|
|
|
697 if (!perl_enabled(TRUE))
|
|
|
698 {
|
|
|
699 EMSG(_(e_noperl));
|
|
|
700 vim_free(script);
|
|
|
701 return;
|
|
|
702 }
|
|
|
703 #endif
|
|
|
704 perl_init();
|
|
|
705 }
|
|
|
706
|
|
|
707 {
|
|
|
708 dSP;
|
|
|
709 ENTER;
|
|
|
710 SAVETMPS;
|
|
|
711
|
|
|
712 if (script == NULL)
|
|
|
713 sv = newSVpv((char *)eap->arg, 0);
|
|
|
714 else
|
|
|
715 {
|
|
|
716 sv = newSVpv(script, 0);
|
|
|
717 vim_free(script);
|
|
|
718 }
|
|
|
719
|
|
|
720 #ifdef HAVE_SANDBOX
|
|
|
721 if (sandbox)
|
|
|
722 {
|
|
1990
|
723 safe = perl_get_sv( "VIM::safe", FALSE );
|
|
1934
|
724 # ifndef MAKE_TEST /* avoid a warning for unreachable code */
|
|
1990
|
725 if (safe == NULL || !SvTRUE(safe))
|
|
7
|
726 EMSG(_("E299: Perl evaluation forbidden in sandbox without the Safe module"));
|
|
|
727 else
|
|
1934
|
728 # endif
|
|
7
|
729 {
|
|
|
730 PUSHMARK(SP);
|
|
|
731 XPUSHs(safe);
|
|
|
732 XPUSHs(sv);
|
|
|
733 PUTBACK;
|
|
|
734 perl_call_method("reval", G_DISCARD);
|
|
|
735 }
|
|
|
736 }
|
|
|
737 else
|
|
|
738 #endif
|
|
|
739 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
|
|
|
740
|
|
|
741 SvREFCNT_dec(sv);
|
|
|
742
|
|
|
743 err = SvPV(GvSV(PL_errgv), length);
|
|
|
744
|
|
|
745 FREETMPS;
|
|
|
746 LEAVE;
|
|
|
747
|
|
|
748 if (!length)
|
|
|
749 return;
|
|
|
750
|
|
|
751 msg_split((char_u *)err, highlight_attr[HLF_E]);
|
|
|
752 return;
|
|
|
753 }
|
|
|
754 }
|
|
|
755
|
|
|
756 static int
|
|
|
757 replace_line(line, end)
|
|
|
758 linenr_T *line, *end;
|
|
|
759 {
|
|
|
760 char *str;
|
|
|
761
|
|
|
762 if (SvOK(GvSV(PL_defgv)))
|
|
|
763 {
|
|
|
764 str = SvPV(GvSV(PL_defgv), PL_na);
|
|
|
765 ml_replace(*line, (char_u *)str, 1);
|
|
|
766 changed_bytes(*line, 0);
|
|
|
767 }
|
|
|
768 else
|
|
|
769 {
|
|
|
770 ml_delete(*line, FALSE);
|
|
|
771 deleted_lines_mark(*line, 1L);
|
|
|
772 --(*end);
|
|
|
773 --(*line);
|
|
|
774 }
|
|
|
775 return OK;
|
|
|
776 }
|
|
|
777
|
|
|
778 /*
|
|
|
779 * ":perldo".
|
|
|
780 */
|
|
|
781 void
|
|
|
782 ex_perldo(eap)
|
|
|
783 exarg_T *eap;
|
|
|
784 {
|
|
|
785 STRLEN length;
|
|
|
786 SV *sv;
|
|
|
787 char *str;
|
|
|
788 linenr_T i;
|
|
|
789
|
|
|
790 if (bufempty())
|
|
|
791 return;
|
|
|
792
|
|
|
793 if (perl_interp == NULL)
|
|
|
794 {
|
|
|
795 #ifdef DYNAMIC_PERL
|
|
|
796 if (!perl_enabled(TRUE))
|
|
|
797 {
|
|
|
798 EMSG(_(e_noperl));
|
|
|
799 return;
|
|
|
800 }
|
|
|
801 #endif
|
|
|
802 perl_init();
|
|
|
803 }
|
|
|
804 {
|
|
|
805 dSP;
|
|
|
806 length = strlen((char *)eap->arg);
|
|
129
|
807 sv = newSV(length + sizeof("sub VIM::perldo {") - 1 + 1);
|
|
|
808 sv_setpvn(sv, "sub VIM::perldo {", sizeof("sub VIM::perldo {") - 1);
|
|
7
|
809 sv_catpvn(sv, (char *)eap->arg, length);
|
|
|
810 sv_catpvn(sv, "}", 1);
|
|
|
811 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
|
|
|
812 SvREFCNT_dec(sv);
|
|
|
813 str = SvPV(GvSV(PL_errgv), length);
|
|
|
814 if (length)
|
|
|
815 goto err;
|
|
|
816
|
|
|
817 if (u_save(eap->line1 - 1, eap->line2 + 1) != OK)
|
|
|
818 return;
|
|
|
819
|
|
|
820 ENTER;
|
|
|
821 SAVETMPS;
|
|
|
822 for (i = eap->line1; i <= eap->line2; i++)
|
|
|
823 {
|
|
129
|
824 sv_setpv(GvSV(PL_defgv), (char *)ml_get(i));
|
|
7
|
825 PUSHMARK(sp);
|
|
|
826 perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
|
|
|
827 str = SvPV(GvSV(PL_errgv), length);
|
|
|
828 if (length)
|
|
|
829 break;
|
|
|
830 SPAGAIN;
|
|
|
831 if (SvTRUEx(POPs))
|
|
|
832 {
|
|
|
833 if (replace_line(&i, &eap->line2) != OK)
|
|
|
834 {
|
|
|
835 PUTBACK;
|
|
|
836 break;
|
|
|
837 }
|
|
|
838 }
|
|
|
839 PUTBACK;
|
|
|
840 }
|
|
|
841 FREETMPS;
|
|
|
842 LEAVE;
|
|
|
843 check_cursor();
|
|
|
844 update_screen(NOT_VALID);
|
|
|
845 if (!length)
|
|
|
846 return;
|
|
|
847
|
|
|
848 err:
|
|
|
849 msg_split((char_u *)str, highlight_attr[HLF_E]);
|
|
|
850 return;
|
|
|
851 }
|
|
|
852 }
|
|
|
853
|
|
1681
|
854 #ifndef FEAT_WINDOWS
|
|
|
855 int win_valid(win_T *w) { return TRUE; }
|
|
|
856 int win_count() { return 1; }
|
|
|
857 win_T *win_find_nr(int n) { return curwin; }
|
|
|
858 #endif
|
|
|
859
|
|
7
|
860 XS(XS_VIM_Msg);
|
|
|
861 XS(XS_VIM_SetOption);
|
|
|
862 XS(XS_VIM_DoCommand);
|
|
|
863 XS(XS_VIM_Eval);
|
|
|
864 XS(XS_VIM_Buffers);
|
|
|
865 XS(XS_VIM_Windows);
|
|
|
866 XS(XS_VIWIN_DESTROY);
|
|
|
867 XS(XS_VIWIN_Buffer);
|
|
|
868 XS(XS_VIWIN_SetHeight);
|
|
|
869 XS(XS_VIWIN_Cursor);
|
|
|
870 XS(XS_VIBUF_DESTROY);
|
|
|
871 XS(XS_VIBUF_Name);
|
|
|
872 XS(XS_VIBUF_Number);
|
|
|
873 XS(XS_VIBUF_Count);
|
|
|
874 XS(XS_VIBUF_Get);
|
|
|
875 XS(XS_VIBUF_Set);
|
|
|
876 XS(XS_VIBUF_Delete);
|
|
|
877 XS(XS_VIBUF_Append);
|
|
|
878 XS(boot_VIM);
|
|
|
879
|
|
|
880 static void
|
|
|
881 xs_init(pTHX)
|
|
|
882 {
|
|
|
883 char *file = __FILE__;
|
|
|
884
|
|
|
885 /* DynaLoader is a special case */
|
|
|
886 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
|
|
|
887 newXS("VIM::bootstrap", boot_VIM, file);
|
|
|
888 }
|
|
|
889
|
|
|
890 typedef win_T * VIWIN;
|
|
|
891 typedef buf_T * VIBUF;
|
|
|
892
|
|
|
893 MODULE = VIM PACKAGE = VIM
|
|
|
894
|
|
|
895 void
|
|
|
896 Msg(text, hl=NULL)
|
|
|
897 char *text;
|
|
|
898 char *hl;
|
|
|
899
|
|
|
900 PREINIT:
|
|
|
901 int attr;
|
|
|
902 int id;
|
|
|
903
|
|
|
904 PPCODE:
|
|
|
905 if (text != NULL)
|
|
|
906 {
|
|
|
907 attr = 0;
|
|
|
908 if (hl != NULL)
|
|
|
909 {
|
|
|
910 id = syn_name2id((char_u *)hl);
|
|
|
911 if (id != 0)
|
|
|
912 attr = syn_id2attr(id);
|
|
|
913 }
|
|
|
914 msg_split((char_u *)text, attr);
|
|
|
915 }
|
|
|
916
|
|
|
917 void
|
|
|
918 SetOption(line)
|
|
|
919 char *line;
|
|
|
920
|
|
|
921 PPCODE:
|
|
|
922 if (line != NULL)
|
|
|
923 do_set((char_u *)line, 0);
|
|
|
924 update_screen(NOT_VALID);
|
|
|
925
|
|
|
926 void
|
|
|
927 DoCommand(line)
|
|
|
928 char *line;
|
|
|
929
|
|
|
930 PPCODE:
|
|
|
931 if (line != NULL)
|
|
|
932 do_cmdline_cmd((char_u *)line);
|
|
|
933
|
|
|
934 void
|
|
|
935 Eval(str)
|
|
|
936 char *str;
|
|
|
937
|
|
|
938 PREINIT:
|
|
|
939 char_u *value;
|
|
|
940 PPCODE:
|
|
714
|
941 value = eval_to_string((char_u *)str, (char_u **)0, TRUE);
|
|
7
|
942 if (value == NULL)
|
|
|
943 {
|
|
|
944 XPUSHs(sv_2mortal(newSViv(0)));
|
|
|
945 XPUSHs(sv_2mortal(newSVpv("", 0)));
|
|
|
946 }
|
|
|
947 else
|
|
|
948 {
|
|
|
949 XPUSHs(sv_2mortal(newSViv(1)));
|
|
|
950 XPUSHs(sv_2mortal(newSVpv((char *)value, 0)));
|
|
|
951 vim_free(value);
|
|
|
952 }
|
|
|
953
|
|
|
954 void
|
|
|
955 Buffers(...)
|
|
|
956
|
|
|
957 PREINIT:
|
|
|
958 buf_T *vimbuf;
|
|
|
959 int i, b;
|
|
|
960
|
|
|
961 PPCODE:
|
|
|
962 if (items == 0)
|
|
|
963 {
|
|
|
964 if (GIMME == G_SCALAR)
|
|
|
965 {
|
|
|
966 i = 0;
|
|
|
967 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
|
|
|
968 ++i;
|
|
|
969
|
|
|
970 XPUSHs(sv_2mortal(newSViv(i)));
|
|
|
971 }
|
|
|
972 else
|
|
|
973 {
|
|
|
974 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
|
|
|
975 XPUSHs(newBUFrv(newSV(0), vimbuf));
|
|
|
976 }
|
|
|
977 }
|
|
|
978 else
|
|
|
979 {
|
|
|
980 for (i = 0; i < items; i++)
|
|
|
981 {
|
|
|
982 SV *sv = ST(i);
|
|
|
983 if (SvIOK(sv))
|
|
|
984 b = SvIV(ST(i));
|
|
|
985 else
|
|
|
986 {
|
|
|
987 char_u *pat;
|
|
|
988 STRLEN len;
|
|
|
989
|
|
|
990 pat = (char_u *)SvPV(sv, len);
|
|
|
991 ++emsg_off;
|
|
|
992 b = buflist_findpat(pat, pat+len, FALSE, FALSE);
|
|
|
993 --emsg_off;
|
|
|
994 }
|
|
|
995
|
|
|
996 if (b >= 0)
|
|
|
997 {
|
|
|
998 vimbuf = buflist_findnr(b);
|
|
|
999 if (vimbuf)
|
|
|
1000 XPUSHs(newBUFrv(newSV(0), vimbuf));
|
|
|
1001 }
|
|
|
1002 }
|
|
|
1003 }
|
|
|
1004
|
|
|
1005 void
|
|
|
1006 Windows(...)
|
|
|
1007
|
|
|
1008 PREINIT:
|
|
|
1009 win_T *vimwin;
|
|
|
1010 int i, w;
|
|
|
1011
|
|
|
1012 PPCODE:
|
|
|
1013 if (items == 0)
|
|
|
1014 {
|
|
|
1015 if (GIMME == G_SCALAR)
|
|
|
1016 XPUSHs(sv_2mortal(newSViv(win_count())));
|
|
|
1017 else
|
|
|
1018 {
|
|
|
1019 for (vimwin = firstwin; vimwin != NULL; vimwin = W_NEXT(vimwin))
|
|
|
1020 XPUSHs(newWINrv(newSV(0), vimwin));
|
|
|
1021 }
|
|
|
1022 }
|
|
|
1023 else
|
|
|
1024 {
|
|
|
1025 for (i = 0; i < items; i++)
|
|
|
1026 {
|
|
|
1027 w = SvIV(ST(i));
|
|
|
1028 vimwin = win_find_nr(w);
|
|
|
1029 if (vimwin)
|
|
|
1030 XPUSHs(newWINrv(newSV(0), vimwin));
|
|
|
1031 }
|
|
|
1032 }
|
|
|
1033
|
|
|
1034 MODULE = VIM PACKAGE = VIWIN
|
|
|
1035
|
|
|
1036 void
|
|
|
1037 DESTROY(win)
|
|
|
1038 VIWIN win
|
|
|
1039
|
|
|
1040 CODE:
|
|
|
1041 if (win_valid(win))
|
|
502
|
1042 win->w_perl_private = 0;
|
|
7
|
1043
|
|
|
1044 SV *
|
|
|
1045 Buffer(win)
|
|
|
1046 VIWIN win
|
|
|
1047
|
|
|
1048 CODE:
|
|
|
1049 if (!win_valid(win))
|
|
|
1050 win = curwin;
|
|
|
1051 RETVAL = newBUFrv(newSV(0), win->w_buffer);
|
|
|
1052 OUTPUT:
|
|
|
1053 RETVAL
|
|
|
1054
|
|
|
1055 void
|
|
|
1056 SetHeight(win, height)
|
|
|
1057 VIWIN win
|
|
|
1058 int height;
|
|
|
1059
|
|
|
1060 PREINIT:
|
|
|
1061 win_T *savewin;
|
|
|
1062
|
|
|
1063 PPCODE:
|
|
|
1064 if (!win_valid(win))
|
|
|
1065 win = curwin;
|
|
|
1066 savewin = curwin;
|
|
|
1067 curwin = win;
|
|
|
1068 win_setheight(height);
|
|
|
1069 curwin = savewin;
|
|
|
1070
|
|
|
1071 void
|
|
|
1072 Cursor(win, ...)
|
|
|
1073 VIWIN win
|
|
|
1074
|
|
|
1075 PPCODE:
|
|
|
1076 if(items == 1)
|
|
|
1077 {
|
|
|
1078 EXTEND(sp, 2);
|
|
|
1079 if (!win_valid(win))
|
|
|
1080 win = curwin;
|
|
|
1081 PUSHs(sv_2mortal(newSViv(win->w_cursor.lnum)));
|
|
|
1082 PUSHs(sv_2mortal(newSViv(win->w_cursor.col)));
|
|
|
1083 }
|
|
|
1084 else if(items == 3)
|
|
|
1085 {
|
|
|
1086 int lnum, col;
|
|
|
1087
|
|
|
1088 if (!win_valid(win))
|
|
|
1089 win = curwin;
|
|
|
1090 lnum = SvIV(ST(1));
|
|
|
1091 col = SvIV(ST(2));
|
|
|
1092 win->w_cursor.lnum = lnum;
|
|
|
1093 win->w_cursor.col = col;
|
|
|
1094 check_cursor(); /* put cursor on an existing line */
|
|
|
1095 update_screen(NOT_VALID);
|
|
|
1096 }
|
|
|
1097
|
|
|
1098 MODULE = VIM PACKAGE = VIBUF
|
|
|
1099
|
|
|
1100 void
|
|
|
1101 DESTROY(vimbuf)
|
|
|
1102 VIBUF vimbuf;
|
|
|
1103
|
|
|
1104 CODE:
|
|
|
1105 if (buf_valid(vimbuf))
|
|
502
|
1106 vimbuf->b_perl_private = 0;
|
|
7
|
1107
|
|
|
1108 void
|
|
|
1109 Name(vimbuf)
|
|
|
1110 VIBUF vimbuf;
|
|
|
1111
|
|
|
1112 PPCODE:
|
|
|
1113 if (!buf_valid(vimbuf))
|
|
|
1114 vimbuf = curbuf;
|
|
|
1115 /* No file name returns an empty string */
|
|
|
1116 if (vimbuf->b_fname == NULL)
|
|
|
1117 XPUSHs(sv_2mortal(newSVpv("", 0)));
|
|
|
1118 else
|
|
|
1119 XPUSHs(sv_2mortal(newSVpv((char *)vimbuf->b_fname, 0)));
|
|
|
1120
|
|
|
1121 void
|
|
|
1122 Number(vimbuf)
|
|
|
1123 VIBUF vimbuf;
|
|
|
1124
|
|
|
1125 PPCODE:
|
|
|
1126 if (!buf_valid(vimbuf))
|
|
|
1127 vimbuf = curbuf;
|
|
|
1128 XPUSHs(sv_2mortal(newSViv(vimbuf->b_fnum)));
|
|
|
1129
|
|
|
1130 void
|
|
|
1131 Count(vimbuf)
|
|
|
1132 VIBUF vimbuf;
|
|
|
1133
|
|
|
1134 PPCODE:
|
|
|
1135 if (!buf_valid(vimbuf))
|
|
|
1136 vimbuf = curbuf;
|
|
|
1137 XPUSHs(sv_2mortal(newSViv(vimbuf->b_ml.ml_line_count)));
|
|
|
1138
|
|
|
1139 void
|
|
|
1140 Get(vimbuf, ...)
|
|
|
1141 VIBUF vimbuf;
|
|
|
1142
|
|
|
1143 PREINIT:
|
|
|
1144 char_u *line;
|
|
|
1145 int i;
|
|
|
1146 long lnum;
|
|
|
1147 PPCODE:
|
|
|
1148 if (buf_valid(vimbuf))
|
|
|
1149 {
|
|
|
1150 for (i = 1; i < items; i++)
|
|
|
1151 {
|
|
|
1152 lnum = SvIV(ST(i));
|
|
|
1153 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
|
|
|
1154 {
|
|
|
1155 line = ml_get_buf(vimbuf, lnum, FALSE);
|
|
|
1156 XPUSHs(sv_2mortal(newSVpv((char *)line, 0)));
|
|
|
1157 }
|
|
|
1158 }
|
|
|
1159 }
|
|
|
1160
|
|
|
1161 void
|
|
|
1162 Set(vimbuf, ...)
|
|
|
1163 VIBUF vimbuf;
|
|
|
1164
|
|
|
1165 PREINIT:
|
|
|
1166 int i;
|
|
|
1167 long lnum;
|
|
|
1168 char *line;
|
|
|
1169 PPCODE:
|
|
|
1170 if (buf_valid(vimbuf))
|
|
|
1171 {
|
|
|
1172 if (items < 3)
|
|
|
1173 croak("Usage: VIBUF::Set(vimbuf, lnum, @lines)");
|
|
|
1174
|
|
|
1175 lnum = SvIV(ST(1));
|
|
|
1176 for(i = 2; i < items; i++, lnum++)
|
|
|
1177 {
|
|
|
1178 line = SvPV(ST(i),PL_na);
|
|
|
1179 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
|
|
|
1180 {
|
|
918
|
1181 aco_save_T aco;
|
|
|
1182
|
|
|
1183 /* set curwin/curbuf for "vimbuf" and save some things */
|
|
|
1184 aucmd_prepbuf(&aco, vimbuf);
|
|
|
1185
|
|
7
|
1186 if (u_savesub(lnum) == OK)
|
|
|
1187 {
|
|
|
1188 ml_replace(lnum, (char_u *)line, TRUE);
|
|
|
1189 changed_bytes(lnum, 0);
|
|
|
1190 }
|
|
934
|
1191
|
|
918
|
1192 /* restore curwin/curbuf and a few other things */
|
|
|
1193 aucmd_restbuf(&aco);
|
|
|
1194 /* Careful: autocommands may have made "vimbuf" invalid! */
|
|
7
|
1195 }
|
|
|
1196 }
|
|
|
1197 }
|
|
|
1198
|
|
|
1199 void
|
|
|
1200 Delete(vimbuf, ...)
|
|
|
1201 VIBUF vimbuf;
|
|
|
1202
|
|
|
1203 PREINIT:
|
|
|
1204 long i, lnum = 0, count = 0;
|
|
|
1205 PPCODE:
|
|
|
1206 if (buf_valid(vimbuf))
|
|
|
1207 {
|
|
|
1208 if (items == 2)
|
|
|
1209 {
|
|
|
1210 lnum = SvIV(ST(1));
|
|
|
1211 count = 1;
|
|
|
1212 }
|
|
|
1213 else if (items == 3)
|
|
|
1214 {
|
|
|
1215 lnum = SvIV(ST(1));
|
|
|
1216 count = 1 + SvIV(ST(2)) - lnum;
|
|
|
1217 if(count == 0)
|
|
|
1218 count = 1;
|
|
|
1219 if(count < 0)
|
|
|
1220 {
|
|
|
1221 lnum -= count;
|
|
|
1222 count = -count;
|
|
|
1223 }
|
|
|
1224 }
|
|
|
1225 if (items >= 2)
|
|
|
1226 {
|
|
|
1227 for (i = 0; i < count; i++)
|
|
|
1228 {
|
|
|
1229 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
|
|
|
1230 {
|
|
918
|
1231 aco_save_T aco;
|
|
|
1232
|
|
|
1233 /* set curwin/curbuf for "vimbuf" and save some things */
|
|
|
1234 aucmd_prepbuf(&aco, vimbuf);
|
|
934
|
1235
|
|
7
|
1236 if (u_savedel(lnum, 1) == OK)
|
|
|
1237 {
|
|
|
1238 ml_delete(lnum, 0);
|
|
1929
|
1239 check_cursor();
|
|
7
|
1240 deleted_lines_mark(lnum, 1L);
|
|
|
1241 }
|
|
934
|
1242
|
|
918
|
1243 /* restore curwin/curbuf and a few other things */
|
|
|
1244 aucmd_restbuf(&aco);
|
|
|
1245 /* Careful: autocommands may have made "vimbuf" invalid! */
|
|
934
|
1246
|
|
7
|
1247 update_curbuf(VALID);
|
|
|
1248 }
|
|
|
1249 }
|
|
|
1250 }
|
|
|
1251 }
|
|
|
1252
|
|
|
1253 void
|
|
|
1254 Append(vimbuf, ...)
|
|
|
1255 VIBUF vimbuf;
|
|
|
1256
|
|
|
1257 PREINIT:
|
|
|
1258 int i;
|
|
|
1259 long lnum;
|
|
|
1260 char *line;
|
|
|
1261 PPCODE:
|
|
|
1262 if (buf_valid(vimbuf))
|
|
|
1263 {
|
|
|
1264 if (items < 3)
|
|
|
1265 croak("Usage: VIBUF::Append(vimbuf, lnum, @lines)");
|
|
|
1266
|
|
|
1267 lnum = SvIV(ST(1));
|
|
|
1268 for (i = 2; i < items; i++, lnum++)
|
|
|
1269 {
|
|
|
1270 line = SvPV(ST(i),PL_na);
|
|
|
1271 if (lnum >= 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
|
|
|
1272 {
|
|
918
|
1273 aco_save_T aco;
|
|
|
1274
|
|
|
1275 /* set curwin/curbuf for "vimbuf" and save some things */
|
|
|
1276 aucmd_prepbuf(&aco, vimbuf);
|
|
|
1277
|
|
7
|
1278 if (u_inssub(lnum + 1) == OK)
|
|
|
1279 {
|
|
|
1280 ml_append(lnum, (char_u *)line, (colnr_T)0, FALSE);
|
|
|
1281 appended_lines_mark(lnum, 1L);
|
|
|
1282 }
|
|
934
|
1283
|
|
918
|
1284 /* restore curwin/curbuf and a few other things */
|
|
|
1285 aucmd_restbuf(&aco);
|
|
|
1286 /* Careful: autocommands may have made "vimbuf" invalid! */
|
|
934
|
1287
|
|
7
|
1288 update_curbuf(VALID);
|
|
|
1289 }
|
|
|
1290 }
|
|
|
1291 }
|
|
|
1292
|
