Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Further improvements to the Tcl integration subsystem. |
|---|---|
| Downloads: | Tarball | ZIP archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
18fc492a95b0ce408a9a84abfa0eb8d4 |
| User & Date: | mistachkin 2015-06-11 21:25:30.287 |
Context
|
2015-06-13
| ||
| 18:47 | Fix missing parenthesis on index page, remove trailing spaces. Other minor improvements. ... (check-in: 09fee89348 user: mistachkin tags: trunk) | |
|
2015-06-11
| ||
| 21:50 | merge trunk ... (check-in: 5e9253da21 user: jan.nijtmans tags: exec-rel-paths) | |
| 21:25 | Further improvements to the Tcl integration subsystem. ... (check-in: 18fc492a95 user: mistachkin tags: trunk) | |
| 17:10 | Update referenced OpenSSL version. ... (check-in: 0626182eb3 user: mistachkin tags: trunk) | |
Changes
Changes to src/diffcmd.c.
| ︙ | ︙ | |||
660 661 662 663 664 665 666 |
if( zTempFile ){
blob_write_to_file(&script, zTempFile);
fossil_print("To see diff, run: tclsh \"%s\"\n", zTempFile);
}else{
#if defined(FOSSIL_ENABLE_TCL)
Th_FossilInit(TH_INIT_DEFAULT);
if( evaluateTclWithEvents(g.interp, &g.tcl, blob_str(&script),
| | | 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 |
if( zTempFile ){
blob_write_to_file(&script, zTempFile);
fossil_print("To see diff, run: tclsh \"%s\"\n", zTempFile);
}else{
#if defined(FOSSIL_ENABLE_TCL)
Th_FossilInit(TH_INIT_DEFAULT);
if( evaluateTclWithEvents(g.interp, &g.tcl, blob_str(&script),
blob_size(&script), 1, 1, 0)==TCL_OK ){
blob_reset(&script);
return;
}
/*
* If evaluation of the Tcl script fails, the reason may be that Tk
* could not be found by the loaded Tcl, or that Tcl cannot be loaded
* dynamically (e.g. x64 Tcl with x86 Fossil). Therefore, fallback
|
| ︙ | ︙ |
Changes to src/main.c.
| ︙ | ︙ | |||
107 108 109 110 111 112 113 114 115 116 117 118 119 120 | void *hLibrary; /* The Tcl library module handle. */ void *xFindExecutable; /* See tcl_FindExecutableProc in th_tcl.c. */ void *xCreateInterp; /* See tcl_CreateInterpProc in th_tcl.c. */ void *xDeleteInterp; /* See tcl_DeleteInterpProc in th_tcl.c. */ void *xFinalize; /* See tcl_FinalizeProc in th_tcl.c. */ Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */ int useObjProc; /* Non-zero if an objProc can be called directly. */ char *setup; /* The optional Tcl setup script. */ void *xPreEval; /* Optional, called before Tcl_Eval*(). */ void *pPreContext; /* Optional, provided to xPreEval(). */ void *xPostEval; /* Optional, called after Tcl_Eval*(). */ void *pPostContext; /* Optional, provided to xPostEval(). */ }; #endif | > | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | void *hLibrary; /* The Tcl library module handle. */ void *xFindExecutable; /* See tcl_FindExecutableProc in th_tcl.c. */ void *xCreateInterp; /* See tcl_CreateInterpProc in th_tcl.c. */ void *xDeleteInterp; /* See tcl_DeleteInterpProc in th_tcl.c. */ void *xFinalize; /* See tcl_FinalizeProc in th_tcl.c. */ Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */ int useObjProc; /* Non-zero if an objProc can be called directly. */ int useTip285; /* Non-zero if TIP #285 is available. */ char *setup; /* The optional Tcl setup script. */ void *xPreEval; /* Optional, called before Tcl_Eval*(). */ void *pPreContext; /* Optional, provided to xPreEval(). */ void *xPostEval; /* Optional, called after Tcl_Eval*(). */ void *pPostContext; /* Optional, provided to xPostEval(). */ }; #endif |
| ︙ | ︙ |
Changes to src/th.h.
| ︙ | ︙ | |||
170 171 172 173 174 175 176 | #ifdef FOSSIL_ENABLE_TCL /* ** Interfaces to the full Tcl core library from "th_tcl.c". */ int th_register_tcl(Th_Interp *, void *); int unloadTcl(Th_Interp *, void *); | | | 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 | #ifdef FOSSIL_ENABLE_TCL /* ** Interfaces to the full Tcl core library from "th_tcl.c". */ int th_register_tcl(Th_Interp *, void *); int unloadTcl(Th_Interp *, void *); int evaluateTclWithEvents(Th_Interp *,void *,const char *,int,int,int,int); #endif /* ** General purpose hash table from th_lang.c. */ typedef struct Th_Hash Th_Hash; typedef struct Th_HashEntry Th_HashEntry; |
| ︙ | ︙ |
Changes to src/th_tcl.c.
| ︙ | ︙ | |||
165 166 167 168 169 170 171 | ** when the Tcl library is being loaded dynamically by a stubs-enabled ** application (i.e. the inverse of using a stubs-enabled package). These are ** the only Tcl API functions that MUST be called prior to being able to call ** Tcl_InitStubs (i.e. because it requires a Tcl interpreter). For complete ** cleanup if the Tcl stubs initialization fails somehow, the Tcl_DeleteInterp ** and Tcl_Finalize function types are also required. */ | | | | 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 | ** when the Tcl library is being loaded dynamically by a stubs-enabled ** application (i.e. the inverse of using a stubs-enabled package). These are ** the only Tcl API functions that MUST be called prior to being able to call ** Tcl_InitStubs (i.e. because it requires a Tcl interpreter). For complete ** cleanup if the Tcl stubs initialization fails somehow, the Tcl_DeleteInterp ** and Tcl_Finalize function types are also required. */ typedef void (tcl_FindExecutableProc) (const char *); typedef Tcl_Interp *(tcl_CreateInterpProc) (void); typedef void (tcl_DeleteInterpProc) (Tcl_Interp *); typedef void (tcl_FinalizeProc) (void); /* ** The function types for the "hook" functions to be called before and after a ** TH1 command makes a call to evaluate a Tcl script. If the "pre" function ** returns anything but TH_OK, then evaluation of the Tcl script is skipped and ** that value is used as the return code. If the "post" function returns |
| ︙ | ︙ | |||
275 276 277 278 279 280 281 282 283 284 285 286 287 288 |
return 0; /* NOTE: Disabled on Tcl 8.4, missing public API. */
}
if( major==8 && minor==6 && type==TCL_BETA_RELEASE && patchLevel<3 ){
return 0; /* NOTE: Disabled on Tcl 8.6b1/b2, SF bug #3399564. */
}
return 1; /* NOTE: For all other cases, assume good. */
}
/*
** Creates and initializes a Tcl interpreter for use with the specified TH1
** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
** by the caller. This must be declared here because quite a few functions in
** this file need to use it before it can be defined.
*/
| > > > > > > > > > > > > > > > | 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 |
return 0; /* NOTE: Disabled on Tcl 8.4, missing public API. */
}
if( major==8 && minor==6 && type==TCL_BETA_RELEASE && patchLevel<3 ){
return 0; /* NOTE: Disabled on Tcl 8.6b1/b2, SF bug #3399564. */
}
return 1; /* NOTE: For all other cases, assume good. */
}
/*
** Is the loaded version of Tcl one where TIP #285 (asynchronous script
** cancellation) is available? This should return non-zero only for Tcl
** 8.6 and higher.
*/
static int canUseTip285(){
int major = -1, minor = -1, patchLevel = -1, type = -1;
Tcl_GetVersion(&major, &minor, &patchLevel, &type);
if( major<0 || minor<0 || patchLevel<0 || type<0 ){
return 0; /* NOTE: Invalid version info, assume bad. */
}
return (major>8 || (major==8 && minor>=6));
}
/*
** Creates and initializes a Tcl interpreter for use with the specified TH1
** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
** by the caller. This must be declared here because quite a few functions in
** this file need to use it before it can be defined.
*/
|
| ︙ | ︙ | |||
377 378 379 380 381 382 383 384 385 386 387 388 389 390 | void *hLibrary; /* The Tcl library module handle. */ tcl_FindExecutableProc *xFindExecutable; /* Tcl_FindExecutable() pointer. */ tcl_CreateInterpProc *xCreateInterp; /* Tcl_CreateInterp() pointer. */ tcl_DeleteInterpProc *xDeleteInterp; /* Tcl_DeleteInterp() pointer. */ tcl_FinalizeProc *xFinalize; /* Tcl_Finalize() pointer. */ Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */ int useObjProc; /* Non-zero if an objProc can be called directly. */ char *setup; /* The optional Tcl setup script. */ tcl_NotifyProc *xPreEval; /* Optional, called before Tcl_Eval*(). */ void *pPreContext; /* Optional, provided to xPreEval(). */ tcl_NotifyProc *xPostEval; /* Optional, called after Tcl_Eval*(). */ void *pPostContext; /* Optional, provided to xPostEval(). */ }; | > | 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 | void *hLibrary; /* The Tcl library module handle. */ tcl_FindExecutableProc *xFindExecutable; /* Tcl_FindExecutable() pointer. */ tcl_CreateInterpProc *xCreateInterp; /* Tcl_CreateInterp() pointer. */ tcl_DeleteInterpProc *xDeleteInterp; /* Tcl_DeleteInterp() pointer. */ tcl_FinalizeProc *xFinalize; /* Tcl_Finalize() pointer. */ Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */ int useObjProc; /* Non-zero if an objProc can be called directly. */ int useTip285; /* Non-zero if TIP #285 is available. */ char *setup; /* The optional Tcl setup script. */ tcl_NotifyProc *xPreEval; /* Optional, called before Tcl_Eval*(). */ void *pPreContext; /* Optional, provided to xPreEval(). */ tcl_NotifyProc *xPostEval; /* Optional, called after Tcl_Eval*(). */ void *pPostContext; /* Optional, provided to xPostEval(). */ }; |
| ︙ | ︙ | |||
921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 |
void fossil_print(const char *zFormat, ...); /* printf.h */
int evaluateTclWithEvents(
Th_Interp *interp,
void *pContext,
const char *zScript,
int nScript,
int bWait,
int bVerbose
){
struct TclContext *tclContext = (struct TclContext *)pContext;
Tcl_Interp *tclInterp;
int rc;
int flags = TCL_ALL_EVENTS;
if( createTclInterp(interp, pContext)!=TH_OK ){
return TH_ERROR;
}
tclInterp = tclContext->interp;
rc = Tcl_EvalEx(tclInterp, zScript, nScript, TCL_EVAL_GLOBAL);
if( rc!=TCL_OK ){
if( bVerbose ){
const char *zResult = getTclResult(tclInterp, 0);
fossil_print("%s: ", getTclReturnCodeName(rc, 0));
fossil_print("%s\n", zResult);
}
return rc;
}
if( !bWait ) flags |= TCL_DONT_WAIT;
while( Tcl_DoOneEvent(flags) ){
| > > > > < > > | > > > > > | 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 |
void fossil_print(const char *zFormat, ...); /* printf.h */
int evaluateTclWithEvents(
Th_Interp *interp,
void *pContext,
const char *zScript,
int nScript,
int bCancel,
int bWait,
int bVerbose
){
struct TclContext *tclContext = (struct TclContext *)pContext;
Tcl_Interp *tclInterp;
int rc;
int flags = TCL_ALL_EVENTS;
int useTip285;
if( createTclInterp(interp, pContext)!=TH_OK ){
return TH_ERROR;
}
tclInterp = tclContext->interp;
useTip285 = bCancel ? tclContext->useTip285 : 0;
rc = Tcl_EvalEx(tclInterp, zScript, nScript, TCL_EVAL_GLOBAL);
if( rc!=TCL_OK ){
if( bVerbose ){
const char *zResult = getTclResult(tclInterp, 0);
fossil_print("%s: ", getTclReturnCodeName(rc, 0));
fossil_print("%s\n", zResult);
}
return rc;
}
if( !bWait ) flags |= TCL_DONT_WAIT;
Tcl_Preserve((ClientData)tclInterp);
while( Tcl_DoOneEvent(flags) ){
if( Tcl_InterpDeleted(tclInterp) ){
break;
}
if( useTip285 && Tcl_Canceled(tclInterp, 0)!=TCL_OK ){
break;
}
}
Tcl_Release((ClientData)tclInterp);
return rc;
}
/*
** Creates and initializes a Tcl interpreter for use with the specified TH1
** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
** by the caller.
|
| ︙ | ︙ | |||
1030 1031 1032 1033 1034 1035 1036 |
Th_ErrorMessage(interp,
"Tcl error setting arguments:", Tcl_GetStringResult(tclInterp), -1);
Tcl_DeleteInterp(tclInterp);
tclContext->interp = tclInterp = 0;
return TH_ERROR;
}
/*
| | | > > > > > | 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 |
Th_ErrorMessage(interp,
"Tcl error setting arguments:", Tcl_GetStringResult(tclInterp), -1);
Tcl_DeleteInterp(tclInterp);
tclContext->interp = tclInterp = 0;
return TH_ERROR;
}
/*
** Determine (and cache) if an objProc can be called directly for a Tcl
** command invoked via the tclInvoke TH1 command.
*/
tclContext->useObjProc = canUseObjProc();
/*
** Determine (and cache) whether or not we can use TIP #285 (asynchronous
** script cancellation).
*/
tclContext->useTip285 = canUseTip285();
/* Add the TH1 integration commands to Tcl. */
Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);
/* If necessary, evaluate the custom Tcl setup script. */
setup = tclContext->setup;
if( setup && Tcl_Eval(tclInterp, setup)!=TCL_OK ){
|
| ︙ | ︙ |