base/scriptinv.c

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