base/scriptinv.c

   1 /*
   2  */
   3
   4 #include "hbytes.h"
   5
   6 void scriptinv_init(ScriptToInvoke *si) {
   7   si->obj= 0;
   8   si->xargs= 0;
   9 }
  10
  11 void scriptinv_cancel(ScriptToInvoke *si) {
  12   if (si->obj) { Tcl_DecrRefCount(si->obj); si->obj= 0; }
  13   if (si->xargs) { Tcl_DecrRefCount(si->xargs); si->xargs= 0; }
  14 }
  15
  16 int scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
  17                   Tcl_Obj *newscript, Tcl_Obj *xargs) {
  18   int rc, xlength;
  19
  20   scriptinv_cancel(si);
  21
  22   rc= Tcl_ListObjLength(ip, newscript, &si->llength);  if (rc) return rc;
  23   Tcl_IncrRefCount(newscript);
  24
  25   if (xargs) {
  26     rc= Tcl_ListObjLength(ip, xargs, &xlength);  if (rc) return rc;
  27     Tcl_IncrRefCount(xargs);
  28     si->llength += xlength;
  29   }
  30
  31   si->obj= newscript;
  32   si->xargs= xargs;
  33   si->ip= ip;
  34   return 0;
  35 }
  36
  37 void scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv) {
  38   Tcl_Obj *invoke=0;
  39   int i, rc;
  40
  41   assert(si->obj);
  42   for (i=0; i<argc; i++) Tcl_IncrRefCount(argv[i]);
  43
  44   invoke= Tcl_DuplicateObj(si->obj);
  45   Tcl_IncrRefCount(invoke);
  46
  47   if (si->xargs) {
  48     rc= Tcl_ListObjAppendList(si->ip, invoke, si->xargs);
  49     if (rc) goto x_rc;
  50   }
  51
  52   rc= Tcl_ListObjReplace(si->ip, invoke,si->llength,0, argc,argv);
  53   if (rc) goto x_rc;
  54
  55   rc= Tcl_EvalObjEx(si->ip,invoke,TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
  56   if (rc) goto x_rc;
  57
  58   rc= 0;
  59
  60 x_rc:
  61   for (i=0; i<argc; i++) Tcl_DecrRefCount(argv[i]);
  62   if (invoke) Tcl_DecrRefCount(invoke);
  63   if (rc) Tcl_BackgroundError(si->ip);
  64 }