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