base/scriptinv.c

   1 /*
   2  */
   3
   4 #include "chiark-tcl-base.h"
   5
   6 void cht_scriptinv_init(ScriptToInvoke *si) {
   7   si->obj= 0;
   8   si->xargs= 0;
   9 }
  10
  11 void cht_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 cht_scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
  17                   Tcl_Obj *newscript, Tcl_Obj *xargs) {
  18   int rc, xlength;
  19
  20   cht_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 int cht_scriptinv_invoke_fg(ScriptToInvoke *si, int argc,
  38                             Tcl_Obj *const *argv) {
  39   Tcl_Obj *invoke=0;
  40   int i, rc;
  41
  42   assert(si->obj);
  43   for (i=0; i<argc; i++) Tcl_IncrRefCount(argv[i]);
  44
  45   invoke= Tcl_DuplicateObj(si->obj);
  46   Tcl_IncrRefCount(invoke);
  47
  48   if (si->xargs) {
  49     rc= Tcl_ListObjAppendList(si->ip, invoke, si->xargs);
  50     if (rc) goto x_rc;
  51   }
  52
  53   rc= Tcl_ListObjReplace(si->ip, invoke,si->llength,0, argc,argv);
  54   if (rc) goto x_rc;
  55
  56   rc= Tcl_EvalObjEx(si->ip,invoke,TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
  57   if (rc) goto x_rc;
  58
  59   rc= 0;
  60
  61 x_rc:
  62   for (i=0; i<argc; i++) Tcl_DecrRefCount(argv[i]);
  63   if (invoke) Tcl_DecrRefCount(invoke);
  64   return rc;
  65 }
  66
  67 void cht_scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv) {
  68   int rc;
  69   rc= cht_scriptinv_invoke_fg(si, argc, argv);
  70   if (rc) Tcl_BackgroundError(si->ip);
  71 }