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 # if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
 140 #  define Perl_sv_free2 dll_Perl_sv_free2
 141 # endif
 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
 169 # define Perl_sys_init dll_Perl_sys_init
 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
 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);
 204 static void (*Perl_croak)(pTHX_ const char*, ...);
 205 static void (*Perl_croak_nocontext)(const char*, ...);
 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
 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
 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
 273 #if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
 274 static void (*Perl_sv_free2)(pTHX_ SV*);
 275 static void (*Perl_sys_init)(int* argc, char*** argv);
 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
 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
 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
 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},
 361 #if (PERL_REVISION == 5) && (PERL_VERSION < 10)
 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},
 373 #else
 374     {"Perl_sv_free2", (PERL_PROC*)&Perl_sv_free2},
 375     {"Perl_sys_init", (PERL_PROC*)&Perl_sys_init},
 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
 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 {
 458     char *bootargs[] = { "VI", NULL };
 459     int argc = 3;
 460     static char *argv[] = { "", "-e", "" };
 461
 462 #if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
 463     Perl_sys_init(&argc, (char***)&argv);
 464 #endif
 465     perl_interp = perl_alloc();
 466     perl_construct(perl_interp);
 467     perl_parse(perl_interp, xs_init, argc, argv, 0);
 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;
 490 #if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
 491         Perl_sys_term();
 492 #endif
 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
 515     while ((next = strchr(token, '\n')) && !got_int)
 516     {
 517         *next++ = '\0';                 /* replace \n with \0 */
 518         msg_attr((char_u *)token, attr);
 519         token = next;
 520     }
 521     if (*token && !got_int)
 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 *
 531 eval_to_string(arg, nextcmd, dolist)
 532     char_u      *arg;
 533     char_u      **nextcmd;
 534     int         dolist;
 535 {
 536     return NULL;
 537 }
 538 #endif
 539
 540 /*
 541  * Create a new reference to an SV pointing to the SCR structure
 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
 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  */
 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));
 567 }
 568
 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 }
 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 {
 595     if (wp->w_perl_private)
 596         sv_setiv((SV *)wp->w_perl_private, 0);
 597     return;
 598 }
 599
 600     void
 601 perl_buf_free(bp)
 602     buf_T *bp;
 603 {
 604     if (bp->b_perl_private)
 605         sv_setiv((SV *)bp->b_perl_private, 0);
 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     {
 723         if ((safe = perl_get_sv( "VIM::safe", FALSE )) == NULL || !SvTRUE(safe))
 724             EMSG(_("E299: Perl evaluation forbidden in sandbox without the Safe module"));
 725         else
 726         {
 727             PUSHMARK(SP);
 728             XPUSHs(safe);
 729             XPUSHs(sv);
 730             PUTBACK;
 731             perl_call_method("reval", G_DISCARD);
 732         }
 733     }
 734     else
 735 #endif
 736         perl_eval_sv(sv, G_DISCARD | G_NOARGS);
 737
 738     SvREFCNT_dec(sv);
 739
 740     err = SvPV(GvSV(PL_errgv), length);
 741
 742     FREETMPS;
 743     LEAVE;
 744
 745     if (!length)
 746         return;
 747
 748     msg_split((char_u *)err, highlight_attr[HLF_E]);
 749     return;
 750     }
 751 }
 752
 753     static int
 754 replace_line(line, end)
 755     linenr_T    *line, *end;
 756 {
 757     char *str;
 758
 759     if (SvOK(GvSV(PL_defgv)))
 760     {
 761         str = SvPV(GvSV(PL_defgv), PL_na);
 762         ml_replace(*line, (char_u *)str, 1);
 763         changed_bytes(*line, 0);
 764     }
 765     else
 766     {
 767         ml_delete(*line, FALSE);
 768         deleted_lines_mark(*line, 1L);
 769         --(*end);
 770         --(*line);
 771     }
 772     return OK;
 773 }
 774
 775 /*
 776  * ":perldo".
 777  */
 778     void
 779 ex_perldo(eap)
 780     exarg_T     *eap;
 781 {
 782     STRLEN      length;
 783     SV          *sv;
 784     char        *str;
 785     linenr_T    i;
 786
 787     if (bufempty())
 788         return;
 789
 790     if (perl_interp == NULL)
 791     {
 792 #ifdef DYNAMIC_PERL
 793         if (!perl_enabled(TRUE))
 794         {
 795             EMSG(_(e_noperl));
 796             return;
 797         }
 798 #endif
 799         perl_init();
 800     }
 801     {
 802     dSP;
 803     length = strlen((char *)eap->arg);
 804     sv = newSV(length + sizeof("sub VIM::perldo {") - 1 + 1);
 805     sv_setpvn(sv, "sub VIM::perldo {", sizeof("sub VIM::perldo {") - 1);
 806     sv_catpvn(sv, (char *)eap->arg, length);
 807     sv_catpvn(sv, "}", 1);
 808     perl_eval_sv(sv, G_DISCARD | G_NOARGS);
 809     SvREFCNT_dec(sv);
 810     str = SvPV(GvSV(PL_errgv), length);
 811     if (length)
 812         goto err;
 813
 814     if (u_save(eap->line1 - 1, eap->line2 + 1) != OK)
 815         return;
 816
 817     ENTER;
 818     SAVETMPS;
 819     for (i = eap->line1; i <= eap->line2; i++)
 820     {
 821         sv_setpv(GvSV(PL_defgv), (char *)ml_get(i));
 822         PUSHMARK(sp);
 823         perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
 824         str = SvPV(GvSV(PL_errgv), length);
 825         if (length)
 826             break;
 827         SPAGAIN;
 828         if (SvTRUEx(POPs))
 829         {
 830             if (replace_line(&i, &eap->line2) != OK)
 831             {
 832                 PUTBACK;
 833                 break;
 834             }
 835         }
 836         PUTBACK;
 837     }
 838     FREETMPS;
 839     LEAVE;
 840     check_cursor();
 841     update_screen(NOT_VALID);
 842     if (!length)
 843         return;
 844
 845 err:
 846     msg_split((char_u *)str, highlight_attr[HLF_E]);
 847     return;
 848     }
 849 }
 850
 851 #ifndef FEAT_WINDOWS
 852 int win_valid(win_T *w) { return TRUE; }
 853 int win_count() { return 1; }
 854 win_T *win_find_nr(int n) { return curwin; }
 855 #endif
 856
 857 XS(XS_VIM_Msg);
 858 XS(XS_VIM_SetOption);
 859 XS(XS_VIM_DoCommand);
 860 XS(XS_VIM_Eval);
 861 XS(XS_VIM_Buffers);
 862 XS(XS_VIM_Windows);
 863 XS(XS_VIWIN_DESTROY);
 864 XS(XS_VIWIN_Buffer);
 865 XS(XS_VIWIN_SetHeight);
 866 XS(XS_VIWIN_Cursor);
 867 XS(XS_VIBUF_DESTROY);
 868 XS(XS_VIBUF_Name);
 869 XS(XS_VIBUF_Number);
 870 XS(XS_VIBUF_Count);
 871 XS(XS_VIBUF_Get);
 872 XS(XS_VIBUF_Set);
 873 XS(XS_VIBUF_Delete);
 874 XS(XS_VIBUF_Append);
 875 XS(boot_VIM);
 876
 877     static void
 878 xs_init(pTHX)
 879 {
 880     char *file = __FILE__;
 881
 882     /* DynaLoader is a special case */
 883     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
 884     newXS("VIM::bootstrap", boot_VIM, file);
 885 }
 886
 887 typedef win_T * VIWIN;
 888 typedef buf_T * VIBUF;
 889
 890 MODULE = VIM        PACKAGE = VIM
 891
 892 void
 893 Msg(text, hl=NULL)
 894     char        *text;
 895     char        *hl;
 896
 897     PREINIT:
 898     int         attr;
 899     int         id;
 900
 901     PPCODE:
 902     if (text != NULL)
 903     {
 904         attr = 0;
 905         if (hl != NULL)
 906         {
 907             id = syn_name2id((char_u *)hl);
 908             if (id != 0)
 909                 attr = syn_id2attr(id);
 910         }
 911         msg_split((char_u *)text, attr);
 912     }
 913
 914 void
 915 SetOption(line)
 916     char *line;
 917
 918     PPCODE:
 919     if (line != NULL)
 920         do_set((char_u *)line, 0);
 921     update_screen(NOT_VALID);
 922
 923 void
 924 DoCommand(line)
 925     char *line;
 926
 927     PPCODE:
 928     if (line != NULL)
 929         do_cmdline_cmd((char_u *)line);
 930
 931 void
 932 Eval(str)
 933     char *str;
 934
 935     PREINIT:
 936         char_u *value;
 937     PPCODE:
 938         value = eval_to_string((char_u *)str, (char_u **)0, TRUE);
 939         if (value == NULL)
 940         {
 941             XPUSHs(sv_2mortal(newSViv(0)));
 942             XPUSHs(sv_2mortal(newSVpv("", 0)));
 943         }
 944         else
 945         {
 946             XPUSHs(sv_2mortal(newSViv(1)));
 947             XPUSHs(sv_2mortal(newSVpv((char *)value, 0)));
 948             vim_free(value);
 949         }
 950
 951 void
 952 Buffers(...)
 953
 954     PREINIT:
 955     buf_T *vimbuf;
 956     int i, b;
 957
 958     PPCODE:
 959     if (items == 0)
 960     {
 961         if (GIMME == G_SCALAR)
 962         {
 963             i = 0;
 964             for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
 965                 ++i;
 966
 967             XPUSHs(sv_2mortal(newSViv(i)));
 968         }
 969         else
 970         {
 971             for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
 972                 XPUSHs(newBUFrv(newSV(0), vimbuf));
 973         }
 974     }
 975     else
 976     {
 977         for (i = 0; i < items; i++)
 978         {
 979             SV *sv = ST(i);
 980             if (SvIOK(sv))
 981                 b = SvIV(ST(i));
 982             else
 983             {
 984                 char_u *pat;
 985                 STRLEN len;
 986
 987                 pat = (char_u *)SvPV(sv, len);
 988                 ++emsg_off;
 989                 b = buflist_findpat(pat, pat+len, FALSE, FALSE);
 990                 --emsg_off;
 991             }
 992
 993             if (b >= 0)
 994             {
 995                 vimbuf = buflist_findnr(b);
 996                 if (vimbuf)
 997                     XPUSHs(newBUFrv(newSV(0), vimbuf));
 998             }
 999         }
1000     }
1001
1002 void
1003 Windows(...)
1004
1005     PREINIT:
1006     win_T   *vimwin;
1007     int     i, w;
1008
1009     PPCODE:
1010     if (items == 0)
1011     {
1012         if (GIMME == G_SCALAR)
1013             XPUSHs(sv_2mortal(newSViv(win_count())));
1014         else
1015         {
1016             for (vimwin = firstwin; vimwin != NULL; vimwin = W_NEXT(vimwin))
1017                 XPUSHs(newWINrv(newSV(0), vimwin));
1018         }
1019     }
1020     else
1021     {
1022         for (i = 0; i < items; i++)
1023         {
1024             w = SvIV(ST(i));
1025             vimwin = win_find_nr(w);
1026             if (vimwin)
1027                 XPUSHs(newWINrv(newSV(0), vimwin));
1028         }
1029     }
1030
1031 MODULE = VIM        PACKAGE = VIWIN
1032
1033 void
1034 DESTROY(win)
1035     VIWIN win
1036
1037     CODE:
1038     if (win_valid(win))
1039         win->w_perl_private = 0;
1040
1041 SV *
1042 Buffer(win)
1043     VIWIN win
1044
1045     CODE:
1046     if (!win_valid(win))
1047         win = curwin;
1048     RETVAL = newBUFrv(newSV(0), win->w_buffer);
1049     OUTPUT:
1050     RETVAL
1051
1052 void
1053 SetHeight(win, height)
1054     VIWIN win
1055     int height;
1056
1057     PREINIT:
1058     win_T *savewin;
1059
1060     PPCODE:
1061     if (!win_valid(win))
1062         win = curwin;
1063     savewin = curwin;
1064     curwin = win;
1065     win_setheight(height);
1066     curwin = savewin;
1067
1068 void
1069 Cursor(win, ...)
1070     VIWIN win
1071
1072     PPCODE:
1073     if(items == 1)
1074     {
1075       EXTEND(sp, 2);
1076       if (!win_valid(win))
1077           win = curwin;
1078       PUSHs(sv_2mortal(newSViv(win->w_cursor.lnum)));
1079       PUSHs(sv_2mortal(newSViv(win->w_cursor.col)));
1080     }
1081     else if(items == 3)
1082     {
1083       int lnum, col;
1084
1085       if (!win_valid(win))
1086           win = curwin;
1087       lnum = SvIV(ST(1));
1088       col = SvIV(ST(2));
1089       win->w_cursor.lnum = lnum;
1090       win->w_cursor.col = col;
1091       check_cursor();               /* put cursor on an existing line */
1092       update_screen(NOT_VALID);
1093     }
1094
1095 MODULE = VIM        PACKAGE = VIBUF
1096
1097 void
1098 DESTROY(vimbuf)
1099     VIBUF vimbuf;
1100
1101     CODE:
1102     if (buf_valid(vimbuf))
1103         vimbuf->b_perl_private = 0;
1104
1105 void
1106 Name(vimbuf)
1107     VIBUF vimbuf;
1108
1109     PPCODE:
1110     if (!buf_valid(vimbuf))
1111         vimbuf = curbuf;
1112     /* No file name returns an empty string */
1113     if (vimbuf->b_fname == NULL)
1114         XPUSHs(sv_2mortal(newSVpv("", 0)));
1115     else
1116         XPUSHs(sv_2mortal(newSVpv((char *)vimbuf->b_fname, 0)));
1117
1118 void
1119 Number(vimbuf)
1120     VIBUF vimbuf;
1121
1122     PPCODE:
1123     if (!buf_valid(vimbuf))
1124         vimbuf = curbuf;
1125     XPUSHs(sv_2mortal(newSViv(vimbuf->b_fnum)));
1126
1127 void
1128 Count(vimbuf)
1129     VIBUF vimbuf;
1130
1131     PPCODE:
1132     if (!buf_valid(vimbuf))
1133         vimbuf = curbuf;
1134     XPUSHs(sv_2mortal(newSViv(vimbuf->b_ml.ml_line_count)));
1135
1136 void
1137 Get(vimbuf, ...)
1138     VIBUF vimbuf;
1139
1140     PREINIT:
1141     char_u *line;
1142     int i;
1143     long lnum;
1144     PPCODE:
1145     if (buf_valid(vimbuf))
1146     {
1147         for (i = 1; i < items; i++)
1148         {
1149             lnum = SvIV(ST(i));
1150             if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1151             {
1152                 line = ml_get_buf(vimbuf, lnum, FALSE);
1153                 XPUSHs(sv_2mortal(newSVpv((char *)line, 0)));
1154             }
1155         }
1156     }
1157
1158 void
1159 Set(vimbuf, ...)
1160     VIBUF vimbuf;
1161
1162     PREINIT:
1163     int i;
1164     long lnum;
1165     char *line;
1166     PPCODE:
1167     if (buf_valid(vimbuf))
1168     {
1169         if (items < 3)
1170             croak("Usage: VIBUF::Set(vimbuf, lnum, @lines)");
1171
1172         lnum = SvIV(ST(1));
1173         for(i = 2; i < items; i++, lnum++)
1174         {
1175             line = SvPV(ST(i),PL_na);
1176             if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1177             {
1178                 aco_save_T      aco;
1179
1180                 /* set curwin/curbuf for "vimbuf" and save some things */
1181                 aucmd_prepbuf(&aco, vimbuf);
1182
1183                 if (u_savesub(lnum) == OK)
1184                 {
1185                     ml_replace(lnum, (char_u *)line, TRUE);
1186                     changed_bytes(lnum, 0);
1187                 }
1188
1189                 /* restore curwin/curbuf and a few other things */
1190                 aucmd_restbuf(&aco);
1191                 /* Careful: autocommands may have made "vimbuf" invalid! */
1192             }
1193         }
1194     }
1195
1196 void
1197 Delete(vimbuf, ...)
1198     VIBUF vimbuf;
1199
1200     PREINIT:
1201     long i, lnum = 0, count = 0;
1202     PPCODE:
1203     if (buf_valid(vimbuf))
1204     {
1205         if (items == 2)
1206         {
1207             lnum = SvIV(ST(1));
1208             count = 1;
1209         }
1210         else if (items == 3)
1211         {
1212             lnum = SvIV(ST(1));
1213             count = 1 + SvIV(ST(2)) - lnum;
1214             if(count == 0)
1215                 count = 1;
1216             if(count < 0)
1217             {
1218                 lnum -= count;
1219                 count = -count;
1220             }
1221         }
1222         if (items >= 2)
1223         {
1224             for (i = 0; i < count; i++)
1225             {
1226                 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1227                 {
1228                     aco_save_T  aco;
1229
1230                     /* set curwin/curbuf for "vimbuf" and save some things */
1231                     aucmd_prepbuf(&aco, vimbuf);
1232
1233                     if (u_savedel(lnum, 1) == OK)
1234                     {
1235                         ml_delete(lnum, 0);
1236                         deleted_lines_mark(lnum, 1L);
1237                         if (aco.save_buf == curbuf)
1238                             check_cursor();
1239                     }
1240
1241                     /* restore curwin/curbuf and a few other things */
1242                     aucmd_restbuf(&aco);
1243                     /* Careful: autocommands may have made "vimbuf" invalid! */
1244
1245                     update_curbuf(VALID);
1246                 }
1247             }
1248         }
1249     }
1250
1251 void
1252 Append(vimbuf, ...)
1253     VIBUF vimbuf;
1254
1255     PREINIT:
1256     int         i;
1257     long        lnum;
1258     char        *line;
1259     PPCODE:
1260     if (buf_valid(vimbuf))
1261     {
1262         if (items < 3)
1263             croak("Usage: VIBUF::Append(vimbuf, lnum, @lines)");
1264
1265         lnum = SvIV(ST(1));
1266         for (i = 2; i < items; i++, lnum++)
1267         {
1268             line = SvPV(ST(i),PL_na);
1269             if (lnum >= 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1270             {
1271                 aco_save_T      aco;
1272
1273                 /* set curwin/curbuf for "vimbuf" and save some things */
1274                 aucmd_prepbuf(&aco, vimbuf);
1275
1276                 if (u_inssub(lnum + 1) == OK)
1277                 {
1278                     ml_append(lnum, (char_u *)line, (colnr_T)0, FALSE);
1279                     appended_lines_mark(lnum, 1L);
1280                 }
1281
1282                 /* restore curwin/curbuf and a few other things */
1283                 aucmd_restbuf(&aco);
1284                 /* Careful: autocommands may have made "vimbuf" invalid! */
1285
1286                 update_curbuf(VALID);
1287             }
1288         }
1289     }
1290