Mercurial > vim

comparison src/if_perl.xs @ 8885:54a380c74547 v7.4.1729

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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)
author Christian Brabandt <cb@256bit.org>
date Thu, 14 Apr 2016 14:15:05 +0200
parents 83d0b976d9b3
children 240ad5a78199
comparison
equal deleted inserted replaced
8884:a36c5c7384c4 8885:54a380c74547
55 #endif 55 #endif
56 56
57 #include <EXTERN.h> 57 #include <EXTERN.h>
58 #include <perl.h> 58 #include <perl.h>
59 #include <XSUB.h> 59 #include <XSUB.h>
60 60 #if defined(PERLIO_LAYERS) && !defined(USE_SFIO)
61 # include <perliol.h>
62 #endif
61 63
62 /* 64 /*
63 * Work around clashes between Perl and Vim namespace. proto.h doesn't 65 * Work around clashes between Perl and Vim namespace. proto.h doesn't
64 * include if_perl.pro and perlsfio.pro when IN_PERL_FILE is defined, because 66 * include if_perl.pro and perlsfio.pro when IN_PERL_FILE is defined, because
65 * we need the CV typedef. proto.h can't be moved to after including 67 * we need the CV typedef. proto.h can't be moved to after including
291 # define Perl_hv_iterkey dll_Perl_hv_iterkey 293 # define Perl_hv_iterkey dll_Perl_hv_iterkey
292 # define Perl_hv_iterval dll_Perl_hv_iterval 294 # define Perl_hv_iterval dll_Perl_hv_iterval
293 # define Perl_av_fetch dll_Perl_av_fetch 295 # define Perl_av_fetch dll_Perl_av_fetch
294 # define Perl_av_len dll_Perl_av_len 296 # define Perl_av_len dll_Perl_av_len
295 # define Perl_sv_2nv_flags dll_Perl_sv_2nv_flags 297 # define Perl_sv_2nv_flags dll_Perl_sv_2nv_flags
298 # if defined(PERLIO_LAYERS) && !defined(USE_SFIO)
299 # define PerlIOBase_pushed dll_PerlIOBase_pushed
300 # define PerlIO_define_layer dll_PerlIO_define_layer
301 # endif
296 302
297 /* 303 /*
298 * Declare HANDLE for perl.dll and function pointers. 304 * Declare HANDLE for perl.dll and function pointers.
299 */ 305 */
300 static HANDLE hPerlLib = NULL; 306 static HANDLE hPerlLib = NULL;
443 static char * (*Perl_hv_iterkey)(pTHX_ HE *, I32 *); 449 static char * (*Perl_hv_iterkey)(pTHX_ HE *, I32 *);
444 static SV * (*Perl_hv_iterval)(pTHX_ HV *, HE *); 450 static SV * (*Perl_hv_iterval)(pTHX_ HV *, HE *);
445 static SV** (*Perl_av_fetch)(pTHX_ AV *, SSize_t, I32); 451 static SV** (*Perl_av_fetch)(pTHX_ AV *, SSize_t, I32);
446 static SSize_t (*Perl_av_len)(pTHX_ AV *); 452 static SSize_t (*Perl_av_len)(pTHX_ AV *);
447 static NV (*Perl_sv_2nv_flags)(pTHX_ SV *const, const I32); 453 static NV (*Perl_sv_2nv_flags)(pTHX_ SV *const, const I32);
454 #if defined(PERLIO_LAYERS) && !defined(USE_SFIO)
455 static IV (*PerlIOBase_pushed)(pTHX_ PerlIO *, const char *, SV *, PerlIO_funcs *);
456 static void (*PerlIO_define_layer)(pTHX_ PerlIO_funcs *);
457 #endif
448 458
449 /* 459 /*
450 * Table of name to function pointer of perl. 460 * Table of name to function pointer of perl.
451 */ 461 */
452 static struct { 462 static struct {
582 {"Perl_hv_iterkey", (PERL_PROC*)&Perl_hv_iterkey}, 592 {"Perl_hv_iterkey", (PERL_PROC*)&Perl_hv_iterkey},
583 {"Perl_hv_iterval", (PERL_PROC*)&Perl_hv_iterval}, 593 {"Perl_hv_iterval", (PERL_PROC*)&Perl_hv_iterval},
584 {"Perl_av_fetch", (PERL_PROC*)&Perl_av_fetch}, 594 {"Perl_av_fetch", (PERL_PROC*)&Perl_av_fetch},
585 {"Perl_av_len", (PERL_PROC*)&Perl_av_len}, 595 {"Perl_av_len", (PERL_PROC*)&Perl_av_len},
586 {"Perl_sv_2nv_flags", (PERL_PROC*)&Perl_sv_2nv_flags}, 596 {"Perl_sv_2nv_flags", (PERL_PROC*)&Perl_sv_2nv_flags},
597 #if defined(PERLIO_LAYERS) && !defined(USE_SFIO)
598 {"PerlIOBase_pushed", (PERL_PROC*)&PerlIOBase_pushed},
599 {"PerlIO_define_layer", (PERL_PROC*)&PerlIO_define_layer},
600 #endif
587 {"", NULL}, 601 {"", NULL},
588 }; 602 };
589 603
590 /* Work around for perl-5.18. 604 /* Work around for perl-5.18.
591 * The definitions of S_SvREFCNT_inc and S_SvREFCNT_dec are needed, so include 605 * The definitions of S_SvREFCNT_inc and S_SvREFCNT_dec are needed, so include
643 perl_enabled(int verbose) 657 perl_enabled(int verbose)
644 { 658 {
645 return perl_runtime_link_init((char *)p_perldll, verbose) == OK; 659 return perl_runtime_link_init((char *)p_perldll, verbose) == OK;
646 } 660 }
647 #endif /* DYNAMIC_PERL */ 661 #endif /* DYNAMIC_PERL */
662
663 #if defined(PERLIO_LAYERS) && !defined(USE_SFIO)
664 static void vim_IOLayer_init(void);
665 #endif
648 666
649 /* 667 /*
650 * perl_init(): initialize perl interpreter 668 * perl_init(): initialize perl interpreter
651 * We have to call perl_parse to initialize some structures, 669 * We have to call perl_parse to initialize some structures,
652 * there's nothing to actually parse. 670 * there's nothing to actually parse.
669 #ifdef USE_SFIO 687 #ifdef USE_SFIO
670 sfdisc(PerlIO_stdout(), sfdcnewvim()); 688 sfdisc(PerlIO_stdout(), sfdcnewvim());
671 sfdisc(PerlIO_stderr(), sfdcnewvim()); 689 sfdisc(PerlIO_stderr(), sfdcnewvim());
672 sfsetbuf(PerlIO_stdout(), NULL, 0); 690 sfsetbuf(PerlIO_stdout(), NULL, 0);
673 sfsetbuf(PerlIO_stderr(), NULL, 0); 691 sfsetbuf(PerlIO_stderr(), NULL, 0);
692 #elif defined(PERLIO_LAYERS)
693 vim_IOLayer_init();
674 #endif 694 #endif
675 } 695 }
676 696
677 /* 697 /*
678 * perl_end(): clean up after ourselves 698 * perl_end(): clean up after ourselves
1305 msg_split((char_u *)str, highlight_attr[HLF_E]); 1325 msg_split((char_u *)str, highlight_attr[HLF_E]);
1306 return; 1326 return;
1307 } 1327 }
1308 } 1328 }
1309 1329
1330 #if defined(PERLIO_LAYERS) && !defined(USE_SFIO)
1331 typedef struct {
1332 struct _PerlIO base;
1333 int attr;
1334 } PerlIOVim;
1335
1336 static IV
1337 PerlIOVim_pushed(pTHX_ PerlIO *f, const char *mode,
1338 SV *arg, PerlIO_funcs *tab)
1339 {
1340 PerlIOVim *s = PerlIOSelf(f, PerlIOVim);
1341 s->attr = 0;
1342 if (arg && SvPOK(arg)) {
1343 int id = syn_name2id((char_u *)SvPV_nolen(arg));
1344 if (id != 0)
1345 s->attr = syn_id2attr(id);
1346 }
1347 return PerlIOBase_pushed(aTHX_ f, mode, (SV *)NULL, tab);
1348 }
1349
1350 static SSize_t
1351 PerlIOVim_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
1352 {
1353 char_u *str;
1354 PerlIOVim * s = PerlIOSelf(f, PerlIOVim);
1355
1356 str = vim_strnsave((char_u *)vbuf, count);
1357 if (str == NULL)
1358 return 0;
1359 msg_split((char_u *)str, s->attr);
1360 vim_free(str);
1361
1362 return count;
1363 }
1364
1365 static PERLIO_FUNCS_DECL(PerlIO_Vim) = {
1366 sizeof(PerlIO_funcs),
1367 "Vim",
1368 sizeof(PerlIOVim),
1369 PERLIO_K_DUMMY, /* flags */
1370 PerlIOVim_pushed,
1371 NULL, /* popped */
1372 NULL, /* open */
1373 NULL, /* binmode */
1374 NULL, /* arg */
1375 NULL, /* fileno */
1376 NULL, /* dup */
1377 NULL, /* read */
1378 NULL, /* unread */
1379 PerlIOVim_write,
1380 NULL, /* seek */
1381 NULL, /* tell */
1382 NULL, /* close */
1383 NULL, /* flush */
1384 NULL, /* fill */
1385 NULL, /* eof */
1386 NULL, /* error */
1387 NULL, /* clearerr */
1388 NULL, /* setlinebuf */
1389 NULL, /* get_base */
1390 NULL, /* get_bufsiz */
1391 NULL, /* get_ptr */
1392 NULL, /* get_cnt */
1393 NULL /* set_ptrcnt */
1394 };
1395
1396 /* Use Vim routine for print operator */
1397 static void
1398 vim_IOLayer_init(void)
1399 {
1400 PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_Vim));
1401 (void)eval_pv( "binmode(STDOUT, ':Vim')"
1402 " && binmode(STDERR, ':Vim(ErrorMsg)');", 0);
1403 }
1404 #endif /* PERLIO_LAYERS && !USE_SFIO */
1405
1310 #ifndef FEAT_WINDOWS 1406 #ifndef FEAT_WINDOWS
1311 int 1407 int
1312 win_valid(win_T *w) 1408 win_valid(win_T *w)
1313 { 1409 {
1314 return TRUE; 1410 return TRUE;