Fossil SCM

Perform lazy setup of the Tcl integration subsystem when it is actually enabled.

mistachkin 2011-10-26 14:57 UTC tcl-integration
Commit e49581506a2b6b674910c23eefa55506aa417751
Parent 62d928cb41a1370…
6 files changed +2 +24 -3 +1 -1 +1 -1 +73 -10 +1 -1
~ src/db.c ~ src/main.c ~ src/th.h ~ src/th_main.c ~ src/th_tcl.c ~ win/Makefile.mingw.mistachkin
M src/db.c
+2
--- src/db.c
+++ src/db.c
@@ -1792,11 +1792,13 @@
17921792
 { "repo-cksum", 0, 0, 0, "on" },
17931793
 { "self-register", 0, 0, 0, "off" },
17941794
 { "ssl-ca-location",0, 40, 0, "" },
17951795
 { "ssl-identity", 0, 40, 0, "" },
17961796
 { "ssh-command", 0, 32, 0, "" },
1797
+#ifdef FOSSIL_ENABLE_TCL
17971798
 { "tcl", 0, 0, 0, "off" },
1799
+#endif
17981800
 { "web-browser", 0, 32, 0, "" },
17991801
 { "white-foreground", 0, 0, 0, "off" },
18001802
 { 0,0,0,0,0 }
18011803
 };
18021804
18031805
--- src/db.c
+++ src/db.c
@@ -1792,11 +1792,13 @@
1792 { "repo-cksum", 0, 0, 0, "on" },
1793 { "self-register", 0, 0, 0, "off" },
1794 { "ssl-ca-location",0, 40, 0, "" },
1795 { "ssl-identity", 0, 40, 0, "" },
1796 { "ssh-command", 0, 32, 0, "" },
 
1797 { "tcl", 0, 0, 0, "off" },
 
1798 { "web-browser", 0, 32, 0, "" },
1799 { "white-foreground", 0, 0, 0, "off" },
1800 { 0,0,0,0,0 }
1801 };
1802
1803
--- src/db.c
+++ src/db.c
@@ -1792,11 +1792,13 @@
1792 { "repo-cksum", 0, 0, 0, "on" },
1793 { "self-register", 0, 0, 0, "off" },
1794 { "ssl-ca-location",0, 40, 0, "" },
1795 { "ssl-identity", 0, 40, 0, "" },
1796 { "ssh-command", 0, 32, 0, "" },
1797 #ifdef FOSSIL_ENABLE_TCL
1798 { "tcl", 0, 0, 0, "off" },
1799 #endif
1800 { "web-browser", 0, 32, 0, "" },
1801 { "white-foreground", 0, 0, 0, "off" },
1802 { 0,0,0,0,0 }
1803 };
1804
1805
M src/main.c
+24 -3
--- src/main.c
+++ src/main.c
@@ -24,16 +24,17 @@
2424
 #include <time.h>
2525
 #include <fcntl.h>
2626
 #include <sys/types.h>
2727
 #include <sys/stat.h>
2828
29
+
30
+#if INTERFACE
31
+
2932
 #ifdef FOSSIL_ENABLE_TCL
3033
 #include "tcl.h"
3134
 #endif
3235
33
-#if INTERFACE
34
-
3536
 /*
3637
 ** Number of elements in an array
3738
 */
3839
 #define count(X) (sizeof(X)/sizeof(X[0]))
3940
@@ -72,10 +73,23 @@
7273
 char TktFmt; /* t: create new ticket report formats */
7374
 char RdAddr; /* e: read email addresses or other private data */
7475
 char Zip; /* z: download zipped artifact via /zip URL */
7576
 char Private; /* x: can send and receive private content */
7677
 };
78
+
79
+#ifdef FOSSIL_ENABLE_TCL
80
+/*
81
+** All Tcl related context information is in this structure. This structure
82
+** definition has been copied from and should be kept in sync with the one in
83
+** "th_tcl.c".
84
+*/
85
+struct TclContext {
86
+ int argc;
87
+ char **argv;
88
+ Tcl_Interp *interp;
89
+};
90
+#endif
7791
7892
 /*
7993
 ** All global variables are in this structure.
8094
 */
