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