summaryrefslogtreecommitdiff
path: root/src/if_perl.xs
diff options
context:
space:
mode:
authorBram Moolenaar <Bram@vim.org>2016-04-14 14:09:25 +0200
committerBram Moolenaar <Bram@vim.org>2016-04-14 14:09:25 +0200
commit6244a0fc29163ba1c734f92b55a89e01e6cf2a67 (patch)
tree4434a2cb73983bfd0d5488c9b93eeef03ef8d0ec /src/if_perl.xs
parent81edd171a9465cf99cede4fa4a7b7bca3d538b0f (diff)
downloadvim-git-6244a0fc29163ba1c734f92b55a89e01e6cf2a67.tar.gz
patch 7.4.1729v7.4.1729
Problem: The Perl interface cannot use 'print' operator for writing directly in standard IO. Solution: Add a minimal implementation of PerlIO Layer feature and try to use it for STDOUT/STDERR. (Damien)
Diffstat (limited to 'src/if_perl.xs')
-rw-r--r--src/if_perl.xs98
1 files changed, 97 insertions, 1 deletions
diff --git a/src/if_perl.xs b/src/if_perl.xs
index 4fbc13e3a..b091bf7ca 100644
--- a/src/if_perl.xs
+++ b/src/if_perl.xs
@@ -57,7 +57,9 @@
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
-
+#if defined(PERLIO_LAYERS) && !defined(USE_SFIO)
+# include <perliol.h>
+#endif
/*
* Work around clashes between Perl and Vim namespace. proto.h doesn't
@@ -293,6 +295,10 @@ typedef int perl_key;
# define Perl_av_fetch dll_Perl_av_fetch
# define Perl_av_len dll_Perl_av_len
# define Perl_sv_2nv_flags dll_Perl_sv_2nv_flags
+# if defined(PERLIO_LAYERS) && !defined(USE_SFIO)
+# define PerlIOBase_pushed dll_PerlIOBase_pushed
+# define PerlIO_define_layer dll_PerlIO_define_layer
+# endif
/*
* Declare HANDLE for perl.dll and function pointers.
@@ -445,6 +451,10 @@ static SV * (*Perl_hv_iterval)(pTHX_ HV *, HE *);
static SV** (*Perl_av_fetch)(pTHX_ AV *, SSize_t, I32);
static SSize_t (*Perl_av_len)(pTHX_ AV *);
static NV (*Perl_sv_2nv_flags)(pTHX_ SV *const, const I32);
+#if defined(PERLIO_LAYERS) && !defined(USE_SFIO)
+static IV (*PerlIOBase_pushed)(pTHX_ PerlIO *, const char *, SV *, PerlIO_funcs *);
+static void (*PerlIO_define_layer)(pTHX_ PerlIO_funcs *);
+#endif
/*
* Table of name to function pointer of perl.
@@ -584,6 +594,10 @@ static struct {
{"Perl_av_fetch", (PERL_PROC*)&Perl_av_fetch},
{"Perl_av_len", (PERL_PROC*)&Perl_av_len},
{"Perl_sv_2nv_flags", (PERL_PROC*)&Perl_sv_2nv_flags},
+#if defined(PERLIO_LAYERS) && !defined(USE_SFIO)
+ {"PerlIOBase_pushed", (PERL_PROC*)&PerlIOBase_pushed},
+ {"PerlIO_define_layer", (PERL_PROC*)&PerlIO_define_layer},
+#endif
{"", NULL},
};
@@ -646,6 +660,10 @@ perl_enabled(int verbose)
}
#endif /* DYNAMIC_PERL */
+#if defined(PERLIO_LAYERS) && !defined(USE_SFIO)
+static void vim_IOLayer_init(void);
+#endif
+
/*
* perl_init(): initialize perl interpreter
* We have to call perl_parse to initialize some structures,
@@ -671,6 +689,8 @@ perl_init(void)
sfdisc(PerlIO_stderr(), sfdcnewvim());
sfsetbuf(PerlIO_stdout(), NULL, 0);
sfsetbuf(PerlIO_stderr(), NULL, 0);
+#elif defined(PERLIO_LAYERS)
+ vim_IOLayer_init();
#endif
}
@@ -1307,6 +1327,82 @@ err:
}
}
+#if defined(PERLIO_LAYERS) && !defined(USE_SFIO)
+typedef struct {
+ struct _PerlIO base;
+ int attr;
+} PerlIOVim;
+
+ static IV
+PerlIOVim_pushed(pTHX_ PerlIO *f, const char *mode,
+ SV *arg, PerlIO_funcs *tab)
+{
+ PerlIOVim *s = PerlIOSelf(f, PerlIOVim);
+ s->attr = 0;
+ if (arg && SvPOK(arg)) {
+ int id = syn_name2id((char_u *)SvPV_nolen(arg));
+ if (id != 0)
+ s->attr = syn_id2attr(id);
+ }
+ return PerlIOBase_pushed(aTHX_ f, mode, (SV *)NULL, tab);
+}
+
+ static SSize_t
+PerlIOVim_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
+{
+ char_u *str;
+ PerlIOVim * s = PerlIOSelf(f, PerlIOVim);
+
+ str = vim_strnsave((char_u *)vbuf, count);
+ if (str == NULL)
+ return 0;
+ msg_split((char_u *)str, s->attr);
+ vim_free(str);
+
+ return count;
+}
+
+static PERLIO_FUNCS_DECL(PerlIO_Vim) = {
+ sizeof(PerlIO_funcs),
+ "Vim",
+ sizeof(PerlIOVim),
+ PERLIO_K_DUMMY, /* flags */
+ PerlIOVim_pushed,
+ NULL, /* popped */
+ NULL, /* open */
+ NULL, /* binmode */
+ NULL, /* arg */
+ NULL, /* fileno */
+ NULL, /* dup */
+ NULL, /* read */
+ NULL, /* unread */
+ PerlIOVim_write,
+ NULL, /* seek */
+ NULL, /* tell */
+ NULL, /* close */
+ NULL, /* flush */
+ NULL, /* fill */
+ NULL, /* eof */
+ NULL, /* error */
+ NULL, /* clearerr */
+ NULL, /* setlinebuf */
+ NULL, /* get_base */
+ NULL, /* get_bufsiz */
+ NULL, /* get_ptr */
+ NULL, /* get_cnt */
+ NULL /* set_ptrcnt */
+};
+
+/* Use Vim routine for print operator */
+ static void
+vim_IOLayer_init(void)
+{
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_Vim));
+ (void)eval_pv( "binmode(STDOUT, ':Vim')"
+ " && binmode(STDERR, ':Vim(ErrorMsg)');", 0);
+}
+#endif /* PERLIO_LAYERS && !USE_SFIO */
+
#ifndef FEAT_WINDOWS
int
win_valid(win_T *w)