8195
 struct Global {
@@ -148,10 +162,15 @@
148162
 char *zIpAddr; /* The remote IP address */
149163
 char *zNonce; /* The nonce used for login */
150164
151165
 /* permissions used by the server */
152166
 struct FossilUserPerms perm;
167
+
168
+#ifdef FOSSIL_ENABLE_TCL
169
+ /* all Tcl related context necessary for integration */
170
+ struct TclContext tcl;
171
+#endif
153172
154173
 /* For defense against Cross-site Request Forgery attacks */
155174
 char zCsrfToken[12]; /* Value of the anti-CSRF token */
156175
 int okCsrf; /* Anti-CSRF token is present and valid */
157176
@@ -318,11 +337,13 @@
318337
 int idx;
319338
 int rc;
320339
 int i;
321340
322341
 #ifdef FOSSIL_ENABLE_TCL
323
- Tcl_FindExecutable(argv[0]);
342
+ g.tcl.argc = argc;
343
+ g.tcl.argv = argv;
344
+ g.tcl.interp = 0;
324345
 #endif
325346
326347
 sqlite3_config(SQLITE_CONFIG_LOG, fossil_sqlite_log, 0);
327348
 g.now = time(0);
328349
 g.argc = argc;
329350
--- src/main.c
+++ src/main.c
@@ -24,16 +24,17 @@
24 #include <time.h>
25 #include <fcntl.h>
26 #include <sys/types.h>
27 #include <sys/stat.h>
28
 
 
 
29 #ifdef FOSSIL_ENABLE_TCL
30 #include "tcl.h"
31 #endif
32
33 #if INTERFACE
34
35 /*
36 ** Number of elements in an array
37 */
38 #define count(X) (sizeof(X)/sizeof(X[0]))
39
@@ -72,10 +73,23 @@
72 char TktFmt; /* t: create new ticket report formats */
73 char RdAddr; /* e: read email addresses or other private data */
74 char Zip; /* z: download zipped artifact via /zip URL */
75 char Private; /* x: can send and receive private content */
76 };
 
 
 
 
 
 
 
 
 
 
 
 
 
