src/if_perl.xs

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