# HG changeset patch
# User Christian Brabandt <cb@256bit.org>
# Date 1460636105 -7200
# Node ID 54a380c7454788c5f39b391d5f158fda2a5c6e5f
# Parent  a36c5c7384c4ceeb878a5a3c00222359c4a545f2
commit https://github.com/vim/vim/commit/6244a0fc29163ba1c734f92b55a89e01e6cf2a67
Author: Bram Moolenaar <Bram@vim.org>
Date:   Thu Apr 14 14:09:25 2016 +0200

    patch 7.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)

diff --git a/src/if_perl.xs b/src/if_perl.xs
--- 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 
 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)
diff --git a/src/testdir/test_perl.vim b/src/testdir/test_perl.vim
--- a/src/testdir/test_perl.vim
+++ b/src/testdir/test_perl.vim
@@ -92,3 +92,14 @@ function Test_VIM_package()
   perl VIM::SetOption('et')
   call assert_true(&et)
 endf
+
+function Test_stdio()
+  redir =>l:out
+  perl <<EOF
+    VIM::Msg("&VIM::Msg");
+    print "STDOUT";
+    print STDERR "STDERR";
+EOF
+  redir END
+  call assert_equal(['&VIM::Msg', 'STDOUT', 'STDERR'], split(l:out, "\n"))
+endf
diff --git a/src/version.c b/src/version.c
--- a/src/version.c
+++ b/src/version.c
@@ -749,6 +749,8 @@ static char *(features[]) =
 static int included_patches[] =
 {   /* Add new patch number below this line */
 /**/
+    1729,
+/**/
     1728,
 /**/
     1727,