77
78 /*
79 ** All global variables are in this structure.
80 */
81 struct Global {
@@ -148,10 +162,15 @@
148 char *zIpAddr; /* The remote IP address */
149 char *zNonce; /* The nonce used for login */
150
151 /* permissions used by the server */
152 struct FossilUserPerms perm;
 
 
 
 
 
153
154 /* For defense against Cross-site Request Forgery attacks */
155 char zCsrfToken[12]; /* Value of the anti-CSRF token */
156 int okCsrf; /* Anti-CSRF token is present and valid */
157
@@ -318,11 +337,13 @@
318 int idx;
319 int rc;
320 int i;
321
322 #ifdef FOSSIL_ENABLE_TCL
323 Tcl_FindExecutable(argv[0]);
 
 
324 #endif
325
326 sqlite3_config(SQLITE_CONFIG_LOG, fossil_sqlite_log, 0);
327 g.now = time(0);
328 g.argc = argc;
329
--- src/main.c
+++ src/main.c
@@ -24,16 +24,17 @@
24 #include <time.h>
25 #include <fcntl.h>
26 #include <sys/types.h>
27 #include <sys/stat.h>
28
29
30 #if INTERFACE
31
32 #ifdef FOSSIL_ENABLE_TCL
33 #include "tcl.h"
34 #endif
35
 
 
36 /*
37 ** Number of elements in an array
38 */
39 #define count(X) (sizeof(X)/sizeof(X[0]))
40
@@ -72,10 +73,23 @@
73 char TktFmt; /* t: create new ticket report formats */
74 char RdAddr; /* e: read email addresses or other private data */
75 char Zip; /* z: download zipped artifact via /zip URL */
76 char Private; /* x: can send and receive private content */
77 };
78
79 #ifdef FOSSIL_ENABLE_TCL
80 /*
81 ** All Tcl related context information is in this structure. This structure
82 ** definition has been copied from and should be kept in sync with the one in
83 ** "th_tcl.c".
84 */
85 struct TclContext {
86 int argc;
87 char **argv;
88 Tcl_Interp *interp;
89 };
90 #endif
91
92 /*
93 ** All global variables are in this structure.
94 */
95 struct Global {
@@ -148,10 +162,15 @@
162 char *zIpAddr; /* The remote IP address */
163 char *zNonce; /* The nonce used for login */
164
165 /* permissions used by the server */
166 struct FossilUserPerms perm;
167
168 #ifdef FOSSIL_ENABLE_TCL
169 /* all Tcl related context necessary for integration */
170 struct TclContext tcl;
171 #endif
172
173 /* For defense against Cross-site Request Forgery attacks */
174 char zCsrfToken[12]; /* Value of the anti-CSRF token */
175 int okCsrf; /* Anti-CSRF token is present and valid */
176
@@ -318,11 +337,13 @@
337 int idx;
338 int rc;
339 int i;
340
341 #ifdef FOSSIL_ENABLE_TCL
342 g.tcl.argc = argc;
343 g.tcl.argv = argv;
344 g.tcl.interp = 0;
345 #endif
346
347 sqlite3_config(SQLITE_CONFIG_LOG, fossil_sqlite_log, 0);
348 g.now = time(0);
349 g.argc = argc;
350
M src/th.h
+1 -1
--- src/th.h
+++ src/th.h
@@ -154,11 +154,11 @@
154154
 */
155155
 int th_register_language(Th_Interp *interp); /* th_lang.c */
156156
 int th_register_sqlite(Th_Interp *interp); /* th_sqlite.c */
157157
 int th_register_vfs(Th_Interp *interp); /* th_vfs.c */
158158
 int th_register_testvfs(Th_Interp *interp); /* th_testvfs.c */
159
-int th_register_tcl(Th_Interp *interp); /* th_tcl.c */
159
+int th_register_tcl(Th_Interp *interp, void *pContext); /* th_tcl.c */
160160
161161
 /*
162162
 ** General purpose hash table from th_lang.c.
163163
 */
164164
 typedef struct Th_Hash Th_Hash;
165165
--- src/th.h
+++ src/th.h
@@ -154,11 +154,11 @@
154 */
155 int th_register_language(Th_Interp *interp); /* th_lang.c */
156 int th_register_sqlite(Th_Interp *interp); /* th_sqlite.c */
157 int th_register_vfs(Th_Interp *interp); /* th_vfs.c */
158 int th_register_testvfs(Th_Interp *interp); /* th_testvfs.c */
159 int th_register_tcl(Th_Interp *interp); /* th_tcl.c */
160
161 /*
162 ** General purpose hash table from th_lang.c.
163 */
164 typedef struct Th_Hash Th_Hash;
165
--- src/th.h
+++ src/th.h
@@ -154,11 +154,11 @@
154 */
155 int th_register_language(Th_Interp *interp); /* th_lang.c */
156 int th_register_sqlite(Th_Interp *interp); /* th_sqlite.c */
157 int th_register_vfs(Th_Interp *interp); /* th_vfs.c */
158 int th_register_testvfs(Th_Interp *interp); /* th_testvfs.c */
159 int th_register_tcl(Th_Interp *interp, void *pContext); /* th_tcl.c */
160
161 /*
162 ** General purpose hash table from th_lang.c.
163 */
164 typedef struct Th_Hash Th_Hash;
165
M src/th_main.c
+1 -1
--- src/th_main.c
+++ src/th_main.c
@@ -395,11 +395,11 @@
395395
 int i;
396396
 g.interp = Th_CreateInterp(&vtab);
397397
 th_register_language(g.interp); /* Basic scripting commands. */
398398
 #ifdef FOSSIL_ENABLE_TCL
399399
 if( getenv("TH1_ENABLE_TCL")!=0 || db_get_boolean("tcl", 0) ){
400
- th_register_tcl(g.interp); /* Tcl integration commands. */
400
+ th_register_tcl(g.interp, &g.tcl); /* Tcl integration commands. */
401401
 }
402402
 #endif
403403
 for(i=0; i<sizeof(aCommand)/sizeof(aCommand[0]); i++){
404404
 Th_CreateCommand(g.interp, aCommand[i].zName, aCommand[i].xProc,
405405
 aCommand[i].pContext, 0);
406406
--- src/th_main.c
+++ src/th_main.c
@@ -395,11 +395,11 @@
395 int i;
396 g.interp = Th_CreateInterp(&vtab);
397 th_register_language(g.interp); /* Basic scripting commands. */
398 #ifdef FOSSIL_ENABLE_TCL
399 if( getenv("TH1_ENABLE_TCL")!=0 || db_get_boolean("tcl", 0) ){
400 th_register_tcl(g.interp); /* Tcl integration commands. */
401 }
402 #endif
403 for(i=0; i<sizeof(aCommand)/sizeof(aCommand[0]); i++){
404 Th_CreateCommand(g.interp, aCommand[i].zName, aCommand[i].xProc,
405 aCommand[i].pContext, 0);
406
--- src/th_main.c
+++ src/th_main.c
@@ -395,11 +395,11 @@
395 int i;
396 g.interp = Th_CreateInterp(&vtab);
397 th_register_language(g.interp); /* Basic scripting commands. */
398 #ifdef FOSSIL_ENABLE_TCL
399 if( getenv("TH1_ENABLE_TCL")!=0 || db_get_boolean("tcl", 0) ){
400 th_register_tcl(g.interp, &g.tcl); /* Tcl integration commands. */
401 }
402 #endif
403 for(i=0; i<sizeof(aCommand)/sizeof(aCommand[0]); i++){
404 Th_CreateCommand(g.interp, aCommand[i].zName, aCommand[i].xProc,
405 aCommand[i].pContext, 0);
406
M src/th_tcl.c
+73 -10
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -39,10 +39,25 @@
3939
 for(i=1; i<argc; i++){ \
4040
 Tcl_DecrRefCount(objv[i-1]); \
4141
 } \
4242
 ckfree((char *)objv);
4343
44
+/*
45
+** Fetch the Tcl interpreter from the specified void pointer, cast to a Tcl
46
+** context.
47
+ */
48
+#define GET_CTX_TCL_INTERP(ctx) \
49
+ ((struct TclContext *)(ctx))->interp
50
+
51
+/*
52
+** Creates and initializes a Tcl interpreter for use with the specified TH1
53
+** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
54
+** by the caller. This must be declared here because quite a few functions in
55
+** this file need to use it before it can be defined.
56
+ */
57
+static int createTclInterp(Th_Interp *interp, void *pContext);
58
+
4459
 /*
4560
 ** Returns the Tcl interpreter result as a string with the associated length.
4661
 ** If the Tcl interpreter or the Tcl result are NULL, the length will be 0.
4762
 ** If the length pointer is NULL, the length will not be stored.
4863
 */
@@ -61,10 +76,20 @@
6176
 return 0;
6277
 }
6378
 return Tcl_GetStringFromObj(resultPtr, pN);
6479
 }
6580
81
+/*
82
+** Tcl context information used by TH1. This structure definition has been
83
+** copied from and should be kept in sync with the one in "main.c".
84
+*/
85
+struct TclContext {
86
+ int argc;
87
+ char **argv;
88
+ Tcl_Interp *interp;
89
+};
90
+
6691
 /*
6792
 ** Syntax:
6893
 **
6994
 ** tclEval arg ?arg ...?
7095
 */
@@ -79,14 +104,17 @@
79104
 Tcl_Obj *objPtr;
80105
 int rc;
81106
 int nResult;
82107
 const char *zResult;
83108
109
+ if ( createTclInterp(interp, ctx)!=TH_OK ){
110
+ return TH_ERROR;
111
+ }
84112
 if( argc<2 ){
85113
 return Th_WrongNumArgs(interp, "tclEval arg ?arg ...?");
86114
 }
87
- tclInterp = (Tcl_Interp *)ctx;
115
+ tclInterp = GET_CTX_TCL_INTERP(ctx);
88116
 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
89117
 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
90118
 return TH_ERROR;
91119
 }
92120
 Tcl_Preserve((ClientData)tclInterp);
@@ -127,14 +155,17 @@
127155
 Tcl_Obj *resultObjPtr;
128156
 int rc;
129157
 int nResult;
130158
 const char *zResult;
131159
160
+ if ( createTclInterp(interp, ctx)!=TH_OK ){
161
+ return TH_ERROR;
162
+ }
132163
 if( argc<2 ){
133164
 return Th_WrongNumArgs(interp, "tclExpr arg ?arg ...?");
134165
 }
135
- tclInterp = (Tcl_Interp *)ctx;
166
+ tclInterp = GET_CTX_TCL_INTERP(ctx);
136167
 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
137168
 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
138169
 return TH_ERROR;
139170
 }
