chiark / gitweb /
some maskmap stuff;
[chiark-tcl.git] / 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, Tcl_Obj *newscript) {
18   int rc;
19   
20   scriptinv_cancel(si);
21
22   rc= Tcl_ListObjLength(ip, newscript, &si->llength);
23   if (rc) return rc;
24
25   Tcl_IncrRefCount(newscript);
26   si->obj= newscript;
27   si->ip= ip;
28   return 0;
29 }  
30   
31 void scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj **argv) {
32   Tcl_Obj *invoke=0;
33   int i, rc;
34
35   assert(si->obj);
36
37   for (i=0; i<argc; i++) Tcl_IncrRefCount(argv[i]);
38   invoke= Tcl_DuplicateObj(si->obj);
39   Tcl_IncrRefCount(invoke);
40
41   rc= Tcl_ListObjReplace(si->ip,invoke,si->llength,0,argc,argv);
42   for (i=0; i<argc; i++) { Tcl_DecrRefCount(argv[i]); argv[i]= 0; }
43   if (rc) goto x_rc;
44
45   rc= Tcl_EvalObjEx(si->ip,invoke,TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
46   if (rc) goto x_rc;
47
48   rc= 0;
49   
50 x_rc:
51   if (invoke) Tcl_DecrRefCount(invoke);
52   if (rc) Tcl_BackgroundError(si->ip);
53 }