1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
/*
* base code for various Tcl extensions
* Copyright 2006-2012 Ian Jackson
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License as
* published by the Free Software Foundation; either version 2 of the
* License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see <http://www.gnu.org/licenses/>.
*/
#include "chiark-tcl-base.h"
void cht_scriptinv_init(ScriptToInvoke *si) {
si->ipq= 0;
si->script= 0;
si->xargs= 0;
}
void cht_scriptinv_cancel(ScriptToInvoke *si) {
if (si->script) { Tcl_DecrRefCount(si->script); si->script= 0; }
if (si->xargs) { Tcl_DecrRefCount(si->xargs); si->xargs= 0; }
si->ipq= 0;
}
int cht_scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
Tcl_Obj *newscript, Tcl_Obj *xargs) {
int rc, xlength;
cht_scriptinv_cancel(si);
if (!newscript) return 0;
rc= Tcl_ListObjLength(ip, newscript, &si->llen); if (rc) return rc;
Tcl_IncrRefCount(newscript);
if (xargs) {
rc= Tcl_ListObjLength(ip, xargs, &xlength); if (rc) return rc;
Tcl_IncrRefCount(xargs);
assert(si->llen < INT_MAX/2 && xlength < INT_MAX/2);
si->llen += xlength;
}
si->script= newscript;
si->xargs= xargs;
si->ipq= ip;
return 0;
}
int cht_scriptinv_invoke_fg(ScriptToInvoke *si, int argc,
Tcl_Obj *const *argv) {
Tcl_Obj *invoke=0;
int i, rc;
if (!si->ipq) return TCL_OK;
for (i=0; i<argc; i++) Tcl_IncrRefCount(argv[i]);
invoke= Tcl_DuplicateObj(si->script);
Tcl_IncrRefCount(invoke);
if (si->xargs) {
rc= Tcl_ListObjAppendList(si->ipq, invoke, si->xargs);
if (rc) goto x_rc;
}
rc= Tcl_ListObjReplace(si->ipq, invoke,si->llen,0, argc,argv);
if (rc) goto x_rc;
rc= Tcl_EvalObjEx(si->ipq, invoke, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
if (rc) goto x_rc;
rc= 0;
x_rc:
for (i=0; i<argc; i++) Tcl_DecrRefCount(argv[i]);
if (invoke) Tcl_DecrRefCount(invoke);
return rc;
}
void cht_scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv) {
int rc;
rc= cht_scriptinv_invoke_fg(si, argc, argv);
if (rc) Tcl_BackgroundError(si->ipq);
}
|