140171
 Tcl_Preserve((ClientData)tclInterp);
@@ -186,14 +217,17 @@
186217
 #ifndef USE_TCL_EVALOBJV
187218
 Tcl_Obj *objPtr;
188219
 #endif
189220
 USE_ARGV_TO_OBJV();
190221
222
+ if ( createTclInterp(interp, ctx)!=TH_OK ){
223
+ return TH_ERROR;
224
+ }
191225
 if( argc<2 ){
192226
 return Th_WrongNumArgs(interp, "tclInvoke command ?arg ...?");
193227
 }
194
- tclInterp = (Tcl_Interp *)ctx;
228
+ tclInterp = GET_CTX_TCL_INTERP(ctx);
195229
 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
196230
 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
197231
 return TH_ERROR;
198232
 }
199233
 Tcl_Preserve((ClientData)tclInterp);
@@ -324,36 +358,65 @@
324358
 Th_RenameCommand(th1Interp, aCommand[i].zName, -1, NULL, 0);
325359
 }
326360
 }
327361
328362
 /*
329
-** Register the Tcl language commands with interpreter interp.
330
-** Usually this is called soon after interpreter creation.
331
-*/
332
-int th_register_tcl(Th_Interp *interp){
333
- int i;
334
- Tcl_Interp *tclInterp = Tcl_CreateInterp();
363
+** Creates and initializes a Tcl interpreter for use with the specified TH1
364
+** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
365
+** by the caller.
366
+ */
367
+static int createTclInterp(
368
+ Th_Interp *interp,
369
+ void *pContext
370
+){
371
+ struct TclContext *tclContext = (struct TclContext *)pContext;
372
+ Tcl_Interp *tclInterp;
335373
374
+ if ( !tclContext ){
375
+ Th_ErrorMessage(interp,
376
+ "Invalid Tcl context", (const char *)"", 0);
377
+ return TH_ERROR;
378
+ }
379
+ if ( tclContext->interp ){
380
+ return TH_OK;
381
+ }
382
+ if ( tclContext->argc>0 && tclContext->argv ) {
383
+ Tcl_FindExecutable(tclContext->argv[0]);
384
+ }
385
+ tclInterp = tclContext->interp = Tcl_CreateInterp();
336386
 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
337387
 Th_ErrorMessage(interp,
338388
 "Could not create Tcl interpreter", (const char *)"", 0);
339389
 return TH_ERROR;
340390
 }
341391
 if( Tcl_Init(tclInterp)!=TCL_OK ){
342392
 Th_ErrorMessage(interp,
343393
 "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
344394
 Tcl_DeleteInterp(tclInterp);
395
+ tclContext->interp = tclInterp = 0;
345396
 return TH_ERROR;
346397
 }
347398
 /* Add the TH1 integration commands to Tcl. */
348399
 Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
349400
 Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
350401
 Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);
402
+ return TH_OK;
403
+}
404
+
405
+/*
406
+** Register the Tcl language commands with interpreter interp.
407
+** Usually this is called soon after interpreter creation.
408
+*/
409
+int th_register_tcl(
410
+ Th_Interp *interp,
411
+ void *pContext
412
+){
413
+ int i;
351414
 /* Add the Tcl integration commands to TH1. */
352415
 for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
353416
 void *ctx = aCommand[i].pContext;
354417
 /* Use Tcl interpreter for context? */
355
- if( !ctx ) ctx = tclInterp;
418
+ if( !ctx ) ctx = pContext;
356419
 Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
357420
 }
