Here's an updated patch that got a bit more testing.
It includes both of the previous patches; the major change is that only a
single string
can be returned from perl.
I'd still hope for some feedback, or at least a "won't do because ..." hint.
Regards,
Phil
--
Versioning your /etc, /home or even your whole installation?
Try fsvs (fsvs.tigris.org)!
--
You received this message from the "vim_dev" maillist.
Do not top-post! Type your reply below the text you are replying to.
For more information, visit http://www.vim.org/maillist.php
diff -r bfade53bcafb src/Makefile
--- a/src/Makefile Fri Dec 17 20:24:01 2010 +0100
+++ b/src/Makefile Tue Dec 21 09:11:06 2010 +0100
@@ -2367,8 +2368,9 @@
auto/if_perl.c: if_perl.xs
$(PERL) -e 'unless ( $$] >= 5.005 ) { for (qw(na defgv errgv)) { print "#define PL_$$_ $$_\n" }}' > $@
- $(PERL) $(PERLLIB)/ExtUtils/xsubpp -prototypes -typemap \
- $(PERLLIB)/ExtUtils/typemap if_perl.xs >> $@
+ $(PERL) $(PERLLIB)/ExtUtils/xsubpp -prototypes \
+ -typemap $(PERLLIB)/ExtUtils/typemap \
+ -typemap if_perl_typemap if_perl.xs >> $@
auto/osdef.h: auto/config.h osdef.sh osdef1.h.in osdef2.h.in
CC="$(CC) $(OSDEF_CFLAGS)" srcdir=$(srcdir) sh $(srcdir)/osdef.sh
diff -r bfade53bcafb src/eval.c
--- a/src/eval.c Fri Dec 17 20:24:01 2010 +0100
+++ b/src/eval.c Tue Dec 21 09:11:06 2010 +0100
@@ -645,6 +645,9 @@
static void f_nextnonblank __ARGS((typval_T *argvars, typval_T *rettv));
static void f_nr2char __ARGS((typval_T *argvars, typval_T *rettv));
static void f_pathshorten __ARGS((typval_T *argvars, typval_T *rettv));
+#ifdef FEAT_PERL
+void f_perleval __ARGS((typval_T *argvars, typval_T *rettv));
+#endif
#ifdef FEAT_FLOAT
static void f_pow __ARGS((typval_T *argvars, typval_T *rettv));
#endif
@@ -7839,6 +7842,9 @@
{"nextnonblank", 1, 1, f_nextnonblank},
{"nr2char", 1, 1, f_nr2char},
{"pathshorten", 1, 1, f_pathshorten},
+#ifdef FEAT_PERL
+ {"perleval", 1, 19, f_perleval},
+#endif
#ifdef FEAT_FLOAT
{"pow", 2, 2, f_pow},
#endif
diff -r bfade53bcafb src/if_perl.xs
--- a/src/if_perl.xs Fri Dec 17 20:24:01 2010 +0100
+++ b/src/if_perl.xs Tue Dec 21 09:11:06 2010 +0100
@@ -886,6 +886,125 @@
}
}
+
+void
+f_perleval(argvars, rettv)
+ typval_T *argvars;
+ typval_T *rettv;
+{
+ char_u *cmd;
+ int count, i;
+ STRLEN len;
+ SV *sv;
+ list_T *retlist;
+ I32 ax;
+ typval_T *v;
+ char *cp;
+
+ if (perl_interp == NULL)
+ {
+#ifdef DYNAMIC_PERL
+ if (!perl_enabled(TRUE))
+ {
+ EMSG(_(e_noperl));
+ return;
+ }
+#endif
+ perl_init();
+ }
+
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ EXTEND(SP, 20);
+ if (argvars[0].v_type != VAR_STRING) {
+ return;
+ }
+
+ cmd = argvars[0].vval.v_string;
+
+ for(i=1; i<20; i++)
+ {
+ sv = NULL;
+ // see perlcall
+ switch(argvars[i].v_type)
+ {
+ case VAR_NUMBER:
+ sv = newSViv(argvars[i].vval.v_number);
+ break;
+ case VAR_STRING:
+ sv = newSVpv(argvars[i].vval.v_string,
+ argvars[i].vval.v_string ?
+ strlen(argvars[i].vval.v_string) : 0);
+ break;
+ case VAR_FLOAT:
+ sv = newSVnv(argvars[i].vval.v_float);
+ break;
+
+ case VAR_LIST:
+ case VAR_DICT:
+ /* These two could be supported, I think. */
+ break;
+
+ case VAR_FUNC:
+ break;
+ default:
+ case VAR_UNKNOWN:
+ break;
+ }
+
+ if (!sv)
+ break;
+
+ XPUSHs(sv_2mortal(sv));
+ }
+
+ PUTBACK;
+
+ count = call_pv(cmd, G_SCALAR | G_EVAL);
+// count = call_pv(cmd, G_ARRAY | G_EVAL);
+
+ SPAGAIN;
+
+ /* Default value */
+ rettv->v_type = VAR_NUMBER;
+ rettv->vval.v_number = -1;
+
+ /* Check the eval first */
+ if (SvTRUE(ERRSV))
+ {
+ /* Remove the undef value */
+ POPs;
+ }
+ else
+ {
+ if (count == 1)
+ {
+ sv = POPs;
+ cp = SvPV(sv, len);
+ rettv->v_type = VAR_STRING;
+ rettv->vval.v_string = vim_strnsave(cp, len+2);
+ rettv->vval.v_string[len] = 0;
+ }
+ }
+
+// rettv->v_lock = 0;
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return;
+}
+
+
#ifndef FEAT_WINDOWS
int win_valid(win_T *w) { return TRUE; }
int win_count() { return 1; }
@@ -959,6 +1124,27 @@
update_screen(NOT_VALID);
void
+SetVar(name, val)
+ char *name;
+ char *val;
+
+ PPCODE:
+ if (name != NULL)
+ set_internal_string_var(name, val);
+ update_screen(NOT_VALID);
+
+
+void
+GetVar(name)
+ char *name;
+
+ PPCODE:
+ if (name != NULL)
+ XPUSHs(sv_2mortal(newSVpv((char *)get_var_value(name), 0)));
+ update_screen(NOT_VALID);
+
+
+void
DoCommand(line)
char *line;
diff -r bfade53bcafb src/proto/if_perl.pro
--- a/src/proto/if_perl.pro Fri Dec 17 20:24:01 2010 +0100
+++ b/src/proto/if_perl.pro Tue Dec 21 09:11:06 2010 +0100
@@ -6,3 +6,4 @@
void perl_buf_free __ARGS((buf_T *bp));
void ex_perl __ARGS((exarg_T *eap));
void ex_perldo __ARGS((exarg_T *eap));
+void f_perleval(typval_T *argvars, typval_T *rettv);
diff -r bfade53bcafb src/if_perl_typemap
--- a/src/if_perl_typemap
+++ b/src/if_perl_typemap
@@ -0,0 +1,3 @@
+TYPEMAP
+typval_T * T_PTROBJ
+
