chiark / gitweb /
a066572c2873ecc3edff403574c8f6cc2a89f350
[chiark-tcl.git] / base / scriptinv.c
1 /*
2  */
3
4 #include "chiark-tcl-base.h"
5
6 void cht_scriptinv_init(ScriptToInvoke *si) {
7   si->ipq= 0;
8   si->script= 0;
9   si->xargs= 0;
10 }
11
12 void cht_scriptinv_cancel(ScriptToInvoke *si) {
13   if (si->script) { Tcl_DecrRefCount(si->script); si->script= 0; }
14   if (si->xargs) { Tcl_DecrRefCount(si->xargs); si->xargs= 0; }
15   si->ipq= 0;
16 }
17
18 int cht_scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
19                   Tcl_Obj *newscript, Tcl_Obj *xargs) {
20   int rc, xlength;
21   
22   cht_scriptinv_cancel(si);
23   if (!newscript) return 0;
24
25   rc= Tcl_ListObjLength(ip, newscript, &si->llen);  if (rc) return rc;
26   Tcl_IncrRefCount(newscript);
27
28   if (xargs) {
29     rc= Tcl_ListObjLength(ip, xargs, &xlength);  if (rc) return rc;
30     Tcl_IncrRefCount(xargs);
31     si->llen += xlength;
32   }
33
34   si->script= newscript;
35   si->xargs= xargs;
36   si->ipq= ip;
37   return 0;
38 }  
39   
40 int cht_scriptinv_invoke_fg(ScriptToInvoke *si, int argc,
41                             Tcl_Obj *const *argv) {
42   Tcl_Obj *invoke=0;
43   int i, rc;
44
45   if (!si->ipq) return TCL_OK;
46
47   for (i=0; i<argc; i++) Tcl_IncrRefCount(argv[i]);
48
49   invoke= Tcl_DuplicateObj(si->script);
50   Tcl_IncrRefCount(invoke);
51
52   if (si->xargs) {
53     rc= Tcl_ListObjAppendList(si->ipq, invoke, si->xargs);
54     if (rc) goto x_rc;
55   }
56
57   rc= Tcl_ListObjReplace(si->ipq, invoke,si->llen,0, argc,argv);
58   if (rc) goto x_rc;
59
60   rc= Tcl_EvalObjEx(si->ipq, invoke, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
61   if (rc) goto x_rc;
62
63   rc= 0;
64   
65 x_rc:
66   for (i=0; i<argc; i++) Tcl_DecrRefCount(argv[i]);
67   if (invoke) Tcl_DecrRefCount(invoke);
68   return rc;
69 }
70
71 void cht_scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv) {
72   int rc;
73   rc= cht_scriptinv_invoke_fg(si, argc, argv);
74   if (rc) Tcl_BackgroundError(si->ipq);
75 }