358421
 return TH_OK;
359422
 }
360423
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -39,10 +39,25 @@
39 for(i=1; i<argc; i++){ \
40 Tcl_DecrRefCount(objv[i-1]); \
41 } \
42 ckfree((char *)objv);
43
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
44 /*
45 ** Returns the Tcl interpreter result as a string with the associated length.
46 ** If the Tcl interpreter or the Tcl result are NULL, the length will be 0.
47 ** If the length pointer is NULL, the length will not be stored.
48 */
@@ -61,10 +76,20 @@
61 return 0;
62 }
63 return Tcl_GetStringFromObj(resultPtr, pN);
64 }
65
 
 
 
 
 
 
 
 
 
 
66 /*
67 ** Syntax:
68 **
69 ** tclEval arg ?arg ...?
70 */
@@ -79,14 +104,17 @@
79 Tcl_Obj *objPtr;
80 int rc;
81 int nResult;
82 const char *zResult;
83
 
 
 
84 if( argc<2 ){
85 return Th_WrongNumArgs(interp, "tclEval arg ?arg ...?");
86 }
87 tclInterp = (Tcl_Interp *)ctx;
88 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
89 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
90 return TH_ERROR;
91 }
92 Tcl_Preserve((ClientData)tclInterp);
@@ -127,14 +155,17 @@
127 Tcl_Obj *resultObjPtr;
128 int rc;
129 int nResult;
130 const char *zResult;
131
 
 
 
132 if( argc<2 ){
133 return Th_WrongNumArgs(interp, "tclExpr arg ?arg ...?");
134 }
135 tclInterp = (Tcl_Interp *)ctx;
136 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
137 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
138 return TH_ERROR;
139 }
140 Tcl_Preserve((ClientData)tclInterp);
@@ -186,14 +217,17 @@
186 #ifndef USE_TCL_EVALOBJV
187 Tcl_Obj *objPtr;
188 #endif
189 USE_ARGV_TO_OBJV();
190
 
 
 
191 if( argc<2 ){
192 return Th_WrongNumArgs(interp, "tclInvoke command ?arg ...?");
193 }
194 tclInterp = (Tcl_Interp *)ctx;
195 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
196 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
197 return TH_ERROR;
198 }
199 Tcl_Preserve((ClientData)tclInterp);
@@ -324,36 +358,65 @@
324 Th_RenameCommand(th1Interp, aCommand[i].zName, -1, NULL, 0);
325 }
326 }
327
328 /*
329 ** Register the Tcl language commands with interpreter interp.
330 ** Usually this is called soon after interpreter creation.
331 */
332 int th_register_tcl(Th_Interp *interp){
333 int i;
334 Tcl_Interp *tclInterp = Tcl_CreateInterp();
 
 
 
 
335
 
 
 
 
 
 
 
 
 
 
 
 
336 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
337 Th_ErrorMessage(interp,
338 "Could not create Tcl interpreter", (const char *)"", 0);
339 return TH_ERROR;
340 }
341 if( Tcl_Init(tclInterp)!=TCL_OK ){
342 Th_ErrorMessage(interp,
343 "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
344 Tcl_DeleteInterp(tclInterp);
 
345 return TH_ERROR;
346 }
347 /* Add the TH1 integration commands to Tcl. */
348 Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
349 Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
350 Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);
 
 
 
 
 
 
 
 
 
 
 
 
351 /* Add the Tcl integration commands to TH1. */
352 for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
353 void *ctx = aCommand[i].pContext;
354 /* Use Tcl interpreter for context? */
355 if( !ctx ) ctx = tclInterp;
356 Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
357 }
358 return TH_OK;
359 }
360
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -39,10 +39,25 @@
39 for(i=1; i<argc; i++){ \
40 Tcl_DecrRefCount(objv[i-1]); \
41 } \
42 ckfree((char *)objv);
43
44 /*
45 ** Fetch the Tcl interpreter from the specified void pointer, cast to a Tcl
46 ** context.
47 */
48 #define GET_CTX_TCL_INTERP(ctx) \
49 ((struct TclContext *)(ctx))->interp
50
51 /*
52 ** Creates and initializes a Tcl interpreter for use with the specified TH1
53 ** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
54 ** by the caller. This must be declared here because quite a few functions in
55 ** this file need to use it before it can be defined.
56 */
57 static int createTclInterp(Th_Interp *interp, void *pContext);
58
59 /*
60 ** Returns the Tcl interpreter result as a string with the associated length.
61 ** If the Tcl interpreter or the Tcl result are NULL, the length will be 0.
62 ** If the length pointer is NULL, the length will not be stored.
63 */
@@ -61,10 +76,20 @@
76 return 0;
77 }
78 return Tcl_GetStringFromObj(resultPtr, pN);
79 }
80
81 /*
82 ** Tcl context information used by TH1. This structure definition has been
83 ** copied from and should be kept in sync with the one in "main.c".
84 */
85 struct TclContext {
86 int argc;
87 char **argv;
88 Tcl_Interp *interp;
89 };
90
91 /*
92 ** Syntax:
93 **
94 ** tclEval arg ?arg ...?
95 */
@@ -79,14 +104,17 @@
104 Tcl_Obj *objPtr;
105 int rc;
106 int nResult;
107 const char *zResult;
108
109 if ( createTclInterp(interp, ctx)!=TH_OK ){
110 return TH_ERROR;
111 }
112 if( argc<2 ){
113 return Th_WrongNumArgs(interp, "tclEval arg ?arg ...?");
114 }
115 tclInterp = GET_CTX_TCL_INTERP(ctx);
116 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
117 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
118 return TH_ERROR;
119 }
120 Tcl_Preserve((ClientData)tclInterp);
@@ -127,14 +155,17 @@
155 Tcl_Obj *resultObjPtr;
156 int rc;
157 int nResult;
158 const char *zResult;
159
160 if ( createTclInterp(interp, ctx)!=TH_OK ){
161 return TH_ERROR;
162 }
163 if( argc<2 ){
164 return Th_WrongNumArgs(interp, "tclExpr arg ?arg ...?");
165 }
166 tclInterp = GET_CTX_TCL_INTERP(ctx);
167 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
168 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
169 return TH_ERROR;
170 }
171 Tcl_Preserve((ClientData)tclInterp);
@@ -186,14 +217,17 @@
217 #ifndef USE_TCL_EVALOBJV
218 Tcl_Obj *objPtr;
219 #endif
220 USE_ARGV_TO_OBJV();
221
222 if ( createTclInterp(interp, ctx)!=TH_OK ){
223 return TH_ERROR;
224 }
225 if( argc<2 ){
226 return Th_WrongNumArgs(interp, "tclInvoke command ?arg ...?");
227 }
228 tclInterp = GET_CTX_TCL_INTERP(ctx);
229 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
230 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
231 return TH_ERROR;
232 }
233 Tcl_Preserve((ClientData)tclInterp);
@@ -324,36 +358,65 @@
358 Th_RenameCommand(th1Interp, aCommand[i].zName, -1, NULL, 0);
359 }
360 }
361
362 /*
363 ** Creates and initializes a Tcl interpreter for use with the specified TH1
364 ** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
365 ** by the caller.
366 */
367 static int createTclInterp(
368 Th_Interp *interp,
369 void *pContext
370 ){
371 struct TclContext *tclContext = (struct TclContext *)pContext;
372 Tcl_Interp *tclInterp;
373
374 if ( !tclContext ){
375 Th_ErrorMessage(interp,
376 "Invalid Tcl context", (const char *)"", 0);
377 return TH_ERROR;
378 }
379 if ( tclContext->interp ){
380 return TH_OK;
381 }
382 if ( tclContext->argc>0 && tclContext->argv ) {
383 Tcl_FindExecutable(tclContext->argv[0]);
384 }
385 tclInterp = tclContext->interp = Tcl_CreateInterp();
386 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
387 Th_ErrorMessage(interp,
388 "Could not create Tcl interpreter", (const char *)"", 0);
389 return TH_ERROR;
390 }
391 if( Tcl_Init(tclInterp)!=TCL_OK ){
392 Th_ErrorMessage(interp,
393 "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
394 Tcl_DeleteInterp(tclInterp);
395 tclContext->interp = tclInterp = 0;
396 return TH_ERROR;
397 }
398 /* Add the TH1 integration commands to Tcl. */
399 Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
400 Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
401 Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);
402 return TH_OK;
403 }
404
405 /*
406 ** Register the Tcl language commands with interpreter interp.
407 ** Usually this is called soon after interpreter creation.
408 */
409 int th_register_tcl(
410 Th_Interp *interp,
411 void *pContext
412 ){
413 int i;
414 /* Add the Tcl integration commands to TH1. */
415 for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
416 void *ctx = aCommand[i].pContext;
417 /* Use Tcl interpreter for context? */
418 if( !ctx ) ctx = pContext;
419 Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
420 }
421 return TH_OK;
422 }
423
M win/Makefile.mingw.mistachkin
+1 -1
--- win/Makefile.mingw.mistachkin
+++ win/Makefile.mingw.mistachkin
@@ -42,11 +42,11 @@
4242
 #### The directory where the OpenSSL library source code is located.
4343
 # The recommended usage here is to use the Sysinternals junction tool
4444
 # to create a hard link between an "openssl-1.x" sub-directory of the
4545
 # Fossil source code directory and the target OpenSSL source directory.
4646
 #
47
-OPENSSLDIR = $(SRCDIR)/../openssl-1.0.0d
47
+OPENSSLDIR = $(SRCDIR)/../openssl-1.0.0e
4848
4949
 #### Either the directory where the Tcl library is installed or the Tcl
5050
 # source code directory resides (depending on the value of the macro
5151
 # FOSSIL_TCL_SOURCE). If this points to the Tcl install directory,
5252
 # this directory must have "include" and "lib" sub-directories. If
5353
--- win/Makefile.mingw.mistachkin
+++ win/Makefile.mingw.mistachkin
@@ -42,11 +42,11 @@
42 #### The directory where the OpenSSL library source code is located.
43 # The recommended usage here is to use the Sysinternals junction tool
44 # to create a hard link between an "openssl-1.x" sub-directory of the
45 # Fossil source code directory and the target OpenSSL source directory.
46 #
47 OPENSSLDIR = $(SRCDIR)/../openssl-1.0.0d
48
49 #### Either the directory where the Tcl library is installed or the Tcl
50 # source code directory resides (depending on the value of the macro
51 # FOSSIL_TCL_SOURCE). If this points to the Tcl install directory,
52 # this directory must have "include" and "lib" sub-directories. If
53
--- win/Makefile.mingw.mistachkin
+++ win/Makefile.mingw.mistachkin
@@ -42,11 +42,11 @@
42 #### The directory where the OpenSSL library source code is located.
43 # The recommended usage here is to use the Sysinternals junction tool
44 # to create a hard link between an "openssl-1.x" sub-directory of the
45 # Fossil source code directory and the target OpenSSL source directory.
46 #
47 OPENSSLDIR = $(SRCDIR)/../openssl-1.0.0e
48
49 #### Either the directory where the Tcl library is installed or the Tcl
50 # source code directory resides (depending on the value of the macro
51 # FOSSIL_TCL_SOURCE). If this points to the Tcl install directory,
52 # this directory must have "include" and "lib" sub-directories. If
53

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button